diff --git a/bower.json b/bower.json index 11a7893..1ca578f 100644 --- a/bower.json +++ b/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" diff --git a/src/Data/Argonaut/Decode/Class.purs b/src/Data/Argonaut/Decode/Class.purs index 398fe9a..03ca376 100644 --- a/src/Data/Argonaut/Decode/Class.purs +++ b/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 diff --git a/src/Data/Argonaut/Encode/Class.purs b/src/Data/Argonaut/Encode/Class.purs index ba8fb4d..d2ee94c 100644 --- a/src/Data/Argonaut/Encode/Class.purs +++ b/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) diff --git a/test/Test/Main.purs b/test/Test/Main.purs index d9e9b94..339478f 100644 --- a/test/Test/Main.purs +++ b/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