@@ -5,9 +5,6 @@ module Elm.Constraint
55 , exactly
66 , anything
77 , toChars
8− , toString
9− , Error(..)
10− , fromString
118 , satisfies
129 , check
1310 , intersect
@@ -16,6 +13,8 @@ module Elm.Constraint
1613 , untilNextMajor
1714 , untilNextMinor
1815 , expand
16+ --
17+ , Error(..)
1918 , decoder
2019 , encode
2120 )
@@ -24,11 +23,12 @@ module Elm.Constraint
2423
2524import Control.Monad (liftM4)
2625import Data.Binary (Binary, get, put, getWord8, putWord8)
27−import qualified Data.Utf8 as Utf8
2826
2927import qualified Elm.Version as V
3028import qualified Json.Decode as D
3129import qualified Json.Encode as E
30+import qualified Parse.Primitives as P
31+import Parse.Primitives (Row, Col)
3232
3333
3434
@@ -61,78 +61,21 @@ anything =
6161
6262
6363
64−-- TO STRING
64+-- TO CHARS
6565
6666
67−toChars :: Constraint -> String
67+toChars :: Constraint -> [Char]
6868toChars constraint =
69− Utf8.toChars (toString constraint)
70−
71−
72−toString :: Constraint -> Utf8.String
73−toString constraint =
7469 case constraint of
7570 Range lower lowerOp upperOp upper ->
76− Utf8.join 0x20 {- -}
77− [ V.toString lower
78− , toStringHelp lowerOp
79− , "v"
80− , toStringHelp upperOp
81− , V.toString upper
82− ]
71+ V.toChars lower ++ opToChars lowerOp ++ "v" ++ opToChars upperOp ++ V.toChars upper
8372
8473
85−toStringHelp :: Op -> Utf8.String
86−toStringHelp op =
74+opToChars :: Op -> [Char]
75+opToChars op =
8776 case op of
88− Less -> "<"
89− 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
77+ Less -> " < "
78+ LessOrEqual -> " <= "
13679
13780
13881
@@ -245,18 +188,12 @@ expand constraint@(Range lower lowerOp upperOp upper) version
245188
246189encode :: Constraint -> E.Value
247190encode constraint =
248− E.string (toString constraint)
191+ E.chars (toChars constraint)
249192
250193
251194decoder :: D.Decoder Error Constraint
252195decoder =
253− do str <- D.string
254− case fromString str of
255− Right constraint ->
256− return constraint
257−
258− Left err ->
259− D.failure err
196+ D.customString parser BadFormat
260197
261198
262199
@@ -279,4 +216,45 @@ instance Binary Op where
279216 case n of
280217 0 -> return Less
281218 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