On Thu, Sep 29, 2011 at 03:49:13PM +0200, Agata Murawska wrote:
> On Mon, Sep 26, 2011 at 11:57 AM, Iustin Pop <[email protected]> wrote:
> > This replaces the hand-coded opcode serialisation code with
> > auto-generation based on TemplateHaskell.
> > ---
> > htools/Ganeti/OpCodes.hs | 121 +++++++++-------------------------
> > htools/Ganeti/THH.hs | 164
> > ++++++++++++++++++++++++++++++++++++++++++++++
> > 2 files changed, 195 insertions(+), 90 deletions(-)
> > + let declD = DataD [] (mkName name) []
> > + (map (\(cname, fields) -> NormalC (mkName cname) fields)
> > decl_d)
> > + [''Show, ''Read, ''Eq]
> For readability reasons I'd take the map into separate variable -- map
> with lambda function as an argument of another function seems like a
> little too deep
Ack, will do. Actually this whole block (two maps) can be simplified, I
wrote very ugly code; we only need one single map.
> > +saveConstructor sname fields = do
> > + let cname = mkName sname
> > + let fnames = map (\(n, _, _) -> mkName n) fields
> > + let pat = conP cname (map varP fnames)
> > + let felems = map (uncurry saveField) (zip fnames fields)
> > + -- now build the OP_ID serialisation
> > + opid = [| [( $(litE (stringL "OP_ID")),
> > + $(varE (mkName "showJSON"))
> > + $(litE (stringL (deCamelCase sname))) )] |]
> > + flist = listE (opid:felems)
> > + -- and finally convert all this to a json object
> > + flist' = [| $(varE (mkName "makeObj")) (concat $flist) |]
> > + clause [pat] (normalB flist') []
> I found this part hard to read because of the amount of brackets.
> Maybe some of them may be replaced with function composition?
I'll try :) I haven't converted all cases, since I will write a more
generic patch after this.
Interdiff:
diff --git a/htools/Ganeti/THH.hs b/htools/Ganeti/THH.hs
index cc91df1..7584a2b 100644
--- a/htools/Ganeti/THH.hs
+++ b/htools/Ganeti/THH.hs
@@ -253,12 +253,13 @@ genOpCode :: String -- ^ Type name to use
-> Q [Dec]
genOpCode name cons = do
decl_d <- mapM (\(cname, fields) -> do
- fields' <- mapM (\(_, b, _) -> b) fields
- return (cname, map (\b -> (NotStrict, b)) fields'))
+ -- we only need the type of the field, without Q
+ fields' <- mapM (\(_, qt, _) ->
+ qt >>= \t -> return (NotStrict, t))
+ fields
+ return $ NormalC (mkName cname) fields')
cons
- let declD = DataD [] (mkName name) []
- (map (\(cname, fields) -> NormalC (mkName cname) fields) decl_d)
- [''Show, ''Read, ''Eq]
+ let declD = DataD [] (mkName name) [] decl_d [''Show, ''Read, ''Eq]
(savesig, savefn) <- genSaveOpCode cons
(loadsig, loadfn) <- genLoadOpCode cons
@@ -308,7 +309,7 @@ saveConstructor sname fields = do
-- now build the OP_ID serialisation
opid = [| [( $(litE (stringL "OP_ID")),
$(varE (mkName "showJSON"))
- $(litE (stringL (deCamelCase sname))) )] |]
+ $(litE . stringL . deCamelCase $ sname) )] |]
flist = listE (opid:felems)
-- and finally convert all this to a json object
flist' = [| $(varE (mkName "makeObj")) (concat $flist) |]
--
iustin
