On Fri, Dec 13, 2013 at 12:47:52PM +0100, Petr Pudlak wrote:
> This greatly enhances code readability.
>
> Also fix monadic types "Q ExpQ" [which is "Q (Q Exp)"] to "Q Exp".
>
> Signed-off-by: Petr Pudlak <[email protected]>
> ---
> src/Ganeti/Hs2Py/GenOpCodes.hs | 12 ++++----
> src/Ganeti/THH.hs | 65
> ++++++++++++++++++++++++------------------
> 2 files changed, 44 insertions(+), 33 deletions(-)
>
> diff --git a/src/Ganeti/Hs2Py/GenOpCodes.hs b/src/Ganeti/Hs2Py/GenOpCodes.hs
> index 0683b5d..5f0c48c 100644
> --- a/src/Ganeti/Hs2Py/GenOpCodes.hs
> +++ b/src/Ganeti/Hs2Py/GenOpCodes.hs
> @@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
> MA
>
> module Ganeti.Hs2Py.GenOpCodes (showPyClasses) where
>
> -import Data.List (intercalate, zipWith4)
> +import Data.List (intercalate)
>
> import Ganeti.OpCodes
> import Ganeti.THH
> @@ -42,11 +42,11 @@ pyClassDoc doc
> " \"\"\"" ++ doc ++ "\"\"\"" ++ "\n"
>
> -- | Generates an opcode parameter in Python.
> -pyClassField :: String -> String -> Maybe PyValueEx -> String -> String
> -pyClassField name typ Nothing doc =
> +pyClassField :: OpCodeField -> String
> +pyClassField (OpCodeField name typ Nothing doc) =
> "(" ++ intercalate ", " [show name, "None", typ, show doc] ++ ")"
>
Trailing whitespace.
> -pyClassField name typ (Just (PyValueEx def)) doc =
> +pyClassField (OpCodeField name typ (Just def) doc) =
> "(" ++ intercalate ", " [show name, showValue def, typ, show doc] ++ ")"
>
Trailing whitespace.
> -- | Comma intercalates and indents opcode parameters in Python.
> @@ -55,7 +55,7 @@ intercalateIndent xs = intercalate "," (map ("\n " ++)
> xs)
>
> -- | Generates an opcode as a Python class.
> showPyClass :: OpCodeDescriptor -> String
> -showPyClass (name, typ, doc, fields, types, defs, docs, dsc) =
> +showPyClass (OpCodeDescriptor name typ doc fields dsc) =
> let
> baseclass
> | name == "OpInstanceMultiAlloc" = "OpInstanceMultiAllocBase"
> @@ -71,7 +71,7 @@ showPyClass (name, typ, doc, fields, types, defs, docs,
> dsc) =
> pyClassDoc doc ++
> opDscField ++
> " OP_PARAMS = [" ++
> - intercalateIndent (zipWith4 pyClassField fields types defs docs) ++
> + intercalateIndent (map pyClassField fields) ++
> "\n ]" ++ "\n" ++
> " OP_RESULT = " ++ typ ++
> withLU ++ "\n\n"
> diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs
> index 7728e4d..c6b48e6 100644
> --- a/src/Ganeti/THH.hs
> +++ b/src/Ganeti/THH.hs
> @@ -40,7 +40,8 @@ module Ganeti.THH ( declareSADT
> , genAllOpIDs
> , PyValue(..)
> , PyValueEx(..)
> - , OpCodeDescriptor
> + , OpCodeField(..)
> + , OpCodeDescriptor(..)
> , genOpCode
> , genStrOfOp
> , genStrOfKey
> @@ -67,9 +68,11 @@ module Ganeti.THH ( declareSADT
> , excErrMsg
> ) where
>
> -import Control.Monad (liftM)
> +import Control.Applicative
> +import Control.Monad
> import Data.Char
> import Data.List
> +import Data.Maybe
> import qualified Data.Set as Set
> import Language.Haskell.TH
>
> @@ -79,8 +82,6 @@ import Text.JSON.Pretty (pp_value)
> import Ganeti.JSON
> import Ganeti.PyValue
>
> -import Data.Maybe
> -import Data.Functor ((<$>))
>
> -- * Exported types
>
> @@ -585,11 +586,20 @@ type OpParam = (String, Q Type, Q Exp)
>
> -- * Python code generation
>
> +data OpCodeField = OpCodeField { ocfName :: String
> + , ocfType :: String
> + , ocfDefl :: Maybe PyValueEx
> + , ocfDoc :: String
> + }
> +
> -- | Transfers opcode data between the opcode description (through
> -- @genOpCode@) and the Python code generation functions.
> -type OpCodeDescriptor =
> - (String, String, String, [String],
> - [String], [Maybe PyValueEx], [String], String)
> +data OpCodeDescriptor = OpCodeDescriptor { ocdName :: String
> + , ocdType :: String
> + , ocdDoc :: String
> + , ocdFields :: [OpCodeField]
> + , ocdDescr :: String
> + }
>
> -- | Strips out the module name
> --
> @@ -682,41 +692,42 @@ maybeApp (Just expr) typ =
>
> -- | Generates a Python type according to whether the field is
> -- optional
> -genPyType :: OptionalType -> Q Type -> Q ExpQ
> -genPyType opt typ =
> - do t <- typ
> - stringE <$> pyOptionalType (opt /= NotOptional) t
> +genPyType' :: OptionalType -> Q Type -> Q Exp
> +genPyType' opt typ = typ >>= pyOptionalType (opt /= NotOptional) >>= stringE
>
> -- | Generates Python types from opcode parameters.
> -genPyTypes :: [Field] -> Q ExpQ
> -genPyTypes fs =
> - listE <$> mapM (\f -> genPyType (fieldIsOptional f) (fieldType f)) fs
> +genPyType :: Field -> Q Exp
> +genPyType f = genPyType' (fieldIsOptional f) (fieldType f)
>
> -- | Generates Python default values from opcode parameters.
> -genPyDefaults :: [Field] -> ExpQ
> -genPyDefaults fs =
> - listE $ map (\f -> maybeApp (fieldDefault f) (fieldType f)) fs
> +genPyDefault :: Field -> Q Exp
> +genPyDefault f = maybeApp (fieldDefault f) (fieldType f)
> +
> +pyField :: Field -> Q Exp
> +pyField f = [| OpCodeField $(stringE (fieldName f))
> + $(genPyType f)
> + $(genPyDefault f)
> + $(stringE (fieldDoc f)) |]
>
> -- | Generates a Haskell function call to "showPyClass" with the
> -- necessary information on how to build the Python class string.
> -pyClass :: OpCodeConstructor -> ExpQ
> +pyClass :: OpCodeConstructor -> Q Exp
> pyClass (consName, consType, consDoc, consFields, consDscField) =
> do let pyClassVar = varNameE "showPyClass"
> consName' = stringE consName
> - consType' <- genPyType NotOptional consType
> + let consType' = genPyType' NotOptional consType
> let consDoc' = stringE consDoc
> +{-
> consFieldNames = listE $ map (stringE . fieldName) consFields
> consFieldDocs = listE $ map (stringE . fieldDoc) consFields
> consFieldTypes <- genPyTypes consFields
> let consFieldDefaults = genPyDefaults consFields
> - [| ($consName',
> - $consType',
> - $consDoc',
> - $consFieldNames,
> - $consFieldTypes,
> - $consFieldDefaults,
> - $consFieldDocs,
> - consDscField) |]
> + -}
This is a comment.
Rest LGTM.
Thanks,
Jose
> + [| OpCodeDescriptor $consName'
> + $consType'
> + $consDoc'
> + $(listE $ map pyField consFields)
> + consDscField |]
>
> -- | Generates a function called "pyClasses" that holds the list of
> -- all the opcode descriptors necessary for generating the Python
> --
> 1.8.5.1
>
--
Jose Antonio Lopes
Ganeti Engineering
Google Germany GmbH
Dienerstr. 12, 80331, München
Registergericht und -nummer: Hamburg, HRB 86891
Sitz der Gesellschaft: Hamburg
Geschäftsführer: Graham Law, Christine Elizabeth Flores
Steuernummer: 48/725/00206
Umsatzsteueridentifikationsnummer: DE813741370
