From 0f92c18f667c3f20c369e797b283f7ef1333eefc Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Fri, 17 Jan 2025 10:08:37 +0100
Subject: [PATCH 1/6] QLS: ModelStateTypeParams

---
 test/Test/Database/LSMTree/StateMachine.hs | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/test/Test/Database/LSMTree/StateMachine.hs b/test/Test/Database/LSMTree/StateMachine.hs
index 0eed7cbb6..07bad3f95 100644
--- a/test/Test/Database/LSMTree/StateMachine.hs
+++ b/test/Test/Database/LSMTree/StateMachine.hs
@@ -490,11 +490,14 @@ instance R.ResolveValue Value where
   Model state
 -------------------------------------------------------------------------------}
 
-type ModelState :: ((Type -> Type) -> Type -> Type -> Type -> Type) -> Type
-data ModelState h = ModelState Model.Model Stats
+type ModelStateTypeParams = TableKind
+type TableKind = (Type -> Type) -> Type -> Type -> Type -> Type
+
+type ModelState :: ModelStateTypeParams -> Type
+data ModelState ps = ModelState Model.Model Stats
   deriving stock Show
 
-initModelState :: ModelState h
+initModelState :: ModelState ps
 initModelState = ModelState Model.initModel initStats
 
 {-------------------------------------------------------------------------------

From 610874fe4dd2f87261a518b2693a9ab634ecaed5 Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Fri, 17 Jan 2025 10:20:45 +0100
Subject: [PATCH 2/6] QLS: Table type family

---
 test/Test/Database/LSMTree/StateMachine.hs | 218 +++++++++++----------
 1 file changed, 111 insertions(+), 107 deletions(-)

diff --git a/test/Test/Database/LSMTree/StateMachine.hs b/test/Test/Database/LSMTree/StateMachine.hs
index 07bad3f95..c9609e511 100644
--- a/test/Test/Database/LSMTree/StateMachine.hs
+++ b/test/Test/Database/LSMTree/StateMachine.hs
@@ -493,6 +493,10 @@ instance R.ResolveValue Value where
 type ModelStateTypeParams = TableKind
 type TableKind = (Type -> Type) -> Type -> Type -> Type -> Type
 
+type Table :: ModelStateTypeParams -> TableKind
+type family Table ps where
+  Table h = h
+
 type ModelState :: ModelStateTypeParams -> Type
 data ModelState ps = ModelState Model.Model Stats
   deriving stock Show
@@ -535,82 +539,82 @@ type C k v b = (K k, V v, B b)
   StateModel
 -------------------------------------------------------------------------------}
 
