Improve generics and add tests (#3)

* Improve generics and add tests

* Streamline generic function names

To be more inline with genericShow, genericRead, etc. to all start
with genericReadForeign... or genericWriteForeign... for best dis-
coverability when writing code

* Add more variants of Variants

* Spago install newtype

* Add info in README

Author: i-am-the-slime

.tidyrc.json

@@ -6,5 +6,5 @@
   "ribbon": 1,
   "typeArrowPlacement": "last",
   "unicode": "always",
-  "width": 80
+  "width": 160
 }

.vscode/settings.json

@@ -1,3 +1,3 @@
 {
-  "purescript.buildCommand": "spago -x test.dhall build -- --purs-args --json-errors"
+  "purescript.buildCommand": "spago -x test.dhall build --purs-args --json-errors"
 }

README.md

@@ -8,6 +8,15 @@
 
 ## Usage
 
+```purescript
+import Yoga.JSON as JSON
+
+serialised :: String
+serialised =
+  JSON.writeJSON { first_name: "Lola", last_name: "Flores" }
+```
+
+Check out the tests for how to encode/decode increasingly complex types.
 
 ## Migrate from `purescript-simple-json`
 
@@ -17,5 +26,19 @@
 
 There is an inbuilt codec for `Tuple`s thanks to @ursi
 
