Skip to content

Commit c88bf05

Browse files
jorisdraljorisdral
committed
A class for the unified LSM-Tree API
1 parent 5e80026 commit c88bf05

File tree

2 files changed

+275
-0
lines changed

2 files changed

+275
-0
lines changed

‎lsm-tree.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -343,6 +343,7 @@ test-suite lsm-tree-test
343343
hs-source-dirs: test
344344
main-is: Main.hs
345345
other-modules:
346+
Database.LSMTree.Class
346347
Database.LSMTree.Class.Common
347348
Database.LSMTree.Class.Monoidal
348349
Database.LSMTree.Class.Normal

‎test/Database/LSMTree/Class.hs‎

Lines changed: 274 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,274 @@
1+
{-# LANGUAGE TypeFamilies #-}
2+
3+
-- | An abstraction of the normal LSM API, instantiated by both the real
4+
-- implementation and a model (see "Database.LSMTree.Model.IO").
5+
module Database.LSMTree.Class (
6+
IsTable (..)
7+
, withTableNew
8+
, withTableFromSnapshot
9+
, withTableDuplicate
10+
, withCursor
11+
, module Common
12+
, module Types
13+
) where
14+
15+
import Control.Monad.Class.MonadThrow (MonadThrow (..))
16+
import Data.Kind (Constraint, Type)
17+
import Data.Typeable (Proxy (..))
18+
import qualified Data.Vector as V
19+
import Database.LSMTree as Types (LookupResult (..), QueryResult (..),
20+
ResolveValue, Update (..))
21+
import qualified Database.LSMTree as R
22+
import Database.LSMTree.Class.Common as Common
23+
24+
-- | Class abstracting over table operations.
25+
--
26+
type IsTable :: ((Type -> Type) -> Type -> Type -> Type -> Type) -> Constraint
27+
class (IsSession (Session h)) => IsTable h where
28+
type Session h :: (Type -> Type) -> Type
29+
type TableConfig h :: Type
30+
type BlobRef h :: (Type -> Type) -> Type -> Type
31+
type Cursor h :: (Type -> Type) -> Type -> Type -> Type -> Type
32+
33+
new ::
34+
( IOLike m
35+
, C k v b
36+
)
37+
=> Session h m
38+
-> TableConfig h
39+
-> m (h m k v b)
40+
41+
close ::
42+
( IOLike m
43+
, C k v b
44+
)
45+
=> h m k v b
46+
-> m ()
47+
48+
lookups ::
49+
( IOLike m
50+
, SerialiseKey k
51+
, SerialiseValue v
52+
, ResolveValue v
53+
, C k v b
54+
)
55+
=> h m k v b
56+
-> V.Vector k
57+
-> m (V.Vector (LookupResult v (BlobRef h m b)))
58+
59+
rangeLookup ::
60+
( IOLike m
61+
, SerialiseKey k
62+
, SerialiseValue v
63+
, ResolveValue v
64+
, C k v b
65+
)
66+
=> h m k v b
67+
-> Range k
68+
-> m (V.Vector (QueryResult k v (BlobRef h m b)))
69+
70+
newCursor ::
71+
( IOLike m
72+
, SerialiseKey k
73+
, C k v b
74+
)
75+
=> Maybe k
76+
-> h m k v b
77+
-> m (Cursor h m k v b)
78+
79+
closeCursor ::
80+
( IOLike m
81+
, C k v b
82+
)
83+
=> proxy h
84+
-> Cursor h m k v b
85+
-> m ()
86+
87+
readCursor ::
88+
( IOLike m
89+
, SerialiseKey k
90+
, SerialiseValue v
91+
, ResolveValue v
92+
, C k v b
93+
)
94+
=> proxy h
95+
-> Int
96+
-> Cursor h m k v b
97+
-> m (V.Vector (QueryResult k v (BlobRef h m b)))
98+
99+
retrieveBlobs ::
100+
( IOLike m
101+
, SerialiseValue b
102+
, C_ b
103+
)
104+
=> proxy h
105+
-> Session h m
106+
-> V.Vector (BlobRef h m b)
107+
-> m (V.Vector b)
108+
109+
updates ::
110+
( IOLike m
111+
, SerialiseKey k
112+
, SerialiseValue v
113+
, SerialiseValue b
114+
, ResolveValue v
115+
, C k v b
116+
)
117+
=> h m k v b
118+
-> V.Vector (k, Update v b)
119+
-> m ()
120+
121+
inserts ::
122+
( IOLike m
123+
, SerialiseKey k
124+
, SerialiseValue v
125+
, SerialiseValue b
126+
, ResolveValue v
127+
, C k v b
128+
)
129+
=> h m k v b
130+
-> V.Vector (k, v, Maybe b)
131+
-> m ()
132+
133+
deletes ::
134+
( IOLike m
135+
, SerialiseKey k
136+
, SerialiseValue v
137+
, SerialiseValue b
138+
, ResolveValue v
139+
, C k v b
140+
)
141+
=> h m k v b
142+
-> V.Vector k
143+
-> m ()
144+
145+
mupserts ::
146+
( IOLike m
147+
, SerialiseKey k
148+
, SerialiseValue v
149+
, SerialiseValue b
150+
, ResolveValue v
151+
, C k v b
152+
)
153+
=> h m k v b
154+
-> V.Vector (k, v)
155+
-> m ()
156+
157+
createSnapshot ::
158+
( IOLike m
159+
, SerialiseKey k
160+
, SerialiseValue v
161+
, SerialiseValue b
162+
, ResolveValue v
163+
, C k v b
164+
)
165+
=> SnapshotLabel
166+
-> SnapshotName
167+
-> h m k v b
168+
-> m ()
169+
170+
openSnapshot ::
171+
( IOLike m
172+
, SerialiseKey k
173+
, SerialiseValue v
174+
, ResolveValue v
175+
, SerialiseValue b
176+
, C k v b
177+
)
178+
=> Session h m
179+
-> SnapshotLabel
180+
-> SnapshotName
181+
-> m (h m k v b)
182+
183+
duplicate ::
184+
( IOLike m
185+
, C k v b
186+
)
187+
=> h m k v b
188+
-> m (h m k v b)
189+
190+
union ::
191+
( IOLike m
192+
, ResolveValue v
193+
, SerialiseValue v
194+
, C k v b
195+
)
196+
=> h m k v b
197+
-> h m k v b
198+
-> m (h m k v b)
199+
200+
withTableNew :: forall h m k v b a.
201+
( IOLike m
202+
, IsTable h
203+
, C k v b
204+
)
205+
=> Session h m
206+
-> TableConfig h
207+
-> (h m k v b -> m a)
208+
-> m a
209+
withTableNew sesh conf = bracket (new sesh conf) close
210+
211+
withTableFromSnapshot :: forall h m k v b a.
212+
( IOLike m, IsTable h
213+
, SerialiseKey k, SerialiseValue v, SerialiseValue b, ResolveValue v
214+
, C k v b
215+
)
216+
=> Session h m
217+
-> SnapshotLabel
218+
-> SnapshotName
219+
-> (h m k v b -> m a)
220+
-> m a
221+
withTableFromSnapshot sesh label snap = bracket (openSnapshot sesh label snap) close
222+
223+
withTableDuplicate :: forall h m k v b a.
224+
( IOLike m
225+
, IsTable h
226+
, C k v b
227+
)
228+
=> h m k v b
229+
-> (h m k v b -> m a)
230+
-> m a
231+
withTableDuplicate table = bracket (duplicate table) close
232+
233+
withCursor :: forall h m k v b a.
234+
( IOLike m
235+
, IsTable h
236+
, SerialiseKey k
237+
, C k v b
238+
)
239+
=> Maybe k
240+
-> h m k v b
241+
-> (Cursor h m k v b -> m a)
242+
-> m a
243+
withCursor offset hdl = bracket (newCursor offset hdl) (closeCursor (Proxy @h))
244+
245+
{-------------------------------------------------------------------------------
246+
Real instance
247+
-------------------------------------------------------------------------------}
248+
249+
instance IsTable R.Table where
250+
type Session R.Table = R.Session
251+
type TableConfig R.Table = R.TableConfig
252+
type BlobRef R.Table = R.BlobRef
253+
type Cursor R.Table = R.Cursor
254+
255+
new = R.new
256+
close = R.close
257+
lookups = R.lookups
258+
updates = R.updates
259+
inserts = R.inserts
260+
deletes = R.deletes
261+
mupserts = R.mupserts
262+
263+
rangeLookup = R.rangeLookup
264+
retrieveBlobs _ = R.retrieveBlobs
265+
266+
newCursor = maybe R.newCursor R.newCursorAtOffset
267+
closeCursor _ = R.closeCursor
268+
readCursor _ = R.readCursor
269+
270+
createSnapshot = R.createSnapshot
271+
openSnapshot sesh snap = R.openSnapshot sesh R.configNoOverride snap
272+
273+
duplicate = R.duplicate
274+
union = R.union

0 commit comments

Comments
 (0)