@@ -2,6 +2,7 @@ module Main (main) where
22
33import Control.Monad.Writer.Strict
44import Data.Aeson hiding (Options)
5+import Data.Aeson.Types
56import Data.HashMap.Strict qualified as HM
67import Data.Map.Lazy qualified as M
78import Data.Vector (Vector)
@@ -42,15 +43,17 @@ parseSumType :: Vector Value -> Parser SumType
4243parseSumType = fmap (SumType . fold) . traverse parseConstructor . V.toList
4344 where
4445 parseConstructor (String s) = pure $ one (s, Nothing)
45− parseConstructor (Object o) | [(k, v)] <- HM.toList o = one . (k,) . Just <$> parseJSON v
46+ parseConstructor (Object o)
47+ | [(k, v)] <- HM.toList o =
48+ prependFailure ("in constructor " <> toString k <> ", ") $ one . (k,) . Just <$> parseJSON v
4649 parseConstructor (Object _) = fail "Sum types can only have one name per constructor"
4750 parseConstructor _ = fail "Sum Bad sum type ;("
4851
4952instance FromJSON Datatype where
50− parseJSON (Array a) = SumDatatype <$> parseSumType a
51− parseJSON (Object o) | [("List", x)] <- HM.toList o = List <$> parseJSON x
52− parseJSON (Object o) | [("Maybe", x)] <- HM.toList o = MaybeType <$> parseJSON x
53− parseJSON (Object o) = ProductType <$> traverse parseJSON (M.fromList $ HM.toList o)
53+ parseJSON (Array a) = prependFailure "in Sum, " $ SumDatatype <$> parseSumType a
54+ parseJSON (Object o) | [("List", x)] <- HM.toList o = prependFailure "in List, " $ List <$> parseJSON x
55+ parseJSON (Object o) | [("Maybe", x)] <- HM.toList o = prependFailure "in Maybe, " $ MaybeType <$> parseJSON x
56+ parseJSON (Object o) = prependFailure "in Record, " $ ProductType <$> traverse parseJSON (M.fromList $ HM.toList o)
5457 parseJSON (String "Bool") = pure BoolType
5558 parseJSON (String "Int") = pure IntType
5659 parseJSON (String "Float") = pure FloatType