@@ -8,6 +8,7 @@ import System.Exit
88import System.IO
99
1010import Control.Applicative ((<$>))
11+import Control.Arrow (second)
1112import Data.Aeson
1213import Data.Aeson.Encode.Pretty
1314import qualified Data.List as List
@@ -41,7 +42,7 @@ main = do
4142
4243config = Config { confIndent = 2, confCompare = keyOrder keys }
4344 where
44− keys = ["name","document","comment","raw","aliases","datatypes"
45+ keys = ["tag","name","document","comment","raw","aliases","datatypes"
4546 ,"values","typeVariables","type","constructors"]
4647
4748parseFile path = do
@@ -148,15 +149,31 @@ collect infixes types aliases adts things =
148149 [ "name" .= name, "raw" .= source, "comment" .= comment ] ++ fields
149150
150151instance ToJSON Type where
151− toJSON tipe =
152− case tipe of
153− Lambda t1 t2 -> toJSON [ "->", toJSON t1, toJSON t2 ]
154− Var x -> toJSON x
155− Data name ts -> toJSON (toJSON name : map toJSON ts)
156− Record fields ext -> object $ map (\(n,t) -> Text.pack n .= toJSON t) fields'
157− where fields' = case ext of
158− Nothing -> fields
159− Just x -> ("_", Var x) : fields
152+ toJSON tipe =
153+ object $
154+ case tipe of
155+ Lambda t1 t2 ->
156+ [ "tag" .= ("function" :: Text.Text)
157+ , "input" .= toJSON t1
158+ , "output" .= toJSON t2
159+ ]
160+
161+ Var x ->
162+ [ "tag" .= ("var" :: Text.Text)
163+ , "name" .= toJSON x
164+ ]
165+
166+ Data name ts ->
167+ [ "tag" .= ("adt" :: Text.Text)
168+ , "name" .= toJSON name
169+ , "args" .= map toJSON ts
170+ ]
171+
172+ Record fields ext ->
173+ [ "tag" .= ("record" :: Text.Text)
174+ , "fields" .= toJSON (map (toJSON . second toJSON) fields)
175+ , "extension" .= toJSON ext
176+ ]
160177
161178ctorToJson tipe (ctor, tipes) =
162179 object [ "name" .= ctor