@@ -31,18 +31,18 @@ module Data.Codec.Argonaut
31
31
import Prelude
32
32
33
33
import Control.Monad.Reader (ReaderT (..), runReaderT )
34
- import Control.Monad.Writer (Writer , writer , mapWriter )
34
+ import Control.Monad.Writer (Writer , mapWriter , writer )
35
35
import Data.Argonaut.Core as J
36
36
import Data.Array as A
37
37
import Data.Bifunctor as BF
38
38
import Data.Codec (BasicCodec , Codec , GCodec (..), basicCodec , bihoistGCodec , decode , encode )
39
- import Data.Codec (decode , encode , (~ ), (<~< ), (>~> )) as Exports
39
+ import Data.Codec (decode , encode , (<~< ), (>~> ), (~ )) as Exports
40
40
import Data.Either (Either (..), note )
41
41
import Data.Generic.Rep (class Generic )
42
42
import Data.Int as I
43
43
import Data.List ((:))
44
44
import Data.List as L
45
- import Data.Maybe (Maybe (..), maybe , fromJust )
45
+ import Data.Maybe (Maybe (..), fromJust , maybe )
46
46
import Data.Profunctor.Star (Star (..))
47
47
import Data.String as S
48
48
import Data.String.CodeUnits as SCU
@@ -73,25 +73,25 @@ derive instance genericJsonDecodeError ∷ Generic JsonDecodeError _
73
73
74
74
instance showJsonDecodeError ∷ Show JsonDecodeError where
75
75
show = case _ of
76
- TypeMismatch s -> " (TypeMismatch " <> show s <> " )"
77
- UnexpectedValue j -> " (UnexpectedValue " <> J .stringify j <> " )"
78
- AtIndex i e -> " (AtIndex " <> show i <> " " <> show e <> " )"
79
- AtKey k e -> " (AtKey " <> show k <> " " <> show e <> " )"
80
- Named s e -> " (Named " <> show s <> " " <> show e <> " )"
81
- MissingValue -> " MissingValue"
76
+ TypeMismatch s → " (TypeMismatch " <> show s <> " )"
77
+ UnexpectedValue j → " (UnexpectedValue " <> J .stringify j <> " )"
78
+ AtIndex i e → " (AtIndex " <> show i <> " " <> show e <> " )"
79
+ AtKey k e → " (AtKey " <> show k <> " " <> show e <> " )"
80
+ Named s e → " (Named " <> show s <> " " <> show e <> " )"
81
+ MissingValue → " MissingValue"
82
82
83
83
-- | Prints a `JsonDecodeError` as a somewhat readable error message.
84
84
printJsonDecodeError ∷ JsonDecodeError → String
85
85
printJsonDecodeError err =
86
86
" An error occurred while decoding a JSON value:\n " <> go err
87
87
where
88
- go = case _ of
89
- TypeMismatch ty → " Expected value of type '" <> ty <> " '."
90
- UnexpectedValue val → " Unexpected value " <> J .stringify val <> " ."
91
- AtIndex ix inner → " At array index " <> show ix <> " :\n " <> go inner
92
- AtKey key inner → " At object key " <> key <> " :\n " <> go inner
93
- Named name inner → " Under '" <> name <> " ':\n " <> go inner
94
- MissingValue → " No value was found."
88
+ go = case _ of
89
+ TypeMismatch ty → " Expected value of type '" <> ty <> " '."
90
+ UnexpectedValue val → " Unexpected value " <> J .stringify val <> " ."
91
+ AtIndex ix inner → " At array index " <> show ix <> " :\n " <> go inner
92
+ AtKey key inner → " At object key " <> key <> " :\n " <> go inner
93
+ Named name inner → " Under '" <> name <> " ':\n " <> go inner
94
+ MissingValue → " No value was found."
95
95
96
96
-- | The "identity codec" for `Json` values.
97
97
json ∷ JsonCodec J.Json
@@ -163,7 +163,8 @@ type JIndexedCodec a =
163
163
(Either JsonDecodeError )
164
164
(Array J.Json )
165
165
(L.List J.Json )
166
- a a
166
+ a
167
+ a
167
168
168
169
-- | A codec for types that are encoded as an array with a specific layout.
169
170
-- |
@@ -204,7 +205,8 @@ type JPropCodec a =
204
205
(Either JsonDecodeError )
205
206
(FO.Object J.Json )
206
207
(L.List (Tuple String J.Json ))
207
- a a
208
+ a
209
+ a
208
210
209
211
-- | A codec for objects that are encoded with specific properties.
210
212
-- |
@@ -225,6 +227,7 @@ prop key codec = GCodec dec enc
225
227
BF .lmap (AtKey key) case FO .lookup key obj of
226
228
Just val → decode codec val
227
229
Nothing → Left MissingValue
230
+
228
231
enc ∷ Star (Writer (L.List (Tuple String J.Json ))) a a
229
232
enc = Star \val → writer $ Tuple val (pure (Tuple key (encode codec val)))
230
233
@@ -265,29 +268,33 @@ recordProp
265
268
recordProp p codecA codecR =
266
269
let key = reflectSymbol p in GCodec (dec' key) (enc' key)
267
270
where
268
- dec' ∷ String → ReaderT (FO.Object J.Json ) (Either JsonDecodeError ) (Record r' )
269
- dec' key = ReaderT \obj → do
270
- r ← decode codecR obj
271
- a ← BF .lmap (AtKey key) case FO .lookup key obj of
272
- Just val → decode codecA val
273
- Nothing → Left MissingValue
274
- pure $ unsafeSet key a r
275
- enc' ∷ String → Star (Writer (L.List (Tuple String J.Json ))) (Record r' ) (Record r' )
276
- enc' key = Star \val →
277
- writer $ Tuple val
278
- $ Tuple key (encode codecA (unsafeGet key val))
279
- : encode codecR (unsafeForget val)
280
- unsafeForget ∷ Record r' → Record r
281
- unsafeForget = unsafeCoerce
282
- unsafeSet ∷ String → a → Record r → Record r'
283
- unsafeSet key a = unsafeCoerce <<< FO .insert key a <<< unsafeCoerce
284
- unsafeGet ∷ String → Record r' → a
285
- unsafeGet s = unsafePartial fromJust <<< FO .lookup s <<< unsafeCoerce
286
-
271
+ dec' ∷ String → ReaderT (FO.Object J.Json ) (Either JsonDecodeError ) (Record r' )
272
+ dec' key = ReaderT \obj → do
273
+ r ← decode codecR obj
274
+ a ← BF .lmap (AtKey key) case FO .lookup key obj of
275
+ Just val → decode codecA val
276
+ Nothing → Left MissingValue
277
+ pure $ unsafeSet key a r
278
+
279
+ enc' ∷ String → Star (Writer (L.List (Tuple String J.Json ))) (Record r' ) (Record r' )
280
+ enc' key = Star \val →
281
+ writer $ Tuple val
282
+ $ Tuple key (encode codecA (unsafeGet key val))
283
+ : encode codecR (unsafeForget val)
284
+
285
+ unsafeForget ∷ Record r' → Record r
286
+ unsafeForget = unsafeCoerce
287
+
288
+ unsafeSet ∷ String → a → Record r → Record r'
289
+ unsafeSet key a = unsafeCoerce <<< FO .insert key a <<< unsafeCoerce
290
+
291
+ unsafeGet ∷ String → Record r' → a
292
+ unsafeGet s = unsafePartial fromJust <<< FO .lookup s <<< unsafeCoerce
293
+
287
294
-- | Used with `record` to define an optional field.
288
295
-- |
289
296
-- | This will only decode the property as `Nothing` if the field does not exist
290
- -- | in the object - having a values such as `null` assigned will need handling
297
+ -- | in the object - having a values such as `null` assigned will need handling
291
298
-- | separately.
292
299
-- |
293
300
-- | The property will be omitted when encoding and the value is `Nothing`.
@@ -302,29 +309,33 @@ recordPropOptional
302
309
recordPropOptional p codecA codecR =
303
310
let key = reflectSymbol p in GCodec (dec' key) (enc' key)
304
311
where
305
- dec' ∷ String → ReaderT (FO.Object J.Json ) (Either JsonDecodeError ) (Record r' )
306
- dec' key = ReaderT \obj → do
307
- r ← decode codecR obj
308
- a ← BF .lmap (AtKey key) case FO .lookup key obj of
309
- Just val → Just <$> decode codecA val
310
- _ → Right Nothing
311
- pure $ unsafeSet key a r
312
- enc' ∷ String → Star (Writer (L.List (Tuple String J.Json ))) (Record r' ) (Record r' )
313
- enc' key = Star \val → do
314
- let w = encode codecR (unsafeForget val)
315
- writer $ Tuple val case unsafeGet key val of
316
- Just a → Tuple key (encode codecA a) : w
317
- Nothing → w
318
- unsafeForget ∷ Record r' → Record r
319
- unsafeForget = unsafeCoerce
320
- unsafeSet ∷ String → Maybe a → Record r → Record r'
321
- unsafeSet key a = unsafeCoerce <<< FO .insert key a <<< unsafeCoerce
322
- unsafeGet ∷ String → Record r' → Maybe a
323
- unsafeGet s = unsafePartial fromJust <<< FO .lookup s <<< unsafeCoerce
312
+ dec' ∷ String → ReaderT (FO.Object J.Json ) (Either JsonDecodeError ) (Record r' )
313
+ dec' key = ReaderT \obj → do
314
+ r ← decode codecR obj
315
+ a ← BF .lmap (AtKey key) case FO .lookup key obj of
316
+ Just val → Just <$> decode codecA val
317
+ _ → Right Nothing
318
+ pure $ unsafeSet key a r
319
+
320
+ enc' ∷ String → Star (Writer (L.List (Tuple String J.Json ))) (Record r' ) (Record r' )
321
+ enc' key = Star \val → do
322
+ let w = encode codecR (unsafeForget val)
323
+ writer $ Tuple val case unsafeGet key val of
324
+ Just a → Tuple key (encode codecA a) : w
325
+ Nothing → w
326
+
327
+ unsafeForget ∷ Record r' → Record r
328
+ unsafeForget = unsafeCoerce
329
+
330
+ unsafeSet ∷ String → Maybe a → Record r → Record r'
331
+ unsafeSet key a = unsafeCoerce <<< FO .insert key a <<< unsafeCoerce
332
+
333
+ unsafeGet ∷ String → Record r' → Maybe a
334
+ unsafeGet s = unsafePartial fromJust <<< FO .lookup s <<< unsafeCoerce
324
335
325
336
jsonPrimCodec
326
337
∷ ∀ a
327
- . String
338
+ . String
328
339
→ (J.Json → Maybe a )
329
340
→ (a → J.Json )
330
341
→ JsonCodec a
0 commit comments