@@ -0,0 +1,117 @@
1+diff --git a/tests/graph-properties.hs b/tests/graph-properties.hs
2+deleted file mode 100644
3+index ffe4483..0000000
4+--- a/tests/graph-properties.hs
5++++ /dev/null
6+@@ -1,111 +0,0 @@
7+-{-# LANGUAGE CPP #-}
8+-
9+-import Data.Graph as G
10+-
11+-import Control.Applicative (Const(Const, getConst), pure, (<$>), (<*>), liftA2)
12+-
13+-import Test.Framework
14+-import Test.Framework.Providers.QuickCheck2
15+-import Test.QuickCheck
16+-import Test.QuickCheck.Function (Fun (..), apply)
17+-import Test.QuickCheck.Poly (A, B, C)
18+-import Control.Monad (ap)
19+-
20+-default (Int)
21+-
22+-main :: IO ()
23+-main = defaultMain
24+- [
25+- testProperty "monad_id1" prop_monad_id1
26+- , testProperty "monad_id2" prop_monad_id2
27+- , testProperty "monad_assoc" prop_monad_assoc
28+- , testProperty "ap_ap" prop_ap_ap
29+- , testProperty "ap_liftA2" prop_ap_liftA2
30+- , testProperty "monadFix_ls" prop_monadFix_ls
31+- ]
32+-
33+-{--------------------------------------------------------------------
34+- Arbitrary trees
35+---------------------------------------------------------------------}
36+-
37+-newtype G = G Graph
38+-
39+--- This instance isn't balanced very well; the trees will probably tend
40+--- to lean left. But it's better than nothing and we can fix it later.
41+-instance Arbitrary a => Arbitrary G where
42+- arbitrary = sized arbgraph
43+- where
44+- arbgraph :: Arbitrary a => Int -> Gen G
45+- arbgraph nv = do
46+- lo <- arbitrary
47+- hi <- (lo+) <$> choose (0, nv)
48+-{-
49+- arbtree 0 = fmap ((,) 1) $ Node <$> arbitrary <*> pure []
50+- arbtree n = do
51+- root <- arbitrary
52+- num_children <- choose (0, n - 1)
53+- (st, tl) <- go num_children
54+- return (1+st, Node root tl)
55+--}
56+-
57+- go 0 = pure (0, [])
58+- go n = do
59+- (sh, hd) <- arbtree n
60+- (st, tl) <- go (n - sh)
61+- pure (sh + st, hd : tl)
62+-
63+--- genericShrink only became available when generics did, so it's
64+--- not available under GHC 7.0.
65+-#if __GLASGOW_HASKELL__ >= 704
66+- shrink = genericShrink
67+-#endif
68+-
69+-----------------------------------------------------------------
70+--- Unit tests
71+-----------------------------------------------------------------
72+-
73+-----------------------------------------------------------------
74+--- QuickCheck
75+-----------------------------------------------------------------
76+-
77+-apply2 :: Fun (a, b) c -> a -> b -> c
78+-apply2 f a b = apply f (a, b)
79+-
80+-prop_ap_ap :: Tree (Fun A B) -> Tree A -> Property
81+-prop_ap_ap fs xs = (apply <$> fs <*> xs) === ((apply <$> fs) `ap` xs)
82+-
83+-prop_ap_liftA2 :: Fun (A, B) C -> Tree A -> Tree B -> Property
84+-prop_ap_liftA2 f as bs = (apply2 f <$> as <*> bs) === liftA2 (apply2 f) as bs
85+-
86+-prop_monad_id1 :: Tree A -> Property
87+-prop_monad_id1 t = (t >>= pure) === t
88+-
89+-prop_monad_id2 :: A -> Fun A (Tree B) -> Property
90+-prop_monad_id2 a f = (pure a >>= apply f) === apply f a
91+-
92+-prop_monad_assoc :: Tree A -> Fun A (Tree B) -> Fun B (Tree C) -> Property
93+-prop_monad_assoc ta atb btc =
94+- ((ta >>= apply atb) >>= apply btc)
95+- ===
96+- (ta >>= \a -> apply atb a >>= apply btc)
97+-
98+--- The left shrinking law
99+---
100+--- This test is kind of wonky and unprincipled, because it's
101+--- rather tricky to construct test cases!
102+--- This is the most important MonadFix law to test because it's the
103+--- least intuitive by far, and because it's the only one that's
104+--- sensitive to the Monad instance.
105+-prop_monadFix_ls :: Int -> Tree Int -> Fun Int (Tree Int) -> Property
106+-prop_monadFix_ls val ta ti =
107+- fmap ($val) (mfix (\x -> ta >>= \y -> f x y))
108+- ===
109+- fmap ($val) (ta >>= \y -> mfix (\x -> f x y))
110+- where
111+- fact :: Int -> (Int -> Int) -> Int -> Int
112+- fact x _ 0 = x + 1
113+- fact x f n = x + n * f ((n - 1) `mod` 23)
114+-
115+- f :: (Int -> Int) -> Int -> Tree (Int -> Int)
116+- f q y = let t = apply ti y
117+- in fmap (\w -> fact w q) t