Arb instances

Gruntfile.js

@@ -16,7 +16,7 @@ module.exports = function(grunt) {
         src: ["<%=libFiles%>"]
       },
       tests: {
-        src: ["tests/Tests.purs", "<%=libFiles%>"]
+        src: ["tests/**/*.purs", "<%=libFiles%>"]
       }
     },
 

README.md

@@ -16,6 +16,8 @@
 
     instance applyListT :: (Monad f) => Apply (ListT f)
 
+    instance arbitraryListT :: (Monad f, Arbitrary a) => Arbitrary (ListT f a)
+
     instance bindListT :: (Monad f) => Bind (ListT f)
 
     instance functorListT :: (Functor f) => Functor (ListT f)
@@ -99,6 +101,8 @@
 
     instance applyList :: Apply List
 
+    instance arbitraryList :: (Arbitrary a) => Arbitrary (List a)
+
     instance bindList :: Bind List
 
     instance eqList :: (Eq a) => Eq (List a)

src/Control/Monad/ListT.purs

@@ -10,7 +10,9 @@ module Control.Monad.ListT
   , wrapEffect
   , wrapLazy
   , unfold
+  , iterate
   , fromArray
+  , toArray
   , take
   , takeWhile
   , drop
@@ -22,6 +24,7 @@ module Control.Monad.ListT
   , head
   , tail
   , foldl
+  , foldl'
   , scanl
   , zipWith'
   , zipWith
@@ -35,6 +38,9 @@ module Control.Monad.ListT
   import Data.Tuple
   import qualified Data.Array as A
 
+  import Test.QuickCheck
+  import Test.QuickCheck.LCG
+
   data ListT f a = ListT (f (Step a (ListT f a)))
 
   data Step a s =
@@ -96,6 +102,9 @@ module Control.Monad.ListT
   instance monadTransListT :: MonadTrans ListT where
     lift = fromEffect
 
+  instance arbitraryListT :: (Monad f, Arbitrary a) => Arbitrary (ListT f a) where
+    arbitrary = fromArray <$> arbitrary
+
   singleton :: forall f a. (Applicative f) => a -> ListT f a
   singleton a = prepend a nil
 
@@ -112,11 +121,18 @@ module Control.Monad.ListT
   unfold f z = ListT $ g <$> f z where
       g (Just (Tuple z a))  = Yield a (defer \_ -> (unfold f z))
       g Nothing             = Done
+
+  iterate :: forall f a. (Monad f) => (a -> a) -> a -> ListT f a
+  iterate f a = unfold g a where
+    g a = pure $ Just (Tuple (f a) a)
 
   fromArray :: forall f a. (Monad f) => [a] -> ListT f a
   fromArray xs = unfold f 0 where    
     f n = pure $ Tuple (n + 1) <$> (xs A.!! n)
 
+  toArray :: forall f a. (Monad f) => ListT f a -> f [a]
+  toArray = ((<$>) A.reverse) <<< foldl (flip (:)) []
+
   take :: forall f a. (Applicative f) => Number -> ListT f a -> ListT f a
   take 0 fa = nil
   take n fa = stepMap f fa where
@@ -171,6 +187,12 @@ module Control.Monad.ListT
   tail :: forall f a. (Monad f) => ListT f a -> f (Maybe (ListT f a))
   tail l = ((<$>) snd) <$> uncons l
 
+  foldl' :: forall f a b. (Monad f) => (b -> a -> f b) -> b -> ListT f a -> f b
+  foldl' f = loop where
+    loop b l = uncons l >>= g where
+      g Nothing             = pure b
+      g (Just (Tuple a as)) = (f b a) >>= (flip loop as)
+
   foldl :: forall f a b. (Monad f) => (b -> a -> b) -> b -> ListT f a -> f b
   foldl f = loop where
     loop b l = uncons l >>= g where

src/Data/List.purs

@@ -46,6 +46,9 @@ import Control.Plus
 import Control.Alternative
 import Control.MonadPlus
 
+import Test.QuickCheck
+import Test.QuickCheck.LCG
+
 data List a = Nil | Cons a (List a)
 
 instance showList :: (Show a) => Show (List a) where
@@ -130,6 +133,9 @@ instance alternativeList :: Alternative List
 
 instance monadPlusList :: MonadPlus List
 
+instance arbitraryList :: (Arbitrary a) => Arbitrary (List a) where
+  arbitrary = fromArray <$> arbitrary
+
 fromArray :: forall a. [a] -> List a
 fromArray = foldr Cons Nil
 

tests/Control/Monad/ListT.purs

@@ -0,0 +1,39 @@
+module Tests.Data.ListT (runListTTests) where
+
+  import Debug.Trace
+
+  import Control.Monad.Identity
+
+  import Test.QuickCheck
+  import Test.QuickCheck.LCG
+  import Data.Tuple
+  import Data.Maybe
+
+  import Control.Monad.ListT
+  import qualified Data.Array as A
+
+  data ZeroToTen = ZeroToTen Number
+
+  runZeroToTen :: ZeroToTen -> Number
+  runZeroToTen (ZeroToTen n) = n
+
+  instance arbZeroToTen :: Arbitrary ZeroToTen where
+    arbitrary = ZeroToTen <$> chooseInt 0 10
+
+  checkFromToArray a = 
+    (runIdentity $ (toArray <<< fromArray) a) == (a :: [Number]) <?> "toArray <<< fromArray == id"
+
+  checkTake (Tuple a (ZeroToTen n)) = 
+    (runIdentity $ (toArray <<< (take n) <<< fromArray) a) == A.take n (a :: [Number]) <?> "take"
+
+  checkIterate (ZeroToTen n) =
+    (runIdentity $ head $ iterate ((+) 1) n) == Just n <?> "iterate"
+
+  runListTTests = do
+    trace "Running ListT tests"
+
+    quickCheck $ checkFromToArray
+
+    quickCheck $ checkTake
+
+    quickCheck $ checkIterate

tests/Data/List/List.purs

@@ -0,0 +1,11 @@
+module Tests.Data.List where
+
+  import Debug.Trace
+
+  import Test.QuickCheck
+  import Test.QuickCheck.LCG
+
+  import Data.List
+
+  runListTests = do
+    trace "Running List tests"

tests/Tests.purs

@@ -2,9 +2,12 @@ module Main where
 
 import Debug.Trace
 
-import Data.List
-
 import Test.QuickCheck
+import Test.QuickCheck.LCG
+
+import Tests.Data.List
+import Tests.Data.ListT
 
 main = do
-  trace "Done"
+  runListTests
+  runListTTests