git.iko.soy/elk
on master help sign in
Get docs compiling for now
5340536Evan Czaplicki
compiler/Docs.hs+29−19
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# OPTIONS_GHC -W #-}
1{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
2{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
2module Main where
3module Main where
3
4
@@ -16,10 +17,11 @@ import qualified Data.Map as Map
16import qualified Data.ByteString.Lazy as BS
17import qualified Data.ByteString.Lazy as BS
17import qualified Data.Text as Text
18import qualified Data.Text as Text
18
19
19−import qualified SourceSyntax.Helpers as Help
20+import qualified AST.Helpers as Help
20−import qualified SourceSyntax.Type as T
21+import qualified AST.Type as T
21−import qualified SourceSyntax.Expression as E
22+import qualified AST.Declaration as D
22−import qualified SourceSyntax.Declaration as D
23+import qualified AST.Expression.Source as Src
24+import qualified AST.Variable as Var
23
25
24import Text.Parsec hiding (newline,spaces)
26import Text.Parsec hiding (newline,spaces)
25import Parse.Declaration (alias,datatype,infixDecl)
27import Parse.Declaration (alias,datatype,infixDecl)
@@ -74,7 +76,7 @@ docComment = do
74 let reversed = dropWhile (`elem` " \n\r") . drop 2 $ reverse contents
76 let reversed = dropWhile (`elem` " \n\r") . drop 2 $ reverse contents
75 return $ dropWhile (==' ') (reverse reversed)
77 return $ dropWhile (==' ') (reverse reversed)
76
78
77−moduleDocs :: IParser (String, [String], String)
79+--moduleDocs :: IParser (String, [String], String)
78moduleDocs = do
80moduleDocs = do
79 optional freshLine
81 optional freshLine
80 (names,exports) <- moduleDef
82 (names,exports) <- moduleDef
@@ -83,10 +85,10 @@ moduleDocs = do
83 structure <- docComment
85 structure <- docComment
84 return (List.intercalate "." names, exports, structure)
86 return (List.intercalate "." names, exports, structure)
85
87
86−document :: IParser [(String, D.ParseDeclaration, String)]
88+--document :: IParser [(String, D.SourceDecl, String)]
87document = onFreshLines (\t ts -> ts ++ [t]) [] docThing
89document = onFreshLines (\t ts -> ts ++ [t]) [] docThing
88
90
89−docThing :: IParser (String, D.ParseDeclaration, String)
91+--docThing :: IParser (String, D.SourceDecl, String)
90docThing = uncommentable <|> commented <|> uncommented ""
92docThing = uncommentable <|> commented <|> uncommented ""
91 where
93 where
92 uncommentable = do
94 uncommentable = do
@@ -106,10 +108,11 @@ docThing = uncommentable <|> commented <|> uncommented ""
106documentToJson name exports structure things =
108documentToJson 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
110− , "aliases" .= toList aliases
112+-- , "aliases" .= toList aliases
111− , "datatypes" .= toList adts
113+-- , "datatypes" .= toList adts
112 ]
114 ]
115+{--
113 where
116 where
114 (values, aliases, adts) = collect Map.empty Map.empty Map.empty Map.empty things
117 (values, aliases, adts) = collect Map.empty Map.empty Map.empty Map.empty things
115
118
@@ -120,7 +123,8 @@ documentToJson name exports structure things =
120 case Map.null exportMap of
123 case Map.null exportMap of
121 True -> dict
124 True -> dict
122 False -> Map.filterWithKey (\k _ -> Map.member k exportMap) dict
125 False -> Map.filterWithKey (\k _ -> Map.member k exportMap) dict
123−
126+--}
127+{--
124collect infixes types aliases adts things =
128collect infixes types aliases adts things =
125 case things of
129 case things of
126 [] -> (Map.union customOps nonCustomOps, aliases, adts)
130 [] -> (Map.union customOps nonCustomOps, aliases, adts)
@@ -138,13 +142,13 @@ collect infixes types aliases adts things =
138 case decl of
142 case decl of
139 D.Fixity assoc prec name ->
143 D.Fixity assoc prec name ->
140 collect (Map.insert name (assoc,prec) infixes) types aliases adts rest
144 collect (Map.insert name (assoc,prec) infixes) types aliases adts rest
141− D.Definition (E.TypeAnnotation name tipe) ->
145+ D.Definition (Src.TypeAnnotation name tipe) ->
142 collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest
146 collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest
143 D.TypeAlias name vars tipe ->
147 D.TypeAlias name vars tipe ->
144 let fields = ["typeVariables" .= vars, "type" .= tipe ]
148 let fields = ["typeVariables" .= vars, "type" .= tipe ]
145 in collect infixes types (insert name fields aliases) adts rest
149 in collect infixes types (insert name fields aliases) adts rest
146 D.Datatype name vars ctors ->
150 D.Datatype name vars ctors ->
147− let tipe = T.Data name (map T.Var vars)
151+ let tipe = T.App (T.Type name) (map T.Var vars)
148 fields = ["typeVariables" .= vars
152 fields = ["typeVariables" .= vars
149 , "constructors" .= map (ctorToJson tipe) ctors ]
153 , "constructors" .= map (ctorToJson tipe) ctors ]
150 in collect infixes types aliases (insert name fields adts) rest
154 in collect infixes types aliases (insert name fields adts) rest
@@ -152,8 +156,8 @@ collect infixes types aliases adts things =
152 insert name fields dict = Map.insert name (obj name fields) dict
156 insert name fields dict = Map.insert name (obj name fields) dict
153 obj name fields =
157 obj name fields =
154 [ "name" .= name, "raw" .= source, "comment" .= comment ] ++ fields
158 [ "name" .= name, "raw" .= source, "comment" .= comment ] ++ fields
155−
159+--}
156−instance ToJSON T.Type where
160+instance Var.ToString var => ToJSON (T.Type var) where
157 toJSON tipe =
161 toJSON tipe =
158 object $
162 object $
159 case tipe of
163 case tipe of
@@ -168,10 +172,16 @@ instance ToJSON T.Type where
168 [ "tag" .= ("var" :: Text.Text)
172 [ "tag" .= ("var" :: Text.Text)
169 , "name" .= toJSON x
173 , "name" .= toJSON x
170 ]
174 ]
171−
175+
176+ T.Type name ->
177+ [ "tag" .= ("adt" :: Text.Text)
178+ , "name" .= toJSON (Var.toString name)
179+ , "args" .= ([] :: [()])
180+ ]
181+
172− T.Data name ts ->
182+ T.App (T.Type name) ts ->
173 [ "tag" .= ("adt" :: Text.Text)
183 [ "tag" .= ("adt" :: Text.Text)
174− , "name" .= toJSON name
184+ , "name" .= toJSON (Var.toString name)
175 , "args" .= map toJSON ts
185 , "args" .= map toJSON ts
176 ]
186 ]
177
187
@@ -181,7 +191,7 @@ instance ToJSON T.Type where
181 , "extension" .= toJSON ext
191 , "extension" .= toJSON ext
182 ]
192 ]
183
193
184−ctorToJson :: T.Type -> (String, [T.Type]) -> Value
194+ctorToJson :: Var.ToString var => T.Type var -> (String, [T.Type var]) -> Value
185ctorToJson tipe (ctor, tipes) =
195ctorToJson tipe (ctor, tipes) =
186 object [ "name" .= ctor
196 object [ "name" .= ctor
187 , "type" .= foldr T.Lambda tipe tipes ]
197 , "type" .= foldr T.Lambda tipe tipes ]