Merge pull request #431 from IntersectMBO/dcoutts/lockstep-io-sim-tweak-generation

Add more labels to the quickcheck-lockstep StateMachine tests

Author: dcoutts

test/Database/LSMTree/Model/Normal.hs

@@ -30,6 +30,8 @@ module Database.LSMTree.Model.Normal (
   , snapshot
     -- * Multiple writable table handles
   , duplicate
+    -- * Testing
+  , size
   ) where
 
 import qualified Crypto.Hash.SHA256 as SHA256
@@ -61,6 +63,9 @@ type role Table nominal nominal nominal
 empty :: Table k v blob
 empty = Table Map.empty
 
+size :: Table k v blob -> Int
+size (Table m) = Map.size m
+
 -- | This instance is for testing and debugging only.
 instance
     (SerialiseKey k, SerialiseValue v, SerialiseValue blob)

test/Database/LSMTree/Model/Normal/Session.hs

@@ -24,10 +24,14 @@ module Database.LSMTree.Model.Normal.Session (
     Model (..)
   , initModel
   , UpdateCounter (..)
-    -- ** SomeTable
+    -- ** SomeTable, for testing
   , SomeTable (..)
   , toSomeTable
   , fromSomeTable
+  , withSomeTable
+  , TableHandleID
+  , tableHandleID
+  , Model.size
     -- ** Constraints
   , C
   , C_
@@ -118,7 +122,9 @@ newtype UpdateCounter = UpdateCounter Word64
   deriving stock (Show, Eq, Ord)
   deriving newtype (Num)
 
-newtype SomeTable = SomeTable Dynamic
+data SomeTable where
+     SomeTable :: (Typeable k, Typeable v, Typeable blob)
+               => Model.Table k v blob -> SomeTable
 
 instance Show SomeTable where
   show (SomeTable table) = show table
@@ -127,13 +133,20 @@ toSomeTable ::
      (Typeable k, Typeable v, Typeable blob)
   => Model.Table k v blob
   -> SomeTable
-toSomeTable = SomeTable . toDyn
+toSomeTable = SomeTable
 
 fromSomeTable ::
      (Typeable k, Typeable v, Typeable blob)
   => SomeTable
   -> Maybe (Model.Table k v blob)
-fromSomeTable (SomeTable tbl) = fromDynamic tbl
+fromSomeTable (SomeTable tbl) = cast tbl
+
+withSomeTable ::
+     (forall k v blob. (Typeable k, Typeable v, Typeable blob)
+                    => Model.Table k v blob -> a)
+  -> SomeTable
+  -> a
+withSomeTable f (SomeTable tbl) = f tbl
 
 newtype SomeCursor = SomeCursor Dynamic