-It includes @justinwoo's codecs for en- and decoding generics
-from [simple-json-generics](https://github.com/justinwoo/purescript-simple-json-generics)
+It includes @justinwoo's codecs for en- and decoding generics inspired by
+[simple-json-generics](https://github.com/justinwoo/purescript-simple-json-generics)
+
+### 💣 The Variant Codec is different
+If you want to emulate `simple-json`'s format you may use the newtype  `TaggedVariant`
+
+```purescript
+type YourVariantRow = ( a :: Int, b :: String )
+type YourVariant = Variant YourVariantRow
+x :: YourVariant
+x = inj (Proxy :: Proxy "a") 5
+-- encoded = writeJSON x
+-- ^ Let's say you had this before
+-- You can now do:
+encoded = writeJSON (TaggedVariant "type" "value" x)
+```

packages.dhall

@@ -1,5 +1,5 @@
 let upstream =
-      https://github.com/purescript/package-sets/releases/download/psc-0.15.0-20220509/packages.dhall
-        sha256:d4c1a03606efdbb7bb7745a9d3aa908cb1ba5611921373659a4c7bf1c41c106c
+      https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220610/packages.dhall
+        sha256:348212b7c79da7d343bed71b48ed164d426f1977f92196babac49bd560b32e75
 
 in  upstream

spago.dhall

@@ -14,6 +14,7 @@
   , "identity"
   , "lists"
   , "maybe"
+  , "newtype"
   , "nullable"
   , "partial"
   , "prelude"

src/Yoga/Generics.purs

@@ -35,11 +35,11 @@ import Prelude
 
 import Control.Alt ((<|>))
 import Control.Apply (lift2)
-import Control.Monad.Except (ExceptT(..), except, runExcept, runExceptT, throwError, withExcept)
+import Control.Monad.Except (ExceptT(..), except, runExcept, throwError, withExcept)
 import Data.Array as Array
 import Data.Array.NonEmpty (NonEmptyArray, fromArray, toArray)
 import Data.Bifunctor (lmap)
-import Data.Either (Either(..), hush, note)
+import Data.Either (Either, hush, note)
 import Data.Identity (Identity(..))
 import Data.List.NonEmpty (singleton)
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
@@ -272,37 +272,20 @@ instance
   , Row.Cons name ty from' to
   ) ⇒
   ReadForeignFields (Cons name ty tail) from to where
-  getFields _ obj = (compose <$> first) `exceptTApply` rest
+  getFields _ obj = do
+    compose <$> first <*> rest
     where
-    first = do
-      value ← withExcept' (readImpl =<< readProp name obj)
-      pure $ Builder.insert nameP value
+    value = withExcept' (readImpl =<< readProp name obj)
+    first = Builder.insert nameP <$> value
     rest = getFields tailP obj
     nameP = Proxy ∷ Proxy name
     tailP = Proxy ∷ Proxy tail
     name = reflectSymbol nameP
-    withExcept' = withExcept <<< map $ ErrorAtProperty name
+    withExcept' = (withExcept <<< map) (ErrorAtProperty name)
 
 readAtIdx ∷ ∀ a. ReadForeign a ⇒ Int → Foreign → F a
 readAtIdx i f = withExcept (map (ErrorAtIndex i)) (readImpl f)
 
-exceptTApply ∷
-  ∀ a b e m.
-  Semigroup e ⇒
-  Applicative m ⇒
-  ExceptT e m (a → b) →
-  ExceptT e m a →
-  ExceptT e m b
-exceptTApply fun a = ExceptT $ applyEither
-  <$> runExceptT fun
-  <*> runExceptT a
-
-applyEither ∷ ∀ e a b. Semigroup e ⇒ Either e (a → b) → Either e a → Either e b
-applyEither (Left e) (Right _) = Left e
-applyEither (Left e1) (Left e2) = Left (e1 <> e2)
-applyEither (Right _) (Left e) = Left e
-applyEither (Right fun) (Right a) = Right (fun a)
-
 instance
   ReadForeignFields Nil () () where
   getFields _ _ =
@@ -323,31 +306,25 @@ class
     Foreign →
     F (Variant row)
 
-instance
-  ReadForeignVariant Nil trash where
-  readVariantImpl _ _ = fail $ ForeignError
-    "Unable to match any variant member."
-
 instance
   ( IsSymbol name
   , ReadForeign ty
   , Row.Cons name ty trash row
   , ReadForeignVariant tail row
   ) ⇒
   ReadForeignVariant (Cons name ty tail) row where
-  readVariantImpl _ o =
-    do
-      obj ∷ { type ∷ String, value ∷ Foreign } ← readImpl o
-      if obj.type == name then do
-        value ∷ ty ← readImpl obj.value
-        pure $ inj namep value
-      else
-        (fail <<< ForeignError $ "Did not match variant tag " <> name)
-      <|> readVariantImpl (Proxy ∷ Proxy tail) o
+  readVariantImpl _ o = readVariantImpl (Proxy :: Proxy tail) o <|> ado
+    value :: ty <- readProp name o >>= readImpl
+    in inj namep value
     where
     namep = Proxy ∷ Proxy name
     name = reflectSymbol namep
 
+instance
+  ReadForeignVariant Nil trash where
+  readVariantImpl _ _ = fail $ ForeignError
+    "Unable to match any variant member."
+
 -- -- | A class for writing a value into JSON
 -- -- | need to do this intelligently using Foreign probably, because of null and undefined whatever
 class WriteForeign a where
@@ -449,7 +426,7 @@ instance
   WriteForeignVariant Nil () where
   writeVariantImpl _ _ =
     -- a PureScript-defined variant cannot reach this path, but a JavaScript FFI one could.
-    unsafeCrashWith "Variant was not able to be writen row WriteForeign."
+    unsafeCrashWith "Attempted to write empty variant."
 
 instance
   ( IsSymbol name
@@ -466,10 +443,8 @@ instance
       variant
     where
     namep = Proxy ∷ Proxy name
-    writeVariant value = unsafeToForeign
-      { type: reflectSymbol namep
-      , value: writeImpl value
-      }
+    name = reflectSymbol namep
+    writeVariant value = writeImpl $ Object.singleton name (writeImpl value)
 
 instance ReadForeign a ⇒ ReadForeign (NonEmptyArray a) where
   readImpl f = do
@@ -480,4 +455,4 @@ instance ReadForeign a ⇒ ReadForeign (NonEmptyArray a) where
       $ fromArray raw
 
 instance writeForeignNEArray ∷ WriteForeign a ⇒ WriteForeign (NonEmptyArray a) where
-  writeImpl a = writeImpl <<< toArray $ a
+  writeImpl a = writeImpl <<< toArray $ a

src/Yoga/Generics/TaggedSumRep.purs

@@ -0,0 +1,16 @@
+module Yoga.JSON.Error where
+
+import Prelude
+
+import Foreign (ForeignError(..))
+
+toJSONPath :: ForeignError -> String
+toJSONPath fe = "$" <> path
+  where
+  path = go fe
+  go = case _ of
+    ForeignError _ -> ""
+    TypeMismatch _ _ -> ""
+    ErrorAtIndex i e -> "[" <> show i <> "]" <> go e
+    ErrorAtProperty _ (TypeMismatch _ "undefined") -> ""
+    ErrorAtProperty prop e -> "." <> prop <> go e

src/Yoga/Generics/UntaggedProductRep.purs

@@ -0,0 +1,8 @@
+module Yoga.JSON.Generics
+  ( module Exported
+  ) where
+
+import Yoga.JSON.Generics.TaggedSumRep (class ReadGenericTaggedSumRep, class WriteGenericTaggedSumRep, Options, defaultOptions, genericReadForeignTaggedSum, genericReadForeignTaggedSumRep, genericWriteForeignTaggedSum, genericWriteForeignTaggedSumRep) as Exported
+import Yoga.JSON.Generics.UntaggedSumRep (class ReadGenericUntaggedSumRep, class WriteGenericUntaggedSumRep, genericReadForeignUntaggedSum, genericReadForeignUntaggedSumRep, genericWriteForeignUntaggedSum, genericWriteForeignUntaggedSumRep) as Exported
+import Yoga.JSON.Generics.EnumSumRep (class GenericEnumSumRep, genericEnumReadForeign, genericEnumWriteForeign, genericReadForeignEnum, genericWriteForeignEnum) as Exported
+import Yoga.JSON.Generics.UntaggedProductRep (class ReadGenericUntaggedProduct, class WriteGenericUntaggedProduct, Offset, genericReadForeignUntaggedProduct, genericReadForeignUntaggedProductRep, genericWriteForeignUntaggedProduct, genericWriteForeignUntaggedProductRep) as Exported