@@ -31,18 +31,18 @@ module Data.Codec.Argonaut
3131import Prelude
3232
3333import Control.Monad.Reader (ReaderT (..), runReaderT )
34- import Control.Monad.Writer (Writer , writer , mapWriter )
34+ import Control.Monad.Writer (Writer , mapWriter , writer )
3535import Data.Argonaut.Core as J
3636import Data.Array as A
3737import Data.Bifunctor as BF
3838import 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
4040import Data.Either (Either (..), note )
4141import Data.Generic.Rep (class Generic )
4242import Data.Int as I
4343import Data.List ((:))
4444import Data.List as L
45- import Data.Maybe (Maybe (..), maybe , fromJust )
45+ import Data.Maybe (Maybe (..), fromJust , maybe )
4646import Data.Profunctor.Star (Star (..))
4747import Data.String as S
4848import Data.String.CodeUnits as SCU
@@ -73,25 +73,25 @@ derive instance genericJsonDecodeError ∷ Generic JsonDecodeError _
7373
7474instance showJsonDecodeError ∷ Show JsonDecodeError where
7575 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"
8282
8383-- | Prints a `JsonDecodeError` as a somewhat readable error message.
8484printJsonDecodeError ∷ JsonDecodeError → String
8585printJsonDecodeError err =
8686 " An error occurred while decoding a JSON value:\n " <> go err
8787 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."
9595
9696-- | The "identity codec" for `Json` values.
9797json ∷ JsonCodec J.Json
@@ -163,7 +163,8 @@ type JIndexedCodec a =
163163 (Either JsonDecodeError )
164164 (Array J.Json )
165165 (L.List J.Json )
166- a a
166+ a
167+ a
167168
168169-- | A codec for types that are encoded as an array with a specific layout.
169170-- |
@@ -204,7 +205,8 @@ type JPropCodec a =
204205 (Either JsonDecodeError )
205206 (FO.Object J.Json )
206207 (L.List (Tuple String J.Json ))
207- a a
208+ a
209+ a
208210
209211-- | A codec for objects that are encoded with specific properties.
210212-- |
@@ -225,6 +227,7 @@ prop key codec = GCodec dec enc
225227 BF .lmap (AtKey key) case FO .lookup key obj of
226228 Just val → decode codec val
227229 Nothing → Left MissingValue
230+
228231 enc ∷ Star (Writer (L.List (Tuple String J.Json ))) a a
229232 enc = Star \val → writer $ Tuple val (pure (Tuple key (encode codec val)))
230233
@@ -265,29 +268,33 @@ recordProp
265268recordProp p codecA codecR =
266269 let key = reflectSymbol p in GCodec (dec' key) (enc' key)
267270 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+
287294-- | Used with `record` to define an optional field.
288295-- |
289296-- | 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
291298-- | separately.
292299-- |
293300-- | The property will be omitted when encoding and the value is `Nothing`.
@@ -302,29 +309,33 @@ recordPropOptional
302309recordPropOptional p codecA codecR =
303310 let key = reflectSymbol p in GCodec (dec' key) (enc' key)
304311 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
324335
325336jsonPrimCodec
326337 ∷ ∀ a
327- . String
338+ . String
328339 → (J.Json → Maybe a )
329340 → (a → J.Json )
330341 → JsonCodec a
0 commit comments