Commit 6897a51e authored by Petr Pudlak's avatar Petr Pudlak

Use a data type when generating Python types of OpCodes

Currently they are generated only as Strings.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarJose A. Lopes <jabolopes@google.com>
parent 0d78accc
......@@ -129,6 +129,7 @@ HS_DIRS = \
src/Ganeti/Storage/Diskstats \
src/Ganeti/Storage/Drbd \
src/Ganeti/Storage/Lvm \
src/Ganeti/THH \
test/hs \
test/hs/Test \
test/hs/Test/Ganeti \
......@@ -726,6 +727,7 @@ HS_LIB_SRCS = \
src/Ganeti/Storage/Lvm/Types.hs \
src/Ganeti/Storage/Utils.hs \
src/Ganeti/THH.hs \
src/Ganeti/THH/PyType.hs \
src/Ganeti/Types.hs \
src/Ganeti/UDSServer.hs \
src/Ganeti/Utils.hs
......
......@@ -44,9 +44,10 @@ pyClassDoc doc
-- | Generates an opcode parameter in Python.
pyClassField :: OpCodeField -> String
pyClassField (OpCodeField name typ Nothing doc) =
"(" ++ intercalate ", " [show name, "None", typ, show doc] ++ ")"
"(" ++ intercalate ", " [show name, "None", showValue typ, show doc] ++ ")"
pyClassField (OpCodeField name typ (Just def) doc) =
"(" ++ intercalate ", " [show name, showValue def, typ, show doc] ++ ")"
"(" ++ intercalate ", "
[show name, showValue def, showValue typ, show doc] ++ ")"
-- | Comma intercalates and indents opcode parameters in Python.
intercalateIndent :: [String] -> String
......@@ -72,7 +73,7 @@ showPyClass (OpCodeDescriptor name typ doc fields dsc) =
" OP_PARAMS = [" ++
intercalateIndent (map pyClassField fields) ++
"\n ]" ++ "\n" ++
" OP_RESULT = " ++ typ ++
" OP_RESULT = " ++ showValue typ ++
withLU ++ "\n\n"
-- | Generates all opcodes as Python classes.
......
......@@ -10,7 +10,7 @@ needs in this module (except the one for unittests).
{-
Copyright (C) 2011, 2012 Google Inc.
Copyright (C) 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
......@@ -81,6 +81,7 @@ import Text.JSON.Pretty (pp_value)
import Ganeti.JSON
import Ganeti.PyValue
import Ganeti.THH.PyType
-- * Exported types
......@@ -587,7 +588,7 @@ type OpParam = (String, Q Type, Q Exp)
-- * Python code generation
data OpCodeField = OpCodeField { ocfName :: String
, ocfType :: String
, ocfType :: PyType
, ocfDefl :: Maybe PyValueEx
, ocfDoc :: String
}
......@@ -595,87 +596,12 @@ data OpCodeField = OpCodeField { ocfName :: String
-- | Transfers opcode data between the opcode description (through
-- @genOpCode@) and the Python code generation functions.
data OpCodeDescriptor = OpCodeDescriptor { ocdName :: String
, ocdType :: String
, ocdType :: PyType
, ocdDoc :: String
, ocdFields :: [OpCodeField]
, ocdDescr :: String
}
-- | Strips out the module name
--
-- @
-- pyBaseName "Data.Map" = "Map"
-- @
pyBaseName :: String -> String
pyBaseName str =
case span (/= '.') str of
(x, []) -> x
(_, _:x) -> pyBaseName x
-- | Converts a Haskell type name into a Python type name.
--
-- @
-- pyTypename "Bool" = "ht.TBool"
-- @
pyTypeName :: Show a => a -> String
pyTypeName name =
"ht.T" ++ (case pyBaseName (show name) of
"()" -> "None"
"Map" -> "DictOf"
"Set" -> "SetOf"
"ListSet" -> "SetOf"
"Either" -> "Or"
"GenericContainer" -> "DictOf"
"JSValue" -> "Any"
"JSObject" -> "Object"
str -> str)
-- | Converts a Haskell type into a Python type.
--
-- @
-- pyType [Int] = "ht.TListOf(ht.TInt)"
-- @
pyType :: Type -> Q String
pyType (AppT typ1 typ2) =
do t <- pyCall typ1 typ2
return $ t ++ ")"
pyType (ConT name) = return (pyTypeName name)
pyType ListT = return "ht.TListOf"
pyType (TupleT 0) = return "ht.TNone"
pyType (TupleT _) = return "ht.TTupleOf"
pyType typ = error $ "unhandled case for type " ++ show typ
-- | Converts a Haskell type application into a Python type.
--
-- @
-- Maybe Int = "ht.TMaybe(ht.TInt)"
-- @
pyCall :: Type -> Type -> Q String
pyCall (AppT typ1 typ2) arg =
do t <- pyCall typ1 typ2
targ <- pyType arg
return $ t ++ ", " ++ targ
pyCall typ1 typ2 =
do t1 <- pyType typ1
t2 <- pyType typ2
return $ t1 ++ "(" ++ t2
-- | @pyType opt typ@ converts Haskell type @typ@ into a Python type,
-- where @opt@ determines if the converted type is optional (i.e.,
-- Maybe).
--
-- @
-- pyType False [Int] = "ht.TListOf(ht.TInt)" (mandatory)
-- pyType True [Int] = "ht.TMaybe(ht.TListOf(ht.TInt))" (optional)
-- @
pyOptionalType :: Bool -> Type -> Q String
pyOptionalType opt typ
| opt = do t <- pyType typ
return $ "ht.TMaybe(" ++ t ++ ")"
| otherwise = pyType typ
-- | Optionally encapsulates default values in @PyValueEx@.
--
-- @maybeApp exp typ@ returns a quoted expression that encapsulates
......@@ -689,14 +615,15 @@ maybeApp Nothing _ =
maybeApp (Just expr) typ =
[| Just ($(conE (mkName "PyValueEx")) ($expr :: $typ)) |]
-- | Generates a Python type according to whether the field is
-- optional
genPyType' :: OptionalType -> Q Type -> Q Exp
genPyType' opt typ = typ >>= pyOptionalType (opt /= NotOptional) >>= stringE
-- optional.
--
-- The type of created expression is PyType.
genPyType' :: OptionalType -> Q Type -> Q PyType
genPyType' opt typ = typ >>= pyOptionalType (opt /= NotOptional)
-- | Generates Python types from opcode parameters.
genPyType :: Field -> Q Exp
genPyType :: Field -> Q PyType
genPyType f = genPyType' (fieldIsOptional f) (fieldType f)
-- | Generates Python default values from opcode parameters.
......@@ -704,8 +631,9 @@ genPyDefault :: Field -> Q Exp
genPyDefault f = maybeApp (fieldDefault f) (fieldType f)
pyField :: Field -> Q Exp
pyField f = [| OpCodeField $(stringE (fieldName f))
$(genPyType f)
pyField f = genPyType f >>= \t ->
[| OpCodeField $(stringE (fieldName f))
t
$(genPyDefault f)
$(stringE (fieldDoc f)) |]
......@@ -715,10 +643,10 @@ pyClass :: OpCodeConstructor -> Q Exp
pyClass (consName, consType, consDoc, consFields, consDscField) =
do let pyClassVar = varNameE "showPyClass"
consName' = stringE consName
let consType' = genPyType' NotOptional consType
consType' <- genPyType' NotOptional consType
let consDoc' = stringE consDoc
[| OpCodeDescriptor $consName'
$consType'
consType'
$consDoc'
$(listE $ map pyField consFields)
consDscField |]
......
{-# LANGUAGE TemplateHaskell #-}
{-| PyType helper for Ganeti Haskell code.
-}
{-
Copyright (C) 2013 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
-}
module Ganeti.THH.PyType
( PyType(..)
, pyType
, pyOptionalType
) where
import Control.Applicative
import Control.Monad
import Data.List (intercalate)
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (Lift(..))
import Ganeti.PyValue
-- | Represents a Python encoding of types.
data PyType
= PTMaybe PyType
| PTApp PyType [PyType]
| PTOther String
| PTAny
| PTDictOf
| PTListOf
| PTNone
| PTObject
| PTOr
| PTSetOf
| PTTupleOf
deriving (Show, Eq, Ord)
-- TODO: We could use th-lift to generate this instance automatically.
instance Lift PyType where
lift (PTMaybe x) = [| PTMaybe x |]
lift (PTApp tf as) = [| PTApp tf as |]
lift (PTOther i) = [| PTOther i |]
lift PTAny = [| PTAny |]
lift PTDictOf = [| PTDictOf |]
lift PTListOf = [| PTListOf |]
lift PTNone = [| PTNone |]
lift PTObject = [| PTObject |]
lift PTOr = [| PTOr |]
lift PTSetOf = [| PTSetOf |]
lift PTTupleOf = [| PTTupleOf |]
instance PyValue PyType where
showValue (PTMaybe x) = ptApp (ht "Maybe") [x]
showValue (PTApp tf as) = ptApp (showValue tf) as
showValue (PTOther i) = ht i
showValue PTAny = ht "Any"
showValue PTDictOf = ht "DictOf"
showValue PTListOf = ht "ListOf"
showValue PTNone = ht "None"
showValue PTObject = ht "Object"
showValue PTOr = ht "Or"
showValue PTSetOf = ht "SetOf"
showValue PTTupleOf = ht "TupleOf"
ht :: String -> String
ht = ("ht.T" ++)
ptApp :: String -> [PyType] -> String
ptApp name ts = name ++ "(" ++ intercalate ", " (map showValue ts) ++ ")"
-- | Converts a Haskell type name into a Python type name.
pyTypeName :: Name -> PyType
pyTypeName name =
case nameBase name of
"()" -> PTNone
"Map" -> PTDictOf
"Set" -> PTSetOf
"ListSet" -> PTSetOf
"Either" -> PTOr
"GenericContainer" -> PTDictOf
"JSValue" -> PTAny
"JSObject" -> PTObject
str -> PTOther str
-- | Converts a Haskell type into a Python type.
pyType :: Type -> Q PyType
pyType t | not (null args) = PTApp `liftM` pyType fn `ap` mapM pyType args
where (fn, args) = pyAppType t
pyType (ConT name) = return $ pyTypeName name
pyType ListT = return PTListOf
pyType (TupleT 0) = return PTNone
pyType (TupleT _) = return PTTupleOf
pyType typ = fail $ "unhandled case for type " ++ show typ
-- | Returns a type and its type arguments.
pyAppType :: Type -> (Type, [Type])
pyAppType = g []
where
g as (AppT typ1 typ2) = g (typ2 : as) typ1
g as typ = (typ, as)
-- | @pyType opt typ@ converts Haskell type @typ@ into a Python type,
-- where @opt@ determines if the converted type is optional (i.e.,
-- Maybe).
pyOptionalType :: Bool -> Type -> Q PyType
pyOptionalType True typ = PTMaybe <$> pyType typ
pyOptionalType False typ = pyType typ
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment