@@ -43,10 +43,12 @@ data Value
4343-- DECODERS
4444
4545
46+-- TODO switch to CPS if possible
47+--
4648newtype Decoder e a =
47− Decoder
48− { _run :: (Error e -> Error e) -> Value -> Either (Error e) a
49− }
49+ Decoder {
50+ _run :: Value -> Either (Error e) a
51+ }
5052
5153
5254data Error e
@@ -67,6 +69,13 @@ data Type
6769 | TArrayWith Int Int
6870
6971
72+mapLeft :: (e -> e') -> Either e a -> Either e' a
73+mapLeft func eith =
74+ case eith of
75+ Right a -> Right a
76+ Left e -> Left (func e)
77+
78+
7079
7180-- PRIMITIVES
7281
@@ -78,18 +87,18 @@ string =
7887
7988text :: Decoder e Text
8089text =
81− Decoder $ \mkError value ->
90+ Decoder $ \value ->
8291 case value of
8392 String txt ->
8493 Right txt
8594
8695 _ ->
87− Left (mkError (Expecting value TString))
96+ Left (Expecting value TString)
8897
8998
9099bool :: Decoder e Bool
91100bool =
92− Decoder $ \mkError value ->
101+ Decoder $ \value ->
93102 case value of
94103 TRUE ->
95104 Right True
@@ -98,18 +107,18 @@ bool =
98107 Right False
99108
100109 _ ->
101− Left (mkError (Expecting value TBool))
110+ Left (Expecting value TBool)
102111
103112
104113int :: Decoder e Int
105114int =
106− Decoder $ \mkError value ->
115+ Decoder $ \value ->
107116 case value of
108117 Integer integer ->
109118 Right integer
110119
111120 _ ->
112− Left (mkError (Expecting value TInt))
121+ Left (Expecting value TInt)
113122
114123
115124
@@ -118,67 +127,80 @@ int =
118127
119128list :: Decoder e a -> Decoder e [a]
120129list (Decoder run) =
121− Decoder $ \mkError value ->
130+ Decoder $ \value ->
122131 case value of
123132 Array vector ->
124− Vector.toList <$>
125− Vector.imapM (\i v -> run (mkError . Index i) v) vector
133+ let
134+ runHelp i v =
135+ mapLeft (Index i) (run v)
136+ in
137+ Vector.toList <$> Vector.imapM runHelp vector
126138
127139 _ ->
128− Left (mkError (Expecting value TArray))
140+ Left (Expecting value TArray)
129141
130142
131143dict :: Decoder e a -> Decoder e (HashMap.HashMap Text a)
132144dict (Decoder run) =
133− Decoder $ \mkError value ->
145+ Decoder $ \value ->
134146 case value of
135147 Object _ hashMap ->
136− HashMap.traverseWithKey (\k v -> run (mkError . Field k) v) hashMap
148+ let
149+ runHelp k v =
150+ mapLeft (Field k) (run v)
151+ in
152+ HashMap.traverseWithKey runHelp hashMap
137153
138154 _ ->
139− Left (mkError (Expecting value TObject))
155+ Left (Expecting value TObject)
140156
141157
142158pairs :: Decoder e a -> Decoder e [(Text, a)]
143159pairs (Decoder run) =
144− Decoder $ \mkError value ->
160+ Decoder $ \value ->
145161 case value of
146162 Object kvs _ ->
147− traverse (\(k,v) -> (,) k <$> run (mkError . Field k) v) kvs
163+ let
164+ runHelp (k,v) =
165+ case run v of
166+ Right a -> Right (k, a)
167+ Left e -> Left (Field k e)
168+ in
169+ traverse runHelp kvs
148170
149171 _ ->
150− Left (mkError (Expecting value TObject))
172+ Left (Expecting value TObject)
151173
152174
153175maybe :: Decoder e a -> Decoder e (Maybe a)
154176maybe (Decoder run) =
155− Decoder $ \mkError value ->
156− case run mkError value of
157− Left _ ->
158− Right Nothing
159−
177+ Decoder $ \value ->
178+ case run value of
160179 Right a ->
161180 Right (Just a)
162181
182+ Left _ ->
183+ Right Nothing
184+
163185
164186
165187-- OBJECT PRIMITIVES
166188
167189
168190field :: Text -> Decoder e a -> Decoder e a
169−field name (Decoder run) =
170− Decoder $ \mkError value ->
191+field k (Decoder run) =
192+ Decoder $ \value ->
171193 case value of
172194 Object _ hashMap ->
173− case HashMap.lookup name hashMap of
195+ case HashMap.lookup k hashMap of
174196 Just v ->
175− run (mkError . Field name) v
197+ mapLeft (Field k) (run v)
176198
177199 Nothing ->
178− Left $ mkError $ Expecting value (ObjectWith name)
200+ Left (Expecting value (TObjectWith k))
179201
180202 _ ->
181− Left (mkError (Expecting value TObject))
203+ Left (Expecting value TObject)
182204
183205
184206at :: [Text] -> Decoder e a -> Decoder e a
@@ -192,18 +214,18 @@ at names decoder =
192214
193215index :: Int -> Decoder e a -> Decoder e a
194216index i (Decoder run) =
195− Decoder $ \mkError value ->
217+ Decoder $ \value ->
196218 case value of
197219 Array vector ->
198220 case vector !? i of
199221 Just v ->
200− run (mkError . Index i) v
222+ mapLeft (Index i) (run v)
201223
202224 Nothing ->
203− Left $ mkError $ Expecting value $ ArrayWith i (Vector.length vector)
225+ Left (Expecting value (TArrayWith i (Vector.length vector)))
204226
205227 _ ->
206− Left (mkError (Expecting value TArray))
228+ Left (Expecting value TArray)
207229
208230
209231
@@ -212,22 +234,23 @@ index i (Decoder run) =
212234
213235map :: (a -> value) -> Decoder e a -> Decoder e value
214236map func (Decoder run) =
215− Decoder $ \mkError value ->
216− func <$> run mkError value
237+ Decoder $ \value ->
238+ func <$> run value
239+
217240
218241
219242map2 :: (a -> b -> value) -> Decoder e a -> Decoder e b -> Decoder e value
220243map2 func (Decoder runA) (Decoder runB) =
221− Decoder $ \mkError value ->
244+ Decoder $ \value ->
222245 func
223− <$> runA mkError value
224− <*> runB mkError value
246+ <$> runA value
247+ <*> runB value
225248
226249
227250mapError :: (e -> e') -> Decoder e a -> Decoder e' a
228251mapError func (Decoder run) =
229− Decoder $ \mkError value ->
230− run (mapErrorHelp func . mkError) value
252+ Decoder $ \value ->
253+ mapLeft (mapErrorHelp func) (run value)
231254
232255
233256mapErrorHelp :: (e -> e') -> Error e -> Error e'
@@ -235,16 +258,16 @@ mapErrorHelp func err =
235258 case err of
236259 Field f subErr -> Field f (mapErrorHelp func subErr)
237260 Index i subErr -> Index i (mapErrorHelp func subErr)
238− OneOf errors -> OneOf (map (mapErrorHelp func) errors)
261+ OneOf errors -> OneOf (fmap (mapErrorHelp func) errors)
239262 Failure v e -> Failure v (func e)
240263 Expecting v e -> Expecting v e
241264
242265
243266apply :: Decoder e (a -> b) -> Decoder e a -> Decoder e b
244267apply (Decoder runFunc) (Decoder runArg) =
245− Decoder $ \mkError value ->
246− do func <- runFunc mkError value
247− arg <- runArg mkError value
268+ Decoder $ \value ->
269+ do func <- runFunc value
270+ arg <- runArg value
248271 return (func arg)
249272
250273
@@ -275,21 +298,21 @@ instance Monad (Decoder e) where
275298
276299succeed :: a -> Decoder e a
277300succeed a =
278− Decoder $ \_ _ -> Right a
301+ Decoder $ \_ -> Right a
279302
280303
281304fail :: e -> Decoder e a
282305fail err =
283− Decoder $ \mkError value ->
284− Left (mkError (Failure value err))
306+ Decoder $ \value ->
307+ Left (Failure value err)
285308
286309
287310andThen :: (a -> Decoder e b) -> Decoder e a -> Decoder e b
288311andThen callback (Decoder runA) =
289− Decoder $ \mkError value ->
290− do a <- runA mkError value
312+ Decoder $ \value ->
313+ do a <- runA value
291314 let (Decoder runB) = callback a
292− runB mkError value
315+ runB value
293316
294317
295318
@@ -301,16 +324,16 @@ oneOf decoders =
301324 Decoder (oneOfHelp decoders [])
302325
303326
304−oneOfHelp :: [Decoder e a] -> [Error e] -> (Error e -> Error e) -> Value -> Either (Error e) a
305−oneOfHelp decoders errors mkError value =
327+oneOfHelp :: [Decoder e a] -> [Error e] -> Value -> Either (Error e) a
328+oneOfHelp decoders errors value =
306329 case decoders of
307330 [] ->
308− Left (mkError (OneOf (reverse errors)))
331+ Left (OneOf (reverse errors))
309332
310333 Decoder run : otherDecoders ->
311− case run mkError value of
334+ case run value of
312335 Right a ->
313336 Right a
314337
315338 Left err ->
316− oneOfHelp otherDecoders (err:errors) mkError value
339+ oneOfHelp otherDecoders (err:errors) value