git.iko.soy/elk
on master help sign in
Begin generating JSON representations of types.
5b2c4f6Evan Czaplicki
Elm.cabal+2−1
compare with master
unifiedsplit
@@ -203,7 +203,8 @@ Executable elm-doc
203 mtl >= 2,
203 mtl >= 2,
204 pandoc >= 1.10,
204 pandoc >= 1.10,
205 parsec >= 3.1.1,
205 parsec >= 3.1.1,
206− pretty
206+ pretty,
207+ text
207
208
208Test-Suite test-elm
209Test-Suite test-elm
209 Type: exitcode-stdio-1.0
210 Type: exitcode-stdio-1.0
compiler/Docs.hs+27−6
@@ -12,8 +12,10 @@ import Data.Aeson.Encode.Pretty
12import qualified Data.List as List
12import qualified Data.List as List
13import qualified Data.Map as Map
13import qualified Data.Map as Map
14import qualified Data.ByteString.Lazy as BS
14import qualified Data.ByteString.Lazy as BS
15+import qualified Data.Text as Text
15
16
16import SourceSyntax.Helpers (isSymbol)
17import SourceSyntax.Helpers (isSymbol)
18+import SourceSyntax.Type (Type(..))
17import SourceSyntax.Declaration (Declaration(..), Assoc(..))
19import SourceSyntax.Declaration (Declaration(..), Assoc(..))
18import SourceSyntax.Expression (Def(..))
20import SourceSyntax.Expression (Def(..))
19
21
@@ -52,7 +54,7 @@ docs :: IParser Value
52docs = do
54docs = do
53 (name, exports, structure) <- moduleDocs
55 (name, exports, structure) <- moduleDocs
54 things <- document
56 things <- document
55− return $ toJson name exports structure things
57+ return $ documentToJson name exports structure things
56
58
57docComment :: IParser String
59docComment :: IParser String
58docComment = do
60docComment = do
@@ -103,7 +105,7 @@ docThing = uncommentable <|> commented <|> uncommented ""
103 return (comment, def, src)
105 return (comment, def, src)
104
106
105
107
106−toJson name exports structure things =
108+documentToJson name exports structure things =
107 object $ [ "name" .= name
109 object $ [ "name" .= name
108 , "document" .= structure
110 , "document" .= structure
109 , "values" .= toList values
111 , "values" .= toList values
@@ -139,12 +141,31 @@ collect infixes types aliases adts things =
139 Fixity assoc prec name ->
141 Fixity assoc prec name ->
140 collect (Map.insert name (assoc,prec) infixes) types aliases adts rest
142 collect (Map.insert name (assoc,prec) infixes) types aliases adts rest
141 Definition (TypeAnnotation name tipe) ->
143 Definition (TypeAnnotation name tipe) ->
142− collect infixes (insert name [] types) aliases adts rest
144+ collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest
143 TypeAlias name vars tipe ->
145 TypeAlias name vars tipe ->
146+ let fields = ["typeVariables" .= vars, "type" .= tipe ]
144− collect infixes types (insert name ["vars" .= vars] aliases) adts rest
147+ in collect infixes types (insert name fields aliases) adts rest
145 Datatype name vars ctors ->
148 Datatype name vars ctors ->
149+ let tipe = Data name (map Var vars)
150+ fields = ["typeVariables" .= vars, "constructors" .= map (ctorToJson tipe) ctors ]
146− collect infixes types aliases (insert name ["vars" .= vars] adts) rest
151+ in collect infixes types aliases (insert name fields adts) rest
147 where
152 where
148 insert name fields dict = Map.insert name (obj name fields) dict
153 insert name fields dict = Map.insert name (obj name fields) dict
149 obj name fields =
154 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 ]