Permalink
Browse files

Fix ToJSON generation for simple objects

  • Loading branch information...
1 parent c624cc6 commit b2099625e1cf1ea90c52bc78933cebd430f399d9 @timjb committed Sep 26, 2012
Showing with 15 additions and 2 deletions.
  1. +1 −1 src/Data/Aeson/Schema/CodeGen.hs
  2. +1 −1 src/Data/Aeson/Schema/CodeGenM.hs
  3. +13 −0 test/Data/Aeson/Schema/CodeGen/Tests.hs
@@ -308,7 +308,7 @@ generateObject decName name schema = case (propertiesList, schemaAdditionalPrope
(doE $ checkers ++ [noBindS parseAdditional])
[| fail "not an object" |]
let typ = [t| M.Map Text $(additionalType) |]
- let to = [| Object . HM.fromList . map $(additionalTo) . M.toList |]
+ let to = [| Object . HM.fromList . map (second $(additionalTo)) . M.toList |]
return ((typ, parser, to), True)
_ -> do
let validatesStmt = assertValidates (lift schema) [| Object $(varE obj) |]
@@ -104,7 +104,7 @@ genRecord name fields classes = Declaration <$> dataDec
, maybe "" ((" " <>) . renderComment . ("^ " <>)) fieldDesc
]
renderComment :: Text -> Text
- renderComment = T.unlines . map ("-- " <>) . T.lines
+ renderComment = T.intercalate "\n" . map ("-- " <>) . T.lines
recordBlock :: [Text] -> Text
recordBlock [] = dataLine <> " " <> derivingClause
recordBlock (l:ls) = T.unlines $ [dataLine] ++ map indent (["{ " <> l] ++ map (", " <>) ls ++ ["} " <> derivingClause])
@@ -2,6 +2,7 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
@@ -236,6 +237,18 @@ tests = do
case result of
Left err -> HU.assertFailure $ show err
Right _ -> return ()
+ , testCase "simple map" $ do
+ let
+ schema = [schemaQQ| {
+ "type": "object",
+ "additionalProperties": { "type": "number" }
+ } |]
+ graph = M.singleton "A" schema
+ (code, _) <- runQ $ generateModule "SimpleMap" graph
+ result <- typecheck code forkLift
+ case result of
+ Left err -> HU.assertFailure $ show err
+ Right _ -> return ()
]
typecheckGenerate :: ForkLift -> Schema Text -> Property

0 comments on commit b209962

Please sign in to comment.