Add EncodeJson/DecodeJson instances for records

bower.json

@@ -26,7 +26,8 @@
     "purescript-integers": "^4.0.0",
     "purescript-maybe": "^4.0.0",
     "purescript-ordered-collections": "^1.0.0",
-    "purescript-foreign-object": "^1.0.0"
+    "purescript-foreign-object": "^1.0.0",
+    "purescript-record": "^1.0.0"
   },
   "devDependencies": {
     "purescript-test-unit": "^14.0.0"

src/Data/Argonaut/Decode/Class.purs

@@ -1,7 +1,4 @@
-module Data.Argonaut.Decode.Class
-  ( class DecodeJson
-  , decodeJson
-  ) where
+module Data.Argonaut.Decode.Class where
 
 import Prelude
 
@@ -13,10 +10,15 @@ import Data.List (List(..), (:), fromFoldable)
 import Data.Map as M
 import Data.Maybe (maybe, Maybe(..))
 import Data.String (CodePoint, codePointAt)
+import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
 import Data.Traversable (traverse)
 import Data.TraversableWithIndex (traverseWithIndex)
 import Data.Tuple (Tuple(..))
 import Foreign.Object as FO
+import Prim.Row as Row
+import Prim.RowList as RL
+import Record as Record
+import Type.Data.RowList (RLProxy(..))
 
 class DecodeJson a where
   decodeJson :: Json -> Either String a
@@ -98,3 +100,45 @@ decodeJArray = maybe (Left "Value is not an Array") Right <<< toArray
 
 decodeJObject :: Json -> Either String (FO.Object Json)
 decodeJObject = maybe (Left "Value is not an Object") Right <<< toObject
+
+instance decodeRecord
+  :: ( GDecodeJson row list
+     , RL.RowToList row list
+     )
+  => DecodeJson (Record row) where
+
+  decodeJson json =
+    case toObject json of
+      Just object -> gDecodeJson object (RLProxy :: RLProxy list)
+      Nothing     -> Left "Could not convert JSON to object"
+
+class GDecodeJson (row :: # Type) (list :: RL.RowList) | list -> row where
+  gDecodeJson :: FO.Object Json -> RLProxy list -> Either String (Record row)
+
+instance gDecodeJsonNil :: GDecodeJson () RL.Nil where
+  gDecodeJson _ _ = Right {}
+
+instance gDecodeJsonCons
+  :: ( DecodeJson value
+     , GDecodeJson rowTail tail
+     , IsSymbol field
+     , Row.Cons field value rowTail row
+     , Row.Lacks field rowTail
+     )
+  => GDecodeJson row (RL.Cons field value tail) where
+
+  gDecodeJson object _ = do
+    let sProxy :: SProxy field
+        sProxy = SProxy
+
+        fieldName = reflectSymbol sProxy
+
+    rest <- gDecodeJson object (RLProxy :: RLProxy tail)
+
+    case FO.lookup fieldName object of
+      Just jsonVal -> do
+        val <- decodeJson jsonVal
+        Right $ Record.insert sProxy val rest
+
+      Nothing ->
+        Left $ "JSON was missing expected field: " <> fieldName

src/Data/Argonaut/Encode/Class.purs

@@ -11,8 +11,13 @@ import Data.Maybe (Maybe(..))
 import Data.String (CodePoint)
 import Data.String.CodePoints as CP
 import Data.String.CodeUnits as CU
+import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
 import Data.Tuple (Tuple(..))
 import Foreign.Object as FO
+import Prim.Row as Row
+import Prim.RowList as RL
+import Record as Record
+import Type.Data.RowList (RLProxy(..))
 
 class EncodeJson a where
   encodeJson :: a -> Json
@@ -70,3 +75,35 @@ instance encodeMap :: (Ord a, EncodeJson a, EncodeJson b) => EncodeJson (M.Map a
 
 instance encodeVoid :: EncodeJson Void where
   encodeJson = absurd
+
+instance encodeRecord
+  :: ( GEncodeJson row list
+     , RL.RowToList row list
+     )
+  => EncodeJson (Record row) where
+
+  encodeJson rec = fromObject $ gEncodeJson rec (RLProxy :: RLProxy list)
+
+class GEncodeJson (row :: # Type) (list :: RL.RowList) where
+  gEncodeJson :: Record row -> RLProxy list -> FO.Object Json
+
+instance gEncodeJsonNil :: GEncodeJson row RL.Nil where
+  gEncodeJson _ _ = FO.empty
+
+instance gEncodeJsonCons
+  :: ( EncodeJson value
+     , GEncodeJson row tail
+     , IsSymbol field
+     , Row.Cons field value tail' row
+     )
+  => GEncodeJson row (RL.Cons field value tail) where
+
+  gEncodeJson row _ =
+    let
+      sProxy :: SProxy field
+      sProxy = SProxy
+    in
+      FO.insert
+        (reflectSymbol sProxy)
+        (encodeJson $ Record.get sProxy row)
+        (gEncodeJson row $ RLProxy :: RLProxy tail)

test/Test/Main.purs

@@ -17,19 +17,44 @@ import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Foreign.Object as FO
 import Test.QuickCheck (Result(..), (<?>), (===))
+import Test.QuickCheck.Arbitrary (arbitrary)
 import Test.QuickCheck.Gen (Gen, resize, suchThat)
 import Test.Unit (TestSuite, test, suite, failure)
 import Test.Unit.Assert as Assert
 import Test.Unit.Main (runTest)
 import Test.Unit.QuickCheck (quickCheck)
 
+
 main :: Effect Unit
 main = runTest do
   suite "Either Check" eitherCheck
   suite "Encode/Decode Checks" encodeDecodeCheck
+  suite "Encode/Decode Record Checks" encodeDecodeRecordCheck
   suite "Combinators Checks" combinatorsCheck
   suite "Error Message Checks" errorMsgCheck
 
+
+genTestRecord
+  :: Gen (Record
+       ( i :: Int
+       , n :: Number
+       , s :: String
+       ))
+genTestRecord = arbitrary
+
+encodeDecodeRecordCheck :: TestSuite
+encodeDecodeRecordCheck = do
+  test "Testing that any record can be encoded and then decoded" do
+    quickCheck rec_encode_then_decode
+
+  where
+   rec_encode_then_decode :: Gen Result
+   rec_encode_then_decode = do
+    rec <- genTestRecord
+    let redecoded = decodeJson (encodeJson rec)
+    pure $ Right rec == redecoded <?> (show redecoded <> " /= Right " <> show rec)
+
+
 genTestJson :: Gen Json
 genTestJson = resize 5 genJson