diff --git a/.travis.yml b/.travis.yml index 2e30c22..a3c2cac 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,17 +1,22 @@ + language: node_js -dist: trusty sudo: required -node_js: stable +dist: trusty +node_js: 8 +env: + - PATH=$HOME/purescript:$PATH install: + - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p') + - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz + - tar -xvf $HOME/purescript.tar.gz -C $HOME/ + - chmod a+x $HOME/purescript - npm install -g bower - npm install script: - - bower install --production - - npm run -s build - bower install - - npm -s test + - pulp test after_success: - >- test $TRAVIS_TAG && echo $GITHUB_TOKEN | pulp login && - echo y | pulp publish --no-push + echo y | pulp publish --no-push \ No newline at end of file diff --git a/bower.json b/bower.json index 9877557..f03d57b 100644 --- a/bower.json +++ b/bower.json @@ -22,12 +22,13 @@ }, "license": "MIT", "dependencies": { - "purescript-argonaut-core": "^3.0.0", - "purescript-generics": "^4.0.0", - "purescript-integers": "^3.0.0", - "purescript-maybe": "^3.0.0" + "purescript-argonaut-core": "^4.0.0", + "purescript-integers": "^4.0.0", + "purescript-maybe": "^4.0.0", + "purescript-ordered-collections": "^1.0.0", + "purescript-foreign-object": "^1.0.0" }, "devDependencies": { - "purescript-strongcheck": "^3.1.0" + "purescript-quickcheck": "^5.0.0" } } diff --git a/package.json b/package.json index 90bef43..824132e 100644 --- a/package.json +++ b/package.json @@ -6,9 +6,8 @@ "test": "pulp test" }, "devDependencies": { - "pulp": "^11.0.0", - "purescript-psa": "^0.5.0", - "purescript": "^0.11.1", + "pulp": "^12.2.0", + "purescript-psa": "^0.6.0", "rimraf": "^2.6.1" } -} +} \ No newline at end of file diff --git a/src/Data/Argonaut/Decode/Class.purs b/src/Data/Argonaut/Decode/Class.purs index 6ff21d2..7dac424 100644 --- a/src/Data/Argonaut/Decode/Class.purs +++ b/src/Data/Argonaut/Decode/Class.purs @@ -5,17 +5,17 @@ module Data.Argonaut.Decode.Class import Prelude -import Data.Argonaut.Core (Json, JArray, JObject, isNull, foldJsonNull, foldJsonBoolean, foldJsonNumber, foldJsonString, toArray, toObject, toString) +import Data.Argonaut.Core (Json, isNull, caseJsonNull, caseJsonBoolean, caseJsonNumber, caseJsonString, toArray, toObject, toString, stringify) import Data.Bifunctor (lmap) import Data.Either (Either(..)) import Data.Int (fromNumber) import Data.List (List(..), (:), fromFoldable) import Data.Map as M import Data.Maybe (maybe, Maybe(..)) -import Data.String (charAt) -import Data.StrMap as SM +import Data.String (CodePoint, codePointAt) import Data.Traversable (traverse) import Data.Tuple (Tuple(..)) +import Foreign.Object as FO class DecodeJson a where decodeJson :: Json -> Either String a @@ -35,21 +35,21 @@ instance decodeJsonEither :: (DecodeJson a, DecodeJson b) => DecodeJson (Either decodeJson json = lmap ("Couldn't decode Either: " <> _) $ decodeJObject json >>= \obj -> do - tag <- maybe (Left "Expected field 'tag'") Right $ SM.lookup "tag" obj - val <- maybe (Left "Expected field 'value'") Right $ SM.lookup "value" obj + tag <- maybe (Left "Expected field 'tag'") Right $ FO.lookup "tag" obj + val <- maybe (Left "Expected field 'value'") Right $ FO.lookup "value" obj case toString tag of Just "Right" -> Right <$> decodeJson val Just "Left" -> Left <$> decodeJson val _ -> Left "'tag' field was not \"Left\" or \"Right\"" instance decodeJsonNull :: DecodeJson Unit where - decodeJson = foldJsonNull (Left "Value is not a null") (const $ Right unit) + decodeJson = caseJsonNull (Left "Value is not a null") (const $ Right unit) instance decodeJsonBoolean :: DecodeJson Boolean where - decodeJson = foldJsonBoolean (Left "Value is not a Boolean") Right + decodeJson = caseJsonBoolean (Left "Value is not a Boolean") Right instance decodeJsonNumber :: DecodeJson Number where - decodeJson = foldJsonNumber (Left "Value is not a Number") Right + decodeJson = caseJsonNumber (Left "Value is not a Number") Right instance decodeJsonInt :: DecodeJson Int where decodeJson @@ -58,19 +58,19 @@ instance decodeJsonInt :: DecodeJson Int where <=< decodeJson instance decodeJsonString :: DecodeJson String where - decodeJson = foldJsonString (Left "Value is not a String") Right + decodeJson = caseJsonString (Left "Value is not a String") Right instance decodeJsonJson :: DecodeJson Json where decodeJson = Right -instance decodeJsonChar :: DecodeJson Char where +instance decodeJsonChar :: DecodeJson CodePoint where decodeJson j = - maybe (Left $ "Expected character but found: " <> show j) Right - =<< charAt 0 <$> decodeJson j + maybe (Left $ "Expected character but found: " <> stringify j) Right + =<< codePointAt 0 <$> decodeJson j -instance decodeStrMap :: DecodeJson a => DecodeJson (SM.StrMap a) where +instance decodeForeignObject :: DecodeJson a => DecodeJson (FO.Object a) where decodeJson - = lmap ("Couldn't decode StrMap: " <> _) + = lmap ("Couldn't decode ForeignObject: " <> _) <<< (traverse decodeJson <=< decodeJObject) instance decodeArray :: DecodeJson a => DecodeJson (Array a) where @@ -89,8 +89,8 @@ instance decodeMap :: (Ord a, DecodeJson a, DecodeJson b) => DecodeJson (M.Map a instance decodeVoid :: DecodeJson Void where decodeJson _ = Left "Value cannot be Void" -decodeJArray :: Json -> Either String JArray +decodeJArray :: Json -> Either String (Array Json) decodeJArray = maybe (Left "Value is not an Array") Right <<< toArray -decodeJObject :: Json -> Either String JObject +decodeJObject :: Json -> Either String (FO.Object Json) decodeJObject = maybe (Left "Value is not an Object") Right <<< toObject diff --git a/src/Data/Argonaut/Decode/Combinators.purs b/src/Data/Argonaut/Decode/Combinators.purs index b549d59..729964b 100644 --- a/src/Data/Argonaut/Decode/Combinators.purs +++ b/src/Data/Argonaut/Decode/Combinators.purs @@ -2,27 +2,27 @@ module Data.Argonaut.Decode.Combinators where import Prelude -import Data.Argonaut.Core (JObject) +import Data.Argonaut.Core (Json) import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson) import Data.Either (Either(..)) import Data.Maybe (Maybe(..), fromMaybe, maybe) -import Data.StrMap as SM +import Foreign.Object as FO -getField :: forall a. DecodeJson a => JObject -> String -> Either String a +getField :: forall a. DecodeJson a => FO.Object Json -> String -> Either String a getField o s = maybe (Left $ "Expected field " <> show s) decodeJson - (SM.lookup s o) + (FO.lookup s o) infix 7 getField as .? -getFieldOptional :: forall a. DecodeJson a => JObject -> String -> Either String (Maybe a) +getFieldOptional :: forall a. DecodeJson a => FO.Object Json -> String -> Either String (Maybe a) getFieldOptional o s = maybe (pure Nothing) decode - (SM.lookup s o) + (FO.lookup s o) where decode json = Just <$> decodeJson json diff --git a/src/Data/Argonaut/Encode/Class.purs b/src/Data/Argonaut/Encode/Class.purs index 068dff0..ba8fb4d 100644 --- a/src/Data/Argonaut/Encode/Class.purs +++ b/src/Data/Argonaut/Encode/Class.purs @@ -8,9 +8,11 @@ import Data.Int (toNumber) import Data.List (List(..), (:), toUnfoldable) import Data.Map as M import Data.Maybe (Maybe(..)) -import Data.String (singleton) -import Data.StrMap as SM +import Data.String (CodePoint) +import Data.String.CodePoints as CP +import Data.String.CodeUnits as CU import Data.Tuple (Tuple(..)) +import Foreign.Object as FO class EncodeJson a where encodeJson :: a -> Json @@ -27,7 +29,7 @@ instance encodeJsonEither :: (EncodeJson a, EncodeJson b) => EncodeJson (Either where obj :: forall c. EncodeJson c => String -> c -> Json obj tag x = - fromObject $ SM.fromFoldable $ + fromObject $ FO.fromFoldable $ Tuple "tag" (fromString tag) : Tuple "value" (encodeJson x) : Nil instance encodeJsonUnit :: EncodeJson Unit where @@ -46,10 +48,13 @@ instance encodeJsonJString :: EncodeJson String where encodeJson = fromString instance encodeJsonJson :: EncodeJson Json where - encodeJson = id + encodeJson = identity + +instance encodeJsonCodePoint :: EncodeJson CodePoint where + encodeJson = encodeJson <<< CP.singleton instance encodeJsonChar :: EncodeJson Char where - encodeJson = encodeJson <<< singleton + encodeJson = encodeJson <<< CU.singleton instance encodeJsonArray :: EncodeJson a => EncodeJson (Array a) where encodeJson json = fromArray (encodeJson <$> json) @@ -57,7 +62,7 @@ instance encodeJsonArray :: EncodeJson a => EncodeJson (Array a) where instance encodeJsonList :: EncodeJson a => EncodeJson (List a) where encodeJson = fromArray <<< map encodeJson <<< toUnfoldable -instance encodeStrMap :: EncodeJson a => EncodeJson (SM.StrMap a) where +instance encodeForeignObject :: EncodeJson a => EncodeJson (FO.Object a) where encodeJson = fromObject <<< map encodeJson instance encodeMap :: (Ord a, EncodeJson a, EncodeJson b) => EncodeJson (M.Map a b) where diff --git a/src/Data/Argonaut/Encode/Combinators.purs b/src/Data/Argonaut/Encode/Combinators.purs index 5475f78..cf44ff9 100644 --- a/src/Data/Argonaut/Encode/Combinators.purs +++ b/src/Data/Argonaut/Encode/Combinators.purs @@ -11,41 +11,46 @@ module Data.Argonaut.Encode.Combinators where import Prelude -import Data.Argonaut.Core (Json, JAssoc, foldJsonObject, fromObject, jsonSingletonObject) +import Data.Argonaut.Core (Json, caseJsonObject, fromObject, jsonSingletonObject) import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson) import Data.Maybe (Maybe(..)) -import Data.StrMap as SM import Data.Tuple (Tuple(..)) +import Foreign.Object as FO --- | Creates a `JAssoc` entry, representing a key/value pair for an object. +-- | Creates a `Tuple String Json` entry, representing a key/value pair for an object. infix 7 assoc as := -- | The named implementation of the `(:=)` operator. -assoc :: forall a. EncodeJson a => String -> a -> JAssoc +assoc :: forall a. EncodeJson a => String -> a -> Tuple String Json assoc k = Tuple k <<< encodeJson --- | Creates an optional `JAssoc` entry, representing an optional key/value pair for an object. +-- | Creates an optional `Tuple String Json` 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 + :: forall a + . EncodeJson a + => String + -> Maybe a + -> Maybe (Tuple String Json) assocOptional k = (<$>) (((:=) k) <<< encodeJson) --- | Extends a Json object with a `JAssoc` property. +-- | Extends a Json object with a `Tuple String Json` property. infixr 6 extend as ~> -- | The named implementation of the `(~>)` operator. -extend :: forall a. EncodeJson a => JAssoc -> a -> Json +extend :: forall a. EncodeJson a => Tuple String Json -> a -> Json extend (Tuple k v) = - foldJsonObject + caseJsonObject (jsonSingletonObject k v) - (SM.insert k v >>> fromObject) + (FO.insert k v >>> fromObject) <<< encodeJson --- | Optionally extends a Json object with an optional `JAssoc` property. +-- | Optionally extends a Json object with an optional `Tuple String Json` property. infixr 6 extendOptional as ~>? -- | The named implementation of the `(~>?)` operator. -extendOptional :: forall a. EncodeJson a => Maybe JAssoc -> a -> Json +extendOptional :: forall a. EncodeJson a => Maybe (Tuple String Json) -> a -> Json extendOptional (Just kv) = (~>) kv -extendOptional Nothing = encodeJson \ No newline at end of file +extendOptional Nothing = encodeJson diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 9075391..6007243 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -2,112 +2,121 @@ module Test.Main where import Prelude -import Control.Monad.Eff.Console (log) -import Data.Argonaut.Core (JObject, Json, isObject, toObject) +import Control.Monad.Gen.Common (genMaybe) +import Data.Argonaut.Core (Json, isObject, stringify, toObject) import Data.Argonaut.Decode (decodeJson) -import Data.Argonaut.Encode (class EncodeJson, encodeJson, (:=), (:=?), (~>), (~>?)) +import Data.Argonaut.Encode (encodeJson, (:=), (:=?), (~>), (~>?)) import Data.Argonaut.Gen (genJson) +import Data.Bifunctor (rmap) import Data.Either (Either(..)) import Data.Foldable (foldl) import Data.Maybe (Maybe(..), isJust, isNothing, maybe) -import Data.StrMap as SM +import Data.String.Gen (genUnicodeString) import Data.Tuple (Tuple(..)) -import Test.StrongCheck (SC, quickCheck, quickCheck', ()) -import Test.StrongCheck.Arbitrary (class Arbitrary) -import Test.StrongCheck.Gen (suchThat, resize) +import Effect (Effect) +import Effect.Console (log) +import Foreign.Object as FO +import Test.QuickCheck (Result(..), quickCheck, (), (===)) +import Test.QuickCheck.Gen (Gen, resize, suchThat) -main :: SC () Unit +main :: Effect Unit main = do eitherCheck encodeDecodeCheck combinatorsCheck -newtype TestJson = TestJson Json +genTestJson :: Gen Json +genTestJson = resize 5 genJson -instance encodeJsonTestJson :: EncodeJson TestJson where - encodeJson (TestJson x) = encodeJson x - -instance arbitraryTestJson :: Arbitrary TestJson where - arbitrary = TestJson <$> (resize 5 genJson) - -encodeDecodeCheck :: SC () Unit +encodeDecodeCheck :: Effect Unit encodeDecodeCheck = do log "Testing that any JSON can be encoded and then decoded" - quickCheck' 20 prop_encode_then_decode + quickCheck prop_encode_then_decode log "Testing that any JSON can be decoded and then encoded" - quickCheck' 20 (prop_decode_then_encode) + quickCheck prop_decode_then_encode where - prop_encode_then_decode :: TestJson -> Boolean - prop_encode_then_decode (TestJson json) = - Right json == decodeJson (encodeJson json) - - prop_decode_then_encode :: TestJson -> Boolean - prop_decode_then_encode (TestJson json) = - let decoded = (decodeJson json) :: Either String Json in - Right json == (decoded >>= (encodeJson >>> pure)) + prop_encode_then_decode :: Gen Result + prop_encode_then_decode = do + json <- genTestJson + let redecoded = decodeJson (encodeJson json) + pure $ Right json == redecoded (show (rmap stringify redecoded) <> " /= Right " <> stringify json) -newtype Obj = Obj Json -unObj :: Obj -> Json -unObj (Obj j) = j + prop_decode_then_encode :: Gen Result + prop_decode_then_encode = do + json <- genTestJson + let (decoded :: Either String Json) = decodeJson json + let reencoded = decoded >>= (encodeJson >>> pure) + pure $ Right json == reencoded (show (rmap stringify reencoded) <> " /= Right " <> stringify json) -instance arbitraryObj :: Arbitrary Obj where - arbitrary = Obj <$> suchThat (resize 5 genJson) isObject +genObj :: Gen Json +genObj = suchThat (resize 5 genJson) isObject -combinatorsCheck :: SC () Unit +combinatorsCheck :: Effect Unit combinatorsCheck = do log "Check assoc builder `:=`" - quickCheck' 20 prop_assoc_builder_str + quickCheck prop_assoc_builder_str log "Check assocOptional builder `:=?`" - quickCheck' 20 prop_assoc_optional_builder_str + quickCheck prop_assoc_optional_builder_str log "Check JAssoc append `~>`" - quickCheck' 20 prop_assoc_append + quickCheck prop_assoc_append log "Check JAssoc appendOptional `~>?`" - quickCheck' 20 prop_assoc_append_optional + quickCheck prop_assoc_append_optional log "Check get field `obj .? 'foo'`" - quickCheck' 20 prop_get_jobject_field + quickCheck prop_get_jobject_field where - prop_assoc_builder_str :: Tuple String String -> Boolean - prop_assoc_builder_str (Tuple key str) = + prop_assoc_builder_str :: Gen Result + prop_assoc_builder_str = do + key <- genUnicodeString + str <- genUnicodeString case (key := str) of Tuple k json -> - (key == k) && (decodeJson json == Right str) + pure $ Tuple key (decodeJson json) === Tuple k (Right str) - prop_assoc_optional_builder_str :: Tuple String (Maybe String) -> Boolean - prop_assoc_optional_builder_str (Tuple key maybeStr) = + prop_assoc_optional_builder_str :: Gen Result + prop_assoc_optional_builder_str = do + key <- genUnicodeString + maybeStr <- genMaybe genUnicodeString 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)) = + pure $ Tuple key (decodeJson json) === Tuple k (Right maybeStr) + Nothing -> pure Success + + prop_assoc_append :: Gen Result + prop_assoc_append = do + key <- genUnicodeString + val <- genTestJson + obj <- genObj 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)) = + case toObject appended >>= FO.lookup key of + Just value -> pure Success + _ -> pure (Failed "failed to lookup key") + + prop_assoc_append_optional :: Gen Result + prop_assoc_append_optional = do + key <- genUnicodeString + maybeVal <- genMaybe genTestJson + obj <- genObj 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 + pure case toObject appended >>= FO.lookup key of + Just value -> isJust maybeVal === true + _ -> isNothing maybeVal === true + + prop_get_jobject_field :: Gen Result + prop_get_jobject_field = do + obj <- genObj + pure (true === maybe false go (toObject obj)) where - go :: JObject -> Boolean + go :: FO.Object Json -> Boolean go object = - let keys = SM.keys object - in foldl (\ok key -> ok && isJust (SM.lookup key object)) true keys + let keys = FO.keys object + in foldl (\ok key -> ok && isJust (FO.lookup key object)) true keys -eitherCheck :: SC () Unit +eitherCheck :: Effect Unit eitherCheck = do log "Test EncodeJson/DecodeJson Either instance" quickCheck \(x :: Either String String) ->