Merge pull request #13 from input-output-hk/common-small-types
Common small types
Common small types
-- * Constraints
, SomeSerialisationConstraint (..)
, SomeUpdateConstraint (..)
-- * Small types
, Range (..)
) where
import Control.Concurrent.Class.MonadMVar (MonadMVar)
-- TODO: optimize me when SomeSerialisationConstraint is replaced with its
-- final version
deserialise = BS.foldl' (\acc d -> acc * 0x100 + fromIntegral d) 0
{-------------------------------------------------------------------------------
Small auxiliary types
-------------------------------------------------------------------------------}
-- | A range of keys.
--
-- TODO: consider adding key prefixes to the range type.
data Range k =
-- | Inclusive lower bound, exclusive upper bound
FromToExcluding k k
-- | Inclusive lower bound, inclusive upper bound
| FromToIncluding k k
import Data.Map (Map)
import qualified Data.Map.Range as Map.R
import qualified Data.Map.Strict as Map
import Database.LSMTree.Common (SomeSerialisationConstraint (..),
import Database.LSMTree.Common (Range (..),
SomeSerialisationConstraint (..),
SomeUpdateConstraint (..))
import Database.LSMTree.Normal (Range (..))
import Database.LSMTree.Monoidal (LookupResult (..),
RangeLookupResult (..), Update (..))
import GHC.Exts (IsList (..))
{-------------------------------------------------------------------------------
Table querying and updates
-------------------------------------------------------------------------------}
-- | Result of a single point lookup.
data LookupResult k v =
NotFound !k
| Found !k !v
deriving (Eq, Show)
-- | Perform a batch of lookups.
--
-- Lookups can be performed concurrently from multiple Haskell threads.
| k <- ks
]
-- | A result for one point in a range lookup.
data RangeLookupResult k v =
FoundInRange !k !v
deriving (Eq, Show)
-- | Perform a range lookup.
--
-- Range lookups can be performed concurrently from multiple Haskell threads.
( Map.R.Bound (serialise lb) Map.R.Inclusive
, Map.R.Bound (serialise ub) Map.R.Inclusive )
-- | Normal tables support insert, delete and monoidal upsert operations.
--
-- An __update__ is a term that groups all types of table-manipulating
-- operations, like inserts and deletes.
data Update v =
Insert !v
| Delete
-- | TODO: should be given a more suitable name.
| Mupsert !v
deriving (Eq, Show)
-- | Perform a mixed batch of inserts, deletes and monoidal upserts.
--
-- Updates can be performed concurrently from multiple Haskell threads.
import Data.Map (Map)
import qualified Data.Map.Range as Map.R
import qualified Data.Map.Strict as Map
import Database.LSMTree.Common (SomeSerialisationConstraint (..))
import Database.LSMTree.Normal (Range (..))
import Database.LSMTree.Common (Range (..),
SomeSerialisationConstraint (..))
import Database.LSMTree.Normal (LookupResult (..),
RangeLookupResult (..), Update (..))
import GHC.Exts (IsList (..))
{-------------------------------------------------------------------------------
Table querying and updates
-------------------------------------------------------------------------------}
-- | Result of a single point lookup.
data LookupResult k v blob =
NotFound !k
| Found !k !v
| FoundWithBlob !k !v !(BlobRef blob)
deriving (Eq, Show)
-- Note: unfortunately we have to copy these types, as we need to implement BlobRef.
-- | Perform a batch of lookups.
--
-- Lookups can be performed concurrently from multiple Haskell threads.
lookups ::
(SomeSerialisationConstraint k, SomeSerialisationConstraint v)
=> [k]
-> Table k v blob
-> [LookupResult k v blob]
-> [LookupResult k v (BlobRef blob)]
lookups ks tbl =
[ case Map.lookup (serialise k) (_values tbl) of
Nothing -> NotFound k
| k <- ks
]
-- | A result for one point in a range lookup.
data RangeLookupResult k v blob =
FoundInRange !k !v
| FoundInRangeWithBlob !k !v !(BlobRef blob)
deriving (Eq, Show)
-- | Perform a range lookup.
--
-- Range lookups can be performed concurrently from multiple Haskell threads.
rangeLookup :: forall k v blob.
(SomeSerialisationConstraint k, SomeSerialisationConstraint v)
=> Range k
-> Table k v blob
-> [RangeLookupResult k v blob]
-> [RangeLookupResult k v (BlobRef blob)]
rangeLookup r tbl =
[ case v of
(v', Nothing) -> FoundInRange (deserialise k) (deserialise v')
( Map.R.Bound (serialise lb) Map.R.Inclusive
, Map.R.Bound (serialise ub) Map.R.Inclusive )
-- | Normal tables support insert and delete operations.
--
-- An __update__ is a term that groups all types of table-manipulating
-- operations, like inserts and deletes.
data Update v blob =
Insert !v !(Maybe blob)
| Delete
deriving (Eq, Show)
-- | Perform a mixed batch of inserts and deletes.
--
-- Updates can be performed concurrently from multiple Haskell threads.
import Data.Bifunctor (Bifunctor (second))
import Data.Kind (Type)
import Data.Word (Word64)
import Database.LSMTree.Common (IOLike, Session,
import Database.LSMTree.Common (IOLike, Range (..), Session,
SomeSerialisationConstraint, SomeUpdateConstraint,
closeSession, newSession)
Table querying and updates
-------------------------------------------------------------------------------}
-- | A range of keys.
--
-- TODO: consider adding key prefixes to the range type.
data Range k =
-- | Inclusive lower bound, exclusive upper bound
FromToExcluding k k
-- | Inclusive lower bound, inclusive upper bound
| FromToIncluding k k
-- | Result of a single point lookup.
data LookupResult k v =
NotFound !k
| Found !k !v
deriving (Eq, Show)
-- | Perform a batch of lookups.
--
-- | A result for one point in a range lookup.
data RangeLookupResult k v =
FoundInRange !k !v
deriving (Eq, Show)
-- | Perform a range lookup.
--
-> m [RangeLookupResult k v]
rangeLookup = undefined
-- | Normal tables support insert, delete and monoidal upsert operations.
-- | Monoidal tables support insert, delete and monoidal upsert operations.
--
-- An __update__ is a term that groups all types of table-manipulating
-- operations, like inserts and deletes.
import Data.Kind (Type)
import Data.Word (Word64)
import Database.LSMTree.Common (IOLike, Session,
import Database.LSMTree.Common (IOLike, Range (..), Session,
SomeSerialisationConstraint, closeSession, newSession)
{-------------------------------------------------------------------------------
Table querying and updates
-------------------------------------------------------------------------------}
-- | A range of keys.
--
-- TODO: consider adding key prefixes to the range type.
data Range k =
-- | Inclusive lower bound, exclusive upper bound
FromToExcluding k k
-- | Inclusive lower bound, inclusive upper bound
| FromToIncluding k k
-- | Result of a single point lookup.
data LookupResult k v blob =
data LookupResult k v blobref =
NotFound !k
| Found !k !v
| FoundWithBlob !k !v !(BlobRef blob)
| FoundWithBlob !k !v !blobref
deriving (Eq, Show)
-- | Perform a batch of lookups.
--
(IOLike m, SomeSerialisationConstraint k, SomeSerialisationConstraint v)
=> [k]
-> TableHandle m k v blob
-> m [LookupResult k v blob]
-> m [LookupResult k v (BlobRef blob)]
lookups = undefined
-- | A result for one point in a range lookup.
data RangeLookupResult k v blob =
data RangeLookupResult k v blobref =
FoundInRange !k !v
| FoundInRangeWithBlob !k !v !(BlobRef blob)
| FoundInRangeWithBlob !k !v !blobref
deriving (Eq, Show)
-- | Perform a range lookup.
--
(IOLike m, SomeSerialisationConstraint k, SomeSerialisationConstraint v)
=> Range k
-> TableHandle m k v blob
-> m [RangeLookupResult k v blob]
-> m [RangeLookupResult k v (BlobRef blob)]
rangeLookup = undefined
-- | Normal tables support insert and delete operations.
Alonzo builds