-instance ( Show (Class.TableConfig h)
-         , Eq (Class.TableConfig h)
-         , Arbitrary (Class.TableConfig h)
-         , Typeable h
+instance ( Show (Class.TableConfig (Table h))
+         , Eq (Class.TableConfig (Table h))
+         , Arbitrary (Class.TableConfig (Table h))
+         , Typeable (Table h)
          ) => StateModel (Lockstep (ModelState h)) where
   data instance Action (Lockstep (ModelState h)) a where
     -- Tables
     New :: C k v b
         => {-# UNPACK #-} !(PrettyProxy (k, v, b))
-        -> Class.TableConfig h
-        -> Act h (WrapTable h IO k v b)
+        -> Class.TableConfig (Table h)
+        -> Act h (WrapTable (Table h) IO k v b)
     Close :: C k v b
-          => Var h (WrapTable h IO k v b)
+          => Var h (WrapTable (Table h) IO k v b)
           -> Act h ()
     -- Queries
     Lookups :: C k v b
-            => V.Vector k -> Var h (WrapTable h IO k v b)
-            -> Act h (V.Vector (LookupResult v (WrapBlobRef h IO b)))
+            => V.Vector k -> Var h (WrapTable (Table h) IO k v b)
+            -> Act h (V.Vector (LookupResult v (WrapBlobRef (Table h) IO b)))
     RangeLookup :: (C k v b, Ord k)
-                => R.Range k -> Var h (WrapTable h IO k v b)
-                -> Act h (V.Vector (QueryResult k v (WrapBlobRef h IO b)))
+                => R.Range k -> Var h (WrapTable (Table h) IO k v b)
+                -> Act h (V.Vector (QueryResult k v (WrapBlobRef (Table h) IO b)))
     -- Cursor
     NewCursor :: C k v b
               => Maybe k
-              -> Var h (WrapTable h IO k v b)
-              -> Act h (WrapCursor h IO k v b)
+              -> Var h (WrapTable (Table h) IO k v b)
+              -> Act h (WrapCursor (Table h) IO k v b)
     CloseCursor :: C k v b
-                => Var h (WrapCursor h IO k v b)
+                => Var h (WrapCursor (Table h) IO k v b)
                 -> Act h ()
     ReadCursor :: C k v b
                => Int
-               -> Var h (WrapCursor h IO k v b)
-               -> Act h (V.Vector (QueryResult k v (WrapBlobRef h IO b)))
+               -> Var h (WrapCursor (Table h) IO k v b)
+               -> Act h (V.Vector (QueryResult k v (WrapBlobRef (Table h) IO b)))
     -- Updates
     Updates :: C k v b
-            => V.Vector (k, R.Update v b) -> Var h (WrapTable h IO k v b)
+            => V.Vector (k, R.Update v b) -> Var h (WrapTable (Table h) IO k v b)
             -> Act h ()
     Inserts :: C k v b
-            => V.Vector (k, v, Maybe b) -> Var h (WrapTable h IO k v b)
+            => V.Vector (k, v, Maybe b) -> Var h (WrapTable (Table h) IO k v b)
             -> Act h ()
     Deletes :: C k v b
-            => V.Vector k -> Var h (WrapTable h IO k v b)
+            => V.Vector k -> Var h (WrapTable (Table h) IO k v b)
             -> Act h ()
     Mupserts :: C k v b
-             => V.Vector (k, v) -> Var h (WrapTable h IO k v b)
+             => V.Vector (k, v) -> Var h (WrapTable (Table h) IO k v b)
              -> Act h ()
     -- Blobs
     RetrieveBlobs :: B b
-                  => Var h (V.Vector (WrapBlobRef h IO b))
+                  => Var h (V.Vector (WrapBlobRef (Table h) IO b))
                   -> Act h (V.Vector (WrapBlob b))
     -- Snapshots
     CreateSnapshot ::
          C k v b
       => Maybe Errors
-      -> R.SnapshotLabel -> R.SnapshotName -> Var h (WrapTable h IO k v b)
+      -> R.SnapshotLabel -> R.SnapshotName -> Var h (WrapTable (Table h) IO k v b)
       -> Act h ()
     OpenSnapshot   ::
          C k v b
       => {-# UNPACK #-} !(PrettyProxy (k, v, b))
       -> Maybe Errors
       -> R.SnapshotLabel -> R.SnapshotName
-      -> Act h (WrapTable h IO k v b)
+      -> Act h (WrapTable (Table h) IO k v b)
     DeleteSnapshot :: R.SnapshotName -> Act h ()
     ListSnapshots  :: Act h [R.SnapshotName]
     -- Duplicate tables
     Duplicate :: C k v b
-              => Var h (WrapTable h IO k v b)
-              -> Act h (WrapTable h IO k v b)
+              => Var h (WrapTable (Table h) IO k v b)
+              -> Act h (WrapTable (Table h) IO k v b)
     -- Table union
     Union :: C k v b
-          => Var h (WrapTable h IO k v b)
-          -> Var h (WrapTable h IO k v b)
-          -> Act h (WrapTable h IO k v b)
+          => Var h (WrapTable (Table h) IO k v b)
+          -> Var h (WrapTable (Table h) IO k v b)
+          -> Act h (WrapTable (Table h) IO k v b)
     Unions :: C k v b
-           => NonEmpty (Var h (WrapTable h IO k v b))
-           -> Act h (WrapTable h IO k v b)
+           => NonEmpty (Var h (WrapTable (Table h) IO k v b))
+           -> Act h (WrapTable (Table h) IO k v b)
 
   initialState    = Lockstep.Defaults.initialState initModelState
   nextState       = Lockstep.Defaults.nextState
@@ -618,11 +622,11 @@ instance ( Show (Class.TableConfig h)
   arbitraryAction = Lockstep.Defaults.arbitraryAction
   shrinkAction    = Lockstep.Defaults.shrinkAction
 
-deriving stock instance Show (Class.TableConfig h)
+deriving stock instance Show (Class.TableConfig (Table h))
                      => Show (LockstepAction (ModelState h) a)
 
-instance ( Eq (Class.TableConfig h)
-         , Typeable h
+instance ( Eq (Class.TableConfig (Table h))
+         , Typeable (Table h)
          ) => Eq (LockstepAction (ModelState h) a) where
   (==) :: LockstepAction (ModelState h) a -> LockstepAction (ModelState h) a -> Bool
   x == y = go x y
@@ -708,26 +712,26 @@ deriving stock instance Eq FSSim.Blob
   InLockstep
 -------------------------------------------------------------------------------}
 
-instance ( Eq (Class.TableConfig h)
-         , Show (Class.TableConfig h)
-         , Arbitrary (Class.TableConfig h)
-         , Typeable h
+instance ( Eq (Class.TableConfig (Table h))
+         , Show (Class.TableConfig (Table h))
+         , Arbitrary (Class.TableConfig (Table h))
+         , Typeable (Table h)
          ) => InLockstep (ModelState h) where
   type instance ModelOp (ModelState h) = Op
 
   data instance ModelValue (ModelState h) a where
     MTable :: Model.Table k v b
-                 -> Val h (WrapTable h IO k v b)
-    MCursor :: Model.Cursor k v b -> Val h (WrapCursor h IO k v b)
+                 -> Val h (WrapTable (Table h) IO k v b)
+    MCursor :: Model.Cursor k v b -> Val h (WrapCursor (Table h) IO k v b)
     MBlobRef :: Class.C_ b
-             => Model.BlobRef b -> Val h (WrapBlobRef h IO b)
+             => Model.BlobRef b -> Val h (WrapBlobRef (Table h) IO b)
 
     MLookupResult :: (Class.C_ v, Class.C_ b)
-                  => LookupResult v (Val h (WrapBlobRef h IO b))
-                  -> Val h (LookupResult v (WrapBlobRef h IO b))
+                  => LookupResult v (Val h (WrapBlobRef (Table h) IO b))
+                  -> Val h (LookupResult v (WrapBlobRef (Table h) IO b))
     MQueryResult :: Class.C k v b
-                 => QueryResult k v (Val h (WrapBlobRef h IO b))
-                 -> Val h (QueryResult k v (WrapBlobRef h IO b))
+                 => QueryResult k v (Val h (WrapBlobRef (Table h) IO b))
+                 -> Val h (QueryResult k v (WrapBlobRef (Table h) IO b))
 
     MBlob :: (Show b, Typeable b, Eq b)
           => WrapBlob b -> Val h (WrapBlob b)
@@ -741,16 +745,16 @@ instance ( Eq (Class.TableConfig h)
     MVector :: V.Vector (Val h a) -> Val h (V.Vector a)
 
   data instance Observable (ModelState h) a where
-    OTable :: Obs h (WrapTable h IO k v b)
-    OCursor :: Obs h (WrapCursor h IO k v b)
-    OBlobRef :: Obs h (WrapBlobRef h IO b)
+    OTable :: Obs h (WrapTable (Table h) IO k v b)
+    OCursor :: Obs h (WrapCursor (Table h) IO k v b)
+    OBlobRef :: Obs h (WrapBlobRef (Table h) IO b)
 
     OLookupResult :: (Class.C_ v, Class.C_ b)
-                  => LookupResult v (Obs h (WrapBlobRef h IO b))
-                  -> Obs h (LookupResult v (WrapBlobRef h IO b))
+                  => LookupResult v (Obs h (WrapBlobRef (Table h) IO b))
+                  -> Obs h (LookupResult v (WrapBlobRef (Table h) IO b))
     OQueryResult :: Class.C k v b
-                 => QueryResult k v (Obs h (WrapBlobRef h IO b))
-                 -> Obs h (QueryResult k v (WrapBlobRef h IO b))
+                 => QueryResult k v (Obs h (WrapBlobRef (Table h) IO b))
+                 -> Obs h (QueryResult k v (WrapBlobRef (Table h) IO b))
     OBlob :: (Show b, Typeable b, Eq b)
           => WrapBlob b -> Obs h (WrapBlob b)
 
@@ -834,7 +838,7 @@ instance ( Eq (Class.TableConfig h)
     -> [String]
   tagStep states action = map show . tagStep' states action
 
-deriving stock instance Show (Class.TableConfig h) => Show (Val h a)
+deriving stock instance Show (Class.TableConfig (Table h)) => Show (Val h a)
 deriving stock instance Show (Obs h a)
 
 instance Eq (Obs h a) where
@@ -884,7 +888,7 @@ type RealMonad h m = ReaderT (RealEnv h m) m
 -- (see 'perform', 'runIO', 'runIOSim').
 data RealEnv h m = RealEnv {
     -- | The session to run actions in.
-    envSession            :: !(Class.Session h m)
+    envSession            :: !(Class.Session (Table h) m)
     -- | Error handlers to convert thrown exceptions into pure error values.
     --
     -- Uncaught exceptions make the tests fail, so some handlers should be
@@ -920,12 +924,12 @@ data InjectFaultResult =
   RunLockstep
 -------------------------------------------------------------------------------}
 
-instance ( Eq (Class.TableConfig h)
-         , Class.IsTable h
-         , Show (Class.TableConfig h)
-         , Arbitrary (Class.TableConfig h)
-         , Typeable h
-         , NoThunks (Class.Session h IO)
+instance ( Eq (Class.TableConfig (Table h))
+         , Class.IsTable (Table h)
+         , Show (Class.TableConfig (Table h))
+         , Arbitrary (Class.TableConfig (Table h))
+         , Typeable (Table h)
+         , NoThunks (Class.Session (Table h) IO)
          ) => RunLockstep (ModelState h) (RealMonad h IO) where
   observeReal ::
        Proxy (RealMonad h IO)
@@ -981,11 +985,11 @@ instance ( Eq (Class.TableConfig h)
       Union{}          -> Nothing
       Unions{}         -> Nothing
 
-instance ( Eq (Class.TableConfig h)
-         , Class.IsTable h
-         , Show (Class.TableConfig h)
-         , Arbitrary (Class.TableConfig h)
-         , Typeable h
+instance ( Eq (Class.TableConfig (Table h))
+         , Class.IsTable (Table h)
+         , Show (Class.TableConfig (Table h))
+         , Arbitrary (Class.TableConfig (Table h))
+         , Typeable ((Table h))
          ) => RunLockstep (ModelState h) (RealMonad h (IOSim s)) where
   observeReal ::
        Proxy (RealMonad h (IOSim s))
@@ -1045,22 +1049,22 @@ instance ( Eq (Class.TableConfig h)
   RunModel
 -------------------------------------------------------------------------------}
 
-instance ( Eq (Class.TableConfig h)
-         , Class.IsTable h
-         , Show (Class.TableConfig h)
-         , Arbitrary (Class.TableConfig h)
-         , Typeable h
-         , NoThunks (Class.Session h IO)
+instance ( Eq (Class.TableConfig (Table h))
+         , Class.IsTable (Table h)
+         , Show (Class.TableConfig (Table h))
+         , Arbitrary (Class.TableConfig (Table h))
+         , Typeable (Table h)
+         , NoThunks (Class.Session (Table h) IO)
          ) => RunModel (Lockstep (ModelState h)) (RealMonad h IO) where
   perform _     = runIO
   postcondition = Lockstep.Defaults.postcondition
   monitoring    = Lockstep.Defaults.monitoring (Proxy @(RealMonad h IO))
 
-instance ( Eq (Class.TableConfig h)
-         , Class.IsTable h
-         , Show (Class.TableConfig h)
-         , Arbitrary (Class.TableConfig h)
-         , Typeable h
+instance ( Eq (Class.TableConfig (Table h))
+         , Class.IsTable (Table h)
+         , Show (Class.TableConfig (Table h))
+         , Arbitrary (Class.TableConfig (Table h))
+         , Typeable (Table h)
          ) => RunModel (Lockstep (ModelState h)) (RealMonad h (IOSim s)) where
   perform _     = runIOSim
   postcondition = Lockstep.Defaults.postcondition
@@ -1138,16 +1142,16 @@ runModel lookUp = \case
       . Model.runModelM (Model.unions Model.getResolve (fmap (getTable . lookUp) tableVars))
   where
     getTable ::
-         ModelValue (ModelState h) (WrapTable h IO k v b)
+         ModelValue (ModelState h) (WrapTable (Table h) IO k v b)
       -> Model.Table k v b
     getTable (MTable t) = t
 
     getCursor ::
-         ModelValue (ModelState h) (WrapCursor h IO k v b)
+         ModelValue (ModelState h) (WrapCursor (Table h) IO k v b)
       -> Model.Cursor k v b
     getCursor (MCursor t) = t
 
-    getBlobRefs :: ModelValue (ModelState h) (V.Vector (WrapBlobRef h IO b)) -> V.Vector (Model.BlobRef b)
+    getBlobRefs :: ModelValue (ModelState h) (V.Vector (WrapBlobRef (Table h) IO b)) -> V.Vector (Model.BlobRef b)
     getBlobRefs (MVector brs) = fmap (\(MBlobRef br) -> br) brs
 
 wrap ::
@@ -1161,7 +1165,7 @@ wrap f = first (MEither . bimap MErr f)
 -------------------------------------------------------------------------------}
 
 runIO ::
-     forall a h. (Class.IsTable h, NoThunks (Class.Session h IO))
+     forall a h. (Class.IsTable (Table h), NoThunks (Class.Session (Table h) IO))
   => LockstepAction (ModelState h) a
   -> LookUp (RealMonad h IO)
   -> RealMonad h IO (Realized (RealMonad h IO) a)
@@ -1186,9 +1190,9 @@ runIO action lookUp = ReaderT $ \ !env -> do
         NewCursor offset tableVar -> catchErr handlers $
           WrapCursor <$> Class.newCursor offset (unwrapTable $ lookUp' tableVar)
         CloseCursor cursorVar -> catchErr handlers $
-          Class.closeCursor (Proxy @h) (unwrapCursor $ lookUp' cursorVar)
+          Class.closeCursor (Proxy @(Table h)) (unwrapCursor $ lookUp' cursorVar)
         ReadCursor n cursorVar -> catchErr handlers $
-          fmap (fmap WrapBlobRef) <$> Class.readCursor (Proxy @h) n (unwrapCursor $ lookUp' cursorVar)
+          fmap (fmap WrapBlobRef) <$> Class.readCursor (Proxy @(Table h)) n (unwrapCursor $ lookUp' cursorVar)
         Updates kups tableVar -> catchErr handlers $
           Class.updates (unwrapTable $ lookUp' tableVar) kups
         Inserts kins tableVar -> catchErr handlers $
@@ -1198,7 +1202,7 @@ runIO action lookUp = ReaderT $ \ !env -> do
         Mupserts kmups tableVar -> catchErr handlers $
           Class.mupserts (unwrapTable $ lookUp' tableVar) kmups
         RetrieveBlobs blobRefsVar -> catchErr handlers $
-          fmap WrapBlob <$> Class.retrieveBlobs (Proxy @h) session (unwrapBlobRef <$> lookUp' blobRefsVar)
+          fmap WrapBlob <$> Class.retrieveBlobs (Proxy @(Table h)) session (unwrapBlobRef <$> lookUp' blobRefsVar)
         CreateSnapshot merrs label name tableVar ->
           runRealWithInjectedErrors "CreateSnapshot" env merrs
             (Class.createSnapshot label name (unwrapTable $ lookUp' tableVar))
@@ -1225,7 +1229,7 @@ runIO action lookUp = ReaderT $ \ !env -> do
     lookUp' = lookUpGVar (Proxy @(RealMonad h IO)) lookUp
 
 runIOSim ::
-     forall s a h. Class.IsTable h
+     forall s a h. Class.IsTable (Table h)
   => LockstepAction (ModelState h) a
   -> LookUp (RealMonad h (IOSim s))
   -> RealMonad h (IOSim s) (Realized (RealMonad h (IOSim s)) a)
@@ -1248,9 +1252,9 @@ runIOSim action lookUp = ReaderT $ \ !env -> do
         NewCursor offset tableVar -> catchErr handlers $
           WrapCursor <$> Class.newCursor offset (unwrapTable $ lookUp' tableVar)
         CloseCursor cursorVar -> catchErr handlers $
-          Class.closeCursor (Proxy @h) (unwrapCursor $ lookUp' cursorVar)
+          Class.closeCursor (Proxy @(Table h)) (unwrapCursor $ lookUp' cursorVar)
         ReadCursor n cursorVar -> catchErr handlers $
-          fmap (fmap WrapBlobRef) <$> Class.readCursor (Proxy @h) n (unwrapCursor $ lookUp' cursorVar)
+          fmap (fmap WrapBlobRef) <$> Class.readCursor (Proxy @(Table h)) n (unwrapCursor $ lookUp' cursorVar)
         Updates kups tableVar -> catchErr handlers $
           Class.updates (unwrapTable $ lookUp' tableVar) kups
         Inserts kins tableVar -> catchErr handlers $
@@ -1260,7 +1264,7 @@ runIOSim action lookUp = ReaderT $ \ !env -> do
         Mupserts kmups tableVar -> catchErr handlers $
           Class.mupserts (unwrapTable $ lookUp' tableVar) kmups
         RetrieveBlobs blobRefsVar -> catchErr handlers $
-          fmap WrapBlob <$> Class.retrieveBlobs (Proxy @h) session (unwrapBlobRef <$> lookUp' blobRefsVar)
+          fmap WrapBlob <$> Class.retrieveBlobs (Proxy @(Table h)) session (unwrapBlobRef <$> lookUp' blobRefsVar)
         CreateSnapshot merrs label name tableVar ->
           runRealWithInjectedErrors "CreateSnapshot" env merrs
             (Class.createSnapshot label name (unwrapTable $ lookUp' tableVar))
@@ -1341,10 +1345,10 @@ arbitraryActionWithVars ::
      forall h k v b. (
        C k v b
      , Ord k
-     , Eq (Class.TableConfig h)
-     , Show (Class.TableConfig h)
-     , Arbitrary (Class.TableConfig h)
-     , Typeable h
+     , Eq (Class.TableConfig (Table h))
+     , Show (Class.TableConfig (Table h))
+     , Arbitrary (Class.TableConfig (Table h))
+     , Typeable (Table h)
      )
   => Proxy (k, v, b)
   -> R.SnapshotLabel
@@ -1384,7 +1388,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
 
     genTableVar = QC.elements tableVars
 
-    tableVars :: [Var h (WrapTable h IO k v b)]
+    tableVars :: [Var h (WrapTable (Table h) IO k v b)]
     tableVars =
       [ fromRight v
       | v <- findVars ctx Proxy
@@ -1396,7 +1400,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
 
     genCursorVar = QC.elements cursorVars
 
-    cursorVars :: [Var h (WrapCursor h IO k v b)]
+    cursorVars :: [Var h (WrapCursor (Table h) IO k v b)]
     cursorVars =
       [ fromRight v
       | v <- findVars ctx Proxy
@@ -1408,12 +1412,12 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
 
     genBlobRefsVar = QC.elements blobRefsVars
 
-    blobRefsVars :: [Var h (V.Vector (WrapBlobRef h IO b))]
+    blobRefsVars :: [Var h (V.Vector (WrapBlobRef (Table h) IO b))]
     blobRefsVars = fmap (mapGVar (OpComp OpLookupResults)) lookupResultVars
                 ++ fmap (mapGVar (OpComp OpQueryResults))  queryResultVars
       where
-        lookupResultVars :: [Var h (V.Vector (LookupResult  v (WrapBlobRef h IO b)))]
-        queryResultVars  :: [Var h (V.Vector (QueryResult k v (WrapBlobRef h IO b)))]
+        lookupResultVars :: [Var h (V.Vector (LookupResult  v (WrapBlobRef (Table h) IO b)))]
+        queryResultVars  :: [Var h (V.Vector (QueryResult k v (WrapBlobRef (Table h) IO b)))]
 
         lookupResultVars = fromRight <$> findVars ctx Proxy
         queryResultVars  = fromRight <$> findVars ctx Proxy
@@ -1538,7 +1542,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
     -- Unit tests for 0-way and 1-way unions are included in the UnitTests
     -- module. n-way unions for n>3 lead to larger unions, which are less likely
     -- to be finished before the end of an action sequence.
-    genUnionsTableVars :: Gen (NonEmpty (Var h (WrapTable h IO k v b)))
+    genUnionsTableVars :: Gen (NonEmpty (Var h (WrapTable (Table h) IO k v b)))
     genUnionsTableVars = do
         tableVar1 <- genTableVar
         tableVar2 <- genTableVar
@@ -1549,9 +1553,9 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
 
 shrinkActionWithVars ::
      forall h a. (
-       Eq (Class.TableConfig h)
-     , Arbitrary (Class.TableConfig h)
-     , Typeable h
+       Eq (Class.TableConfig (Table h))
+     , Arbitrary (Class.TableConfig (Table h))
+     , Typeable ((Table h))
      )
   => ModelVarContext (ModelState h)
   -> ModelState h
@@ -1670,10 +1674,10 @@ initStats = Stats {
     }
 
 updateStats ::
-     forall h a. ( Show (Class.TableConfig h)
-     , Eq (Class.TableConfig h)
-     , Arbitrary (Class.TableConfig h)
-     , Typeable h
+     forall h a. ( Show (Class.TableConfig (Table h))
+     , Eq (Class.TableConfig (Table h))
+     , Arbitrary (Class.TableConfig (Table h))
+     , Typeable (Table h)
      )
   => LockstepAction (ModelState h) a
   -> ModelLookUp (ModelState h)
@@ -1712,7 +1716,7 @@ updateStats action lookUp modelBefore _modelAfter result =
       (Lookups _ _, MEither (Right (MVector lrs))) -> stats {
           numLookupsResults =
             let count :: (Int, Int, Int)
-                      -> Val h (LookupResult v (WrapBlobRef h IO blob))
+                      -> Val h (LookupResult v (WrapBlobRef (Table h) IO blob))
                       -> (Int, Int, Int)
                 count (nf, f, fwb) (MLookupResult x) = case x of
                   NotFound        -> (nf+1, f  , fwb  )
@@ -1811,7 +1815,7 @@ updateStats action lookUp modelBefore _modelAfter result =
 
         -- Note that batches (of inserts lookups etc) count as one action.
         updateCount :: forall k v b.
-                       Var h (WrapTable h IO k v b)
+                       Var h (WrapTable (Table h) IO k v b)
                     -> Stats
         updateCount tableVar =
           let tid = getTableId (lookUp tableVar)
@@ -1879,7 +1883,7 @@ updateStats action lookUp modelBefore _modelAfter result =
       where
         -- add the current table to the front of the list of tables, if it's
         -- not the latest one already
-        updateLastActionLog :: GVar Op (WrapTable h IO k v b) -> Stats
+        updateLastActionLog :: GVar Op (WrapTable (Table h) IO k v b) -> Stats
         updateLastActionLog tableVar =
           case Map.lookup pthid (dupTableActionLog stats) of
             Just (thid' : _)
@@ -1899,7 +1903,7 @@ updateStats action lookUp modelBefore _modelAfter result =
 
     updDupTableActionLog stats = stats
 
-    getTableId :: ModelValue (ModelState h) (WrapTable h IO k v b)
+    getTableId :: ModelValue (ModelState h) (WrapTable (Table h) IO k v b)
                      -> Model.TableID
     getTableId (MTable t) = Model.tableID t
 

From 172a78b5e01a4e2a6dee6bb7835cb48482657029 Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Fri, 17 Jan 2025 10:22:00 +0100
Subject: [PATCH 3/6] QLS: type synonyms for params

---
 test/Test/Database/LSMTree/StateMachine.hs    | 35 ++++++++++++-------
 test/Test/Database/LSMTree/StateMachine/DL.hs |  4 +--
 2 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/test/Test/Database/LSMTree/StateMachine.hs b/test/Test/Database/LSMTree/StateMachine.hs
index c9609e511..84332bcc3 100644
--- a/test/Test/Database/LSMTree/StateMachine.hs
+++ b/test/Test/Database/LSMTree/StateMachine.hs
@@ -52,8 +52,11 @@ module Test.Database.LSMTree.StateMachine (
     tests
   , labelledExamples
     -- * Properties
+  , ModelIOImpl
   , propLockstep_ModelIOImpl
+  , RealImplRealFS
   , propLockstep_RealImpl_RealFS_IO
+  , RealImplMockFS
   , propLockstep_RealImpl_MockFS_IO
   , propLockstep_RealImpl_MockFS_IOSim
     -- * Lockstep
@@ -160,7 +163,7 @@ tests = testGroup "Test.Database.LSMTree.StateMachine" [
     ]
 
 labelledExamples :: IO ()
-labelledExamples = QC.labelledExamples $ Lockstep.Run.tagActions (Proxy @(ModelState R.Table))
+labelledExamples = QC.labelledExamples $ Lockstep.Run.tagActions (Proxy @(ModelState RealImplMockFS))
 
 {-------------------------------------------------------------------------------
   propLockstep: reference implementation
@@ -173,18 +176,20 @@ instance Arbitrary Model.TableConfig where
 deriving via AllowThunk (ModelIO.Session IO)
     instance NoThunks (ModelIO.Session IO)
 
+type ModelIOImpl = ModelIO.Table
+
 propLockstep_ModelIOImpl ::
-     Actions (Lockstep (ModelState ModelIO.Table))
+     Actions (Lockstep (ModelState ModelIOImpl))
   -> QC.Property
 propLockstep_ModelIOImpl =
     runActionsBracket'
-      (Proxy @(ModelState ModelIO.Table))
+      (Proxy @(ModelState ModelIOImpl))
       acquire
       release
       (\r (session, errsVar) -> do
             faultsVar <- newMutVar []
             let
-              env :: RealEnv ModelIO.Table IO
+              env :: RealEnv ModelIOImpl IO
               env = RealEnv {
                   envSession = session
                 , envHandlers = [handler, diskFaultErrorHandler]
@@ -273,19 +278,21 @@ instance Arbitrary R.WriteBufferAlloc where
       | QC.Positive x' <- QC.shrink (QC.Positive x)
       ]
 
+type RealImplRealFS = R.Table
+
 propLockstep_RealImpl_RealFS_IO ::
      Tracer IO R.LSMTreeTrace
-  -> Actions (Lockstep (ModelState R.Table))
+  -> Actions (Lockstep (ModelState RealImplRealFS))
   -> QC.Property
 propLockstep_RealImpl_RealFS_IO tr =
     runActionsBracket'
-      (Proxy @(ModelState R.Table))
+      (Proxy @(ModelState RealImplRealFS))
       acquire
       release
       (\r (_, session, errsVar) -> do
             faultsVar <- newMutVar []
             let
-              env :: RealEnv R.Table IO
+              env :: RealEnv RealImplRealFS IO
               env = RealEnv {
                   envSession = session
                 , envHandlers = [
@@ -313,19 +320,21 @@ propLockstep_RealImpl_RealFS_IO tr =
         R.closeSession session
         removeDirectoryRecursive tmpDir
 
+type RealImplMockFS = R.Table
+
 propLockstep_RealImpl_MockFS_IO ::
      Tracer IO R.LSMTreeTrace
-  -> Actions (Lockstep (ModelState R.Table))
+  -> Actions (Lockstep (ModelState RealImplMockFS))
   -> QC.Property
 propLockstep_RealImpl_MockFS_IO tr =
     runActionsBracket'
-      (Proxy @(ModelState R.Table))
+      (Proxy @(ModelState RealImplMockFS))
       (acquire_RealImpl_MockFS tr)
       release_RealImpl_MockFS
       (\r (_, session, errsVar) -> do
             faultsVar <- newMutVar []
             let
-              env :: RealEnv R.Table IO
+              env :: RealEnv RealImplMockFS IO
               env = RealEnv {
                   envSession = session
                 , envHandlers = [
@@ -343,7 +352,7 @@ propLockstep_RealImpl_MockFS_IO tr =
 
 propLockstep_RealImpl_MockFS_IOSim ::
      (forall s. Tracer (IOSim s) R.LSMTreeTrace)
-  -> Actions (Lockstep (ModelState R.Table))
+  -> Actions (Lockstep (ModelState RealImplMockFS))
   -> QC.Property
 propLockstep_RealImpl_MockFS_IOSim tr actions =
     monadicIOSim_ prop
@@ -353,7 +362,7 @@ propLockstep_RealImpl_MockFS_IOSim tr actions =
         (fsVar, session, errsVar) <- QC.run (acquire_RealImpl_MockFS tr)
         faultsVar <- QC.run $ newMutVar []
         let
-          env :: RealEnv R.Table (IOSim s)
+          env :: RealEnv RealImplMockFS (IOSim s)
           env = RealEnv {
               envSession = session
             , envHandlers = [
@@ -364,7 +373,7 @@ propLockstep_RealImpl_MockFS_IOSim tr actions =
             , envInjectFaultResults = faultsVar
             }
         void $ QD.runPropertyReaderT
-                (QD.runActions @(Lockstep (ModelState R.Table)) actions)
+                (QD.runActions @(Lockstep (ModelState RealImplMockFS)) actions)
                 env
         faults <- QC.run $ readMutVar faultsVar
         QC.run $ release_RealImpl_MockFS (fsVar, session, errsVar)
diff --git a/test/Test/Database/LSMTree/StateMachine/DL.hs b/test/Test/Database/LSMTree/StateMachine/DL.hs
index e62d47102..dd1a06402 100644
--- a/test/Test/Database/LSMTree/StateMachine/DL.hs
+++ b/test/Test/Database/LSMTree/StateMachine/DL.hs
@@ -29,7 +29,7 @@ tests = testGroup "Test.Database.LSMTree.StateMachine.DL" [
       QC.testProperty "prop_example" prop_example
     ]
 
-instance DynLogicModel (Lockstep (ModelState R.Table))
+instance DynLogicModel (Lockstep (ModelState RealImplMockFS))
 
 -- | An example of how dynamic logic formulas can be run.
 --
@@ -51,7 +51,7 @@ prop_example =
     tr = nullTracer
 
 -- | Create an initial "large" table
-dl_example :: DL (Lockstep (ModelState R.Table)) ()
+dl_example :: DL (Lockstep (ModelState RealImplMockFS)) ()
 dl_example = do
     -- Create an initial table and fill it with some inserts
     var3 <- action $ New (PrettyProxy @((Key, Value, Blob))) (TableConfig {

From 07275cd0a61c661bdf24de1d4c675c301a2b715e Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Fri, 17 Jan 2025 10:36:36 +0100
Subject: [PATCH 4/6] QLS: StaticMaybe

---
 test/Test/Database/LSMTree/StateMachine.hs | 75 ++++++++++++++++++----
 1 file changed, 64 insertions(+), 11 deletions(-)

diff --git a/test/Test/Database/LSMTree/StateMachine.hs b/test/Test/Database/LSMTree/StateMachine.hs
index 84332bcc3..5ff5c8054 100644
--- a/test/Test/Database/LSMTree/StateMachine.hs
+++ b/test/Test/Database/LSMTree/StateMachine.hs
@@ -473,6 +473,7 @@ createSystemTempDirectory prefix = do
     hasBlockIO <- ioHasBlockIO hasFS defaultIOCtxParams
     pure (tempDir, hasFS, hasBlockIO)
 
+
 {-------------------------------------------------------------------------------
   Key and value types
 -------------------------------------------------------------------------------}
@@ -601,13 +602,13 @@ instance ( Show (Class.TableConfig (Table h))
     -- Snapshots
     CreateSnapshot ::
          C k v b
-      => Maybe Errors
+      => StaticMaybe 'True (Maybe Errors)
       -> R.SnapshotLabel -> R.SnapshotName -> Var h (WrapTable (Table h) IO k v b)
       -> Act h ()
     OpenSnapshot   ::
          C k v b
       => {-# UNPACK #-} !(PrettyProxy (k, v, b))
-      -> Maybe Errors
+      -> StaticMaybe 'True (Maybe Errors)
       -> R.SnapshotLabel -> R.SnapshotName
       -> Act h (WrapTable (Table h) IO k v b)
     DeleteSnapshot :: R.SnapshotName -> Act h ()
@@ -917,8 +918,11 @@ data RealEnv h m = RealEnv {
   }
 
 data InjectFaultResult =
-    -- | No faults were injected.
-    InjectFaultNone
+    -- | Fault injection was disabled.
+    InjectFaultDisabled
+      String -- ^ Action name
+    -- | Fault injections were enabled, but no faults injections were generated.
+  | InjectFaultNone
       String -- ^ Action name
     -- | Faults were injected, but the action accidentally succeeded, so the
     -- action had to be rolled back
@@ -1126,12 +1130,12 @@ runModel lookUp = \case
       . Model.runModelM (Model.retrieveBlobs (getBlobRefs . lookUp $ blobsVar))
     CreateSnapshot merrs label name tableVar ->
       wrap MUnit
-      . Model.runModelMWithInjectedErrors merrs
+      . Model.runModelMWithInjectedErrors (staticMaybe Nothing id merrs)
           (Model.createSnapshot label name (getTable $ lookUp tableVar))
           (pure ())
     OpenSnapshot _ merrs label name ->
       wrap MTable
-      . Model.runModelMWithInjectedErrors merrs
+      . Model.runModelMWithInjectedErrors (staticMaybe Nothing id merrs)
           (Model.openSnapshot label name)
           (pure ())
     DeleteSnapshot name ->
@@ -1313,16 +1317,19 @@ runRealWithInjectedErrors ::
      (MonadCatch m, MonadSTM m, PrimMonad m)
   => String -- ^ Name of the action
   -> RealEnv h m
-  -> Maybe Errors
+  -> StaticMaybe b (Maybe Errors)
   -> m t-- ^ Action to run
   -> (t -> m ()) -- ^ Rollback if the action *accidentally* succeeded
   -> m (Either Model.Err t)
 runRealWithInjectedErrors s env merrs k rollback =
   case merrs of
-    Nothing -> do
+    StaticNothing -> do
+      modifyMutVar faultsVar (InjectFaultDisabled s :)
+      catchErr handlers k
+    StaticJust Nothing -> do
       modifyMutVar faultsVar (InjectFaultNone s :)
       catchErr handlers k
-    Just errs -> do
+    StaticJust (Just errs) -> do
       eith <- catchErr handlers $ FSSim.withErrors errsVar errs k
       case eith of
         Left (Model.ErrFsError _) -> do
@@ -1453,7 +1460,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
                 genErrors <*> pure label <*> genUsedSnapshotName)
         | not (null usedSnapshotNames)
           -- TODO: generate errors
-        , let genErrors = pure Nothing
+        , let genErrors = genStaticMaybe $ pure Nothing
         ]
 
      ++ [ (1, fmap Some $ DeleteSnapshot <$> genUsedSnapshotName)
@@ -1481,7 +1488,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
                 genErrors <*> pure label <*> genUnusedSnapshotName <*> genTableVar)
         | not (null unusedSnapshotNames)
            -- TODO: generate errors
-        , let genErrors = pure Nothing
+        , let genErrors = genStaticMaybe $ pure Nothing
         ]
      ++ [ (5,  fmap Some $ Duplicate <$> genTableVar)
         | length tableVars <= 5 -- no more than 5 tables at once
@@ -2147,3 +2154,49 @@ tagFinalState actions tagger =
     finalAnnState = stateAfter @(Lockstep state) actions
 
     finalTags = tagger $ underlyingState finalAnnState
+
+{-------------------------------------------------------------------------------
+  StaticMaybe
+-------------------------------------------------------------------------------}
+
+type StaticMaybe :: Bool -> Type -> Type
+data StaticMaybe isJust a where
+  StaticJust :: a -> StaticMaybe True a
+  StaticNothing :: StaticMaybe False a
+
+deriving stock instance Eq a => Eq (StaticMaybe isJust a)
+deriving stock instance Show a => Show (StaticMaybe isJust a)
+
+staticMaybe :: b -> (a -> b) -> StaticMaybe isJust a -> b
+staticMaybe _ f (StaticJust x) = f x
+staticMaybe z _ StaticNothing  = z
+
+data SBool b where
+  STrue :: SBool True
+  SFalse :: SBool False
+
+class SBoolI a where
+  sbool :: Proxy a -> SBool a
+
+instance SBoolI True where
+  sbool _ = STrue
+
+instance SBoolI False where
+  sbool _ = SFalse
+
+genStaticMaybe ::
+     forall isJust a. SBoolI isJust
+  => Gen a
+  -> Gen (StaticMaybe isJust a)
+genStaticMaybe gen = case sbool (Proxy @isJust) of
+    STrue  -> StaticJust <$> gen
+    SFalse -> pure StaticNothing
+
+shrinkStaticMaybe :: (a -> [a]) -> StaticMaybe isJust a -> [StaticMaybe isJust a]
+shrinkStaticMaybe shr = \case
+    StaticNothing -> []
+    StaticJust x -> StaticJust <$> shr x
+
+instance (Arbitrary a, SBoolI isJust) => Arbitrary (StaticMaybe isJust a) where
+  arbitrary = genStaticMaybe QC.arbitrary
+  shrink = shrinkStaticMaybe QC.shrink

From 6822b5fd7ed7b41de1ce9ae4e75eb81ff63f4ad9 Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Fri, 17 Jan 2025 10:39:04 +0100
Subject: [PATCH 5/6] QLS: OptionFaultInjection

---
 test/Test/Database/LSMTree/StateMachine.hs | 48 ++++++++++++++++++----
 1 file changed, 41 insertions(+), 7 deletions(-)

diff --git a/test/Test/Database/LSMTree/StateMachine.hs b/test/Test/Database/LSMTree/StateMachine.hs
index 5ff5c8054..f8dfa1708 100644
--- a/test/Test/Database/LSMTree/StateMachine.hs
+++ b/test/Test/Database/LSMTree/StateMachine.hs
@@ -176,7 +176,7 @@ instance Arbitrary Model.TableConfig where
 deriving via AllowThunk (ModelIO.Session IO)
     instance NoThunks (ModelIO.Session IO)
 
-type ModelIOImpl = ModelIO.Table
+type ModelIOImpl = '(ModelIO.Table, DisableFaultInjection)
 
 propLockstep_ModelIOImpl ::
      Actions (Lockstep (ModelState ModelIOImpl))
@@ -278,7 +278,7 @@ instance Arbitrary R.WriteBufferAlloc where
       | QC.Positive x' <- QC.shrink (QC.Positive x)
       ]
 
-type RealImplRealFS = R.Table
+type RealImplRealFS = '(R.Table, DisableFaultInjection)
 
 propLockstep_RealImpl_RealFS_IO ::
      Tracer IO R.LSMTreeTrace
@@ -320,7 +320,7 @@ propLockstep_RealImpl_RealFS_IO tr =
         R.closeSession session
         removeDirectoryRecursive tmpDir
 
-type RealImplMockFS = R.Table
+type RealImplMockFS = '(R.Table, EnableFaultInjection)
 
 propLockstep_RealImpl_MockFS_IO ::
      Tracer IO R.LSMTreeTrace
@@ -500,12 +500,21 @@ instance R.ResolveValue Value where
   Model state
 -------------------------------------------------------------------------------}
 
-type ModelStateTypeParams = TableKind
+type ModelStateTypeParams = (TableKind, OptionFaultInjection)
 type TableKind = (Type -> Type) -> Type -> Type -> Type -> Type
 
+data OptionFaultInjection =
+    EnableFaultInjection
+  | DisableFaultInjection
+
 type Table :: ModelStateTypeParams -> TableKind
 type family Table ps where
-  Table h = h
+  Table '(h, iof) = h
+
+type InjectFault :: ModelStateTypeParams -> Bool
+type family InjectFault ps where
+  InjectFault '(h, EnableFaultInjection) = True
+  InjectFault '(h, DisableFaultInjection) = False
 
 type ModelState :: ModelStateTypeParams -> Type
 data ModelState ps = ModelState Model.Model Stats
@@ -553,6 +562,9 @@ instance ( Show (Class.TableConfig (Table h))
          , Eq (Class.TableConfig (Table h))
          , Arbitrary (Class.TableConfig (Table h))
          , Typeable (Table h)
+         , Typeable h
+         , Typeable (InjectFault h)
+         , SBoolI (InjectFault h)
          ) => StateModel (Lockstep (ModelState h)) where
   data instance Action (Lockstep (ModelState h)) a where
     -- Tables
@@ -602,13 +614,13 @@ instance ( Show (Class.TableConfig (Table h))
     -- Snapshots
     CreateSnapshot ::
          C k v b
-      => StaticMaybe 'True (Maybe Errors)
+      => StaticMaybe (InjectFault h) (Maybe Errors)
       -> R.SnapshotLabel -> R.SnapshotName -> Var h (WrapTable (Table h) IO k v b)
       -> Act h ()
     OpenSnapshot   ::
          C k v b
       => {-# UNPACK #-} !(PrettyProxy (k, v, b))
-      -> StaticMaybe 'True (Maybe Errors)
+      -> StaticMaybe (InjectFault h) (Maybe Errors)
       -> R.SnapshotLabel -> R.SnapshotName
       -> Act h (WrapTable (Table h) IO k v b)
     DeleteSnapshot :: R.SnapshotName -> Act h ()
@@ -726,6 +738,9 @@ instance ( Eq (Class.TableConfig (Table h))
          , Show (Class.TableConfig (Table h))
          , Arbitrary (Class.TableConfig (Table h))
          , Typeable (Table h)
+         , Typeable h
+         , Typeable (InjectFault h)
+         , SBoolI (InjectFault h)
          ) => InLockstep (ModelState h) where
   type instance ModelOp (ModelState h) = Op
 
@@ -942,7 +957,10 @@ instance ( Eq (Class.TableConfig (Table h))
          , Show (Class.TableConfig (Table h))
          , Arbitrary (Class.TableConfig (Table h))
          , Typeable (Table h)
+         , Typeable h
          , NoThunks (Class.Session (Table h) IO)
+         , Typeable (InjectFault h)
+         , SBoolI (InjectFault h)
          ) => RunLockstep (ModelState h) (RealMonad h IO) where
   observeReal ::
        Proxy (RealMonad h IO)
@@ -1003,6 +1021,9 @@ instance ( Eq (Class.TableConfig (Table h))
          , Show (Class.TableConfig (Table h))
          , Arbitrary (Class.TableConfig (Table h))
          , Typeable ((Table h))
+         , Typeable h
+         , Typeable (InjectFault h)
+         , SBoolI (InjectFault h)
          ) => RunLockstep (ModelState h) (RealMonad h (IOSim s)) where
   observeReal ::
        Proxy (RealMonad h (IOSim s))
@@ -1067,7 +1088,10 @@ instance ( Eq (Class.TableConfig (Table h))
          , Show (Class.TableConfig (Table h))
          , Arbitrary (Class.TableConfig (Table h))
          , Typeable (Table h)
+         , Typeable h
          , NoThunks (Class.Session (Table h) IO)
+         , Typeable (InjectFault h)
+         , SBoolI (InjectFault h)
          ) => RunModel (Lockstep (ModelState h)) (RealMonad h IO) where
   perform _     = runIO
   postcondition = Lockstep.Defaults.postcondition
@@ -1078,6 +1102,9 @@ instance ( Eq (Class.TableConfig (Table h))
          , Show (Class.TableConfig (Table h))
          , Arbitrary (Class.TableConfig (Table h))
          , Typeable (Table h)
+         , Typeable h
+         , Typeable (InjectFault h)
+         , SBoolI (InjectFault h)
          ) => RunModel (Lockstep (ModelState h)) (RealMonad h (IOSim s)) where
   perform _     = runIOSim
   postcondition = Lockstep.Defaults.postcondition
@@ -1365,6 +1392,9 @@ arbitraryActionWithVars ::
      , Show (Class.TableConfig (Table h))
      , Arbitrary (Class.TableConfig (Table h))
      , Typeable (Table h)
+     , Typeable h
+     , Typeable (InjectFault h)
+     , SBoolI (InjectFault h)
      )
   => Proxy (k, v, b)
   -> R.SnapshotLabel
@@ -1572,6 +1602,7 @@ shrinkActionWithVars ::
        Eq (Class.TableConfig (Table h))
      , Arbitrary (Class.TableConfig (Table h))
      , Typeable ((Table h))
+     , SBoolI (InjectFault h)
      )
   => ModelVarContext (ModelState h)
   -> ModelState h
@@ -1694,6 +1725,9 @@ updateStats ::
      , Eq (Class.TableConfig (Table h))
      , Arbitrary (Class.TableConfig (Table h))
      , Typeable (Table h)
+     , Typeable h
+     , Typeable (InjectFault h)
+     , SBoolI (InjectFault h)
      )
   => LockstepAction (ModelState h) a
   -> ModelLookUp (ModelState h)

From 17a7108e22e2301281ae1b5f4812eed8ebf4dd92 Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Fri, 17 Jan 2025 10:45:54 +0100
Subject: [PATCH 6/6] QLS: rename `h` to `ps` for params

---
 test/Test/Database/LSMTree/StateMachine.hs | 526 ++++++++++-----------
 1 file changed, 263 insertions(+), 263 deletions(-)

diff --git a/test/Test/Database/LSMTree/StateMachine.hs b/test/Test/Database/LSMTree/StateMachine.hs
index f8dfa1708..2a6936e1c 100644
--- a/test/Test/Database/LSMTree/StateMachine.hs
+++ b/test/Test/Database/LSMTree/StateMachine.hs
@@ -527,10 +527,10 @@ initModelState = ModelState Model.initModel initStats
   Type synonyms
 -------------------------------------------------------------------------------}
 
-type Act h a = Action (Lockstep (ModelState h)) (Either Model.Err a)
-type Var h a = ModelVar (ModelState h) a
-type Val h a = ModelValue (ModelState h) a
-type Obs h a = Observable (ModelState h) a
+type Act ps a = Action (Lockstep (ModelState ps)) (Either Model.Err a)
+type Var ps a = ModelVar (ModelState ps) a
+type Val ps a = ModelValue (ModelState ps) a
+type Obs ps a = Observable (ModelState ps) a
 
 type K a = (
     Class.C_ a
@@ -558,85 +558,85 @@ type C k v b = (K k, V v, B b)
   StateModel
 -------------------------------------------------------------------------------}
 
-instance ( Show (Class.TableConfig (Table h))
-         , Eq (Class.TableConfig (Table h))
-         , Arbitrary (Class.TableConfig (Table h))
-         , Typeable (Table h)
-         , Typeable h
-         , Typeable (InjectFault h)
-         , SBoolI (InjectFault h)
-         ) => StateModel (Lockstep (ModelState h)) where
-  data instance Action (Lockstep (ModelState h)) a where
+instance ( Show (Class.TableConfig (Table ps))
+         , Eq (Class.TableConfig (Table ps))
+         , Arbitrary (Class.TableConfig (Table ps))
+         , Typeable (Table ps)
+         , Typeable ps
+         , Typeable (InjectFault ps)
+         , SBoolI (InjectFault ps)
+         ) => StateModel (Lockstep (ModelState ps)) where
+  data instance Action (Lockstep (ModelState ps)) a where
     -- Tables
     New :: C k v b
         => {-# UNPACK #-} !(PrettyProxy (k, v, b))
-        -> Class.TableConfig (Table h)
-        -> Act h (WrapTable (Table h) IO k v b)
+        -> Class.TableConfig (Table ps)
+        -> Act ps (WrapTable (Table ps) IO k v b)
     Close :: C k v b
-          => Var h (WrapTable (Table h) IO k v b)
-          -> Act h ()
+          => Var ps (WrapTable (Table ps) IO k v b)
+          -> Act ps ()
     -- Queries
     Lookups :: C k v b
-            => V.Vector k -> Var h (WrapTable (Table h) IO k v b)
-            -> Act h (V.Vector (LookupResult v (WrapBlobRef (Table h) IO b)))
+            => V.Vector k -> Var ps (WrapTable (Table ps) IO k v b)
+            -> Act ps (V.Vector (LookupResult v (WrapBlobRef (Table ps) IO b)))
     RangeLookup :: (C k v b, Ord k)
-                => R.Range k -> Var h (WrapTable (Table h) IO k v b)
-                -> Act h (V.Vector (QueryResult k v (WrapBlobRef (Table h) IO b)))
+                => R.Range k -> Var ps (WrapTable (Table ps) IO k v b)
+                -> Act ps (V.Vector (QueryResult k v (WrapBlobRef (Table ps) IO b)))
     -- Cursor
     NewCursor :: C k v b
               => Maybe k
-              -> Var h (WrapTable (Table h) IO k v b)
-              -> Act h (WrapCursor (Table h) IO k v b)
+              -> Var ps (WrapTable (Table ps) IO k v b)
+              -> Act ps (WrapCursor (Table ps) IO k v b)
     CloseCursor :: C k v b
-                => Var h (WrapCursor (Table h) IO k v b)
-                -> Act h ()
+                => Var ps (WrapCursor (Table ps) IO k v b)
+                -> Act ps ()
     ReadCursor :: C k v b
                => Int
-               -> Var h (WrapCursor (Table h) IO k v b)
-               -> Act h (V.Vector (QueryResult k v (WrapBlobRef (Table h) IO b)))
+               -> Var ps (WrapCursor (Table ps) IO k v b)
+               -> Act ps (V.Vector (QueryResult k v (WrapBlobRef (Table ps) IO b)))
     -- Updates
     Updates :: C k v b
-            => V.Vector (k, R.Update v b) -> Var h (WrapTable (Table h) IO k v b)
-            -> Act h ()
+            => V.Vector (k, R.Update v b) -> Var ps (WrapTable (Table ps) IO k v b)
+            -> Act ps ()
     Inserts :: C k v b
-            => V.Vector (k, v, Maybe b) -> Var h (WrapTable (Table h) IO k v b)
-            -> Act h ()
+            => V.Vector (k, v, Maybe b) -> Var ps (WrapTable (Table ps) IO k v b)
+            -> Act ps ()
     Deletes :: C k v b
-            => V.Vector k -> Var h (WrapTable (Table h) IO k v b)
-            -> Act h ()
+            => V.Vector k -> Var ps (WrapTable (Table ps) IO k v b)
+            -> Act ps ()
     Mupserts :: C k v b
-             => V.Vector (k, v) -> Var h (WrapTable (Table h) IO k v b)
-             -> Act h ()
+             => V.Vector (k, v) -> Var ps (WrapTable (Table ps) IO k v b)
+             -> Act ps ()
     -- Blobs
     RetrieveBlobs :: B b
-                  => Var h (V.Vector (WrapBlobRef (Table h) IO b))
-                  -> Act h (V.Vector (WrapBlob b))
+                  => Var ps (V.Vector (WrapBlobRef (Table ps) IO b))
+                  -> Act ps (V.Vector (WrapBlob b))
     -- Snapshots
     CreateSnapshot ::
          C k v b
-      => StaticMaybe (InjectFault h) (Maybe Errors)
-      -> R.SnapshotLabel -> R.SnapshotName -> Var h (WrapTable (Table h) IO k v b)
-      -> Act h ()
+      => StaticMaybe (InjectFault ps) (Maybe Errors)
+      -> R.SnapshotLabel -> R.SnapshotName -> Var ps (WrapTable (Table ps) IO k v b)
+      -> Act ps ()
     OpenSnapshot   ::
          C k v b
       => {-# UNPACK #-} !(PrettyProxy (k, v, b))
-      -> StaticMaybe (InjectFault h) (Maybe Errors)
+      -> StaticMaybe (InjectFault ps) (Maybe Errors)
       -> R.SnapshotLabel -> R.SnapshotName
-      -> Act h (WrapTable (Table h) IO k v b)
-    DeleteSnapshot :: R.SnapshotName -> Act h ()
-    ListSnapshots  :: Act h [R.SnapshotName]
+      -> Act ps (WrapTable (Table ps) IO k v b)
+    DeleteSnapshot :: R.SnapshotName -> Act ps ()
+    ListSnapshots  :: Act ps [R.SnapshotName]
     -- Duplicate tables
     Duplicate :: C k v b
-              => Var h (WrapTable (Table h) IO k v b)
-              -> Act h (WrapTable (Table h) IO k v b)
+              => Var ps (WrapTable (Table ps) IO k v b)
+              -> Act ps (WrapTable (Table ps) IO k v b)
     -- Table union
     Union :: C k v b
-          => Var h (WrapTable (Table h) IO k v b)
-          -> Var h (WrapTable (Table h) IO k v b)
-          -> Act h (WrapTable (Table h) IO k v b)
+          => Var ps (WrapTable (Table ps) IO k v b)
+          -> Var ps (WrapTable (Table ps) IO k v b)
+          -> Act ps (WrapTable (Table ps) IO k v b)
     Unions :: C k v b
-           => NonEmpty (Var h (WrapTable (Table h) IO k v b))
-           -> Act h (WrapTable (Table h) IO k v b)
+           => NonEmpty (Var ps (WrapTable (Table ps) IO k v b))
+           -> Act ps (WrapTable (Table ps) IO k v b)
 
   initialState    = Lockstep.Defaults.initialState initModelState
   nextState       = Lockstep.Defaults.nextState
@@ -644,16 +644,16 @@ instance ( Show (Class.TableConfig (Table h))
   arbitraryAction = Lockstep.Defaults.arbitraryAction
   shrinkAction    = Lockstep.Defaults.shrinkAction
 
-deriving stock instance Show (Class.TableConfig (Table h))
-                     => Show (LockstepAction (ModelState h) a)
+deriving stock instance Show (Class.TableConfig (Table ps))
+                     => Show (LockstepAction (ModelState ps) a)
 
-instance ( Eq (Class.TableConfig (Table h))
-         , Typeable (Table h)
-         ) => Eq (LockstepAction (ModelState h) a) where
-  (==) :: LockstepAction (ModelState h) a -> LockstepAction (ModelState h) a -> Bool
+instance ( Eq (Class.TableConfig (Table ps))
+         , Typeable (Table ps)
+         ) => Eq (LockstepAction (ModelState ps) a) where
+  (==) :: LockstepAction (ModelState ps) a -> LockstepAction (ModelState ps) a -> Bool
   x == y = go x y
     where
-      go :: LockstepAction (ModelState h) a -> LockstepAction (ModelState h) a -> Bool
+      go :: LockstepAction (ModelState ps) a -> LockstepAction (ModelState ps) a -> Bool
       go
         (New (PrettyProxy :: PrettyProxy kvb) conf1)
         (New (PrettyProxy :: PrettyProxy kvb) conf2) =
@@ -698,7 +698,7 @@ instance ( Eq (Class.TableConfig (Table h))
           Just vars1 == cast vars2
       go _  _ = False
 
-      _coveredAllCases :: LockstepAction (ModelState h) a -> ()
+      _coveredAllCases :: LockstepAction (ModelState ps) a -> ()
       _coveredAllCases = \case
           New{} -> ()
           Close{} -> ()
@@ -734,63 +734,63 @@ deriving stock instance Eq FSSim.Blob
   InLockstep
 -------------------------------------------------------------------------------}
 
-instance ( Eq (Class.TableConfig (Table h))
-         , Show (Class.TableConfig (Table h))
-         , Arbitrary (Class.TableConfig (Table h))
-         , Typeable (Table h)
-         , Typeable h
-         , Typeable (InjectFault h)
-         , SBoolI (InjectFault h)
-         ) => InLockstep (ModelState h) where
-  type instance ModelOp (ModelState h) = Op
-
-  data instance ModelValue (ModelState h) a where
+instance ( Eq (Class.TableConfig (Table ps))
+         , Show (Class.TableConfig (Table ps))
+         , Arbitrary (Class.TableConfig (Table ps))
+         , Typeable (Table ps)
+         , Typeable ps
+         , Typeable (InjectFault ps)
+         , SBoolI (InjectFault ps)
+         ) => InLockstep (ModelState ps) where
+  type instance ModelOp (ModelState ps) = Op
+
+  data instance ModelValue (ModelState ps) a where
     MTable :: Model.Table k v b
-                 -> Val h (WrapTable (Table h) IO k v b)
-    MCursor :: Model.Cursor k v b -> Val h (WrapCursor (Table h) IO k v b)
+                 -> Val ps (WrapTable (Table ps) IO k v b)
+    MCursor :: Model.Cursor k v b -> Val ps (WrapCursor (Table ps) IO k v b)
     MBlobRef :: Class.C_ b
-             => Model.BlobRef b -> Val h (WrapBlobRef (Table h) IO b)
+             => Model.BlobRef b -> Val ps (WrapBlobRef (Table ps) IO b)
 
     MLookupResult :: (Class.C_ v, Class.C_ b)
-                  => LookupResult v (Val h (WrapBlobRef (Table h) IO b))
-                  -> Val h (LookupResult v (WrapBlobRef (Table h) IO b))
+                  => LookupResult v (Val ps (WrapBlobRef (Table ps) IO b))
+                  -> Val ps (LookupResult v (WrapBlobRef (Table ps) IO b))
     MQueryResult :: Class.C k v b
-                 => QueryResult k v (Val h (WrapBlobRef (Table h) IO b))
-                 -> Val h (QueryResult k v (WrapBlobRef (Table h) IO b))
+                 => QueryResult k v (Val ps (WrapBlobRef (Table ps) IO b))
+                 -> Val ps (QueryResult k v (WrapBlobRef (Table ps) IO b))
 
     MBlob :: (Show b, Typeable b, Eq b)
-          => WrapBlob b -> Val h (WrapBlob b)
-    MSnapshotName :: R.SnapshotName -> Val h R.SnapshotName
-    MErr :: Model.Err -> Val h Model.Err
+          => WrapBlob b -> Val ps (WrapBlob b)
+    MSnapshotName :: R.SnapshotName -> Val ps R.SnapshotName
+    MErr :: Model.Err -> Val ps Model.Err
 
-    MUnit   :: () -> Val h ()
-    MPair   :: (Val h a, Val h b) -> Val h (a, b)
-    MEither :: Either (Val h a) (Val h b) -> Val h (Either a b)
-    MList   :: [Val h a] -> Val h [a]
-    MVector :: V.Vector (Val h a) -> Val h (V.Vector a)
+    MUnit   :: () -> Val ps ()
+    MPair   :: (Val ps a, Val ps b) -> Val ps (a, b)
+    MEither :: Either (Val ps a) (Val ps b) -> Val ps (Either a b)
+    MList   :: [Val ps a] -> Val ps [a]
+    MVector :: V.Vector (Val ps a) -> Val ps (V.Vector a)
 
-  data instance Observable (ModelState h) a where
-    OTable :: Obs h (WrapTable (Table h) IO k v b)
-    OCursor :: Obs h (WrapCursor (Table h) IO k v b)
-    OBlobRef :: Obs h (WrapBlobRef (Table h) IO b)
+  data instance Observable (ModelState ps) a where
+    OTable :: Obs ps (WrapTable (Table ps) IO k v b)
+    OCursor :: Obs ps (WrapCursor (Table ps) IO k v b)
+    OBlobRef :: Obs ps (WrapBlobRef (Table ps) IO b)
 
     OLookupResult :: (Class.C_ v, Class.C_ b)
-                  => LookupResult v (Obs h (WrapBlobRef (Table h) IO b))
-                  -> Obs h (LookupResult v (WrapBlobRef (Table h) IO b))
+                  => LookupResult v (Obs ps (WrapBlobRef (Table ps) IO b))
+                  -> Obs ps (LookupResult v (WrapBlobRef (Table ps) IO b))
     OQueryResult :: Class.C k v b
-                 => QueryResult k v (Obs h (WrapBlobRef (Table h) IO b))
-                 -> Obs h (QueryResult k v (WrapBlobRef (Table h) IO b))
+                 => QueryResult k v (Obs ps (WrapBlobRef (Table ps) IO b))
+                 -> Obs ps (QueryResult k v (WrapBlobRef (Table ps) IO b))
     OBlob :: (Show b, Typeable b, Eq b)
-          => WrapBlob b -> Obs h (WrapBlob b)
+          => WrapBlob b -> Obs ps (WrapBlob b)
 
-    OId :: (Show a, Typeable a, Eq a) => a -> Obs h a
+    OId :: (Show a, Typeable a, Eq a) => a -> Obs ps a
 
-    OPair   :: (Obs h a, Obs h b) -> Obs h (a, b)
-    OEither :: Either (Obs h a) (Obs h b) -> Obs h (Either a b)
-    OList   :: [Obs h a] -> Obs h [a]
-    OVector :: V.Vector (Obs h a) -> Obs h (V.Vector a)
+    OPair   :: (Obs ps a, Obs ps b) -> Obs ps (a, b)
+    OEither :: Either (Obs ps a) (Obs ps b) -> Obs ps (Either a b)
+    OList   :: [Obs ps a] -> Obs ps [a]
+    OVector :: V.Vector (Obs ps a) -> Obs ps (V.Vector a)
 
-  observeModel :: Val h a -> Obs h a
+  observeModel :: Val ps a -> Obs ps a
   observeModel = \case
       MTable _       -> OTable
       MCursor _            -> OCursor
@@ -807,19 +807,19 @@ instance ( Eq (Class.TableConfig (Table h))
       MVector x            -> OVector $ V.map observeModel x
 
   modelNextState ::  forall a.
-       LockstepAction (ModelState h) a
-    -> ModelVarContext (ModelState h)
-    -> ModelState h
-    -> (ModelValue (ModelState h) a, ModelState h)
+       LockstepAction (ModelState ps) a
+    -> ModelVarContext (ModelState ps)
+    -> ModelState ps
+    -> (ModelValue (ModelState ps) a, ModelState ps)
   modelNextState action ctx (ModelState state stats) =
       auxStats $ runModel (lookupVar ctx) action state
     where
-      auxStats :: (Val h a, Model.Model) -> (Val h a, ModelState h)
+      auxStats :: (Val ps a, Model.Model) -> (Val ps a, ModelState ps)
       auxStats (result, state') = (result, ModelState state' stats')
         where
           stats' = updateStats action (lookupVar ctx) state state' result stats
 
-  usedVars :: LockstepAction (ModelState h) a -> [AnyGVar (ModelOp (ModelState h))]
+  usedVars :: LockstepAction (ModelState ps) a -> [AnyGVar (ModelOp (ModelState ps))]
   usedVars = \case
       New _ _                         -> []
       Close tableVar                  -> [SomeGVar tableVar]
@@ -842,31 +842,31 @@ instance ( Eq (Class.TableConfig (Table h))
       Unions tableVars                -> [SomeGVar tableVar | tableVar <- NE.toList tableVars]
 
   arbitraryWithVars ::
-       ModelVarContext (ModelState h)
-    -> ModelState h
-    -> Gen (Any (LockstepAction (ModelState h)))
+       ModelVarContext (ModelState ps)
+    -> ModelState ps
+    -> Gen (Any (LockstepAction (ModelState ps)))
   arbitraryWithVars ctx st =
     QC.scale (max 100) $
     arbitraryActionWithVars (Proxy @(Key, Value, Blob)) keyValueBlobLabel ctx st
 
   shrinkWithVars ::
-       ModelVarContext (ModelState h)
-    -> ModelState h
-    -> LockstepAction (ModelState h) a
-    -> [Any (LockstepAction (ModelState h))]
+       ModelVarContext (ModelState ps)
+    -> ModelState ps
+    -> LockstepAction (ModelState ps) a
+    -> [Any (LockstepAction (ModelState ps))]
   shrinkWithVars = shrinkActionWithVars
 
   tagStep ::
-       (ModelState h, ModelState h)
-    -> LockstepAction (ModelState h) a
-    -> Val h a
+       (ModelState ps, ModelState ps)
+    -> LockstepAction (ModelState ps) a
+    -> Val ps a
     -> [String]
   tagStep states action = map show . tagStep' states action
 
-deriving stock instance Show (Class.TableConfig (Table h)) => Show (Val h a)
-deriving stock instance Show (Obs h a)
+deriving stock instance Show (Class.TableConfig (Table ps)) => Show (Val ps a)
+deriving stock instance Show (Obs ps a)
 
-instance Eq (Obs h a) where
+instance Eq (Obs ps a) where
   obsReal == obsModel = case (obsReal, obsModel) of
       -- The model is conservative about blob retrieval: the model invalidates a
       -- blob reference immediately after an update to the table, and if the SUT
@@ -889,7 +889,7 @@ instance Eq (Obs h a) where
       (OVector x, OVector y) -> x == y
       (_, _) -> False
     where
-      _coveredAllCases :: Obs h a -> ()
+      _coveredAllCases :: Obs ps a -> ()
       _coveredAllCases = \case
           OTable{} -> ()
           OCursor{} -> ()
@@ -907,19 +907,19 @@ instance Eq (Obs h a) where
   Real monad
 -------------------------------------------------------------------------------}
 
-type RealMonad h m = ReaderT (RealEnv h m) m
+type RealMonad ps m = ReaderT (RealEnv ps m) m
 
--- | An environment for implementations @h@ of the public API to run actions in
+-- | An environment for implementations @Table ps@ of the public API to run actions in
 -- (see 'perform', 'runIO', 'runIOSim').
-data RealEnv h m = RealEnv {
+data RealEnv ps m = RealEnv {
     -- | The session to run actions in.
-    envSession            :: !(Class.Session (Table h) m)
+    envSession            :: !(Class.Session (Table ps) m)
     -- | Error handlers to convert thrown exceptions into pure error values.
     --
     -- Uncaught exceptions make the tests fail, so some handlers should be
     -- provided that catch the exceptions and turn them into pure error values
     -- if possible. The state machine infrastructure can then also compare the
-    -- error values obtained from running @h@ to the error values obtained by
+    -- error values obtained from running @Table h@ to the error values obtained by
     -- running the model.
   , envHandlers           :: [Handler m (Maybe Model.Err)]
     -- | A variable holding simulated disk faults,
@@ -952,21 +952,21 @@ data InjectFaultResult =
   RunLockstep
 -------------------------------------------------------------------------------}
 
-instance ( Eq (Class.TableConfig (Table h))
-         , Class.IsTable (Table h)
-         , Show (Class.TableConfig (Table h))
-         , Arbitrary (Class.TableConfig (Table h))
-         , Typeable (Table h)
-         , Typeable h
-         , NoThunks (Class.Session (Table h) IO)
-         , Typeable (InjectFault h)
-         , SBoolI (InjectFault h)
-         ) => RunLockstep (ModelState h) (RealMonad h IO) where
+instance ( Eq (Class.TableConfig (Table ps))
+         , Class.IsTable (Table ps)
+         , Show (Class.TableConfig (Table ps))
+         , Arbitrary (Class.TableConfig (Table ps))
+         , Typeable (Table ps)
+         , Typeable ps
+         , NoThunks (Class.Session (Table ps) IO)
+         , Typeable (InjectFault ps)
+         , SBoolI (InjectFault ps)
+         ) => RunLockstep (ModelState ps) (RealMonad ps IO) where
   observeReal ::
-       Proxy (RealMonad h IO)
-    -> LockstepAction (ModelState h) a
-    -> Realized (RealMonad h IO) a
-    -> Obs h a
+       Proxy (RealMonad ps IO)
+    -> LockstepAction (ModelState ps) a
+    -> Realized (RealMonad ps IO) a
+    -> Obs ps a
   observeReal _proxy action result = case action of
       New{}            -> OEither $ bimap OId (const OTable) result
       Close{}          -> OEither $ bimap OId OId result
@@ -992,9 +992,9 @@ instance ( Eq (Class.TableConfig (Table h))
       Unions{}         -> OEither $ bimap OId (const OTable) result
 
   showRealResponse ::
-       Proxy (RealMonad h IO)
-    -> LockstepAction (ModelState h) a
-    -> Maybe (Dict (Show (Realized (RealMonad h IO) a)))
+       Proxy (RealMonad ps IO)
+    -> LockstepAction (ModelState ps) a
+    -> Maybe (Dict (Show (Realized (RealMonad ps IO) a)))
   showRealResponse _ = \case
       New{}            -> Nothing
       Close{}          -> Just Dict
@@ -1016,20 +1016,20 @@ instance ( Eq (Class.TableConfig (Table h))
       Union{}          -> Nothing
       Unions{}         -> Nothing
 
-instance ( Eq (Class.TableConfig (Table h))
-         , Class.IsTable (Table h)
-         , Show (Class.TableConfig (Table h))
-         , Arbitrary (Class.TableConfig (Table h))
-         , Typeable ((Table h))
-         , Typeable h
-         , Typeable (InjectFault h)
-         , SBoolI (InjectFault h)
-         ) => RunLockstep (ModelState h) (RealMonad h (IOSim s)) where
+instance ( Eq (Class.TableConfig (Table ps))
+         , Class.IsTable (Table ps)
+         , Show (Class.TableConfig (Table ps))
+         , Arbitrary (Class.TableConfig (Table ps))
+         , Typeable ((Table ps))
+         , Typeable ps
+         , Typeable (InjectFault ps)
+         , SBoolI (InjectFault ps)
+         ) => RunLockstep (ModelState ps) (RealMonad ps (IOSim s)) where
   observeReal ::
-       Proxy (RealMonad h (IOSim s))
-    -> LockstepAction (ModelState h) a
-    -> Realized (RealMonad h (IOSim s)) a
-    -> Obs h a
+       Proxy (RealMonad ps (IOSim s))
+    -> LockstepAction (ModelState ps) a
+    -> Realized (RealMonad ps (IOSim s)) a
+    -> Obs ps a
   observeReal _proxy action result = case action of
       New{}            -> OEither $ bimap OId (const OTable) result
       Close{}          -> OEither $ bimap OId OId result
@@ -1055,9 +1055,9 @@ instance ( Eq (Class.TableConfig (Table h))
       Unions{}         -> OEither $ bimap OId (const OTable) result
 
   showRealResponse ::
-       Proxy (RealMonad h (IOSim s))
-    -> LockstepAction (ModelState h) a
-    -> Maybe (Dict (Show (Realized (RealMonad h (IOSim s)) a)))
+       Proxy (RealMonad ps (IOSim s))
+    -> LockstepAction (ModelState ps) a
+    -> Maybe (Dict (Show (Realized (RealMonad ps (IOSim s)) a)))
   showRealResponse _ = \case
       New{}            -> Nothing
       Close{}          -> Just Dict
@@ -1083,41 +1083,41 @@ instance ( Eq (Class.TableConfig (Table h))
   RunModel
 -------------------------------------------------------------------------------}
 
-instance ( Eq (Class.TableConfig (Table h))
-         , Class.IsTable (Table h)
-         , Show (Class.TableConfig (Table h))
-         , Arbitrary (Class.TableConfig (Table h))
-         , Typeable (Table h)
-         , Typeable h
-         , NoThunks (Class.Session (Table h) IO)
-         , Typeable (InjectFault h)
-         , SBoolI (InjectFault h)
-         ) => RunModel (Lockstep (ModelState h)) (RealMonad h IO) where
+instance ( Eq (Class.TableConfig (Table ps))
+         , Class.IsTable (Table ps)
+         , Show (Class.TableConfig (Table ps))
+         , Arbitrary (Class.TableConfig (Table ps))
+         , Typeable (Table ps)
+         , Typeable ps
+         , NoThunks (Class.Session (Table ps) IO)
+         , Typeable (InjectFault ps)
+         , SBoolI (InjectFault ps)
+         ) => RunModel (Lockstep (ModelState ps)) (RealMonad ps IO) where
   perform _     = runIO
   postcondition = Lockstep.Defaults.postcondition
-  monitoring    = Lockstep.Defaults.monitoring (Proxy @(RealMonad h IO))
-
-instance ( Eq (Class.TableConfig (Table h))
-         , Class.IsTable (Table h)
-         , Show (Class.TableConfig (Table h))
-         , Arbitrary (Class.TableConfig (Table h))
-         , Typeable (Table h)
-         , Typeable h
-         , Typeable (InjectFault h)
-         , SBoolI (InjectFault h)
-         ) => RunModel (Lockstep (ModelState h)) (RealMonad h (IOSim s)) where
+  monitoring    = Lockstep.Defaults.monitoring (Proxy @(RealMonad ps IO))
+
+instance ( Eq (Class.TableConfig (Table ps))
+         , Class.IsTable (Table ps)
+         , Show (Class.TableConfig (Table ps))
+         , Arbitrary (Class.TableConfig (Table ps))
+         , Typeable (Table ps)
+         , Typeable ps
+         , Typeable (InjectFault ps)
+         , SBoolI (InjectFault ps)
+         ) => RunModel (Lockstep (ModelState ps)) (RealMonad ps (IOSim s)) where
   perform _     = runIOSim
   postcondition = Lockstep.Defaults.postcondition
-  monitoring    = Lockstep.Defaults.monitoring (Proxy @(RealMonad h (IOSim s)))
+  monitoring    = Lockstep.Defaults.monitoring (Proxy @(RealMonad ps (IOSim s)))
 
 {-------------------------------------------------------------------------------
   Interpreter for the model
 -------------------------------------------------------------------------------}
 
 runModel ::
-     ModelLookUp (ModelState h)
-  -> LockstepAction (ModelState h) a
-  -> Model.Model -> (Val h a, Model.Model)
+     ModelLookUp (ModelState ps)
+  -> LockstepAction (ModelState ps) a
+  -> Model.Model -> (Val ps a, Model.Model)
 runModel lookUp = \case
     New _ _cfg ->
       wrap MTable
@@ -1182,22 +1182,22 @@ runModel lookUp = \case
       . Model.runModelM (Model.unions Model.getResolve (fmap (getTable . lookUp) tableVars))
   where
     getTable ::
-         ModelValue (ModelState h) (WrapTable (Table h) IO k v b)
+         ModelValue (ModelState ps) (WrapTable (Table ps) IO k v b)
       -> Model.Table k v b
     getTable (MTable t) = t
 
     getCursor ::
-         ModelValue (ModelState h) (WrapCursor (Table h) IO k v b)
+         ModelValue (ModelState ps) (WrapCursor (Table ps) IO k v b)
       -> Model.Cursor k v b
     getCursor (MCursor t) = t
 
-    getBlobRefs :: ModelValue (ModelState h) (V.Vector (WrapBlobRef (Table h) IO b)) -> V.Vector (Model.BlobRef b)
+    getBlobRefs :: ModelValue (ModelState ps) (V.Vector (WrapBlobRef (Table ps) IO b)) -> V.Vector (Model.BlobRef b)
     getBlobRefs (MVector brs) = fmap (\(MBlobRef br) -> br) brs
 
 wrap ::
-     (a -> Val h b)
+     (a -> Val ps b)
   -> (Either Model.Err a, Model.Model)
-  -> (Val h (Either Model.Err b), Model.Model)
+  -> (Val ps (Either Model.Err b), Model.Model)
 wrap f = first (MEither . bimap MErr f)
 
 {-------------------------------------------------------------------------------
@@ -1205,18 +1205,18 @@ wrap f = first (MEither . bimap MErr f)
 -------------------------------------------------------------------------------}
 
 runIO ::
-     forall a h. (Class.IsTable (Table h), NoThunks (Class.Session (Table h) IO))
-  => LockstepAction (ModelState h) a
-  -> LookUp (RealMonad h IO)
-  -> RealMonad h IO (Realized (RealMonad h IO) a)
+     forall a ps. (Class.IsTable (Table ps), NoThunks (Class.Session (Table ps) IO))
+  => LockstepAction (ModelState ps) a
+  -> LookUp (RealMonad ps IO)
+  -> RealMonad ps IO (Realized (RealMonad ps IO) a)
 runIO action lookUp = ReaderT $ \ !env -> do
     x <- aux env action
     assertNoThunks (envSession env) $ pure ()
     pure x
   where
     aux ::
-         RealEnv h IO
-      -> LockstepAction (ModelState h) a
+         RealEnv ps IO
+      -> LockstepAction (ModelState ps) a
       -> IO (Realized IO a)
     aux env = \case
         New _ cfg -> catchErr handlers $
@@ -1230,9 +1230,9 @@ runIO action lookUp = ReaderT $ \ !env -> do
         NewCursor offset tableVar -> catchErr handlers $
           WrapCursor <$> Class.newCursor offset (unwrapTable $ lookUp' tableVar)
         CloseCursor cursorVar -> catchErr handlers $
-          Class.closeCursor (Proxy @(Table h)) (unwrapCursor $ lookUp' cursorVar)
+          Class.closeCursor (Proxy @(Table ps)) (unwrapCursor $ lookUp' cursorVar)
         ReadCursor n cursorVar -> catchErr handlers $
-          fmap (fmap WrapBlobRef) <$> Class.readCursor (Proxy @(Table h)) n (unwrapCursor $ lookUp' cursorVar)
+          fmap (fmap WrapBlobRef) <$> Class.readCursor (Proxy @(Table ps)) n (unwrapCursor $ lookUp' cursorVar)
         Updates kups tableVar -> catchErr handlers $
           Class.updates (unwrapTable $ lookUp' tableVar) kups
         Inserts kins tableVar -> catchErr handlers $
@@ -1242,7 +1242,7 @@ runIO action lookUp = ReaderT $ \ !env -> do
         Mupserts kmups tableVar -> catchErr handlers $
           Class.mupserts (unwrapTable $ lookUp' tableVar) kmups
         RetrieveBlobs blobRefsVar -> catchErr handlers $
-          fmap WrapBlob <$> Class.retrieveBlobs (Proxy @(Table h)) session (unwrapBlobRef <$> lookUp' blobRefsVar)
+          fmap WrapBlob <$> Class.retrieveBlobs (Proxy @(Table ps)) session (unwrapBlobRef <$> lookUp' blobRefsVar)
         CreateSnapshot merrs label name tableVar ->
           runRealWithInjectedErrors "CreateSnapshot" env merrs
             (Class.createSnapshot label name (unwrapTable $ lookUp' tableVar))
@@ -1265,20 +1265,20 @@ runIO action lookUp = ReaderT $ \ !env -> do
         session = envSession env
         handlers = envHandlers env
 
-    lookUp' :: Var h x -> Realized IO x
-    lookUp' = lookUpGVar (Proxy @(RealMonad h IO)) lookUp
+    lookUp' :: Var ps x -> Realized IO x
+    lookUp' = lookUpGVar (Proxy @(RealMonad ps IO)) lookUp
 
 runIOSim ::
-     forall s a h. Class.IsTable (Table h)
-  => LockstepAction (ModelState h) a
-  -> LookUp (RealMonad h (IOSim s))
-  -> RealMonad h (IOSim s) (Realized (RealMonad h (IOSim s)) a)
+     forall s a ps. Class.IsTable (Table ps)
+  => LockstepAction (ModelState ps) a
+  -> LookUp (RealMonad ps (IOSim s))
+  -> RealMonad ps (IOSim s) (Realized (RealMonad ps (IOSim s)) a)
 runIOSim action lookUp = ReaderT $ \ !env -> do
     aux env action
   where
     aux ::
-         RealEnv h (IOSim s)
-      -> LockstepAction (ModelState h) a
+         RealEnv ps (IOSim s)
+      -> LockstepAction (ModelState ps) a
       -> IOSim s (Realized (IOSim s) a)
     aux env = \case
         New _ cfg -> catchErr handlers $
@@ -1292,9 +1292,9 @@ runIOSim action lookUp = ReaderT $ \ !env -> do
         NewCursor offset tableVar -> catchErr handlers $
           WrapCursor <$> Class.newCursor offset (unwrapTable $ lookUp' tableVar)
         CloseCursor cursorVar -> catchErr handlers $
-          Class.closeCursor (Proxy @(Table h)) (unwrapCursor $ lookUp' cursorVar)
+          Class.closeCursor (Proxy @(Table ps)) (unwrapCursor $ lookUp' cursorVar)
         ReadCursor n cursorVar -> catchErr handlers $
-          fmap (fmap WrapBlobRef) <$> Class.readCursor (Proxy @(Table h)) n (unwrapCursor $ lookUp' cursorVar)
+          fmap (fmap WrapBlobRef) <$> Class.readCursor (Proxy @(Table ps)) n (unwrapCursor $ lookUp' cursorVar)
         Updates kups tableVar -> catchErr handlers $
           Class.updates (unwrapTable $ lookUp' tableVar) kups
         Inserts kins tableVar -> catchErr handlers $
@@ -1304,7 +1304,7 @@ runIOSim action lookUp = ReaderT $ \ !env -> do
         Mupserts kmups tableVar -> catchErr handlers $
           Class.mupserts (unwrapTable $ lookUp' tableVar) kmups
         RetrieveBlobs blobRefsVar -> catchErr handlers $
-          fmap WrapBlob <$> Class.retrieveBlobs (Proxy @(Table h)) session (unwrapBlobRef <$> lookUp' blobRefsVar)
+          fmap WrapBlob <$> Class.retrieveBlobs (Proxy @(Table ps)) session (unwrapBlobRef <$> lookUp' blobRefsVar)
         CreateSnapshot merrs label name tableVar ->
           runRealWithInjectedErrors "CreateSnapshot" env merrs
             (Class.createSnapshot label name (unwrapTable $ lookUp' tableVar))
@@ -1327,8 +1327,8 @@ runIOSim action lookUp = ReaderT $ \ !env -> do
         session = envSession env
         handlers = envHandlers env
 
-    lookUp' :: Var h x -> Realized (IOSim s) x
-    lookUp' = lookUpGVar (Proxy @(RealMonad h (IOSim s))) lookUp
+    lookUp' :: Var ps x -> Realized (IOSim s) x
+    lookUp' = lookUpGVar (Proxy @(RealMonad ps (IOSim s))) lookUp
 
 -- | @'runRealWithInjectedErrors' _ errsVar merrs action rollback@ runs @action@
 -- with injected errors if available in @merrs@.
@@ -1343,7 +1343,7 @@ runIOSim action lookUp = ReaderT $ \ !env -> do
 runRealWithInjectedErrors ::
      (MonadCatch m, MonadSTM m, PrimMonad m)
   => String -- ^ Name of the action
-  -> RealEnv h m
+  -> RealEnv ps m
   -> StaticMaybe b (Maybe Errors)
   -> m t-- ^ Action to run
   -> (t -> m ()) -- ^ Rollback if the action *accidentally* succeeded
@@ -1385,22 +1385,22 @@ catchErr hs action = catches (Right <$> action) (fmap f hs)
 -------------------------------------------------------------------------------}
 
 arbitraryActionWithVars ::
-     forall h k v b. (
+     forall ps k v b. (
        C k v b
      , Ord k
-     , Eq (Class.TableConfig (Table h))
-     , Show (Class.TableConfig (Table h))
-     , Arbitrary (Class.TableConfig (Table h))
-     , Typeable (Table h)
-     , Typeable h
-     , Typeable (InjectFault h)
-     , SBoolI (InjectFault h)
+     , Eq (Class.TableConfig (Table ps))
+     , Show (Class.TableConfig (Table ps))
+     , Arbitrary (Class.TableConfig (Table ps))
+     , Typeable (Table ps)
+     , Typeable ps
+     , Typeable (InjectFault ps)
+     , SBoolI (InjectFault ps)
      )
   => Proxy (k, v, b)
   -> R.SnapshotLabel
-  -> ModelVarContext (ModelState h)
-  -> ModelState h
-  -> Gen (Any (LockstepAction (ModelState h)))
+  -> ModelVarContext (ModelState ps)
+  -> ModelState ps
+  -> Gen (Any (LockstepAction (ModelState ps)))
 arbitraryActionWithVars _ label ctx (ModelState st _stats) =
     QC.frequency $
       concat
@@ -1410,7 +1410,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
         , genActionsBlobRef
         ]
   where
-    _coveredAllCases :: LockstepAction (ModelState h) a -> ()
+    _coveredAllCases :: LockstepAction (ModelState ps) a -> ()
     _coveredAllCases = \case
         New{} -> ()
         Close{} -> ()
@@ -1434,7 +1434,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
 
     genTableVar = QC.elements tableVars
 
-    tableVars :: [Var h (WrapTable (Table h) IO k v b)]
+    tableVars :: [Var ps (WrapTable (Table ps) IO k v b)]
     tableVars =
       [ fromRight v
       | v <- findVars ctx Proxy
@@ -1446,7 +1446,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
 
     genCursorVar = QC.elements cursorVars
 
-    cursorVars :: [Var h (WrapCursor (Table h) IO k v b)]
+    cursorVars :: [Var ps (WrapCursor (Table ps) IO k v b)]
     cursorVars =
       [ fromRight v
       | v <- findVars ctx Proxy
@@ -1458,12 +1458,12 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
 
     genBlobRefsVar = QC.elements blobRefsVars
 
-    blobRefsVars :: [Var h (V.Vector (WrapBlobRef (Table h) IO b))]
+    blobRefsVars :: [Var ps (V.Vector (WrapBlobRef (Table ps) IO b))]
     blobRefsVars = fmap (mapGVar (OpComp OpLookupResults)) lookupResultVars
                 ++ fmap (mapGVar (OpComp OpQueryResults))  queryResultVars
       where
-        lookupResultVars :: [Var h (V.Vector (LookupResult  v (WrapBlobRef (Table h) IO b)))]
-        queryResultVars  :: [Var h (V.Vector (QueryResult k v (WrapBlobRef (Table h) IO b)))]
+        lookupResultVars :: [Var ps (V.Vector (LookupResult  v (WrapBlobRef (Table ps) IO b)))]
+        queryResultVars  :: [Var ps (V.Vector (QueryResult k v (WrapBlobRef (Table ps) IO b)))]
 
         lookupResultVars = fromRight <$> findVars ctx Proxy
         queryResultVars  = fromRight <$> findVars ctx Proxy
@@ -1481,7 +1481,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
         , let snapshotname = fromJust (R.mkSnapshotName name)
         ]
 
-    genActionsSession :: [(Int, Gen (Any (LockstepAction (ModelState h))))]
+    genActionsSession :: [(Int, Gen (Any (LockstepAction (ModelState ps))))]
     genActionsSession =
         [ (1, fmap Some $ New @k @v @b PrettyProxy <$> QC.arbitrary)
         | length tableVars <= 5 ] -- no more than 5 tables at once
@@ -1499,7 +1499,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
      ++ [ (1, fmap Some $ pure ListSnapshots)
         | not (null tableVars) ] -- otherwise boring!
 
-    genActionsTables :: [(Int, Gen (Any (LockstepAction (ModelState h))))]
+    genActionsTables :: [(Int, Gen (Any (LockstepAction (ModelState ps))))]
     genActionsTables
       | null tableVars = []
       | otherwise      =
@@ -1532,7 +1532,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
         , False -- TODO: enable once table unions is implemented
         ]
 
-    genActionsCursor :: [(Int, Gen (Any (LockstepAction (ModelState h))))]
+    genActionsCursor :: [(Int, Gen (Any (LockstepAction (ModelState ps))))]
     genActionsCursor
       | null cursorVars = []
       | otherwise       =
@@ -1541,15 +1541,15 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
                                       <*> genCursorVar)
         ]
 
-    genActionsBlobRef :: [(Int, Gen (Any (LockstepAction (ModelState h))))]
+    genActionsBlobRef :: [(Int, Gen (Any (LockstepAction (ModelState ps))))]
     genActionsBlobRef =
         [ (5, fmap Some $ RetrieveBlobs <$> genBlobRefsVar)
         | not (null blobRefsVars)
         ]
 
     fromRight ::
-         Var h (Either Model.Err a)
-      -> Var h a
+         Var ps (Either Model.Err a)
+      -> Var ps a
     fromRight = mapGVar (\op -> OpFromRight `OpComp` op)
 
     genLookupKeys :: Gen (V.Vector k)
@@ -1588,7 +1588,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
     -- Unit tests for 0-way and 1-way unions are included in the UnitTests
     -- module. n-way unions for n>3 lead to larger unions, which are less likely
     -- to be finished before the end of an action sequence.
-    genUnionsTableVars :: Gen (NonEmpty (Var h (WrapTable (Table h) IO k v b)))
+    genUnionsTableVars :: Gen (NonEmpty (Var ps (WrapTable (Table ps) IO k v b)))
     genUnionsTableVars = do
         tableVar1 <- genTableVar
         tableVar2 <- genTableVar
@@ -1598,16 +1598,16 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
           ]
 
 shrinkActionWithVars ::
-     forall h a. (
-       Eq (Class.TableConfig (Table h))
-     , Arbitrary (Class.TableConfig (Table h))
-     , Typeable ((Table h))
-     , SBoolI (InjectFault h)
+     forall ps a. (
+       Eq (Class.TableConfig (Table ps))
+     , Arbitrary (Class.TableConfig (Table ps))
+     , Typeable ((Table ps))
+     , SBoolI (InjectFault ps)
      )
-  => ModelVarContext (ModelState h)
-  -> ModelState h
-  -> LockstepAction (ModelState h) a
-  -> [Any (LockstepAction (ModelState h))]
+  => ModelVarContext (ModelState ps)
+  -> ModelState ps
+  -> LockstepAction (ModelState ps) a
+  -> [Any (LockstepAction (ModelState ps))]
 shrinkActionWithVars _ctx _st = \case
     New p conf -> [ Some $ New p conf' | conf' <- QC.shrink conf ]
 
@@ -1650,7 +1650,7 @@ shrinkActionWithVars _ctx _st = \case
   Interpret 'Op' against 'ModelValue'
 -------------------------------------------------------------------------------}
 
-instance InterpretOp Op (ModelValue (ModelState h)) where
+instance InterpretOp Op (ModelValue (ModelState ps)) where
   intOp = \case
     OpId                 -> Just
     OpFst                -> \case MPair   x -> Just (fst x)
@@ -1721,19 +1721,19 @@ initStats = Stats {
     }
 
 updateStats ::
-     forall h a. ( Show (Class.TableConfig (Table h))
-     , Eq (Class.TableConfig (Table h))
-     , Arbitrary (Class.TableConfig (Table h))
-     , Typeable (Table h)
-     , Typeable h
-     , Typeable (InjectFault h)
-     , SBoolI (InjectFault h)
+     forall ps a. ( Show (Class.TableConfig (Table ps))
+     , Eq (Class.TableConfig (Table ps))
+     , Arbitrary (Class.TableConfig (Table ps))
+     , Typeable (Table ps)
+     , Typeable ps
+     , Typeable (InjectFault ps)
+     , SBoolI (InjectFault ps)
      )
-  => LockstepAction (ModelState h) a
-  -> ModelLookUp (ModelState h)
+  => LockstepAction (ModelState ps) a
+  -> ModelLookUp (ModelState ps)
   -> Model.Model
   -> Model.Model
-  -> Val h a
+  -> Val ps a
   -> Stats
   -> Stats
 updateStats action lookUp modelBefore _modelAfter result =
@@ -1766,7 +1766,7 @@ updateStats action lookUp modelBefore _modelAfter result =
       (Lookups _ _, MEither (Right (MVector lrs))) -> stats {
           numLookupsResults =
             let count :: (Int, Int, Int)
-                      -> Val h (LookupResult v (WrapBlobRef (Table h) IO blob))
+                      -> Val ps (LookupResult v (WrapBlobRef (Table ps) IO blob))
                       -> (Int, Int, Int)
                 count (nf, f, fwb) (MLookupResult x) = case x of
                   NotFound        -> (nf+1, f  , fwb  )
@@ -1865,7 +1865,7 @@ updateStats action lookUp modelBefore _modelAfter result =
 
         -- Note that batches (of inserts lookups etc) count as one action.
         updateCount :: forall k v b.
-                       Var h (WrapTable (Table h) IO k v b)
+                       Var ps (WrapTable (Table ps) IO k v b)
                     -> Stats
         updateCount tableVar =
           let tid = getTableId (lookUp tableVar)
@@ -1933,7 +1933,7 @@ updateStats action lookUp modelBefore _modelAfter result =
       where
         -- add the current table to the front of the list of tables, if it's
         -- not the latest one already
-        updateLastActionLog :: GVar Op (WrapTable (Table h) IO k v b) -> Stats
+        updateLastActionLog :: GVar Op (WrapTable (Table ps) IO k v b) -> Stats
         updateLastActionLog tableVar =
           case Map.lookup pthid (dupTableActionLog stats) of
             Just (thid' : _)
@@ -1953,7 +1953,7 @@ updateStats action lookUp modelBefore _modelAfter result =
 
     updDupTableActionLog stats = stats
 
-    getTableId :: ModelValue (ModelState h) (WrapTable (Table h) IO k v b)
+    getTableId :: ModelValue (ModelState ps) (WrapTable (Table ps) IO k v b)
                      -> Model.TableID
     getTableId (MTable t) = Model.tableID t
 
@@ -1979,9 +1979,9 @@ data Tag =
 
 -- | This is run for after every action
 tagStep' ::
-     (ModelState h, ModelState h)
-  -> LockstepAction (ModelState h) a
-  -> Val h a
+     (ModelState ps, ModelState ps)
+  -> LockstepAction (ModelState ps) a
+  -> Val ps a
   -> [Tag]
 tagStep' (ModelState _stateBefore statsBefore,
           ModelState _stateAfter _statsAfter)
@@ -2073,7 +2073,7 @@ data FinalTag =
   deriving stock Show
 
 -- | This is run only after completing every action
-tagFinalState' :: Lockstep (ModelState h) -> [(String, [FinalTag])]
+tagFinalState' :: Lockstep (ModelState ps) -> [(String, [FinalTag])]
 tagFinalState' (getModel -> ModelState finalState finalStats) = concat [
       tagNumLookupsResults
     , tagNumUpdates