feat(QuickCheck): add 'instance Arbitrary (a, b)'

lib/Data/Eq.hm

@@ -19,6 +19,7 @@ module Data.Eq
   ) where
 
 import Data.Unit (Unit)
+import Data.Bool ((&&))
 
 class Eq a where
   eq :: a -> a -> Boolean
@@ -51,6 +52,9 @@ instance Eq Float where
 instance Eq a => Eq (List a) where
   eq = eqListImpl
 
+instance (Eq a, Eq b) => Eq (a, b) where
+  eq (a, b) (c, d) = a == c && b == d
+
 instance Eq Unit where
   eq _ _ = true
 

lib/Data/Map.hm

@@ -15,7 +15,7 @@
 module Data.Map where
 
 import Data.Maybe (Maybe)
-import Control.Monad(bind, return)
+import Control.Monad((<$>))
 import Foreign (ffi0, ffi1, ffi2, ffi3, ffi4)
 import Test.QuickCheck (arbitrary, class Arbitrary)
 import Data.Eq
@@ -132,10 +132,7 @@ tzip [] y = []
 tzip [x|xs] [y|ys] = [ (x,y) | tzip xs ys ]
 
 instance (Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where
-  arbitrary = do
-       xs1 <- arbitrary
-       xs2 <- arbitrary
-       return (fromList (tzip xs1 xs2))
+  arbitrary = fromList <$> arbitrary
 
 instance Eq (Map a b) where
   eq = eqMapImpl

lib/System/IO/Printf.hm

@@ -86,10 +86,14 @@ instance (PrintArg a, Printf t) => Printf (a -> t) where
 class PrintArg a where
   render :: Control -> a -> String
 
+partcal' :: Integer -> Integer -> String
+partcal' _  0 = ""
+partcal' k x = let (a,b) = (x/k,x%k)
+               in  partcal' k a <> rhex b
+
 partcal :: Integer -> Integer -> String
-partcal _  0 = ""
-partcal k x = let (a,b) = (x/k,x%k)
-               in  partcal k a <> rhex b
+partcal _ 0 = "0"
+partcal k x = partcal' k x
 
 rstr :: Integer -> String
 rstr 2 = "0B"

lib/Test/QuickCheck.hm

@@ -32,7 +32,7 @@ import Data.Tuple (fst)
 import Data.Foldable (foldl)
 import Data.Traversable (sequence)
 import Data.Unit (Unit)
-import Control.Monad (class Applicative, pure, class Monad, return, bind, IO, discard, seqio, (>>=))
+import Control.Monad (liftM2, class Applicative, pure, class Monad, return, bind, IO, discard, seqio, (>>=))
 import System.IO (printf, println)
 import System.Random(randomRIO)
 import Data.Binary (listToBin)
@@ -158,8 +158,8 @@ instance Arbitrary Binary where
           tabs x | x >= 0 = x
                  | otherwise = (-x)
 
--- instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where
---   arbitrary = liftM2 (\x y -> (x,y)) arbitrary arbitrary
+instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where
+  arbitrary = liftM2 (\x y -> (x,y)) arbitrary arbitrary
 
 instance Arbitrary a => Arbitrary [a] where
   arbitrary = sized (\n -> choose (0,n) >>= vector)
@@ -224,7 +224,7 @@ check s 0 m n = (printf "%s----- %s      " (replicate n ' ') s :: IO ()) >>= \_
 check s v m n = do
   i <- randomRIO 1332292274972041455 7304856964418773083
   let Gen fun = evaluate m
-      Result r = fun 10 (mkRand i)
+      Result r = fun 15 (mkRand i)
   case r.ok of
     Just true -> check s (v-1) m n
     Just false -> (printf "%sxxxxx %s -----> %s"
@@ -259,7 +259,7 @@ runTest g = do
   res <- runTestGroup 0 g
   let res1 = tgToList res
       (succ, fail, total) = tcount (0,0,0) res1
-  printf "total test functions %d, successed %d, failed %d"  total succ fail
+  printf "total test functions %d, successed %d, failed %d."  total succ fail
 
 tcount :: (Integer, Integer, Integer) -> [TestResult] -> (Integer, Integer, Integer)
 tcount (a,b,c) [] = (a,b,c)

src/Language/Hamler/CodeGen.hs

@@ -410,6 +410,10 @@ literalToErl (ListLiteral xs) = do
 literalToErl (TupleLiteral xs) = do
   xs' <- mapM exprToErl xs
   return . ann . ETuple $ fmap (ann . Expr) xs'
+literalToErl (Tuple2Literal a b) = do
+  a' <- exprToErl a
+  b' <- exprToErl b
+  return . ann . ETuple $ fmap (ann . Expr) [a', b']
 literalToErl (ObjectLiteral xs) = do
   xs' <- forM xs $ \(pps, e) -> do
     e' <- exprToErl e
@@ -568,6 +572,10 @@ literalBinderToPat (ListLiteral xs) = do
 literalBinderToPat (TupleLiteral xs) = do
   xs' <- mapM binderToPat xs
   return . ann $ E.PTuple xs'
+literalBinderToPat (Tuple2Literal a b) = do
+  a' <- binderToPat a
+  b' <- binderToPat b
+  return . ann $ E.PTuple [a', b']
 literalBinderToPat (ObjectLiteral xs) = do
   xs' <- forM xs $ \(pps, e) -> do
     e' <- binderToPat e

stack.yaml

@@ -13,7 +13,7 @@ extra-deps:
 - github: hamler-lang/CoreErlang
   commit: 2bacba611fed9eb773939964aa70e3ad49b8c816
 - github: hamler-lang/purescript
-  commit: e03f1b9516cd439c3b384e658c2201f2a48e1ac3
+  commit: 5c41feb6c3f0605238364020dafd1387f1b7eee0
 - megaparsec-8.0.0@sha256:362f85e243ecbcb550e1de6e5c74ba5a50c09edaa1208c99bc5b9fd242227fc6,3808
 flags:
   these:

tests/Test/Data/Map.hm

@@ -32,6 +32,9 @@ propMapMap m1 f = let l1 = M.toList m1
                       lf1 = \(k,v) -> f v
                   in M.fromList (map lf l1) == M.map lf1 m1
 
+propInsert :: M.Map Integer Integer -> Integer -> Integer -> Boolean
+propInsert m k v = M.insert k v m == M.insert k v (M.insert k v m)
+
 baseMap :: M.Map Integer Integer
 baseMap = M.fromList [(1,2),(2,3),(3,4)]
 
@@ -43,6 +46,7 @@ test = Exe [ quickCheck "put_get "     propMapPutGet
            , quickCheck "singleton" (M.singleton 1 2 == M.fromList [(1,2)])
            , quickCheck "isKey"     (M.isKey 1 baseMap)
            , quickCheck "insert"    (M.insert 1 3 baseMap == M.fromList [(1,3),(2,3),(3,4)])
+           , quickCheck "prop_insert"    propInsert
            , quickCheck "get"       (M.get 1 baseMap == 2)
            , quickCheck "lookup_Just"    (M.lookup 1 baseMap == Just 2)
            , quickCheck "lookup_Nothing"    (M.lookup 10 baseMap == Nothing)
@@ -52,7 +56,7 @@ test = Exe [ quickCheck "put_get "     propMapPutGet
            , quickCheck "not_member"  (M.notMember 10 baseMap == true)
            , quickCheck "update"      (M.update 1 10 baseMap == M.fromList [(1,10),(2,3),(3,4)])
            , quickCheck "updateWith"  (M.updateWith 1 (\x -> x+1) baseMap == M.fromList [(1,3),(2,3),(3,4)])
-           , quickCheck "updateWithInit"  (M.updateWithInit 10 (\x -> x+1) 10 baseMap == M.fromList [(1,3),(2,3),(3,4),(10,10)])
+           , quickCheck "updateWithInit"  (M.updateWithInit 10 (\x -> x+1) 10 baseMap == M.fromList [(1,2),(2,3),(3,4),(10,10)])
            , quickCheck "take"          (case M.take 1 baseMap of
                                             Just (2, v) -> v == M.fromList [(2,3),(3,4)]
                                             _  -> error "error happened"