Move arbitrary term generation into its own module.

semantic-diff.cabal

@@ -77,6 +77,7 @@ test-suite semantic-diff-test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             Spec.hs
+  other-modules:       ArbitraryTerm
   build-depends:       base
                      , containers
                      , free

test/ArbitraryTerm.hs

@@ -0,0 +1,47 @@
+module ArbitraryTerm where
+
+import Categorizable
+import Syntax
+import Term
+import Control.Comonad.Cofree
+import Control.Monad
+import qualified OrderedMap as Map
+import qualified Data.List as List
+import qualified Data.Set as Set
+import GHC.Generics
+import Test.QuickCheck hiding (Fixed)
+
+newtype ArbitraryTerm a annotation = ArbitraryTerm (annotation, (Syntax a (ArbitraryTerm a annotation)))
+  deriving (Show, Eq, Generic)
+
+unTerm :: ArbitraryTerm a annotation -> Term a annotation
+unTerm = unfold unpack
+  where unpack (ArbitraryTerm (annotation, syntax)) = (annotation, syntax)
+
+instance (Eq a, Eq annotation, Arbitrary a, Arbitrary annotation) => Arbitrary (ArbitraryTerm a annotation) where
+  arbitrary = sized (\ x -> boundedTerm x x) -- first indicates the cube of the max length of lists, second indicates the cube of the max depth of the tree
+    where boundedTerm maxLength maxDepth = ArbitraryTerm <$> ((,) <$> arbitrary <*> boundedSyntax maxLength maxDepth)
+          boundedSyntax _ maxDepth | maxDepth <= 0 = liftM Leaf arbitrary
+          boundedSyntax maxLength maxDepth = frequency
+            [ (12, liftM Leaf arbitrary),
+              (1, liftM Indexed $ take maxLength <$> listOf (smallerTerm maxLength maxDepth)),
+              (1, liftM Fixed $ take maxLength <$> listOf (smallerTerm maxLength maxDepth)),
+              (1, liftM (Keyed . Map.fromList) $ take maxLength <$> listOf (arbitrary >>= (\x -> ((,) x) <$> smallerTerm maxLength maxDepth))) ]
+          smallerTerm maxLength maxDepth = boundedTerm (div maxLength 3) (div maxDepth 3)
+  shrink term@(ArbitraryTerm (annotation, syntax)) = (++) (subterms term) $ filter (/= term) $
+    ArbitraryTerm <$> ((,) <$> shrink annotation <*> case syntax of
+      Leaf a -> Leaf <$> shrink a
+      Indexed i -> Indexed <$> (List.subsequences i >>= recursivelyShrink)
+      Fixed f -> Fixed <$> (List.subsequences f >>= recursivelyShrink)
+      Keyed k -> Keyed . Map.fromList <$> (List.subsequences (Map.toList k) >>= recursivelyShrink))
+
+data CategorySet = A | B | C | D deriving (Eq, Show)
+
+instance Categorizable CategorySet where
+  categories A = Set.fromList [ "a" ]
+  categories B = Set.fromList [ "b" ]
+  categories C = Set.fromList [ "c" ]
+  categories D = Set.fromList [ "d" ]
+
+instance Arbitrary CategorySet where
+  arbitrary = elements [ A, B, C, D ]

test/TermSpec.hs

@@ -5,51 +5,11 @@ import Test.Hspec.QuickCheck
 import Test.QuickCheck hiding (Fixed)
 
 import Categorizable
-import qualified OrderedMap as Map
-import qualified Data.List as List
-import qualified Data.Set as Set
 import Interpreter
 import Diff
-import Control.Comonad.Cofree
-import Control.Monad
-import GHC.Generics
 import Syntax
 import Term
-
-newtype ArbitraryTerm a annotation = ArbitraryTerm (annotation, (Syntax a (ArbitraryTerm a annotation)))
-  deriving (Show, Eq, Generic)
-
-unTerm :: ArbitraryTerm a annotation -> Term a annotation
-unTerm = unfold unpack
-  where unpack (ArbitraryTerm (annotation, syntax)) = (annotation, syntax)
-
-instance (Eq a, Eq annotation, Arbitrary a, Arbitrary annotation) => Arbitrary (ArbitraryTerm a annotation) where
-  arbitrary = sized (\ x -> boundedTerm x x) -- first indicates the cube of the max length of lists, second indicates the cube of the max depth of the tree
-    where boundedTerm maxLength maxDepth = ArbitraryTerm <$> ((,) <$> arbitrary <*> boundedSyntax maxLength maxDepth)
-          boundedSyntax _ maxDepth | maxDepth <= 0 = liftM Leaf arbitrary
-          boundedSyntax maxLength maxDepth = frequency
-            [ (12, liftM Leaf arbitrary),
-              (1, liftM Indexed $ take maxLength <$> listOf (smallerTerm maxLength maxDepth)),
-              (1, liftM Fixed $ take maxLength <$> listOf (smallerTerm maxLength maxDepth)),
-              (1, liftM (Keyed . Map.fromList) $ take maxLength <$> listOf (arbitrary >>= (\x -> ((,) x) <$> smallerTerm maxLength maxDepth))) ]
-          smallerTerm maxLength maxDepth = boundedTerm (div maxLength 3) (div maxDepth 3)
-  shrink term@(ArbitraryTerm (annotation, syntax)) = (++) (subterms term) $ filter (/= term) $
-    ArbitraryTerm <$> ((,) <$> shrink annotation <*> case syntax of
-      Leaf a -> Leaf <$> shrink a
-      Indexed i -> Indexed <$> (List.subsequences i >>= recursivelyShrink)
-      Fixed f -> Fixed <$> (List.subsequences f >>= recursivelyShrink)
-      Keyed k -> Keyed . Map.fromList <$> (List.subsequences (Map.toList k) >>= recursivelyShrink))
-
-data CategorySet = A | B | C | D deriving (Eq, Show)
-
-instance Categorizable CategorySet where
-  categories A = Set.fromList [ "a" ]
-  categories B = Set.fromList [ "b" ]
-  categories C = Set.fromList [ "c" ]
-  categories D = Set.fromList [ "d" ]
-
-instance Arbitrary CategorySet where
-  arbitrary = elements [ A, B, C, D ]
+import ArbitraryTerm
 
 main :: IO ()
 main = hspec spec