Format source

Author: thomashoneyman

src/Data/Codec/Argonaut.purs

@@ -30,18 +30,18 @@ module Data.Codec.Argonaut
 import Prelude
 
 import Control.Monad.Reader (ReaderT(..), runReaderT)
-import Control.Monad.Writer (Writer, writer, mapWriter)
+import Control.Monad.Writer (Writer, mapWriter, writer)
 import Data.Argonaut.Core as J
 import Data.Array as A
 import Data.Bifunctor as BF
 import Data.Codec (BasicCodec, Codec, GCodec(..), basicCodec, bihoistGCodec, decode, encode)
-import Data.Codec (decode, encode, (~), (<~<), (>~>)) as Exports
+import Data.Codec (decode, encode, (<~<), (>~>), (~)) as Exports
 import Data.Either (Either(..), note)
 import Data.Generic.Rep (class Generic)
 import Data.Int as I
 import Data.List ((:))
 import Data.List as L
-import Data.Maybe (Maybe(..), maybe, fromJust)
+import Data.Maybe (Maybe(..), fromJust, maybe)
 import Data.Profunctor.Star (Star(..))
 import Data.String as S
 import Data.String.CodeUnits as SCU
@@ -72,25 +72,25 @@ derive instance genericJsonDecodeError ∷ Generic JsonDecodeError _
 
 instance showJsonDecodeError ∷ Show JsonDecodeError where
   show = case _ of
-    TypeMismatch s -> "(TypeMismatch " <> show s <> ")"
-    UnexpectedValue j -> "(UnexpectedValue " <> J.stringify j <> ")"
-    AtIndex i e -> "(AtIndex " <> show i <> " " <> show e <> ")"
-    AtKey k e -> "(AtKey " <> show k <> " " <> show e <> ")"
-    Named s e -> "(Named " <> show s <> " " <> show e <> ")"
-    MissingValue -> "MissingValue"
+    TypeMismatch s → "(TypeMismatch " <> show s <> ")"
+    UnexpectedValue j → "(UnexpectedValue " <> J.stringify j <> ")"
+    AtIndex i e → "(AtIndex " <> show i <> " " <> show e <> ")"
+    AtKey k e → "(AtKey " <> show k <> " " <> show e <> ")"
+    Named s e → "(Named " <> show s <> " " <> show e <> ")"
+    MissingValue → "MissingValue"
 
 -- | Prints a `JsonDecodeError` as a somewhat readable error message.
 printJsonDecodeError ∷ JsonDecodeError → String
 printJsonDecodeError err =
   "An error occurred while decoding a JSON value:\n" <> go err
   where
-    go = case _ of
-      TypeMismatch ty → "  Expected value of type '" <> ty <> "'."
-      UnexpectedValue val → "  Unexpected value " <> J.stringify val <> "."
-      AtIndex ix inner → "  At array index " <> show ix <> ":\n" <> go inner
-      AtKey key inner → "  At object key " <> key <> ":\n" <> go inner
-      Named name inner → "  Under '" <> name <> "':\n" <> go inner
-      MissingValue → "  No value was found."
+  go = case _ of
+    TypeMismatch ty → "  Expected value of type '" <> ty <> "'."
+    UnexpectedValue val → "  Unexpected value " <> J.stringify val <> "."
+    AtIndex ix inner → "  At array index " <> show ix <> ":\n" <> go inner
+    AtKey key inner → "  At object key " <> key <> ":\n" <> go inner
+    Named name inner → "  Under '" <> name <> "':\n" <> go inner
+    MissingValue → "  No value was found."
 
 -- | The "identity codec" for `Json` values.
 json ∷ JsonCodec J.Json
@@ -162,7 +162,8 @@ type JIndexedCodec a =
     (Either JsonDecodeError)
     (Array J.Json)
     (L.List J.Json)
-    a a
+    a
+    a
 
 -- | A codec for types that are encoded as an array with a specific layout.
 -- |
@@ -203,7 +204,8 @@ type JPropCodec a =
     (Either JsonDecodeError)
     (FO.Object J.Json)
     (L.List (Tuple String J.Json))
-    a a
+    a
+    a
 
 -- | A codec for objects that are encoded with specific properties.
 -- |
@@ -224,6 +226,7 @@ prop key codec = GCodec dec enc
     BF.lmap (AtKey key) case FO.lookup key obj of
       Just val → decode codec val
       Nothing → Left MissingValue
+
   enc ∷ Star (Writer (L.List (Tuple String J.Json))) a a
   enc = Star \val → writer $ Tuple val (pure (Tuple key (encode codec val)))
 
