From d60d70cf82fef10c44e2602c230834311a7eccd7 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Fri, 9 Nov 2007 20:05:06 +0000
Subject: [PATCH] Changed the unique identifiers in FlowGraphTest to be their
 own type, to reduce confusion

---
 common/FlowGraphTest.hs | 29 +++++++++++++++++++++--------
 1 file changed, 21 insertions(+), 8 deletions(-)

diff --git a/common/FlowGraphTest.hs b/common/FlowGraphTest.hs
index 309ae14..e090f7b 100644
--- a/common/FlowGraphTest.hs
+++ b/common/FlowGraphTest.hs
@@ -243,8 +243,16 @@ testIf = TestList
 -- which means we'd want Gen [([Meta],a)]
 
 -- However, in order to ensure we make unique meta tags, we have to add the StateT Int wrapper:
+
+newtype Id = Id Int
+
+fromId :: Id -> Int
+fromId (Id n) = n
+
+makeMeta' :: Id -> Meta
+makeMeta' = makeMeta . fromId
       
-type GenL a = StateT Int Gen [([Meta], a)]
+type GenL a = StateT Id Gen [([Meta], a)]
 
 replaceMeta :: Meta -> Meta
 replaceMeta m = sub m 8
@@ -288,20 +296,25 @@ comb3 func list0 list1 list2 = (liftM3 (,,)) list0 list1 list2 >>* product3 >>*
 -- | Wrapper for Quickcheck.
 -- In order to stop conflict with Quickcheck's in-built rules for things such as pairs
 -- (which do not allow overlapping instances), we have to wrap such types ourself.
-data QC a = QC a deriving (Eq, Show)
+newtype QC a = QC a deriving (Eq, Show)
 
 instance Arbitrary (QC (A.Structured, Map.Map [Meta] A.Structured)) where
-  arbitrary = evalStateT genStructured 0 >>* findEmpty >>* QC
+  arbitrary = evalStateT genStructured (Id 0) >>* findEmpty >>* QC
     where
       -- Copies the value for the empty-list key into the first element of the tuple:
       findEmpty :: [([Meta], a)] -> (a, Map.Map [Meta] a)
       findEmpty xs = (fromJust $ Map.lookup [] m, m)
         where m = Map.fromList xs
 
-  -- TODO define a method for coarbitrary?
+  -- coarbitrary is for defined "twiddle" functions over data generated by arbitrary.
+  -- For example, we could have the twiddle functions changing an expression
+  -- in the tree.  I don't think this would be of use right now, given what we're testing
 
-nextIdT :: Monad m => StateT Int m Int
-nextIdT = modify' ((+) 1)
+nextIdT :: Monad m => StateT Id m Id
+nextIdT = modify' incId
+  where
+    incId :: Id -> Id
+    incId (Id n) = (Id $ n+1)
 
 oneofL :: [GenL a] -> GenL a
 oneofL gs = do i <- lift $ choose (0,length gs-1)
@@ -313,7 +326,7 @@ replaceM find replace x | find == x = return replace
 
 
 genStructured :: GenL A.Structured
-genStructured = nextIdT >>* makeMeta >>= \m -> oneofL
+genStructured = nextIdT >>* makeMeta' >>= \m -> oneofL
   [
     genElem2 A.OnlyP m genProcess
     -- TODO A.Several m []
@@ -321,7 +334,7 @@ genStructured = nextIdT >>* makeMeta >>= \m -> oneofL
 
 
 genProcess :: GenL A.Process
-genProcess = nextIdT >>* makeMeta >>= \m -> oneofL
+genProcess = nextIdT >>* makeMeta' >>= \m -> oneofL
   [
     genElem1 A.Skip m
    ,genElem1 A.Stop m