git.iko.soy/elk
on master help sign in
Switch to generating type JSON as strings
a6fc47aEvan Czaplicki
src/Elm/Compiler/Type.hs+58−46
compare with master
unifiedsplit
@@ -8,11 +8,17 @@ import Control.Applicative ((<$>), (<*>))
8import Control.Arrow (second)
8import Control.Arrow (second)
9import Data.Aeson ((.:), (.=))
9import Data.Aeson ((.:), (.=))
10import qualified Data.Aeson as Json
10import qualified Data.Aeson as Json
11+import qualified Data.Aeson.Types as Json
11import qualified Data.ByteString.Lazy.Char8 as BS
12import qualified Data.ByteString.Lazy.Char8 as BS
12import qualified Data.Text as Text
13import qualified Data.Text as Text
13import Text.PrettyPrint as P
14import Text.PrettyPrint as P
14
15
15import qualified AST.Helpers as Help
16import qualified AST.Helpers as Help
17+import qualified AST.Type as Type
18+import qualified AST.Variable as Var
19+import qualified Parse.Helpers as Parse
20+import qualified Parse.Type as Type
21+import qualified Reporting.Annotation as A
16
22
17
23
18data Type
24data Type
@@ -122,62 +128,68 @@ flattenRecord tipe =
122-- JSON for TYPE
128-- JSON for TYPE
123
129
124instance Json.ToJSON Type where
130instance Json.ToJSON Type where
125− toJSON tipe =
131+ toJSON tipe =
126− Json.object (getFields tipe)
132+ Json.String (Text.pack (toString tipe))
127− where
128− getFields tipe =
129− case tipe of
130− Lambda t1 t2 ->
131− [ "tag" .= ("lambda" :: Text.Text)
132− , "in" .= Json.toJSON t1
133− , "out" .= Json.toJSON t2
134− ]
135
133
136− Var x ->
137− [ "tag" .= ("var" :: Text.Text)
138− , "name" .= Json.toJSON x
139− ]
140
134
141− Type name ->
135+instance Json.FromJSON Type where
142− [ "tag" .= ("type" :: Text.Text)
136+ parseJSON value =
143− , "name" .= Json.toJSON name
137+ let
144− ]
138+ failure _ =
139+ fail $
140+ "Trying to decode a type string, but could not handle this value:\n"
141+ ++ BS.unpack (Json.encode value)
142+ in
143+ case value of
144+ Json.String text ->
145+ either failure (return . fromRawType)
146+ (Parse.iParse Type.expr (Text.unpack text))
145
147
146− App t ts ->
148+ Json.Object obj ->
147− [ "tag" .= ("app" :: Text.Text)
149+ fromObject obj
148− , "func" .= Json.toJSON t
149− , "args" .= Json.toJSON ts
150− ]
151
150
152− Record fields ext ->
151+ _ ->
153− [ "tag" .= ("record" :: Text.Text)
152+ failure ()
154− , "fields" .= Json.toJSON (map (Json.toJSON . second Json.toJSON) fields)
155− , "extension" .= Json.toJSON ext
156− ]
157
153
158
154
159−instance Json.FromJSON Type where
155+fromObject :: Json.Object -> Json.Parser Type
160− parseJSON (Json.Object obj) =
156+fromObject obj =
161− do tag <- obj .: "tag"
157+ do tag <- obj .: "tag"
162− case (tag :: String) of
158+ case (tag :: String) of
163− "lambda" ->
159+ "lambda" ->
164− Lambda <$> obj .: "in" <*> obj .: "out"
160+ Lambda <$> obj .: "in" <*> obj .: "out"
161+
162+ "var" ->
163+ Var <$> obj .: "name"
164+
165+ "type" ->
166+ Type <$> obj .: "name"
167+
168+ "app" ->
169+ App <$> obj .: "func" <*> obj .: "args"
170+
171+ "record" ->
172+ Record <$> obj .: "fields" <*> obj .: "extension"
173+
174+ _ ->
175+ fail $ "Error when decoding type with tag: " ++ tag
165
176
166− "var" ->
167− Var <$> obj .: "name"
168
177
169− "type" ->
178+fromRawType :: Type.Raw -> Type
170− Type <$> obj .: "name"
179+fromRawType (A.A _ astType) =
180+ case astType of
181+ Type.RLambda t1 t2 ->
182+ Lambda (fromRawType t1) (fromRawType t2)
171
183
172− "app" ->
184+ Type.RVar x ->
173− App <$> obj .: "func" <*> obj .: "args"
185+ Var x
174
186
175− "record" ->
187+ Type.RType var ->
176− Record <$> obj .: "fields" <*> obj .: "extension"
188+ Type (Var.toString var)
177
189
178− _ ->
190+ Type.RApp t ts ->
179− fail $ "Error when decoding type with tag: " ++ tag
191+ App (fromRawType t) (map fromRawType ts)
180
192
193+ Type.RRecord fields ext ->
194+ Record (map (second fromRawType) fields) (fmap fromRawType ext)
181
195
182− parseJSON value =
183− fail $ "Cannot decode Value from: " ++ BS.unpack (Json.encode value)