Merge pull request #27 from purescript-contrib/ps-0.11

Update for PureScript 0.11

Author: garyb

.travis.yml

@@ -1,7 +1,7 @@
 language: node_js
 dist: trusty
 sudo: required
-node_js: 6
+node_js: stable
 install:
   - npm install -g bower
   - npm install

bower.json

@@ -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"
   }
 }

package.json

@@ -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"
   }
 }

src/Data/Argonaut/Decode.purs

@@ -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, (.?))

src/Data/Argonaut/Decode/Class.purs

@@ -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

src/Data/Argonaut/Encode.purs

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

src/Data/Argonaut/Encode/Class.purs

@@ -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
@@ -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)
@@ -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

test/Test/Main.purs

@@ -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
 
@@ -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
@@ -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