git.iko.soy/elk
on master help sign in
start using D.customString in Elm.Constraint
bdff44cEvan Czaplicki
compiler/src/Elm/Constraint.hs+55−77
compare with master
unifiedsplit
@@ -5,9 +5,6 @@ module Elm.Constraint
5 , exactly
5 , exactly
6 , anything
6 , anything
7 , toChars
7 , toChars
8− , toString
9− , Error(..)
10− , fromString
11 , satisfies
8 , satisfies
12 , check
9 , check
13 , intersect
10 , intersect
@@ -16,6 +13,8 @@ module Elm.Constraint
16 , untilNextMajor
13 , untilNextMajor
17 , untilNextMinor
14 , untilNextMinor
18 , expand
15 , expand
16+ --
17+ , Error(..)
19 , decoder
18 , decoder
20 , encode
19 , encode
21 )
20 )
@@ -24,11 +23,12 @@ module Elm.Constraint
24
23
25import Control.Monad (liftM4)
24import Control.Monad (liftM4)
26import Data.Binary (Binary, get, put, getWord8, putWord8)
25import Data.Binary (Binary, get, put, getWord8, putWord8)
27−import qualified Data.Utf8 as Utf8
28
26
29import qualified Elm.Version as V
27import qualified Elm.Version as V
30import qualified Json.Decode as D
28import qualified Json.Decode as D
31import qualified Json.Encode as E
29import qualified Json.Encode as E
30+import qualified Parse.Primitives as P
31+import Parse.Primitives (Row, Col)
32
32
33
33
34
34
@@ -61,78 +61,21 @@ anything =
61
61
62
62
63
63
64−-- TO STRING
64+-- TO CHARS
65
65
66
66
67−toChars :: Constraint -> String
67+toChars :: Constraint -> [Char]
68toChars constraint =
68toChars constraint =
69− Utf8.toChars (toString constraint)
70−
71−
72−toString :: Constraint -> Utf8.String
73−toString constraint =
74 case constraint of
69 case constraint of
75 Range lower lowerOp upperOp upper ->
70 Range lower lowerOp upperOp upper ->
76− Utf8.join 0x20 {- -}
71+ V.toChars lower ++ opToChars lowerOp ++ "v" ++ opToChars upperOp ++ V.toChars upper
77− [ V.toString lower
78− , toStringHelp lowerOp
79− , "v"
80− , toStringHelp upperOp
81− , V.toString upper
82− ]
83
72
84
73
85−toStringHelp :: Op -> Utf8.String
74+opToChars :: Op -> [Char]
86−toStringHelp op =
75+opToChars op =
87 case op of
76 case op of
88− Less -> "<"
77+ Less -> " < "
89− LessOrEqual -> "<="
78+ LessOrEqual -> " <= "
90−
91−
92−
93−-- FROM STRING
94−
95−
96−data Error
97− = BadLower Utf8.String
98− | BadUpper Utf8.String
99− | BadFormat
100− | InvalidOp
101− | InvalidRange V.Version V.Version
102−
103−
104−fromString :: Utf8.String -> Either Error Constraint
105−fromString string =
106− case Utf8.split 0x20 {- -} string of
107− [lower, lowerOp, "v", upperOp, upper] ->
108− do lo <- versionFromString lower BadLower
109− lop <- opFromString lowerOp
110− hop <- opFromString upperOp
111− hi <- versionFromString upper BadUpper
112− if lo < hi
113− then Right (Range lo lop hop hi)
114− else Left (InvalidRange lo hi)
115−
116− _ ->
117− Left BadFormat
118−
119−
120−versionFromString :: Utf8.String -> (Utf8.String -> Error) -> Either Error V.Version
121−versionFromString string toError =
122− case V.fromString string of
123− Just vsn ->
124− Right vsn
125−
126− Nothing ->
127− Left (toError string)
128−
129−
130−opFromString :: Utf8.String -> Either Error Op
131−opFromString text =
132− case text of
133− "<=" -> Right LessOrEqual
134− "<" -> Right Less
135− _ -> Left InvalidOp
136
79
137
80
138
81
@@ -245,18 +188,12 @@ expand constraint@(Range lower lowerOp upperOp upper) version
245
188
246encode :: Constraint -> E.Value
189encode :: Constraint -> E.Value
247encode constraint =
190encode constraint =
248− E.string (toString constraint)
191+ E.chars (toChars constraint)
249
192
250
193
251decoder :: D.Decoder Error Constraint
194decoder :: D.Decoder Error Constraint
252decoder =
195decoder =
253− do str <- D.string
196+ D.customString parser BadFormat
254− case fromString str of
255− Right constraint ->
256− return constraint
257−
258− Left err ->
259− D.failure err
260
197
261
198
262
199
@@ -279,4 +216,45 @@ instance Binary Op where
279 case n of
216 case n of
280 0 -> return Less
217 0 -> return Less
281 1 -> return LessOrEqual
218 1 -> return LessOrEqual
282− _ -> error "binary encoding of Op was corrupted"
219+ _ -> error "binary encoding of Op was corrupted"
220+
221+
222+
223+-- PARSER
224+
225+
226+data Error
227+ = BadFormat Row Col
228+ | InvalidRange V.Version V.Version
229+
230+
231+parser :: P.Parser Error Constraint
232+parser =
233+ do lower <- parseVersion
234+ P.word1 0x20 {- -} BadFormat
235+ loOp <- parseOp
236+ P.word1 0x20 {- -} BadFormat
237+ P.word1 0x76 {-v-} BadFormat
238+ P.word1 0x20 {- -} BadFormat
239+ hiOp <- parseOp
240+ P.word1 0x20 {- -} BadFormat
241+ higher <- parseVersion
242+ P.Parser $ \state@(P.State _ _ _ _ row col) _ eok _ eerr ->
243+ if lower < higher
244+ then eok (Range lower loOp hiOp higher) state
245+ else eerr row col (\_ _ -> InvalidRange lower higher)
246+
247+
248+parseVersion :: P.Parser Error V.Version
249+parseVersion =
250+ P.specialize (\(r,c) _ _ -> BadFormat r c) V.parser
251+
252+
253+parseOp :: P.Parser Error Op
254+parseOp =
255+ do P.word1 0x3C {-<-} BadFormat
256+ P.oneOfWithFallback
257+ [ do P.word1 0x3D {-=-} BadFormat
258+ return LessOrEqual
259+ ]
260+ Less