@@ -1,3 +1,4 @@
1+{-# OPTIONS_GHC -W #-}
12{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
23module Main where
34
@@ -16,10 +17,11 @@ import qualified Data.Map as Map
1617import qualified Data.ByteString.Lazy as BS
1718import qualified Data.Text as Text
1819
19−import qualified SourceSyntax.Helpers as Help
20−import qualified SourceSyntax.Type as T
21−import qualified SourceSyntax.Expression as E
22−import qualified SourceSyntax.Declaration as D
20+import qualified AST.Helpers as Help
21+import qualified AST.Type as T
22+import qualified AST.Declaration as D
23+import qualified AST.Expression.Source as Src
24+import qualified AST.Variable as Var
2325
2426import Text.Parsec hiding (newline,spaces)
2527import Parse.Declaration (alias,datatype,infixDecl)
@@ -74,7 +76,7 @@ docComment = do
7476 let reversed = dropWhile (`elem` " \n\r") . drop 2 $ reverse contents
7577 return $ dropWhile (==' ') (reverse reversed)
7678
77−moduleDocs :: IParser (String, [String], String)
79+--moduleDocs :: IParser (String, [String], String)
7880moduleDocs = do
7981 optional freshLine
8082 (names,exports) <- moduleDef
@@ -83,10 +85,10 @@ moduleDocs = do
8385 structure <- docComment
8486 return (List.intercalate "." names, exports, structure)
8587
86−document :: IParser [(String, D.ParseDeclaration, String)]
88+--document :: IParser [(String, D.SourceDecl, String)]
8789document = onFreshLines (\t ts -> ts ++ [t]) [] docThing
8890
89−docThing :: IParser (String, D.ParseDeclaration, String)
91+--docThing :: IParser (String, D.SourceDecl, String)
9092docThing = uncommentable <|> commented <|> uncommented ""
9193 where
9294 uncommentable = do
@@ -106,10 +108,11 @@ docThing = uncommentable <|> commented <|> uncommented ""
106108documentToJson name exports structure things =
107109 object $ [ "name" .= name
108110 , "document" .= structure
109− , "values" .= toList values
110− , "aliases" .= toList aliases
111− , "datatypes" .= toList adts
111+-- , "values" .= toList values
112+-- , "aliases" .= toList aliases
113+-- , "datatypes" .= toList adts
112114 ]
115+{--
113116 where
114117 (values, aliases, adts) = collect Map.empty Map.empty Map.empty Map.empty things
115118
@@ -120,7 +123,8 @@ documentToJson name exports structure things =
120123 case Map.null exportMap of
121124 True -> dict
122125 False -> Map.filterWithKey (\k _ -> Map.member k exportMap) dict
123−
126+--}
127+{--
124128collect infixes types aliases adts things =
125129 case things of
126130 [] -> (Map.union customOps nonCustomOps, aliases, adts)
@@ -138,13 +142,13 @@ collect infixes types aliases adts things =
138142 case decl of
139143 D.Fixity assoc prec name ->
140144 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) ->
142146 collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest
143147 D.TypeAlias name vars tipe ->
144148 let fields = ["typeVariables" .= vars, "type" .= tipe ]
145149 in collect infixes types (insert name fields aliases) adts rest
146150 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)
148152 fields = ["typeVariables" .= vars
149153 , "constructors" .= map (ctorToJson tipe) ctors ]
150154 in collect infixes types aliases (insert name fields adts) rest
@@ -152,8 +156,8 @@ collect infixes types aliases adts things =
152156 insert name fields dict = Map.insert name (obj name fields) dict
153157 obj name fields =
154158 [ "name" .= name, "raw" .= source, "comment" .= comment ] ++ fields
155−
156−instance ToJSON T.Type where
159+--}
160+instance Var.ToString var => ToJSON (T.Type var) where
157161 toJSON tipe =
158162 object $
159163 case tipe of
@@ -168,10 +172,16 @@ instance ToJSON T.Type where
168172 [ "tag" .= ("var" :: Text.Text)
169173 , "name" .= toJSON x
170174 ]
171−
172− T.Data name ts ->
175+
176+ T.Type name ->
177+ [ "tag" .= ("adt" :: Text.Text)
178+ , "name" .= toJSON (Var.toString name)
179+ , "args" .= ([] :: [()])
180+ ]
181+
182+ T.App (T.Type name) ts ->
173183 [ "tag" .= ("adt" :: Text.Text)
174− , "name" .= toJSON name
184+ , "name" .= toJSON (Var.toString name)
175185 , "args" .= map toJSON ts
176186 ]
177187
@@ -181,7 +191,7 @@ instance ToJSON T.Type where
181191 , "extension" .= toJSON ext
182192 ]
183193
184−ctorToJson :: T.Type -> (String, [T.Type]) -> Value
194+ctorToJson :: Var.ToString var => T.Type var -> (String, [T.Type var]) -> Value
185195ctorToJson tipe (ctor, tipes) =
186196 object [ "name" .= ctor
187197 , "type" .= foldr T.Lambda tipe tipes ]