git.iko.soy/elk
on master help sign in
Export a few more things from Json.Decode for better error handling
b9fd688Evan Czaplicki
src/Json/Decode.hs+13−10
compare with master
unifiedsplit
@@ -2,10 +2,11 @@
2{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}
2{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}
3module Json.Decode
3module Json.Decode
4 ( parse
4 ( parse
5+ , Failure(..)
5 -- re-export from Json.Decode.Internals
6 -- re-export from Json.Decode.Internals
6− , Json.Decoder, Json.Error(..)
7+ , Json.Decoder, Json.Error(..), Json.Type(..)
7 , Json.string, Json.text, Json.bool, Json.int
8 , Json.string, Json.text, Json.bool, Json.int
8− , Json.list, Json.dict, Json.maybe
9+ , Json.list, Json.dict, Json.pairs, Json.maybe
9 , Json.field, Json.at
10 , Json.field, Json.at
10 , Json.index
11 , Json.index
11 , Json.map, Json.map2, Json.mapError
12 , Json.map, Json.map2, Json.mapError
@@ -38,25 +39,24 @@ import qualified Reporting.Region as R
38-- PARSE
39-- PARSE
39
40
40
41
41−data Result e a
42+data Failure e
42 = BadJson E.Error
43 = BadJson E.Error
43 | BadContent (Json.Error e)
44 | BadContent (Json.Error e)
44− | Success a
45
45
46
46
47−parse :: Json.Decoder e a -> B.ByteString -> Result e a
47+parse :: Json.Decoder e a -> B.ByteString -> Either (Failure e) a
48parse (Json.Decoder run) bytestring =
48parse (Json.Decoder run) bytestring =
49 case P.run jsonFile bytestring of
49 case P.run jsonFile bytestring of
50 Left err ->
50 Left err ->
51− BadJson err
51+ Left (BadJson err)
52
52
53 Right value ->
53 Right value ->
54 case run value of
54 case run value of
55 Left err ->
55 Left err ->
56− BadContent err
56+ Left (BadContent err)
57
57
58 Right answer ->
58 Right answer ->
59− Success answer
59+ Right answer
60
60
61
61
62
62
@@ -181,14 +181,17 @@ string =
181 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
181 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
182 if offset < terminal && I.unsafeIndex fp offset == 0x22 {- " -} then
182 if offset < terminal && I.unsafeIndex fp offset == 0x22 {- " -} then
183
183
184+ let
185+ !offset1 = offset + 1
186+ in
184− case stringHelp fp (offset + 1) terminal row (col + 1) of
187+ case stringHelp fp offset1 terminal row (col + 1) of
185 Err err ->
188 Err err ->
186 cerr err
189 cerr err
187
190
188 Ok newOffset newRow newCol ->
191 Ok newOffset newRow newCol ->
189 let
192 let
190 !newState = State fp newOffset terminal indent newRow newCol ctx
193 !newState = State fp newOffset terminal indent newRow newCol ctx
191− !content = Text.decodeUtf8 (B.PS fp offset (newOffset - offset))
194+ !content = Text.decodeUtf8 (B.PS fp offset1 (newOffset - offset1 - 1))
192 in
195 in
193 cok content newState noError
196 cok content newState noError
194
197
src/Json/Decode/Internals.hs+75−55
@@ -4,6 +4,7 @@ module Json.Decode.Internals
4 ( Value(..)
4 ( Value(..)
5 , Decoder(..)
5 , Decoder(..)
6 , Error(..)
6 , Error(..)
7+ , Type(..)
7 , string, text, bool, int
8 , string, text, bool, int
8 , list, dict, pairs
9 , list, dict, pairs
9 , maybe
10 , maybe
@@ -23,6 +24,7 @@ import qualified Data.HashMap.Strict as HashMap
23import qualified Data.Text as Text
24import qualified Data.Text as Text
24import qualified Data.Vector as Vector
25import qualified Data.Vector as Vector
25import Data.Vector ((!?))
26import Data.Vector ((!?))
27+import qualified Json.Encode as E
26
28
27
29
28
30
@@ -55,8 +57,8 @@ data Error e
55 = Field Text (Error e)
57 = Field Text (Error e)
56 | Index Int (Error e)
58 | Index Int (Error e)
57 | OneOf [Error e]
59 | OneOf [Error e]
58− | Failure Value e
60+ | Failure E.Value e
59− | Expecting Value Type
61+ | Expecting E.Value Type
60
62
61
63
62data Type
64data Type
@@ -69,13 +71,6 @@ data Type
69 | TArrayWith Int Int
71 | TArrayWith Int Int
70
72
71
73
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−
79
74
80-- PRIMITIVES
75-- PRIMITIVES
81
76
@@ -93,7 +88,7 @@ text =
93 Right txt
88 Right txt
94
89
95 _ ->
90 _ ->
96− Left (Expecting value TString)
91+ Left (expecting value TString)
97
92
98
93
99bool :: Decoder e Bool
94bool :: Decoder e Bool
@@ -107,7 +102,7 @@ bool =
107 Right False
102 Right False
108
103
109 _ ->
104 _ ->
110− Left (Expecting value TBool)
105+ Left (expecting value TBool)
111
106
112
107
113int :: Decoder e Int
108int :: Decoder e Int
@@ -118,7 +113,7 @@ int =
118 Right integer
113 Right integer
119
114
120 _ ->
115 _ ->
121− Left (Expecting value TInt)
116+ Left (expecting value TInt)
122
117
123
118
124
119
@@ -137,7 +132,7 @@ list (Decoder run) =
137 Vector.toList <$> Vector.imapM runHelp vector
132 Vector.toList <$> Vector.imapM runHelp vector
138
133
139 _ ->
134 _ ->
140− Left (Expecting value TArray)
135+ Left (expecting value TArray)
141
136
142
137
143dict :: Decoder e a -> Decoder e (HashMap.HashMap Text a)
138dict :: Decoder e a -> Decoder e (HashMap.HashMap Text a)
@@ -152,7 +147,7 @@ dict (Decoder run) =
152 HashMap.traverseWithKey runHelp hashMap
147 HashMap.traverseWithKey runHelp hashMap
153
148
154 _ ->
149 _ ->
155− Left (Expecting value TObject)
150+ Left (expecting value TObject)
156
151
157
152
158pairs :: Decoder e a -> Decoder e [(Text, a)]
153pairs :: Decoder e a -> Decoder e [(Text, a)]
@@ -169,7 +164,7 @@ pairs (Decoder run) =
169 traverse runHelp kvs
164 traverse runHelp kvs
170
165
171 _ ->
166 _ ->
172− Left (Expecting value TObject)
167+ Left (expecting value TObject)
173
168
174
169
175maybe :: Decoder e a -> Decoder e (Maybe a)
170maybe :: Decoder e a -> Decoder e (Maybe a)
@@ -197,10 +192,10 @@ field k (Decoder run) =
197 mapLeft (Field k) (run v)
192 mapLeft (Field k) (run v)
198
193
199 Nothing ->
194 Nothing ->
200− Left (Expecting value (TObjectWith k))
195+ Left (expecting value (TObjectWith k))
201
196
202 _ ->
197 _ ->
203− Left (Expecting value TObject)
198+ Left (expecting value TObject)
204
199
205
200
206at :: [Text] -> Decoder e a -> Decoder e a
201at :: [Text] -> Decoder e a -> Decoder e a
@@ -222,29 +217,14 @@ index i (Decoder run) =
222 mapLeft (Index i) (run v)
217 mapLeft (Index i) (run v)
223
218
224 Nothing ->
219 Nothing ->
225− Left (Expecting value (TArrayWith i (Vector.length vector)))
220+ Left (expecting value (TArrayWith i (Vector.length vector)))
226
221
227 _ ->
222 _ ->
228− Left (Expecting value TArray)
223+ Left (expecting value TArray)
229−
230
224
231
225
232−-- MAPPING
233−
234
226
235−map :: (a -> value) -> Decoder e a -> Decoder e value
227+-- ERRORS
236−map func (Decoder run) =
237− Decoder $ \value ->
238− func <$> run value
239−
240−
241−
242−map2 :: (a -> b -> value) -> Decoder e a -> Decoder e b -> Decoder e value
243−map2 func (Decoder runA) (Decoder runB) =
244− Decoder $ \value ->
245− func
246− <$> runA value
247− <*> runB value
248
228
249
229
250mapError :: (e -> e') -> Decoder e a -> Decoder e' a
230mapError :: (e -> e') -> Decoder e a -> Decoder e' a
@@ -263,33 +243,54 @@ mapErrorHelp func err =
263 Expecting v e -> Expecting v e
243 Expecting v e -> Expecting v e
264
244
265
245
266−apply :: Decoder e (a -> b) -> Decoder e a -> Decoder e b
246+mapLeft :: (e -> e') -> Either e a -> Either e' a
267−apply (Decoder runFunc) (Decoder runArg) =
247+mapLeft func eith =
268− Decoder $ \value ->
248+ case eith of
269− do func <- runFunc value
249+ Right a -> Right a
270− arg <- runArg value
250+ Left e -> Left (func e)
271− return (func arg)
272
251
273
252
274−instance Functor (Decoder e) where
253+expecting :: Value -> Type -> Error e
275− fmap =
254+expecting value tipe =
276− map
255+ Expecting (toEncodeValue value) tipe
277
256
278
257
279−instance Applicative (Decoder e) where
258+toEncodeValue :: Value -> E.Value
280− pure =
259+toEncodeValue value =
281− succeed
260+ case value of
261+ Array vector -> E.array (Vector.toList (Vector.map toEncodeValue vector))
262+ Object fields _ -> E.object (fmap (\(k,v) -> (Text.unpack k, toEncodeValue v)) fields)
263+ String txt -> E.text txt
264+ TRUE -> E.bool True
265+ FALSE -> E.bool False
266+ Integer n -> E.int n
267+ NULL -> E.null
282
268
283− (<*>) =
284− apply
285
269
286
270
287−instance Monad (Decoder e) where
271+-- MAPPING
288− return =
289− succeed
290
272
291− (>>=) decoder callback =
273+
292− andThen callback decoder
274+map :: (a -> value) -> Decoder e a -> Decoder e value
275+map func (Decoder run) =
276+ Decoder $ \value ->
277+ func <$> run value
278+
279+
280+map2 :: (a -> b -> value) -> Decoder e a -> Decoder e b -> Decoder e value
281+map2 func (Decoder runA) (Decoder runB) =
282+ Decoder $ \value ->
283+ func
284+ <$> runA value
285+ <*> runB value
286+
287+
288+apply :: Decoder e (a -> b) -> Decoder e a -> Decoder e b
289+apply (Decoder runFunc) (Decoder runArg) =
290+ Decoder $ \value ->
291+ do func <- runFunc value
292+ arg <- runArg value
293+ return (func arg)
293
294
294
295
295
296
@@ -304,7 +305,7 @@ succeed a =
304fail :: e -> Decoder e a
305fail :: e -> Decoder e a
305fail err =
306fail err =
306 Decoder $ \value ->
307 Decoder $ \value ->
307− Left (Failure value err)
308+ Left (Failure (toEncodeValue value) err)
308
309
309
310
310andThen :: (a -> Decoder e b) -> Decoder e a -> Decoder e b
311andThen :: (a -> Decoder e b) -> Decoder e a -> Decoder e b
@@ -337,3 +338,22 @@ oneOfHelp decoders errors value =
337
338
338 Left err ->
339 Left err ->
339 oneOfHelp otherDecoders (err:errors) value
340 oneOfHelp otherDecoders (err:errors) value
341+
342+
343+
344+-- INSTANCES
345+
346+
347+instance Functor (Decoder e) where
348+ fmap = map
349+
350+
351+instance Applicative (Decoder e) where
352+ pure = succeed
353+ (<*>) = apply
354+
355+
356+instance Monad (Decoder e) where
357+ return = succeed
358+ (>>=) decoder callback =
359+ andThen callback decoder