@@ -264,28 +267,32 @@ recordProp
 recordProp p codecA codecR =
   let key = reflectSymbol p in GCodec (dec' key) (enc' key)
   where
-    dec' ∷ String → ReaderT (FO.Object J.Json) (Either JsonDecodeError) (Record r')
-    dec' key = ReaderT \obj → do
-      r ← decode codecR obj
-      a ← BF.lmap (AtKey key) case FO.lookup key obj of
-        Just val → decode codecA val
-        Nothing → Left MissingValue
-      pure $ unsafeSet key a r
-    enc' ∷ String → Star (Writer (L.List (Tuple String J.Json))) (Record r') (Record r')
-    enc' key = Star \val →
-      writer $ Tuple val
-        $ Tuple key (encode codecA (unsafeGet key val))
-        : encode codecR (unsafeForget val)
-    unsafeForget ∷ Record r' → Record r
-    unsafeForget = unsafeCoerce
-    unsafeSet ∷ String → a → Record r → Record r'
-    unsafeSet key a = unsafeCoerce <<< FO.insert key a <<< unsafeCoerce
-    unsafeGet ∷ String → Record r' → a
-    unsafeGet s = unsafePartial fromJust <<< FO.lookup s <<< unsafeCoerce
+  dec' ∷ String → ReaderT (FO.Object J.Json) (Either JsonDecodeError) (Record r')
+  dec' key = ReaderT \obj → do
+    r ← decode codecR obj
+    a ← BF.lmap (AtKey key) case FO.lookup key obj of
+      Just val → decode codecA val
+      Nothing → Left MissingValue
+    pure $ unsafeSet key a r
+
+  enc' ∷ String → Star (Writer (L.List (Tuple String J.Json))) (Record r') (Record r')
+  enc' key = Star \val →
+    writer $ Tuple val
+      $ Tuple key (encode codecA (unsafeGet key val))
+          : encode codecR (unsafeForget val)
+
+  unsafeForget ∷ Record r' → Record r
+  unsafeForget = unsafeCoerce
+
+  unsafeSet ∷ String → a → Record r → Record r'
+  unsafeSet key a = unsafeCoerce <<< FO.insert key a <<< unsafeCoerce
+
+  unsafeGet ∷ String → Record r' → a
+  unsafeGet s = unsafePartial fromJust <<< FO.lookup s <<< unsafeCoerce
 
 jsonPrimCodec
   ∷ ∀ a
-   . String
+  . String
   → (J.Json → Maybe a)
   → (a → J.Json)
   → JsonCodec a

src/Data/Codec/Argonaut/Common.purs

@@ -14,8 +14,8 @@ import Data.List as L
 import Data.Map as M
 import Data.Maybe (Maybe(..))
 import Data.Profunctor (dimap)
-import Foreign.Object as FO
 import Data.Tuple (Tuple(..), fst, snd)
+import Foreign.Object as FO
 
 -- | A codec for `Maybe` values.
 -- |

src/Data/Codec/Argonaut/Compat.purs

@@ -15,9 +15,9 @@ import Data.Codec.Argonaut.Common (either, list, map, tuple) as Common
 import Data.Either (Either)
 import Data.Functor as F
 import Data.Maybe (Maybe(..))
-import Foreign.Object as FO
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..))
+import Foreign.Object as FO
 
 -- | A codec for `Maybe` values.
 -- |
@@ -32,6 +32,7 @@ maybe codec = basicCodec dec enc
   dec j
     | J.isNull j = pure Nothing
     | otherwise = BF.bimap (Named "Maybe") Just ((decode codec j))
+
   enc ∷ Maybe a → J.Json
   enc = case _ of
     Nothing → J.jsonNull
@@ -53,6 +54,7 @@ foreignObject codec =
   where
   fromArray ∷ ∀ v. Array (Tuple String v) → FO.Object v
   fromArray = FO.fromFoldable
+
   decodeItem ∷ Tuple String J.Json → Either JsonDecodeError (Tuple String a)
   decodeItem (Tuple key value) =
     BF.bimap (AtKey key) (Tuple key) (decode codec value)

src/Data/Codec/Argonaut/Generic.purs

@@ -36,15 +36,13 @@ instance nullarySumCodecSum ∷ (NullarySumCodec a, NullarySumCodec b) ⇒ Nulla
   nullarySumEncode = case _ of
     Inl a → nullarySumEncode a
     Inr b → nullarySumEncode b
