Aggregate constraints for the unified class

Author: jorisdral

test/Database/LSMTree/Class.hs

@@ -49,9 +49,6 @@ class (IsSession (Session h)) => IsTable h where
 
     lookups ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , ResolveValue v
            , C k v b
            )
         => h m k v b
@@ -60,9 +57,6 @@ class (IsSession (Session h)) => IsTable h where
 
     rangeLookup ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , ResolveValue v
            , C k v b
            )
         => h m k v b
@@ -71,7 +65,6 @@ class (IsSession (Session h)) => IsTable h where
 
     newCursor ::
            ( IOLike m
-           , SerialiseKey k
            , C k v b
            )
         => Maybe k
@@ -88,9 +81,6 @@ class (IsSession (Session h)) => IsTable h where
 
     readCursor ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , ResolveValue v
            , C k v b
            )
         => proxy h
@@ -100,8 +90,7 @@ class (IsSession (Session h)) => IsTable h where
 
     retrieveBlobs ::
            ( IOLike m
-           , SerialiseValue b
-           , C_ b
+           , CB b
            )
         => proxy h
         -> Session h m
@@ -110,10 +99,6 @@ class (IsSession (Session h)) => IsTable h where
 
     updates ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , SerialiseValue b
-           , ResolveValue v
            , C k v b
            )
         => h m k v b
@@ -122,10 +107,6 @@ class (IsSession (Session h)) => IsTable h where
 
     inserts ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , SerialiseValue b
-           , ResolveValue v
            , C k v b
            )
         => h m k v b
@@ -134,10 +115,6 @@ class (IsSession (Session h)) => IsTable h where
 
     deletes ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , SerialiseValue b
-           , ResolveValue v
            , C k v b
            )
         => h m k v b
@@ -146,10 +123,6 @@ class (IsSession (Session h)) => IsTable h where
 
     mupserts ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , SerialiseValue b
-           , ResolveValue v
            , C k v b
            )
         => h m k v b
@@ -158,10 +131,6 @@ class (IsSession (Session h)) => IsTable h where
 
     createSnapshot ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , SerialiseValue b
-           , ResolveValue v
            , C k v b
            )
         => SnapshotLabel
@@ -171,10 +140,6 @@ class (IsSession (Session h)) => IsTable h where
 
     openSnapshot ::
            ( IOLike m
-           , SerialiseKey k
-           , SerialiseValue v
-           , ResolveValue v
-           , SerialiseValue b
            , C k v b
            )
         => Session h m
@@ -191,30 +156,22 @@ class (IsSession (Session h)) => IsTable h where
 
     union ::
            ( IOLike m
-           , ResolveValue v
-           , SerialiseValue v
            , C k v b
            )
         => h m k v b
         -> h m k v b
         -> m (h m k v b)
 
 withTableNew :: forall h m k v b a.
-    ( IOLike m
-    , IsTable h
-    , C k v b
-    )
+    (IOLike m, IsTable h, C k v b)
   => Session h m
   -> TableConfig h
   -> (h m k v b -> m a)
   -> m a
 withTableNew sesh conf = bracket (new sesh conf) close
 
 withTableFromSnapshot :: forall h m k v b a.
-     ( IOLike m, IsTable h
-     , SerialiseKey k, SerialiseValue v, SerialiseValue b, ResolveValue v
-     , C k v b
-     )
+     (IOLike m, IsTable h, C k v b)
   => Session h m
   -> SnapshotLabel
   -> SnapshotName
@@ -223,34 +180,22 @@ withTableFromSnapshot :: forall h m k v b a.
 withTableFromSnapshot sesh label snap = bracket (openSnapshot sesh label snap) close
 
 withTableDuplicate :: forall h m k v b a.
-     ( IOLike m
-     , IsTable h
-     , C k v b
-     )
+     (IOLike m, IsTable h, C k v b)
   => h m k v b
   -> (h m k v b -> m a)
   -> m a
 withTableDuplicate table = bracket (duplicate table) close
 
 withTableUnion :: forall h m k v b a.
