@@ -12,8 +12,10 @@ import Data.Aeson.Encode.Pretty
1212import qualified Data.List as List
1313import qualified Data.Map as Map
1414import qualified Data.ByteString.Lazy as BS
15+import qualified Data.Text as Text
1516
1617import SourceSyntax.Helpers (isSymbol)
18+import SourceSyntax.Type (Type(..))
1719import SourceSyntax.Declaration (Declaration(..), Assoc(..))
1820import SourceSyntax.Expression (Def(..))
1921
@@ -52,7 +54,7 @@ docs :: IParser Value
5254docs = do
5355 (name, exports, structure) <- moduleDocs
5456 things <- document
55− return $ toJson name exports structure things
57+ return $ documentToJson name exports structure things
5658
5759docComment :: IParser String
5860docComment = do
@@ -103,7 +105,7 @@ docThing = uncommentable <|> commented <|> uncommented ""
103105 return (comment, def, src)
104106
105107
106−toJson name exports structure things =
108+documentToJson name exports structure things =
107109 object $ [ "name" .= name
108110 , "document" .= structure
109111 , "values" .= toList values
@@ -139,12 +141,31 @@ collect infixes types aliases adts things =
139141 Fixity assoc prec name ->
140142 collect (Map.insert name (assoc,prec) infixes) types aliases adts rest
141143 Definition (TypeAnnotation name tipe) ->
142− collect infixes (insert name [] types) aliases adts rest
144+ collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest
143145 TypeAlias name vars tipe ->
144− collect infixes types (insert name ["vars" .= vars] aliases) adts rest
146+ let fields = ["typeVariables" .= vars, "type" .= tipe ]
147+ in collect infixes types (insert name fields aliases) adts rest
145148 Datatype name vars ctors ->
146− collect infixes types aliases (insert name ["vars" .= vars] adts) rest
149+ let tipe = Data name (map Var vars)
150+ fields = ["typeVariables" .= vars, "constructors" .= map (ctorToJson tipe) ctors ]
151+ in collect infixes types aliases (insert name fields adts) rest
147152 where
148153 insert name fields dict = Map.insert name (obj name fields) dict
149154 obj name fields =
150− [ "name" .= name, "raw" .= source, "comment" .= comment ] ++ fields
155+ [ "name" .= name, "raw" .= source, "comment" .= comment ] ++ fields
156+
157+instance ToJSON Type where
158+ toJSON tipe =
159+ case tipe of
160+ Lambda t1 t2 -> toJSON [ "->", toJSON t1, toJSON t2 ]
161+ Var x -> toJSON x
162+ Data name ts -> toJSON (toJSON name : map toJSON ts)
163+ EmptyRecord -> object []
164+ Record fields ext -> object $ map (\(n,t) -> Text.pack n .= toJSON t) fields'
165+ where fields' = case ext of
166+ EmptyRecord -> fields
167+ _ -> ("_",ext) : fields
168+
169+ctorToJson tipe (ctor, tipes) =
170+ object [ "name" .= ctor
171+ , "type" .= foldr Lambda tipe tipes ]