From 31efb1df44d1e031a5868064dee7d0c17bd88883 Mon Sep 17 00:00:00 2001 From: Forest Loren Toney III Date: Tue, 13 Mar 2018 15:40:05 -0700 Subject: [PATCH 1/2] Add assocOptional and extendOptional encode combinators --- bower.json | 3 ++- src/Data/Argonaut/Encode.purs | 11 ++++++++- src/Data/Argonaut/Encode/Combinators.purs | 19 +++++++++++++++- test/Test/Main.purs | 27 +++++++++++++++++++---- 4 files changed, 53 insertions(+), 7 deletions(-) diff --git a/bower.json b/bower.json index 3fb2c5a..9877557 100644 --- a/bower.json +++ b/bower.json @@ -24,7 +24,8 @@ "dependencies": { "purescript-argonaut-core": "^3.0.0", "purescript-generics": "^4.0.0", - "purescript-integers": "^3.0.0" + "purescript-integers": "^3.0.0", + "purescript-maybe": "^3.0.0" }, "devDependencies": { "purescript-strongcheck": "^3.1.0" diff --git a/src/Data/Argonaut/Encode.purs b/src/Data/Argonaut/Encode.purs index d04cc05..575ad41 100644 --- a/src/Data/Argonaut/Encode.purs +++ b/src/Data/Argonaut/Encode.purs @@ -4,4 +4,13 @@ module Data.Argonaut.Encode ) where import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson) -import Data.Argonaut.Encode.Combinators (assoc, extend, (:=), (~>)) +import Data.Argonaut.Encode.Combinators + ( assoc + , assocOptional + , extend + , extendOptional + , (:=) + , (:=?) + , (~>) + , (~>?) + ) diff --git a/src/Data/Argonaut/Encode/Combinators.purs b/src/Data/Argonaut/Encode/Combinators.purs index ed24256..6ab181c 100644 --- a/src/Data/Argonaut/Encode/Combinators.purs +++ b/src/Data/Argonaut/Encode/Combinators.purs @@ -4,7 +4,8 @@ -- | myJson -- | = "key1" := value1 -- | ~> "key2" := value2 --- | ~> jsonEmptyObject +-- | ~>? "key3" :=? value3 +-- | ~> jsonEmptyOibject -- | ``` module Data.Argonaut.Encode.Combinators where @@ -12,6 +13,7 @@ import Prelude import Data.Argonaut.Core (Json, JAssoc, foldJsonObject, fromObject, jsonSingletonObject) import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson) +import Data.Maybe (Maybe(..)) import Data.StrMap as SM import Data.Tuple (Tuple(..)) @@ -22,6 +24,13 @@ infix 7 assoc as := assoc :: forall a. EncodeJson a => String -> a -> JAssoc assoc k = Tuple k <<< encodeJson +-- | Creates an optional `JAssoc` entry, representing an optional key/value pair for an object. +infix 7 assocOptional as :=? + +-- | The named implementation of the `(:=?)` operator. +assocOptional :: forall a. EncodeJson a => String -> Maybe a -> Maybe JAssoc +assocOptional k = (<$>) (((:=) k) <<< encodeJson) + -- | Extends a Json object with a `JAssoc` property. infixr 6 extend as ~> @@ -32,3 +41,11 @@ extend (Tuple k v) = (jsonSingletonObject k v) (SM.insert k v >>> fromObject) <<< encodeJson + +-- | Optionally extends a Json object with an optional `JAssoc` property. +infixr 6 extendOptional as ~>? + +-- | The named implementation of the `(~>?)` operator. +extendOptional :: forall a. EncodeJson a => Maybe JAssoc -> a -> Json +extendOptional (Just kv) = (~>) kv +extendOptional Nothing = encodeJson \ No newline at end of file diff --git a/test/Test/Main.purs b/test/Test/Main.purs index dbfc995..9075391 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -3,17 +3,15 @@ module Test.Main where import Prelude import Control.Monad.Eff.Console (log) - import Data.Argonaut.Core (JObject, Json, isObject, toObject) import Data.Argonaut.Decode (decodeJson) -import Data.Argonaut.Encode (encodeJson, (:=), (~>)) +import Data.Argonaut.Encode (class EncodeJson, encodeJson, (:=), (:=?), (~>), (~>?)) import Data.Argonaut.Gen (genJson) import Data.Either (Either(..)) import Data.Foldable (foldl) -import Data.Maybe (Maybe(..), maybe, isJust) +import Data.Maybe (Maybe(..), isJust, isNothing, maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) - import Test.StrongCheck (SC, quickCheck, quickCheck', ()) import Test.StrongCheck.Arbitrary (class Arbitrary) import Test.StrongCheck.Gen (suchThat, resize) @@ -26,6 +24,9 @@ main = do newtype TestJson = TestJson Json +instance encodeJsonTestJson :: EncodeJson TestJson where + encodeJson (TestJson x) = encodeJson x + instance arbitraryTestJson :: Arbitrary TestJson where arbitrary = TestJson <$> (resize 5 genJson) @@ -59,8 +60,12 @@ combinatorsCheck :: SC () Unit combinatorsCheck = do log "Check assoc builder `:=`" quickCheck' 20 prop_assoc_builder_str + log "Check assocOptional builder `:=?`" + quickCheck' 20 prop_assoc_optional_builder_str log "Check JAssoc append `~>`" quickCheck' 20 prop_assoc_append + log "Check JAssoc appendOptional `~>?`" + quickCheck' 20 prop_assoc_append_optional log "Check get field `obj .? 'foo'`" quickCheck' 20 prop_get_jobject_field @@ -72,6 +77,13 @@ combinatorsCheck = do Tuple k json -> (key == k) && (decodeJson json == Right str) + prop_assoc_optional_builder_str :: Tuple String (Maybe String) -> Boolean + prop_assoc_optional_builder_str (Tuple key maybeStr) = + case (key :=? maybeStr) of + Just (Tuple k json) -> + (key == k) && (decodeJson json == Right maybeStr) + Nothing -> true + prop_assoc_append :: (Tuple (Tuple String TestJson) Obj) -> Boolean prop_assoc_append (Tuple (Tuple key (TestJson val)) (Obj obj)) = let appended = (key := val) ~> obj @@ -79,6 +91,13 @@ combinatorsCheck = do Just value -> true _ -> false + prop_assoc_append_optional :: Tuple (Tuple String (Maybe TestJson)) Obj -> Boolean + prop_assoc_append_optional (Tuple (Tuple key maybeVal) (Obj obj)) = + let appended = (key :=? maybeVal) ~>? obj + in case toObject appended >>= SM.lookup key of + Just value -> isJust maybeVal + _ -> isNothing maybeVal + prop_get_jobject_field :: Obj -> Boolean prop_get_jobject_field (Obj obj) = maybe false go $ toObject obj From be86b42c01a6b503ef6d104083a62b9da863c2b8 Mon Sep 17 00:00:00 2001 From: Forest Loren Toney III Date: Tue, 13 Mar 2018 16:22:21 -0700 Subject: [PATCH 2/2] Update example to correctly demonstrate optional encoding --- src/Data/Argonaut/Encode/Combinators.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Argonaut/Encode/Combinators.purs b/src/Data/Argonaut/Encode/Combinators.purs index 6ab181c..5475f78 100644 --- a/src/Data/Argonaut/Encode/Combinators.purs +++ b/src/Data/Argonaut/Encode/Combinators.purs @@ -3,8 +3,8 @@ -- | ``` purescript -- | myJson -- | = "key1" := value1 --- | ~> "key2" := value2 --- | ~>? "key3" :=? value3 +-- | ~> "key2" :=? value2 +-- | ~>? "key3" := value3 -- | ~> jsonEmptyOibject -- | ``` module Data.Argonaut.Encode.Combinators where