git.iko.soy/elk
on master help sign in
Add ability to parse very old documentation format
e4b451fEvan Czaplicki
src/Elm/Compiler/Type.hs+45−6
compare with master
unifiedsplit
@@ -12,6 +12,8 @@ module Elm.Compiler.Type
12 where
12 where
13
13
14import Control.Arrow ((***))
14import Control.Arrow ((***))
15+import Data.Aeson ((.:))
16+import qualified Data.Aeson as Aeson
15import qualified Data.Text as Text
17import qualified Data.Text as Text
16import Data.Text (Text)
18import Data.Text (Text)
17import qualified Text.PrettyPrint as P
19import qualified Text.PrettyPrint as P
@@ -173,13 +175,50 @@ encode tipe =
173
175
174decoder :: Decode.Decoder Type
176decoder :: Decode.Decoder Type
175decoder =
177decoder =
178+ Decode.oneOf
179+ [
176− do txt <- Decode.text
180+ do txt <- Decode.text
177− case Parse.run Type.expression txt of
181+ case Parse.run Type.expression (Text.replace "'" "_" txt) of
178− Left _ ->
182+ Left _ ->
179− Decode.fail "a type, like (String -> Int)"
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"
180
219
181− Right (tipe, _, _) ->
220+ _ ->
182− Decode.succeed (fromRawType tipe)
221+ fail $ "Error when decoding type with tag: " ++ tag
183
222
184
223
185fromRawType :: Type.Raw -> Type
224fromRawType :: Type.Raw -> Type
src/Json/Decode.hs+17
@@ -7,6 +7,7 @@ module Json.Decode
7 , field, at
7 , field, at
8 , index
8 , index
9 , map, map2, succeed, fail, andThen, oneOf
9 , map, map2, succeed, fail, andThen, oneOf
10+ , aeson
10 )
11 )
11 where
12 where
12
13
@@ -39,6 +40,7 @@ data Error
39 | Index Int Error
40 | Index Int Error
40 | OneOf [Error]
41 | OneOf [Error]
41 | Failure Aeson.Value String
42 | Failure Aeson.Value String
43+ deriving (Show)
42
44
43
45
44decode :: Decoder a -> Aeson.Value -> Either Error a
46decode :: Decoder a -> Aeson.Value -> Either Error a
@@ -299,3 +301,18 @@ oneOfHelp decoders errors mkError value =
299
301
300 Left err ->
302 Left err ->
301 oneOfHelp otherDecoders (err:errors) mkError value
303 oneOfHelp otherDecoders (err:errors) mkError value
304+
305+
306+
307+-- AESON
308+
309+
310+aeson :: (Aeson.FromJSON a) => Decoder a
311+aeson =
312+ Decoder $ \mkError value ->
313+ case Aeson.fromJSON value of
314+ Aeson.Error msg ->
315+ Left (mkError (Failure value msg))
316+
317+ Aeson.Success a ->
318+ Right a