-  nullarySumDecode name j
-    = Inl <$> nullarySumDecode name j
+  nullarySumDecode name j = Inl <$> nullarySumDecode name j
     <|> Inr <$> nullarySumDecode name j
 
 instance nullarySumCodecCtor ∷ IsSymbol name ⇒ NullarySumCodec (Constructor name NoArguments) where
   nullarySumEncode _ =
     J.fromString $ reflectSymbol (Proxy ∷ Proxy name)
   nullarySumDecode name j = do
     tag ← note (CA.Named name (CA.TypeMismatch "String")) (J.toString j)
-    if tag /= reflectSymbol (Proxy ∷ Proxy name)
-      then Left (CA.Named name (CA.UnexpectedValue j))
-      else Right (Constructor NoArguments)
+    if tag /= reflectSymbol (Proxy ∷ Proxy name) then Left (CA.Named name (CA.UnexpectedValue j))
+    else Right (Constructor NoArguments)

src/Data/Codec/Argonaut/Migration.purs

@@ -59,10 +59,10 @@ import Prelude
 import Data.Argonaut.Core as J
 import Data.Codec (basicCodec)
 import Data.Codec.Argonaut (JsonCodec)
-import Data.Maybe (Maybe(..), maybe, fromMaybe)
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Tuple (Tuple(..), uncurry)
 import Foreign.Object as FO
 import Foreign.Object.ST as FOST
-import Data.Tuple (Tuple(..), uncurry)
 
 -- | When dealing with a JSON object that may be missing a field, this codec
 -- | can be used to alter the JSON before parsing to ensure a default value is
@@ -89,6 +89,7 @@ renameField oldName newName = basicCodec (pure <<< dec) identity
   where
   dec ∷ J.Json → J.Json
   dec j = J.caseJsonObject j (J.fromObject <<< rename) j
+
   rename ∷ FO.Object J.Json → FO.Object J.Json
   rename obj = maybe obj (uncurry (FO.insert newName)) (FO.pop oldName obj)
 
@@ -117,6 +118,7 @@ nestForTagged = basicCodec (pure <<< dec) identity
   where
   dec ∷ J.Json → J.Json
   dec j = J.caseJsonObject j (J.fromObject <<< rewrite) j
+
   rewrite ∷ FO.Object J.Json → FO.Object J.Json
   rewrite obj =
     case FO.pop "tag" obj of
@@ -127,6 +129,7 @@ nestForTagged = basicCodec (pure <<< dec) identity
         result ← FOST.new
         _ ← FOST.poke "tag" tagValue result
         FOST.poke "value" (mkValue obj') result
+
   mkValue ∷ FO.Object J.Json → J.Json
   mkValue obj = case FO.pop "value" obj of
     Just (Tuple valueValue obj') | FO.isEmpty obj' → valueValue
@@ -137,5 +140,6 @@ alterField field f = basicCodec (pure <<< dec) identity
   where
   dec ∷ J.Json → J.Json
   dec j = J.caseJsonObject j (J.fromObject <<< setDefault) j
+
   setDefault ∷ FO.Object J.Json → FO.Object J.Json
   setDefault = FO.alter f field

src/Data/Codec/Argonaut/Record.purs

@@ -41,7 +41,7 @@ record = rowListCodec (Proxy ∷ Proxy rl)
 -- | The class used to enable the building of `Record` codecs by providing a
 -- | record of codecs.
 class RowListCodec (rl ∷ RL.RowList Type) (ri ∷ Row Type) (ro ∷ Row Type) | rl → ri ro where
-  rowListCodec ∷ forall proxy. proxy rl → Record ri → CA.JPropCodec (Record ro)
+  rowListCodec ∷ ∀ proxy. proxy rl → Record ri → CA.JPropCodec (Record ro)
 
 instance rowListCodecNil ∷ RowListCodec RL.Nil () () where
   rowListCodec _ _ = CA.record
@@ -52,7 +52,8 @@ instance rowListCodecCons ∷
   , R.Cons sym a ro' ro
   , IsSymbol sym
   , TE.TypeEquals co (CA.JsonCodec a)
-  ) ⇒ RowListCodec (RL.Cons sym co rs) ri ro where
+  ) ⇒
+  RowListCodec (RL.Cons sym co rs) ri ro where
   rowListCodec _ codecs =
     CA.recordProp (Proxy ∷ Proxy sym) codec tail
     where

src/Data/Codec/Argonaut/Sum.purs

@@ -14,9 +14,9 @@ import Data.Codec.Argonaut (JsonCodec, JsonDecodeError(..), jobject, json, prop,
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..), maybe)
 import Data.Profunctor.Star (Star(..))
