Skip to content

Update for PureScript 0.11 #27

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Apr 8, 2017
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
language: node_js
dist: trusty
sudo: required
node_js: 6
node_js: stable
install:
- npm install -g bower
- npm install
Expand Down
8 changes: 4 additions & 4 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -22,11 +22,11 @@
},
"license": "MIT",
"dependencies": {
"purescript-argonaut-core": "^2.0.0",
"purescript-generics": "^3.0.0",
"purescript-integers": "^2.0.0"
"purescript-argonaut-core": "^3.0.0",
"purescript-generics": "^4.0.0",
"purescript-integers": "^3.0.0"
},
"devDependencies": {
"purescript-strongcheck": "^2.0.0"
"purescript-strongcheck": "^3.1.0"
}
}
8 changes: 4 additions & 4 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,9 @@
"test": "pulp test"
},
"devDependencies": {
"pulp": "^10.0.0",
"purescript-psa": "^0.4.0",
"purescript": "^0.10.7",
"rimraf": "^2.5.4"
"pulp": "^11.0.0",
"purescript-psa": "^0.5.0",
"purescript": "^0.11.1",
"rimraf": "^2.6.1"
}
}
2 changes: 1 addition & 1 deletion src/Data/Argonaut/Decode.purs
Original file line number Diff line number Diff line change
Expand Up @@ -3,5 +3,5 @@ module Data.Argonaut.Decode
, module Data.Argonaut.Decode.Combinators
) where

import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson, gDecodeJson, gDecodeJson')
import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
import Data.Argonaut.Decode.Combinators (getField, (.?))
53 changes: 3 additions & 50 deletions src/Data/Argonaut/Decode/Class.purs
Original file line number Diff line number Diff line change
@@ -1,72 +1,25 @@
module Data.Argonaut.Decode.Class
( class DecodeJson
, decodeJson
, gDecodeJson
, gDecodeJson'
) where

import Prelude

import Data.Argonaut.Core (Json, JArray, JObject, isNull, foldJsonNull, foldJsonBoolean, foldJsonNumber, foldJsonString, toArray, toNumber, toObject, toString, toBoolean)
import Data.Array (zipWithA)
import Data.Argonaut.Core (Json, JArray, JObject, isNull, foldJsonNull, foldJsonBoolean, foldJsonNumber, foldJsonString, toArray, toObject, toString)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Foldable (find)
import Data.Generic (class Generic, GenericSpine(..), GenericSignature(..), fromSpine, toSignature)
import Data.Int (fromNumber)
import Data.List (List(..), (:), fromFoldable)
import Data.Map as M
import Data.Maybe (maybe, Maybe(..))
import Data.String (charAt, toChar)
import Data.String (charAt)
import Data.StrMap as SM
import Data.Traversable (traverse, for)
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..))

import Type.Proxy (Proxy(..))

class DecodeJson a where
decodeJson :: Json -> Either String a

-- | Decode `Json` representation of a value which has a `Generic` type.
gDecodeJson :: forall a. Generic a => Json -> Either String a
gDecodeJson
= maybe (Left "fromSpine failed") Right
<<< fromSpine
<=< gDecodeJson' (toSignature (Proxy :: Proxy a))

-- | Decode `Json` representation of a `GenericSpine`.
gDecodeJson' :: GenericSignature -> Json -> Either String GenericSpine
gDecodeJson' signature json = case signature of
SigNumber -> SNumber <$> mFail "Expected a number" (toNumber json)
SigInt -> SInt <$> mFail "Expected an integer number" (fromNumber =<< toNumber json)
SigString -> SString <$> mFail "Expected a string" (toString json)
SigChar -> SChar <$> mFail "Expected a char" (toChar =<< toString json)
SigBoolean -> SBoolean <$> mFail "Expected a boolean" (toBoolean json)
SigUnit -> pure SUnit
SigArray thunk -> do
jArr <- mFail "Expected an array" $ toArray json
SArray <$> traverse (map const <<< gDecodeJson' (thunk unit)) jArr
SigRecord props -> do
jObj <- mFail "Expected an object" $ toObject json
SRecord <$> for props \({recLabel: lbl, recValue: val}) -> do
pf <- mFail ("'" <> lbl <> "' property missing") (SM.lookup lbl jObj)
sp <- gDecodeJson' (val unit) pf
pure { recLabel: lbl, recValue: const sp }
SigProd typeConstr alts -> do
let decodingErr msg = "When decoding a " <> typeConstr <> ": " <> msg
jObj <- mFail (decodingErr "expected an object") (toObject json)
tagJson <- mFail (decodingErr "'tag' property is missing") (SM.lookup "tag" jObj)
tag <- mFail (decodingErr "'tag' property is not a string") (toString tagJson)
case find ((tag == _) <<< _.sigConstructor) alts of
Nothing -> Left (decodingErr ("'" <> tag <> "' isn't a valid constructor"))
Just { sigValues: sigValues } -> do
vals <- mFail (decodingErr "'values' array is missing") (toArray =<< SM.lookup "values" jObj)
sps <- zipWithA (\k -> gDecodeJson' (k unit)) sigValues vals
pure (SProd tag (const <$> sps))
where
mFail :: forall a. String -> Maybe a -> Either String a
mFail msg = maybe (Left msg) Right

instance decodeJsonMaybe :: DecodeJson a => DecodeJson (Maybe a) where
decodeJson j =
case decode j of
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Argonaut/Encode.purs
Original file line number Diff line number Diff line change
Expand Up @@ -3,5 +3,5 @@ module Data.Argonaut.Encode
, module Data.Argonaut.Encode.Combinators
) where

import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson, gEncodeJson, gEncodeJson')
import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson)
import Data.Argonaut.Encode.Combinators (assoc, extend, (:=), (~>))
28 changes: 1 addition & 27 deletions src/Data/Argonaut/Encode/Class.purs
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,6 @@ import Prelude

