on master help sign in
update for lack of OverloadedStrings on Json.String type
b1f765cEvan Czaplicki
compiler/src/Elm/Compiler/Type.hs+26−27
@@ -15,9 +15,12 @@ module Elm.Compiler.Type
15
15
16
16
17import qualified Data.Name as Name
17import qualified Data.Name as Name
18−import qualified Data.Utf8 as Utf8
19
18
20import qualified AST.Source as Src
19import qualified AST.Source as Src
20+import qualified Json.Decode as D
21+import qualified Json.Encode as E
22+import Json.Encode ((==>))
23+import qualified Json.String as Json
21import qualified Parse.Primitives as P
24import qualified Parse.Primitives as P
22import qualified Parse.Type as Type
25import qualified Parse.Type as Type
23import qualified Reporting.Annotation as A
26import qualified Reporting.Annotation as A
@@ -25,10 +28,6 @@ import qualified Reporting.Doc as D
25import qualified Reporting.Render.Type as RT
28import qualified Reporting.Render.Type as RT
26import qualified Reporting.Render.Type.Localizer as L
29import qualified Reporting.Render.Type.Localizer as L
27
30
28−import qualified Json.Decode as D
29−import qualified Json.Encode as E
30−import Json.Encode ((==>))
31−
32
31
33
32
34-- TYPES
33-- TYPES
@@ -114,18 +113,16 @@ collectLambdas tipe =
114
113
115encode :: Type -> E.Value
114encode :: Type -> E.Value
116encode tipe =
115encode tipe =
117− E.string $ Utf8.fromChars $ D.toLine (toDoc L.empty RT.None tipe)
116+ E.chars $ D.toLine (toDoc L.empty RT.None tipe)
118
117
119
118
120decoder :: D.Decoder () Type
119decoder :: D.Decoder () Type
121decoder =
120decoder =
122− do str <- D.string
121+ let
123− case P.fromByteString Type.expression (error "TODO turn Utf8 to something that can be parsed" str) of
122+ parser =
124− P.Ok (tipe, _, _) _ ->
123+ P.specialize (\_ _ _ -> ()) (fromRawType . fst <$> Type.expression)
125− return (fromRawType tipe)
124+ in
126−
125+ D.customString parser (\_ _ -> ())
127− P.Err _ _ _ _ ->
128− D.failure ()
129
126
130
127
131fromRawType :: Src.Type -> Type
128fromRawType :: Src.Type -> Type
@@ -167,29 +164,31 @@ encodeMetadata :: DebugMetadata -> E.Value
167encodeMetadata (DebugMetadata msg aliases unions) =
164encodeMetadata (DebugMetadata msg aliases unions) =
168 E.object
165 E.object
169 [ "message" ==> encode msg
166 [ "message" ==> encode msg
170− , "aliases" ==> E.object (map toAliasField aliases)
167+ , "aliases" ==> E.object (map toTypeAliasField aliases)
171− , "unions" ==> E.object (map toUnionField unions)
168+ , "unions" ==> E.object (map toCustomTypeField unions)
172 ]
169 ]
173
170
174
171
175−toAliasField :: Alias -> ( Utf8.String, E.Value )
172+toTypeAliasField :: Alias -> ( Json.String, E.Value )
176−toAliasField (Alias name args tipe) =
173+toTypeAliasField (Alias name args tipe) =
177− Name.toUtf8 name ==>
174+ ( Json.fromName name
178− E.object
175+ , E.object
179 [ "args" ==> E.list E.name args
176 [ "args" ==> E.list E.name args
180 , "type" ==> encode tipe
177 , "type" ==> encode tipe
181 ]
178 ]
179+ )
182
180
183
181
184−toUnionField :: Union -> ( Utf8.String, E.Value )
182+toCustomTypeField :: Union -> ( Json.String, E.Value )
185−toUnionField (Union name args constructors) =
183+toCustomTypeField (Union name args constructors) =
186− Name.toUtf8 name ==>
184+ ( Json.fromName name
187− E.object
185+ , E.object
188 [ "args" ==> E.list E.name args
186 [ "args" ==> E.list E.name args
189− , "tags" ==> E.object (map toCtorObject constructors)
187+ , "tags" ==> E.object (map toVariantObject constructors)
190 ]
188 ]
189+ )
191
190
192
191
193−toCtorObject :: (Name.Name, [Type]) -> ( Utf8.String, E.Value )
192+toVariantObject :: (Name.Name, [Type]) -> ( Json.String, E.Value )
194−toCtorObject (name, args) =
193+toVariantObject (name, args) =
195− Name.toUtf8 name ==> E.list encode args
194+ ( Json.fromName name, E.list encode args )