+import Data.Tuple (Tuple(..))
 import Foreign.Object as FO
 import Foreign.Object.ST as FOST
-import Data.Tuple (Tuple(..))
 
 -- | A helper for defining JSON codecs for "enum" sum types, where every
 -- | constructor is nullary, and the type will be encoded as a string.
@@ -33,6 +33,7 @@ enumSum printTag parseTag = GCodec dec enc
     case parseTag value of
       Just a → Right a
       Nothing → Left (UnexpectedValue j)
+
   enc ∷ Star (Writer J.Json) a a
   enc = Star \a → writer $ Tuple a (encode string (printTag a))
 
@@ -70,11 +71,12 @@ taggedSum name printTag parseTag f g = GCodec decodeCase encodeCase
           Right decoder → do
             value ← decode (prop "value" json) obj
             lmap (AtKey "value") (decoder value)
+
   encodeCase ∷ Star (Writer J.Json) a a
   encodeCase = Star case _ of
     a | Tuple tag value ← g a →
       writer $ Tuple a $ encode jobject $
         FO.runST do
           obj ← FOST.new
           _ ← FOST.poke "tag" (encode string (printTag tag)) obj
-          maybe (pure obj) (\v -> FOST.poke "value" v obj) value
+          maybe (pure obj) (\v → FOST.poke "value" v obj) value

src/Data/Codec/Argonaut/Variant.purs

@@ -19,8 +19,8 @@ import Prim.Row as R
 import Prim.RowList as RL
 import Record as Rec
 import Type.Equality as TE
-import Unsafe.Coerce (unsafeCoerce)
 import Type.Proxy (Proxy(..))
+import Unsafe.Coerce (unsafeCoerce)
 
 -- | Builds a codec for a variant from a record, similar to the way
 -- | `Variant.match` works to pattern match on a variant.
@@ -103,33 +103,34 @@ variantCase proxy eacodec (GCodec dec enc) = GCodec dec' enc'
   dec' = ReaderT \j → do
     obj ← decode jobject j
     tag ← decode (prop "tag" string) obj
-    if tag == reflectSymbol proxy
-      then case eacodec of
-        Left a → pure (inj proxy a)
-        Right codec → do
-          value ← decode (prop "value" json) obj
-          inj proxy <$> decode codec value
-      else coerceR <$> runReaderT dec j
+    if tag == reflectSymbol proxy then case eacodec of
+      Left a → pure (inj proxy a)
+      Right codec → do
+        value ← decode (prop "value" json) obj
+        inj proxy <$> decode codec value
+    else coerceR <$> runReaderT dec j
 
   enc' ∷ Star (Writer J.Json) (Variant r') (Variant r')
   enc' = Star \v →
     on proxy
-      (\v' → writer $ Tuple v $ encode jobject $
-        FO.runST do
-          obj ← FOST.new
-          _ ← FOST.poke "tag" (encode string (reflectSymbol proxy)) obj
-          case eacodec of
-            Left _ → pure obj
-            Right codec → FOST.poke "value" (encode codec v') obj)
-      (\v' → un Star enc v' $> v) v
+      ( \v' → writer $ Tuple v $ encode jobject $
+          FO.runST do
+            obj ← FOST.new
+            _ ← FOST.poke "tag" (encode string (reflectSymbol proxy)) obj
+            case eacodec of
+              Left _ → pure obj
+              Right codec → FOST.poke "value" (encode codec v') obj
+      )
+      (\v' → un Star enc v' $> v)
+      v
 
   coerceR ∷ Variant r → Variant r'
   coerceR = unsafeCoerce
 
 -- | The class used to enable the building of `Variant` codecs from a record of
 -- | codecs.
 class VariantCodec (rl ∷ RL.RowList Type) (ri ∷ Row Type) (ro ∷ Row Type) | rl → ri ro where
-  variantCodec ∷ forall proxy. proxy rl → Record ri → JsonCodec (Variant ro)
+  variantCodec ∷ ∀ proxy. proxy rl → Record ri → JsonCodec (Variant ro)
 
 instance variantCodecNil ∷ VariantCodec RL.Nil () () where
   variantCodec _ _ = variant
@@ -140,7 +141,8 @@ instance variantCodecCons ∷
   , R.Cons sym a ro' ro
   , IsSymbol sym
   , TE.TypeEquals co (Either a (JsonCodec a))
-  ) ⇒ VariantCodec (RL.Cons sym co rs) ri ro where
+  ) ⇒
+  VariantCodec (RL.Cons sym co rs) ri ro where
   variantCodec _ codecs =
     variantCase (Proxy ∷ Proxy sym) codec tail
     where