import Data.Argonaut.Core (Json(), jsonNull, fromBoolean, fromNumber, fromString, fromArray, fromObject, jsonEmptyObject, jsonSingletonObject)
import Data.Either (Either(), either)
import Data.Foldable (foldr)
import Data.Generic (class Generic, GenericSpine(..), toSpine)
import Data.Int (toNumber)
import Data.List (List(..), (:), toUnfoldable)
import Data.Map as M
Expand All @@ -17,30 +15,6 @@ import Data.Tuple (Tuple(..))
class EncodeJson a where
encodeJson :: a -> Json

-- | Encode any `Generic` data structure into `Json`.
gEncodeJson :: forall a. Generic a => a -> Json
gEncodeJson = gEncodeJson' <<< toSpine

-- | Encode `GenericSpine` into `Json`.
gEncodeJson' :: GenericSpine -> Json
gEncodeJson' = case _ of
SInt x -> fromNumber $ toNumber x
SString x -> fromString x
SChar x -> fromString $ singleton x
SNumber x -> fromNumber x
SBoolean x -> fromBoolean x
SArray thunks -> fromArray (gEncodeJson' <<< (unit # _) <$> thunks)
SUnit -> jsonNull
SProd constr args ->
fromObject
$ SM.insert "tag" (encodeJson constr)
$ SM.singleton "values" (encodeJson (gEncodeJson' <<< (unit # _) <$> args))
SRecord fields ->
fromObject $ foldr addField SM.empty fields
where
addField field =
SM.insert field.recLabel (gEncodeJson' $ field.recValue unit)

instance encodeJsonMaybe :: EncodeJson a => EncodeJson (Maybe a) where
encodeJson Nothing = jsonEmptyObject
encodeJson (Just a) = jsonSingletonObject "just" (encodeJson a)
Expand Down Expand Up @@ -87,7 +61,7 @@ instance encodeStrMap :: EncodeJson a => EncodeJson (SM.StrMap a) where
encodeJson = fromObject <<< map encodeJson

instance encodeMap :: (Ord a, EncodeJson a, EncodeJson b) => EncodeJson (M.Map a b) where
encodeJson = encodeJson <<< M.toList
encodeJson = encodeJson <<< (M.toUnfoldable :: M.Map a b -> List (Tuple a b))

instance encodeVoid :: EncodeJson Void where
encodeJson = absurd
125 changes: 14 additions & 111 deletions test/Test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,85 +2,40 @@ module Test.Main where

import Prelude

import Control.Monad.Eff.Console (log, logShow)
import Control.Monad.Eff.Console (log)

import Data.Argonaut.Core (JObject, Json, toObject, fromObject, fromArray, fromString, fromNumber, fromBoolean, jsonNull)
import Data.Argonaut.Core (JObject, Json, isObject, toObject)
import Data.Argonaut.Decode (decodeJson)
import Data.Argonaut.Encode (encodeJson, gEncodeJson, (:=), (~>))
import Data.Array (zipWith, nubBy, length)
import Data.Argonaut.Encode (encodeJson, (:=), (~>))
import Data.Argonaut.Gen (genJson)
import Data.Either (Either(..))
import Data.Foldable (foldl)
import Data.Function (on)
import Data.Generic (class Generic)
import Data.List (fromFoldable)
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.StrMap as SM
import Data.Tuple (Tuple(..), fst)
import Data.Tuple (Tuple(..))

import Test.StrongCheck (SC, quickCheck, quickCheck', (<?>))
import Test.StrongCheck.Arbitrary (class Arbitrary, arbitrary)
import Test.StrongCheck.Data.AlphaNumString (AlphaNumString(..))
import Test.StrongCheck.Gen (Gen, Size, showSample, sized, frequency, oneOf, vectorOf)
import Test.StrongCheck.Arbitrary (class Arbitrary)
import Test.StrongCheck.Gen (suchThat, resize)

main :: SC () Unit
main = do
eitherCheck
encodeDecodeCheck
combinatorsCheck
genericsCheck

genJNull :: Gen Json
genJNull = pure jsonNull

genJBool :: Gen Json
genJBool = fromBoolean <$> arbitrary

genJNumber :: Gen Json
genJNumber = fromNumber <$> arbitrary

genJString :: Gen Json
genJString = fromString <$> arbitrary

genJArray :: Size -> Gen Json
genJArray sz = fromArray <$> vectorOf sz (genJson $ sz - 1)

genJObject :: Size -> Gen Json
genJObject sz = do
v <- vectorOf sz (genJson $ sz - 1)
k <- vectorOf (length v) (arbitrary :: Gen AlphaNumString)
pure
let
f (AlphaNumString s) = s <> "x"
k' = f <$> k
in
fromObject <<< SM.fromFoldable <<< nubBy (eq `on` fst) $ zipWith Tuple k' v

genJson :: Size -> Gen Json
genJson 0 = oneOf genJNull [genJBool, genJNumber, genJString]
genJson n = frequency (Tuple 1.0 genJNull) rest where
rest = fromFoldable
[ Tuple 2.0 genJBool
, Tuple 2.0 genJNumber
, Tuple 3.0 genJString
, Tuple 1.0 (genJArray n)
, Tuple 1.0 (genJObject n)
]

newtype TestJson = TestJson Json

instance arbitraryTestJson :: Arbitrary TestJson where
arbitrary = TestJson <$> sized genJson
arbitrary = TestJson <$> (resize 5 genJson)

encodeDecodeCheck :: SC () Unit
encodeDecodeCheck = do
log "Showing small sample of JSON"
showSample (genJson 10)

log "Testing that any JSON can be encoded and then decoded"
quickCheck' 20 prop_encode_then_decode

log "Testing that any JSON can be decoded and then encoded"
quickCheck' 20 prop_decode_then_encode
quickCheck' 20 (prop_decode_then_encode)

where

Expand All @@ -98,7 +53,7 @@ unObj :: Obj -> Json
unObj (Obj j) = j

instance arbitraryObj :: Arbitrary Obj where
arbitrary = Obj <$> genJObject 5
arbitrary = Obj <$> suchThat (resize 5 genJson) isObject

combinatorsCheck :: SC () Unit
combinatorsCheck = do
Expand All @@ -121,69 +76,17 @@ combinatorsCheck = do
prop_assoc_append (Tuple (Tuple key (TestJson val)) (Obj obj)) =
let appended = (key := val) ~> obj
in case toObject appended >>= SM.lookup key of
Just val -> true
Just value -> true
_ -> false

prop_get_jobject_field :: Obj -> Boolean
prop_get_jobject_field (Obj obj) =
maybe false go $ toObject obj
where
go :: JObject -> Boolean
go obj =
let keys = SM.keys obj
in foldl (\ok key -> ok && isJust (SM.lookup key obj)) true keys

newtype MyRecord = MyRecord { foo :: String, bar :: Int }

derive instance genericMyRecord :: Generic MyRecord

data User
= Anonymous
| Guest String
| Registered
{ name :: String
, bio :: Maybe String
, age :: Int
, balance :: Number
, banned :: Boolean
, tweets :: Array String
, followers :: Array User
}

derive instance genericUser :: Generic User

genericsCheck :: SC () Unit
genericsCheck = do
log "Print samples of values encoded with gEncodeJson"
logShow $ gEncodeJson 5
logShow $ gEncodeJson [1, 2, 3, 5]
logShow $ gEncodeJson (Just "foo")
logShow $ gEncodeJson (Right "foo" :: Either String String)
logShow $ gEncodeJson $ MyRecord { foo: "foo", bar: 2}
logShow $ gEncodeJson "foo"
logShow $ gEncodeJson Anonymous
logShow $ gEncodeJson $ Guest "guest's handle"
logShow $ gEncodeJson $ Registered
{ name: "user1"
, bio: Just "Ordinary User"
, age: 5
, balance: 26.6
, banned: false
, tweets: ["Hello", "What's up"]
, followers:
[ Anonymous
, Guest "someGuest"
, Registered
{ name: "user2"
, bio: Nothing
, age: 6
, balance: 32.1
, banned: false
, tweets: ["Hi"]
, followers: []
}
]
}
go object =
let keys = SM.keys object
in foldl (\ok key -> ok && isJust (SM.lookup key object)) true keys

eitherCheck :: SC () Unit
eitherCheck = do
Expand Down