on develop help sign in
W
2adb278Brendan Hay
gen/src/Gen/Syntax.hs+3−24
@@ -84,13 +84,13 @@ verbDecl s p l m = TypeDecl noLoc (vname p l) [] alias
84 res = maybe (tycon "()") (tycon . Free) (_mResponse m)
84 res = maybe (tycon "()") (tycon . Free) (_mResponse m)
85
85
86jsonDecls :: Id -> Pre -> Map Local Solved -> [Decl]
86jsonDecls :: Id -> Pre -> Map Local Solved -> [Decl]
87−jsonDecls n p rs = [from, to]
87+jsonDecls n p (Map.toList -> rs) = [from, to]
88 where
88 where
89 from = InstDecl noLoc Nothing [] [] (unqual "FromJSON") [tycon n]
89 from = InstDecl noLoc Nothing [] [] (unqual "FromJSON") [tycon n]
90 [ funD "parseJSON" $
90 [ funD "parseJSON" $
91 app (app (var "withObject") (str (idToText n))) $
91 app (app (var "withObject") (str (idToText n))) $
92 lamE noLoc [pvar "o"] $
92 lamE noLoc [pvar "o"] $
93− ctorE n (map decode (Map.toList rs))
93+ ctorE n (map decode rs)
94 ]
94 ]
95
95
96 decode (l, s)
96 decode (l, s)
@@ -100,7 +100,7 @@ jsonDecls n p rs = [from, to]
100 | otherwise = optJS l
100 | otherwise = optJS l
101
101
102 to = InstDecl noLoc Nothing [] [] (unqual "ToJSON") [tycon n]
102 to = InstDecl noLoc Nothing [] [] (unqual "ToJSON") [tycon n]
103− [ wildcardD "toJSON" n omit none (map encode (Map.toList rs))
103+ [ wildcardD "toJSON" n omit none (map encode rs)
104 ]
104 ]
105
105
106 omit = app (var "object")
106 omit = app (var "object")
@@ -155,27 +155,6 @@ seqE :: Exp -> [Exp] -> Exp
155seqE l [] = app (var "pure") l
155seqE l [] = app (var "pure") l
156seqE l (r:rs) = infixApp l "<$>" (infixE r "<*>" rs)
156seqE l (r:rs) = infixApp l "<$>" (infixE r "<*>" rs)
157
157
158−-- toJSOND :: Protocol -> Id -> [Field] -> Decl
159−-- toJSOND p n = instD1 "ToJSON" n
160−-- . wildcardD n "toJSON" enc (paren $ app (var "Object") memptyE)
161−-- . map (Right . toJSONE p)
162−-- where
163−-- enc = app (var "object")
164−-- . app (var "catMaybes")
165−-- . listE
166−-- . map (either id id)
167−
168−-- instD1 :: Text -> Id -> InstDecl -> Decl
169−-- instD1 c n = instD c n . (:[])
170−
171−-- instD :: Text -> Id -> [InstDecl] -> Decl
172−-- instD c n = InstDecl noLoc Nothing [] [] (unqual c) [tycon (typeId n)]
173−
174−-- memptyE :: Exp
175−-- memptyE = var "mempty"
176−
177−
178−
179objDecl :: Id -> Pre -> Map Local Solved -> AST Decl
158objDecl :: Id -> Pre -> Map Local Solved -> AST Decl
180objDecl n p rs = DataDecl noLoc arity [] d [] [conDecl d p rs] <$> derivings n
159objDecl n p rs = DataDecl noLoc arity [] d [] [conDecl d p rs] <$> derivings n
181 where
160 where