Merge pull request #38 from foresttoney/master

Add assocOptional and encodeOptional encode combinators

Author: garyb

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"

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
+  , (:=)
+  , (:=?)
+  , (~>)
+  , (~>?)
+  )

src/Data/Argonaut/Encode/Combinators.purs

@@ -3,15 +3,17 @@
 -- | ``` purescript
 -- | myJson
 -- |  = "key1" := value1
--- |  ~> "key2" := value2
--- |  ~> jsonEmptyObject
+-- |  ~> "key2" :=? value2
+-- | ~>? "key3" := value3
+-- |  ~> jsonEmptyOibject
 -- | ```
 module Data.Argonaut.Encode.Combinators where
 
 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

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,13 +77,27 @@ 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
     in case toObject appended >>= SM.lookup key of
       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