Interdiff:
diff --git a/src/Ganeti/Hs2Py/GenOpCodes.hs b/src/Ganeti/Hs2Py/GenOpCodes.hs
index 5f0c48c..0f8fbb1 100644
--- a/src/Ganeti/Hs2Py/GenOpCodes.hs
+++ b/src/Ganeti/Hs2Py/GenOpCodes.hs
@@ -45,10 +45,10 @@ pyClassDoc doc
pyClassField :: OpCodeField -> String
pyClassField (OpCodeField name typ Nothing doc) =
"(" ++ intercalate ", " [show name, "None", typ, show doc] ++ ")"
-
+
pyClassField (OpCodeField name typ (Just def) doc) =
"(" ++ intercalate ", " [show name, showValue def, typ, show doc] ++ ")"
-
+
-- | Comma intercalates and indents opcode parameters in Python.
intercalateIndent :: [String] -> String
intercalateIndent xs = intercalate "," (map ("\n " ++) xs)
diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs
index c6b48e6..e7eb7b6 100644
--- a/src/Ganeti/THH.hs
+++ b/src/Ganeti/THH.hs
@@ -717,12 +717,6 @@ pyClass (consName, consType, consDoc, consFields,
consDscField) =
consName' = stringE consName
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
- -}
[| OpCodeDescriptor $consName'
$consType'
$consDoc'
On Fri, Dec 13, 2013 at 1:18 PM, Jose A. Lopes <[email protected]> wrote:
> 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
>
