@@ -30,18 +30,18 @@ module Data.Codec.Argonaut
30
30
import Prelude
31
31
32
32
import Control.Monad.Reader (ReaderT (..), runReaderT )
33
- import Control.Monad.Writer (Writer , writer , mapWriter )
33
+ import Control.Monad.Writer (Writer , mapWriter , writer )
34
34
import Data.Argonaut.Core as J
35
35
import Data.Array as A
36
36
import Data.Bifunctor as BF
37
37
import Data.Codec (BasicCodec , Codec , GCodec (..), basicCodec , bihoistGCodec , decode , encode )
38
- import Data.Codec (decode , encode , (~ ), (<~< ), (>~> )) as Exports
38
+ import Data.Codec (decode , encode , (<~< ), (>~> ), (~ )) as Exports
39
39
import Data.Either (Either (..), note )
40
40
import Data.Generic.Rep (class Generic )
41
41
import Data.Int as I
42
42
import Data.List ((:))
43
43
import Data.List as L
44
- import Data.Maybe (Maybe (..), maybe , fromJust )
44
+ import Data.Maybe (Maybe (..), fromJust , maybe )
45
45
import Data.Profunctor.Star (Star (..))
46
46
import Data.String as S
47
47
import Data.String.CodeUnits as SCU
@@ -72,25 +72,25 @@ derive instance genericJsonDecodeError ∷ Generic JsonDecodeError _
72
72
73
73
instance showJsonDecodeError ∷ Show JsonDecodeError where
74
74
show = case _ of
75
- TypeMismatch s -> " (TypeMismatch " <> show s <> " )"
76
- UnexpectedValue j -> " (UnexpectedValue " <> J .stringify j <> " )"
77
- AtIndex i e -> " (AtIndex " <> show i <> " " <> show e <> " )"
78
- AtKey k e -> " (AtKey " <> show k <> " " <> show e <> " )"
79
- Named s e -> " (Named " <> show s <> " " <> show e <> " )"
80
- MissingValue -> " MissingValue"
75
+ TypeMismatch s → " (TypeMismatch " <> show s <> " )"
76
+ UnexpectedValue j → " (UnexpectedValue " <> J .stringify j <> " )"
77
+ AtIndex i e → " (AtIndex " <> show i <> " " <> show e <> " )"
78
+ AtKey k e → " (AtKey " <> show k <> " " <> show e <> " )"
79
+ Named s e → " (Named " <> show s <> " " <> show e <> " )"
80
+ MissingValue → " MissingValue"
81
81
82
82
-- | Prints a `JsonDecodeError` as a somewhat readable error message.
83
83
printJsonDecodeError ∷ JsonDecodeError → String
84
84
printJsonDecodeError err =
85
85
" An error occurred while decoding a JSON value:\n " <> go err
86
86
where
87
- go = case _ of
88
- TypeMismatch ty → " Expected value of type '" <> ty <> " '."
89
- UnexpectedValue val → " Unexpected value " <> J .stringify val <> " ."
90
- AtIndex ix inner → " At array index " <> show ix <> " :\n " <> go inner
91
- AtKey key inner → " At object key " <> key <> " :\n " <> go inner
92
- Named name inner → " Under '" <> name <> " ':\n " <> go inner
93
- MissingValue → " No value was found."
87
+ go = case _ of
88
+ TypeMismatch ty → " Expected value of type '" <> ty <> " '."
89
+ UnexpectedValue val → " Unexpected value " <> J .stringify val <> " ."
90
+ AtIndex ix inner → " At array index " <> show ix <> " :\n " <> go inner
91
+ AtKey key inner → " At object key " <> key <> " :\n " <> go inner
92
+ Named name inner → " Under '" <> name <> " ':\n " <> go inner
93
+ MissingValue → " No value was found."
94
94
95
95
-- | The "identity codec" for `Json` values.
96
96
json ∷ JsonCodec J.Json
@@ -162,7 +162,8 @@ type JIndexedCodec a =
162
162
(Either JsonDecodeError )
163
163
(Array J.Json )
164
164
(L.List J.Json )
165
- a a
165
+ a
166
+ a
166
167
167
168
-- | A codec for types that are encoded as an array with a specific layout.
168
169
-- |
@@ -203,7 +204,8 @@ type JPropCodec a =
203
204
(Either JsonDecodeError )
204
205
(FO.Object J.Json )
205
206
(L.List (Tuple String J.Json ))
206
- a a
207
+ a
208
+ a
207
209
208
210
-- | A codec for objects that are encoded with specific properties.
209
211
-- |
@@ -224,6 +226,7 @@ prop key codec = GCodec dec enc
224
226
BF .lmap (AtKey key) case FO .lookup key obj of
225
227
Just val → decode codec val
226
228
Nothing → Left MissingValue
229
+
227
230
enc ∷ Star (Writer (L.List (Tuple String J.Json ))) a a
228
231
enc = Star \val → writer $ Tuple val (pure (Tuple key (encode codec val)))
229
232
@@ -264,28 +267,32 @@ recordProp
264
267
recordProp p codecA codecR =
265
268
let key = reflectSymbol p in GCodec (dec' key) (enc' key)
266
269
where
267
- dec' ∷ String → ReaderT (FO.Object J.Json ) (Either JsonDecodeError ) (Record r' )
268
- dec' key = ReaderT \obj → do
269
- r ← decode codecR obj
270
- a ← BF .lmap (AtKey key) case FO .lookup key obj of
271
- Just val → decode codecA val
272
- Nothing → Left MissingValue
273
- pure $ unsafeSet key a r
274
- enc' ∷ String → Star (Writer (L.List (Tuple String J.Json ))) (Record r' ) (Record r' )
275
- enc' key = Star \val →
276
- writer $ Tuple val
277
- $ Tuple key (encode codecA (unsafeGet key val))
278
- : encode codecR (unsafeForget val)
279
- unsafeForget ∷ Record r' → Record r
280
- unsafeForget = unsafeCoerce
281
- unsafeSet ∷ String → a → Record r → Record r'
282
- unsafeSet key a = unsafeCoerce <<< FO .insert key a <<< unsafeCoerce
283
- unsafeGet ∷ String → Record r' → a
284
- unsafeGet s = unsafePartial fromJust <<< FO .lookup s <<< unsafeCoerce
270
+ dec' ∷ String → ReaderT (FO.Object J.Json ) (Either JsonDecodeError ) (Record r' )
271
+ dec' key = ReaderT \obj → do
272
+ r ← decode codecR obj
273
+ a ← BF .lmap (AtKey key) case FO .lookup key obj of
274
+ Just val → decode codecA val
275
+ Nothing → Left MissingValue
276
+ pure $ unsafeSet key a r
277
+
278
+ enc' ∷ String → Star (Writer (L.List (Tuple String J.Json ))) (Record r' ) (Record r' )
279
+ enc' key = Star \val →
280
+ writer $ Tuple val
281
+ $ Tuple key (encode codecA (unsafeGet key val))
282
+ : encode codecR (unsafeForget val)
283
+
284
+ unsafeForget ∷ Record r' → Record r
285
+ unsafeForget = unsafeCoerce
286
+
287
+ unsafeSet ∷ String → a → Record r → Record r'
288
+ unsafeSet key a = unsafeCoerce <<< FO .insert key a <<< unsafeCoerce
289
+
290
+ unsafeGet ∷ String → Record r' → a
291
+ unsafeGet s = unsafePartial fromJust <<< FO .lookup s <<< unsafeCoerce
285
292
286
293
jsonPrimCodec
287
294
∷ ∀ a
288
- . String
295
+ . String
289
296
→ (J.Json → Maybe a )
290
297
→ (a → J.Json )
291
298
→ JsonCodec a
0 commit comments