Skip to content

Commit

Permalink
Aggregate constraints for the unified class
Browse files Browse the repository at this point in the history
  • Loading branch information
@jorisdral
jorisdral committed Dec 4, 2024
1 parent abc1ee7 commit aa22af7
Show file tree
Hide file tree
Showing 3 changed files with 29 additions and 81 deletions.
67 changes: 6 additions & 61 deletions test/Database/LSMTree/Class.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -71,7 +65,6 @@ class (IsSession (Session h)) => IsTable h where

newCursor ::
( IOLike m
, SerialiseKey k
, C k v b
)
=> Maybe k
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand Down
27 changes: 23 additions & 4 deletions test/Database/LSMTree/Class/Common.hs
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,7 @@
{-# LANGUAGE TypeFamilies #-}

module Database.LSMTree.Class.Common (
C
, C_
C, CK, CV, CB, C_
, IsSession (..)
, SessionArgs (..)
, withSession
Expand All @@ -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
Expand Down
16 changes: 0 additions & 16 deletions test/Test/Database/LSMTree/Class.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down

0 comments on commit aa22af7

Please sign in to comment.