-     ( IOLike m
-     , IsTable h
-     , SerialiseValue v
-     , ResolveValue v
-     , C k v b
-     )
+     (IOLike m, IsTable h, C k v b)
   => h m k v b
   -> h m k v b
   -> (h m k v b -> m a)
   -> m a
 withTableUnion table1 table2 = bracket (table1 `union` table2) close
 
 withCursor :: forall h m k v b a.
-     ( IOLike m
-     , IsTable h
-     , SerialiseKey k
-     , C k v b
-     )
+     (IOLike m, IsTable h, C k v b)
   => Maybe k
   -> h m k v b
   -> (Cursor h m k v b -> m a)

test/Database/LSMTree/Class/Common.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE TypeFamilies #-}
 
 module Database.LSMTree.Class.Common (
-    C
-  , C_
+    C, CK, CV, CB, C_
   , IsSession (..)
   , SessionArgs (..)
   , withSession
@@ -13,17 +12,37 @@ import           Control.Monad.Class.MonadThrow (MonadThrow (..))
 import           Control.Tracer (nullTracer)
 import           Data.Kind (Constraint, Type)
 import           Data.Typeable (Typeable)
+import           Database.LSMTree (ResolveValue)
 import           Database.LSMTree.Common as Types (IOLike, Range (..),
                      SerialiseKey, SerialiseValue, SnapshotLabel (..),
                      SnapshotName)
 import qualified Database.LSMTree.Common as R
 import           System.FS.API (FsPath, HasFS)
 import           System.FS.BlockIO.API (HasBlockIO)
 
--- | Model-specific constraints
-type C k v b = (C_ k, C_ v, C_ b)
+{-------------------------------------------------------------------------------
+  Constraints
+-------------------------------------------------------------------------------}
+
+-- | Constraints for keys, values, and blobs
+type C k v b = (CK k, CV v, CB b)
+
+-- | Constaints for keys
+type CK k = (C_ k, SerialiseKey k)
+
+-- | Constraints for values
+type CV v = (C_ v, SerialiseValue v, ResolveValue v)
+
+-- | Constraints for blobs
+type CB b = (C_ b, SerialiseValue b)
+
+-- | Model-specific constraints for keys, values, and blobs
 type C_ a = (Show a, Eq a, Typeable a)
 
+{-------------------------------------------------------------------------------
+  Session
+-------------------------------------------------------------------------------}
+
 -- | Class abstracting over session operations.
 --
 type IsSession :: ((Type -> Type) -> Type) -> Constraint

test/Test/Database/LSMTree/Class.hs

@@ -182,10 +182,6 @@ retrieveBlobsTrav hdl ses brefs = do
 lookupsWithBlobs :: forall h m k v b.
      ( IsTable h
      , IOLike m
-     , SerialiseKey k
-     , SerialiseValue v
-     , SerialiseValue b
-     , ResolveValue v
      , C k v b
      )
   => h m k v b
@@ -199,10 +195,6 @@ lookupsWithBlobs hdl ses ks = do
 rangeLookupWithBlobs :: forall h m k v b.
      ( IsTable h
      , IOLike m
-     , SerialiseKey k
-     , SerialiseValue v
-     , SerialiseValue b
-     , ResolveValue v
      , C k v b
      )
   => h m k v b
@@ -216,10 +208,6 @@ rangeLookupWithBlobs hdl ses r = do
 readCursorWithBlobs :: forall h m k v b proxy.
      ( IsTable h
      , IOLike m
-     , SerialiseKey k
-     , SerialiseValue v
-     , SerialiseValue b
-     , ResolveValue v
      , C k v b
      )
   => proxy h
@@ -234,10 +222,6 @@ readCursorWithBlobs hdl ses cursor n = do
 readCursorAllWithBlobs :: forall h m k v b proxy.
      ( IsTable h
      , IOLike m
-     , SerialiseKey k
-     , SerialiseValue v
-     , SerialiseValue b
-     , ResolveValue v
      , C k v b
      )
   => proxy h