git.iko.soy/elk
on master help sign in
Create encoders and decoders for Elm.Package and Elm.Compiler.Module
11bd592Evan Czaplicki
src/Elm/Compiler/Module.hs+16−27
compare with master
unifiedsplit
@@ -15,15 +15,14 @@ module Elm.Compiler.Module
15 , nameFromText
15 , nameFromText
16 , hyphenate
16 , hyphenate
17 , dehyphenate
17 , dehyphenate
18− , RawForJson(..)
18+ , encode
19− , fromJson
19+ , decoder
20
20
21 -- canonical names
21 -- canonical names
22 , ModuleName.Canonical(..)
22 , ModuleName.Canonical(..)
23 )
23 )
24 where
24 where
25
25
26−import qualified Data.Aeson as Json
27import qualified Data.Char as Char
26import qualified Data.Char as Char
28import qualified Data.List as List
27import qualified Data.List as List
29import qualified Data.Map as Map
28import qualified Data.Map as Map
@@ -35,6 +34,8 @@ import qualified AST.Module as Module
35import qualified AST.Module.Name as ModuleName
34import qualified AST.Module.Name as ModuleName
36import qualified Elm.Compiler.Type as PublicType
35import qualified Elm.Compiler.Type as PublicType
37import qualified Elm.Compiler.Type.Extract as Extract
36import qualified Elm.Compiler.Type.Extract as Extract
37+import qualified Json.Decode as Decode
38+import qualified Json.Encode as Encode
38
39
39
40
40
41
@@ -105,32 +106,20 @@ isGoodChar char =
105
106
106
107
107
108
108−-- JSON for NAME
109+-- JSON
109
110
110
111
111−newtype RawForJson =
112− RawForJson ModuleName.Raw
112+encode :: ModuleName.Raw -> Encode.Value
113+encode =
114+ Encode.text
113
115
114
116
115−fromJson :: RawForJson -> ModuleName.Raw
117+decoder :: Decode.Decoder ModuleName.Raw
116−fromJson (RawForJson raw) =
118+decoder =
117− raw
119+ do txt <- Decode.text
118−
119−
120−instance Json.ToJSON RawForJson where
121− toJSON (RawForJson name) =
122− Json.toJSON (nameToString name)
123−
124−
125−instance Json.FromJSON RawForJson where
126− parseJSON (Json.String text) =
127− case nameFromText text of
120+ case nameFromText txt of
128− Nothing ->
121+ Nothing ->
129− fail (Text.unpack text ++ " is not a valid module name")
122+ Decode.fail "a module name like \"Html.Events\""
130−
131− Just name ->
132− return (RawForJson name)
133−
134− parseJSON _ =
135− fail "expecting the module name to be a string"
136
123
124+ Just name ->
125+ Decode.succeed name
src/Elm/Package.hs+61−55
@@ -11,11 +11,15 @@ module Elm.Package
11 , bumpPatch, bumpMinor, bumpMajor
11 , bumpPatch, bumpMinor, bumpMajor
12 , filterLatest, majorAndMinor
12 , filterLatest, majorAndMinor
13 , versionToString, versionToText, versionFromText
13 , versionToString, versionToText, versionFromText
14+ , decoder
15+ , encode
16+ , versionDecoder
17+ , encodeVersion
14 )
18 )
15 where
19 where
16
20
17−import qualified Data.Aeson as Json
21+
18−import Data.Binary
22+import Data.Binary (Binary, get, getWord8, put, putWord8)
19import qualified Data.Char as Char
23import qualified Data.Char as Char
20import Data.Function (on)
24import Data.Function (on)
21import qualified Data.List as List
25import qualified Data.List as List
@@ -26,7 +30,10 @@ import qualified Data.Text.Lazy as B (toStrict)
26import qualified Data.Text.Lazy.Builder as B (singleton, toLazyText)
30import qualified Data.Text.Lazy.Builder as B (singleton, toLazyText)
27import qualified Data.Text.Lazy.Builder.Int as B (decimal)
31import qualified Data.Text.Lazy.Builder.Int as B (decimal)
28import Data.Text (Text)
32import Data.Text (Text)
33+import Data.Word (Word16)
29import System.FilePath ((</>))
34import System.FilePath ((</>))
35+import qualified Json.Decode as Decode
36+import qualified Json.Encode as Encode
30
37
31
38
32
39
@@ -117,44 +124,6 @@ validateProjectName text =
117 Right text
124 Right text
118
125
119
126
120−instance Binary Name where
121− get =
122− Name <$> get <*> get
123−
124− put (Name user project) =
125− do put user
126− put project
127−
128−
129−instance Binary Package where
130− get =
131− Package <$> get <*> get
132−
133− put (Package name version) =
134− do put name
135− put version
136−
137−
138−instance Json.FromJSON Name where
139− parseJSON (Json.String text) =
140− case fromText text of
141− Left msg ->
142− fail $
143− "Ran into an invalid package name: "
144− ++ Text.unpack text ++ "\n\n" ++ msg
145−
146− Right name ->
147− return name
148−
149− parseJSON _ =
150− fail "Project name must be a string."
151−
152−
153−instance Json.ToJSON Name where
154− toJSON name =
155− Json.String (toText name)
156−
157−
158
127
159-- PACKAGE VERSIONS
128-- PACKAGE VERSIONS
160
129
@@ -248,6 +217,28 @@ toNumber txt =
248 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
217 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
249
218
250
219
220+
221+-- BINARY
222+
223+
224+instance Binary Name where
225+ get =
226+ Name <$> get <*> get
227+
228+ put (Name user project) =
229+ do put user
230+ put project
231+
232+
233+instance Binary Package where
234+ get =
235+ Package <$> get <*> get
236+
237+ put (Package name version) =
238+ do put name
239+ put version
240+
241+
251instance Binary Version where
242instance Binary Version where
252 get =
243 get =
253 do word <- getWord8
244 do word <- getWord8
@@ -270,23 +261,38 @@ instance Binary Version where
270 put patch
261 put patch
271
262
272
263
273−instance Json.FromJSON Version where
274− parseJSON (Json.String text) =
275− case versionFromText text of
276− Right version ->
277− return version
278
264
265+-- JSON
266+
267+
268+decoder :: Decode.Decoder Name
269+decoder =
270+ do txt <- Decode.text
271+ case fromText txt of
279− Left problem ->
272+ Left _ ->
280− fail $ unlines $
273+ Decode.fail "a valid project name, like \"elm-lang/core\""
281− [ "Ran into an invalid version number: " ++ Text.unpack text
274+
282− , problem
275+ Right name ->
283− ]
276+ Decode.succeed name
277+
278+
279+encode :: Name -> Encode.Value
280+encode name =
281+ Encode.text (toText name)
282+
283+
284
284
285− parseJSON _ =
285+versionDecoder :: Decode.Decoder Version
286− fail "Version number must be stored as a string."
286+versionDecoder =
287+ do txt <- Decode.text
288+ case versionFromText txt of
289+ Right version ->
290+ Decode.succeed version
287
291
292+ Left _ ->
293+ Decode.fail "a version number, like 1.0.0"
288
294
289−instance Json.ToJSON Version where
290− toJSON version =
291− Json.String (versionToText version)
292
295
296+encodeVersion :: Version -> Encode.Value
297+encodeVersion version =
298+ Encode.text (versionToText version)
src/Json/Decode.hs−32
@@ -6,8 +6,6 @@ module Json.Decode
6 , list, dict, maybe
6 , list, dict, maybe
7 , field, at
7 , field, at
8 , map, map2, succeed, fail, andThen
8 , map, map2, succeed, fail, andThen
9− -- elm specific stuff
10− , moduleName, packageName
11 )
9 )
12 where
10 where
13
11
@@ -23,9 +21,6 @@ import qualified Data.Scientific as Scientific
23import qualified Data.Text as Text
21import qualified Data.Text as Text
24import qualified Data.Vector as Vector
22import qualified Data.Vector as Vector
25
23
26−import qualified Elm.Compiler.Module as Module
27−import qualified Elm.Package as Pkg
28−
29
24
30
25
31-- DECODERS
26-- DECODERS
@@ -251,30 +246,3 @@ andThen callback (Decoder runA) =
251 do a <- runA mkError value
246 do a <- runA mkError value
252 let (Decoder runB) = callback a
247 let (Decoder runB) = callback a
253 runB mkError value
248 runB mkError value
254−
255−
256−
257−-- ELM SPECIFIC STUFF
258−
259−
260−moduleName :: Decoder Module.Raw
261−moduleName =
262− do txt <- text
263− case Module.nameFromText txt of
264− Nothing ->
265− fail "a module name like \"Html.Events\""
266−
267− Just name ->
268− succeed name
269−
270−
271−packageName :: Decoder Pkg.Name
272−packageName =
273− do txt <- text
274− case Pkg.fromText txt of
275− Left _ ->
276− fail "a valid project name, like \"elm-lang/core\""
277−
278− Right name ->
279− succeed name
280−