@@ -2,10 +2,10 @@ module Main (main) where
22
33import Control.Monad.Writer.Strict
44import Data.Aeson hiding (Options)
5−import Data.Aeson.Key qualified as Key
6−import Data.Aeson.KeyMap qualified as KeyMap
75import Data.Aeson.Types (Parser)
6+import Data.HashMap.Strict qualified as HM
87import Data.Map.Lazy qualified as M
8+import Data.Text qualified as T
99import Data.Vector (Vector)
1010import Data.Vector qualified as V
1111import Data.Yaml as Yaml
@@ -32,6 +32,7 @@ data Datatype
3232 | IntType
3333 | FloatType
3434 | StringType
35+ | List Datatype
3536 deriving stock (Show)
3637
3738newtype SumType = SumType (Map Text (Maybe Datatype))
@@ -41,13 +42,14 @@ parseSumType :: Vector Value -> Parser SumType
4142parseSumType = fmap (SumType . fold) . traverse parseConstructor . V.toList
4243 where
4344 parseConstructor (String s) = pure $ one (s, Nothing)
44− parseConstructor (Object o) | [(Key.toText -> k, v)] <- KeyMap.toList o = one . (k,) . Just <$> parseJSON v
45+ parseConstructor (Object o) | [(k, v)] <- HM.toList o = one . (k,) . Just <$> parseJSON v
4546 parseConstructor (Object _) = fail "Sum types can only have one name per constructor"
4647 parseConstructor _ = fail "Sum Bad sum type ;("
4748
4849instance FromJSON Datatype where
4950 parseJSON (Array a) = SumDatatype <$> parseSumType a
50− parseJSON (Object o) = ProductType <$> traverse parseJSON (M.mapKeysMonotonic Key.toText $ KeyMap.toMap o)
51+ parseJSON (Object o) | [("List", x)] <- HM.toList o = List <$> parseJSON x
52+ parseJSON (Object o) = ProductType <$> traverse parseJSON (M.fromList $ HM.toList o)
5153 parseJSON (String "Bool") = pure BoolType
5254 parseJSON (String "Int") = pure IntType
5355 parseJSON (String "Float") = pure FloatType
@@ -112,7 +114,7 @@ elmType name (SumDatatype (SumType sums)) = do
112114 SumEncoding'
113115 TaggedObject
114116 { tagFieldName = "tag",
115− contentsFieldName = "values"
117+ contentsFieldName = "contents"
116118 }
117119 }
118120 ]
@@ -173,8 +175,8 @@ psType name (ProductType fields) = do
173175
174176allInstances :: [PS.Instance]
175177allInstances =
176− [ PS.Encode,
177− PS.Decode,
178+ [ PS.EncodeJson,
179+ PS.DecodeJson,
178180 PS.Generic,
179181 PS.Eq,
180182 PS.Ord
@@ -187,6 +189,7 @@ ps datattypes =
187189 PSS.Settings
188190 { generateLenses = False,
189191 genericsGenRep = True,
192+ generateArgonautCodecs = True,
190193 generateForeign = Nothing
191194 }
192195 PSModule