Skip to content

Alternative ModelIO instance for the reference implementation #403

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
mheinzel merged 1 commit into from
Oct 25, 2024
Merged

Alternative ModelIO instance for the reference implementation #403

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 6 additions & 8 deletions lsm-tree.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -335,12 +335,11 @@ test-suite lsm-tree-test
other-modules:
Database.LSMTree.Class.Monoidal
Database.LSMTree.Class.Normal
Database.LSMTree.Model.Monoidal
Database.LSMTree.Model.Normal
Database.LSMTree.Model.Normal.Session
Database.LSMTree.ModelIO.Monoidal
Database.LSMTree.ModelIO.Normal
Database.LSMTree.ModelIO.Session
Database.LSMTree.Model
Database.LSMTree.Model.IO.Monoidal
Database.LSMTree.Model.IO.Normal
Database.LSMTree.Model.Session
Database.LSMTree.Model.Table
Test.Data.Arena
Test.Database.LSMTree.Class.Monoidal
Test.Database.LSMTree.Class.Normal
Expand All @@ -367,8 +366,7 @@ test-suite lsm-tree-test
Test.Database.LSMTree.Internal.Serialise
Test.Database.LSMTree.Internal.Serialise.Class
Test.Database.LSMTree.Internal.Vector
Test.Database.LSMTree.Model.Monoidal
Test.Database.LSMTree.Model.Normal
Test.Database.LSMTree.Model.Table
Test.Database.LSMTree.Monoidal
Test.Database.LSMTree.Normal.StateMachine
Test.Database.LSMTree.Normal.StateMachine.DL
Expand Down
86 changes: 42 additions & 44 deletions test/Database/LSMTree/Class/Monoidal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,11 @@
{-# LANGUAGE TypeFamilies #-}

-- | An abstraction of the monoidal LSM API, instantiated by both the real
-- implementation and a model (see "Database.LSMTree.Model.IO.Monoidal").
module Database.LSMTree.Class.Monoidal (
IsSession (..)
C
, C_
, IsSession (..)
, SessionArgs (..)
, withSession
, IsTableHandle (..)
Expand All @@ -10,21 +14,25 @@ module Database.LSMTree.Class.Monoidal (
, withTableDuplicate
, withTableMerge
, withCursor
, module Types
Copy link
Collaborator Author

@jorisdral jorisdral Oct 23, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not a big fan of re-exports, because it makes it hard to follow where identifiers are coming from. However, it's also weird that one would have to import a bunch of other modules. What do you think?

If we change this, we should make sure it's consistent across the model/class modules

I'm currently leaning towards having no re-exports in the Class and Model modules. The model/class hierarchy is already a little bit complicated, and re-rexports of identifiers might not help

Also, I haven't really been consistent with re-exports vs. no re-exports in these modules myself, so I'm mainly criticising myself 😝

Copy link
Collaborator

@mheinzel mheinzel Oct 24, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think it makes a big difference, but let me share some of my reasoning.

IMHO it's sometimes a bit clearer to have the re-export, for example with convLookupResult :: Model.LookupResult v b -> Class.LookupResult v b it makes it clear that it exists because the model's type doesn't quite fit the class we want to implement. If it was something like -> Real.LookupResult, the purpose is already less obvious.

Another way of thinking about it: The class uses a lot of the same types as the public API of the implementation. Now the question is: Is that a consciously chosen property of the class? If so, we can expect downstream code to also import something like LSMTree.Normal. If it is more of an implementation detail, we should re-export the types and use them as Class._, which allows using/implementing the class without considering the implementation, and also makes it easier to swap types out later.

) where

import Control.Monad.Class.MonadThrow (MonadThrow (..))
import Data.Kind (Constraint, Type)
import Data.Typeable (Proxy (Proxy), Typeable)
import qualified Data.Vector as V
import Data.Void (Void)
import Database.LSMTree.Class.Normal (IsSession (..),
SessionArgs (..), withSession)
import Database.LSMTree.Common (IOLike, Labellable (..), Range (..),
SerialiseKey, SerialiseValue, SnapshotName)
import qualified Database.LSMTree.ModelIO.Monoidal as M
import Database.LSMTree.Monoidal (LookupResult (..), QueryResult (..),
ResolveValue, Update (..))
import Database.LSMTree.Common as Types (IOLike, Labellable (..),
Range (..), SerialiseKey, SerialiseValue, SnapshotName)
import Database.LSMTree.Monoidal as Types (LookupResult (..),
QueryResult (..), ResolveValue, Update (..))
import qualified Database.LSMTree.Monoidal as R

-- | Model-specific constraints
type C k v blob = (C_ k, C_ v, C_ blob)
type C_ a = (Show a, Eq a, Typeable a)

-- | Class abstracting over table handle operations.
--
Expand All @@ -35,13 +43,17 @@ class (IsSession (Session h)) => IsTableHandle h where
type Cursor h :: (Type -> Type) -> Type -> Type -> Type

new ::
IOLike m
( IOLike m
, C k v Void
)
=> Session h m
-> TableConfig h
-> m (h m k v)

close ::
IOLike m
( IOLike m
, C k v Void
)
=> h m k v
-> m ()

Expand All @@ -50,6 +62,7 @@ class (IsSession (Session h)) => IsTableHandle h where
, ResolveValue v
, SerialiseKey k
, SerialiseValue v
, C k v Void
)
=> h m k v
-> V.Vector k
Expand All @@ -60,6 +73,7 @@ class (IsSession (Session h)) => IsTableHandle h where
, ResolveValue v
, SerialiseKey k
, SerialiseValue v
, C k v Void
)
=> h m k v
-> Range k
Expand All @@ -68,13 +82,16 @@ class (IsSession (Session h)) => IsTableHandle h where
newCursor ::
( IOLike m
, SerialiseKey k
, C k v Void
)
=> Maybe k
-> h m k v
-> m (Cursor h m k v)

