@@ -12,6 +12,8 @@ module Elm.Compiler.Type
1212 where
1313
1414import Control.Arrow ((***))
15+import Data.Aeson ((.:))
16+import qualified Data.Aeson as Aeson
1517import qualified Data.Text as Text
1618import Data.Text (Text)
1719import qualified Text.PrettyPrint as P
@@ -173,13 +175,50 @@ encode tipe =
173175
174176decoder :: Decode.Decoder Type
175177decoder =
176− do txt <- Decode.text
177− case Parse.run Type.expression txt of
178− Left _ ->
179− Decode.fail "a type, like (String -> Int)"
178+ Decode.oneOf
179+ [
180+ do txt <- Decode.text
181+ case Parse.run Type.expression (Text.replace "'" "_" txt) of
182+ Left _ ->
183+ Decode.fail "a type, like (String -> Int)"
184+
185+ Right (tipe, _, _) ->
186+ Decode.succeed (fromRawType tipe)
187+ ,
188+ Decode.aeson
189+ ]
190+
191+
192+instance Aeson.FromJSON Type where
193+ parseJSON =
194+ Aeson.withObject "Type" $ \object ->
195+ do tag <- object .: "tag"
196+ case (tag :: String) of
197+ "lambda" ->
198+ Lambda <$> object .: "in" <*> object .: "out"
199+
200+ "var" ->
201+ Var <$> object .: "name"
202+
203+ "type" ->
204+ do name <- object .: "name"
205+ return (Type name [])
206+
207+ "app" ->
208+ do func <- object .: "func"
209+ args <- object .: "args"
210+ case func of
211+ Type name [] ->
212+ return (Type name args)
213+
214+ _ ->
215+ fail "unexpected type application"
216+
217+ "record" ->
218+ Record <$> object .: "fields" <*> object .: "extension"
180219
181− Right (tipe, _, _) ->
182− Decode.succeed (fromRawType tipe)
220+ _ ->
221+ fail $ "Error when decoding type with tag: " ++ tag
183222
184223
185224fromRawType :: Type.Raw -> Type