closeCursor ::
IOLike m
( IOLike m
, C k v Void
)
=> proxy h
-> Cursor h m k v
-> m ()
Expand All @@ -84,6 +101,7 @@ class (IsSession (Session h)) => IsTableHandle h where
, ResolveValue v
, SerialiseKey k
, SerialiseValue v
, C k v Void
)
=> proxy h
-> Int
Expand All @@ -95,6 +113,7 @@ class (IsSession (Session h)) => IsTableHandle h where
, SerialiseKey k
, SerialiseValue v
, ResolveValue v
, C k v Void
)
=> h m k v
-> V.Vector (k, Update v)
Expand All @@ -105,6 +124,7 @@ class (IsSession (Session h)) => IsTableHandle h where
, SerialiseKey k
, SerialiseValue v
, ResolveValue v
, C k v Void
)
=> h m k v
-> V.Vector (k, v)
Expand All @@ -115,6 +135,7 @@ class (IsSession (Session h)) => IsTableHandle h where
, SerialiseKey k
, SerialiseValue v
, ResolveValue v
, C k v Void
)
=> h m k v
-> V.Vector k
Expand All @@ -125,6 +146,7 @@ class (IsSession (Session h)) => IsTableHandle h where
, SerialiseKey k
, SerialiseValue v
, ResolveValue v
, C k v Void
)
=> h m k v
-> V.Vector (k, v)
Expand All @@ -136,8 +158,7 @@ class (IsSession (Session h)) => IsTableHandle h where
, ResolveValue v
, SerialiseKey k
, SerialiseValue v
-- Model-specific constraints
, Typeable k, Typeable v
, C k v Void
)
=> SnapshotName
-> h m k v
Expand All @@ -148,22 +169,24 @@ class (IsSession (Session h)) => IsTableHandle h where
, Labellable (k, v)
, SerialiseKey k
, SerialiseValue v
-- Model-specific constraints
, Typeable k, Typeable v
, C k v Void
)
=> Session h m
-> SnapshotName
-> m (h m k v)

duplicate ::
IOLike m
( IOLike m
, C k v Void
)
=> h m k v
-> m (h m k v)

merge ::
( IOLike m
, ResolveValue v
, SerialiseValue v
, C k v Void
)
=> h m k v
-> h m k v
Expand All @@ -172,6 +195,7 @@ class (IsSession (Session h)) => IsTableHandle h where
withTableNew :: forall h m k v a.
( IOLike m
, IsTableHandle h
, C k v Void
)
=> Session h m
-> TableConfig h
Expand All @@ -185,7 +209,7 @@ withTableOpen :: forall h m k v a.
, SerialiseKey k
, SerialiseValue v
, Labellable (k, v)
, Typeable k, Typeable v
, C k v Void
)
=> Session h m
-> SnapshotName
Expand All @@ -196,6 +220,7 @@ withTableOpen sesh snap = bracket (open sesh snap) close
withTableDuplicate :: forall h m k v a.
( IOLike m
, IsTableHandle h
, C k v Void
)
=> h m k v
-> (h m k v -> m a)
Expand All @@ -207,6 +232,7 @@ withTableMerge :: forall h m k v a.
, IsTableHandle h
, SerialiseValue v
, ResolveValue v
, C k v Void
)
=> h m k v
-> h m k v
Expand All @@ -218,42 +244,14 @@ withCursor :: forall h m k v a.
( IOLike m
, IsTableHandle h
, SerialiseKey k
, C k v Void
)
=> Maybe k
-> h m k v
-> (Cursor h m k v -> m a)
-> m a
withCursor offset hdl = bracket (newCursor offset hdl) (closeCursor (Proxy @h))

{-------------------------------------------------------------------------------
Model instance
-------------------------------------------------------------------------------}

instance IsTableHandle M.TableHandle where
type Session M.TableHandle = M.Session
type TableConfig M.TableHandle = M.TableConfig
type Cursor M.TableHandle = M.Cursor

new = M.new
close = M.close
lookups = flip M.lookups
updates = flip M.updates
inserts = flip M.inserts
deletes = flip M.deletes
mupserts = flip M.mupserts

rangeLookup = flip M.rangeLookup

newCursor = M.newCursor
closeCursor _ = M.closeCursor
readCursor _ = M.readCursor

snapshot = M.snapshot
open = M.open

duplicate = M.duplicate
merge = M.merge

{-------------------------------------------------------------------------------
Real instance
-------------------------------------------------------------------------------}
Expand Down
Loading
Loading