{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE DefaultSignatures #-}

module Database.LSMTree.Internal.Types (
    Session (..),
    Table (..),
    BlobRef (..),
    Cursor (..),
    ResolveValue (..),
    resolveCompatibility,
    resolveAssociativity,
    resolveValidOutput,
    ResolveViaSemigroup (..),
    ResolveAsFirst (..),
    ) where

import           Control.DeepSeq (NFData (..), deepseq)
import           Data.Kind (Type)
import           Data.Semigroup (Sum)
import           Data.Typeable
import qualified Database.LSMTree.Internal.BlobRef as Unsafe
import           Database.LSMTree.Internal.RawBytes (RawBytes (..))
import           Database.LSMTree.Internal.Serialise.Class (SerialiseValue (..))
import qualified Database.LSMTree.Internal.Unsafe as Unsafe

{- |
A session stores context that is shared by multiple tables.

Each session is associated with one session directory where the files
containing table data are stored. Each session locks its session directory.
There can only be one active session for each session directory at a time.
If a database is must be accessed from multiple parts of a program,
one session should be opened and shared between those parts of the program.
Session directories cannot be shared between OS processes.

A session may contain multiple tables, which may each have a different configuration and different key, value, and BLOB types.
Furthermore, sessions may contain both [simple]("Database.LSMTree.Simple") and [full-featured]("Database.LSMTree") tables.
-}
type Session :: (Type -> Type) -> Type
data Session m
  = forall h.
    (Typeable h) =>
    Session !(Unsafe.Session m h)

instance NFData (Session m) where
  rnf :: Session m -> ()
  rnf :: Session m -> ()
rnf (Session Session m h
session) = Session m h -> ()
forall a. NFData a => a -> ()
rnf Session m h
session

{- |
A table is a handle to an individual LSM-tree key\/value store with both in-memory and on-disk parts.

__Warning:__
Tables are ephemeral. Once you close a table, its data is lost forever.
To persist tables, use [snapshots]("Database.LSMTree#g:snapshots").
-}
type role Table nominal nominal nominal nominal

type Table :: (Type -> Type) -> Type -> Type -> Type -> Type
data Table m k v b
  = forall h.
    (Typeable h) =>
    Table !(Unsafe.Table m h)

instance NFData (Table m k v b) where
  rnf :: Table m k v b -> ()
  rnf :: Table m k v b -> ()
rnf (Table Table m h
table) = Table m h -> ()
forall a. NFData a => a -> ()
rnf Table m h
table

{- |
A blob reference is a reference to an on-disk blob.

__Warning:__ A blob reference is /not stable/. Any operation that modifies the table,
cursor, or session that corresponds to a blob reference may cause it to be invalidated.

The word \"blob\" in this type comes from the acronym Binary Large Object.
-}
type role BlobRef nominal nominal

type BlobRef :: (Type -> Type) -> Type -> Type
data BlobRef m b
  = forall h.
    (Typeable h) =>
    BlobRef !(Unsafe.WeakBlobRef m h)

instance Show (BlobRef m b) where
  showsPrec :: Int -> BlobRef m b -> ShowS
  showsPrec :: Int -> BlobRef m b -> ShowS
showsPrec Int
d (BlobRef WeakBlobRef m h
b) = Int -> WeakBlobRef m h -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d WeakBlobRef m h
b

{- |
A cursor is a stable read-only iterator for a table.

A cursor iterates over the entries in a table following the order of the
serialised keys. After the cursor is created, updates to the referenced table
do not affect the cursor.

The name of this type references [database cursors](https://en.wikipedia.org/wiki/Cursor_(databases\)), not, e.g., text editor cursors.
-}
type role Cursor nominal nominal nominal nominal

type Cursor :: (Type -> Type) -> Type -> Type -> Type -> Type
data Cursor m k v b
  = forall h.
    (Typeable h) =>
    Cursor !(Unsafe.Cursor m h)

instance NFData (Cursor m k v b) where
  rnf :: Cursor m k v b -> ()
  rnf :: Cursor m k v b -> ()
rnf (Cursor Cursor m h
cursor) = Cursor m h -> ()
forall a. NFData a => a -> ()
rnf Cursor m h
cursor

--------------------------------------------------------------------------------
-- Monoidal value resolution
--------------------------------------------------------------------------------

{- |
An instance of @'ResolveValue' v@ specifies how to merge values when using
monoidal upsert.

The class has two functions.
The function 'resolve' acts on values, whereas the function 'resolveSerialised' acts on serialised values.
Each function has a default implementation in terms of the other and serialisation\/deserialisation.
The user is encouraged to implement 'resolveSerialised'.

Instances should satisfy the following:

[Compatibility]:
    The functions 'resolve' and 'resolveSerialised' should be compatible:

    prop> serialiseValue (resolve v1 v2) == resolveSerialised (Proxy @v) (serialiseValue v1) (serialiseValue v2)

[Associativity]:
    The function 'resolve' should be associative:

    prop> serialiseValue (v1 `resolve` (v2 `resolve` v3)) == serialiseValue ((v1 `resolve` v2) `resolve` v3)

[Valid Output]:
    The function 'resolveSerialised' should only return deserialisable values:

    prop> deserialiseValue (resolveSerialised (Proxy @v) rb1 rb2) `deepseq` True
-}
-- TODO(optimisation): Include a function that determines whether or not it is safe to remove and Update from the last level of an LSM-tree.
-- TODO(optimisation): Include a function @v -> RawBytes -> RawBytes@ that can be used to merged deserialised and serialised values.
--                     This can be used when inserting values into the write buffer.
class ResolveValue v where
  {-# MINIMAL resolve | resolveSerialised #-}

  {- |
  Combine two values.
  -}
  resolve :: v -> v -> v

  default resolve :: SerialiseValue v => v -> v -> v
  resolve v
v1 v
v2 =
    RawBytes -> v
forall v. SerialiseValue v => RawBytes -> v
deserialiseValue (RawBytes -> v) -> RawBytes -> v
forall a b. (a -> b) -> a -> b
$
      Proxy v -> RawBytes -> RawBytes -> RawBytes
forall v.
ResolveValue v =>
Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveSerialised (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue v
v1) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue v
v2)

  {- |
  Combine two serialised values.

  The user may assume that the input bytes are valid and can be deserialised using 'deserialiseValue'.
  The inputs are only ever produced by 'serialiseValue' and 'resolveSerialised'.
  -}
  resolveSerialised :: Proxy v -> RawBytes -> RawBytes -> RawBytes
  default resolveSerialised :: SerialiseValue v => Proxy v -> RawBytes -> RawBytes -> RawBytes
  resolveSerialised Proxy v
Proxy RawBytes
rb1 RawBytes
rb2 =
    v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue (v -> v -> v
forall v. ResolveValue v => v -> v -> v
resolve (forall v. SerialiseValue v => RawBytes -> v
deserialiseValue @v RawBytes
rb1) (forall v. SerialiseValue v => RawBytes -> v
deserialiseValue @v RawBytes
rb2))

{- |
Test the __Compatibility__ law for the 'ResolveValue' class.
-}
resolveCompatibility :: (SerialiseValue v, ResolveValue v) => v -> v -> Bool
resolveCompatibility :: forall v. (SerialiseValue v, ResolveValue v) => v -> v -> Bool
resolveCompatibility (v
v1 :: v) v
v2 =
  v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue (v -> v -> v
forall v. ResolveValue v => v -> v -> v
resolve v
v1 v
v2) RawBytes -> RawBytes -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy v -> RawBytes -> RawBytes -> RawBytes
forall v.
ResolveValue v =>
Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveSerialised (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue v
v1) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue v
v2)

{- |
Test the __Associativity__ law for the 'ResolveValue' class.
-}
resolveAssociativity :: (SerialiseValue v, ResolveValue v) => v -> v -> v -> Bool
resolveAssociativity :: forall v. (SerialiseValue v, ResolveValue v) => v -> v -> v -> Bool
resolveAssociativity v
v1 v
v2 v
v3 =
  v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue (v
v1 v -> v -> v
forall v. ResolveValue v => v -> v -> v
`resolve` (v
v2 v -> v -> v
forall v. ResolveValue v => v -> v -> v
`resolve` v
v3)) RawBytes -> RawBytes -> Bool
forall a. Eq a => a -> a -> Bool
== v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue ((v
v1 v -> v -> v
forall v. ResolveValue v => v -> v -> v
`resolve` v
v2) v -> v -> v
forall v. ResolveValue v => v -> v -> v
`resolve` v
v3)

{- |
Test the __Valid Output__ law for the 'ResolveValue' class.
-}
resolveValidOutput :: (SerialiseValue v, ResolveValue v, NFData v) => v -> v -> Bool
resolveValidOutput :: forall v.
(SerialiseValue v, ResolveValue v, NFData v) =>
v -> v -> Bool
resolveValidOutput (v
v1 :: v) (v
v2 :: v) =
  forall v. SerialiseValue v => RawBytes -> v
deserialiseValue @v (Proxy v -> RawBytes -> RawBytes -> RawBytes
forall v.
ResolveValue v =>
Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveSerialised (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue v
v1) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue v
v2)) v -> Bool -> Bool
forall a b. NFData a => a -> b -> b
`deepseq` Bool
True

{- |
Wrapper that provides an instance of 'ResolveValue' via the 'Semigroup'
instance of the underlying type.

prop> resolve (ResolveViaSemigroup v1) (ResolveViaSemigroup v2) = ResolveViaSemigroup (v1 <> v2)
-}
newtype ResolveViaSemigroup v = ResolveViaSemigroup v
  deriving stock (ResolveViaSemigroup v -> ResolveViaSemigroup v -> Bool
(ResolveViaSemigroup v -> ResolveViaSemigroup v -> Bool)
-> (ResolveViaSemigroup v -> ResolveViaSemigroup v -> Bool)
-> Eq (ResolveViaSemigroup v)
forall v.
Eq v =>
ResolveViaSemigroup v -> ResolveViaSemigroup v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v.
Eq v =>
ResolveViaSemigroup v -> ResolveViaSemigroup v -> Bool
== :: ResolveViaSemigroup v -> ResolveViaSemigroup v -> Bool
$c/= :: forall v.
Eq v =>
ResolveViaSemigroup v -> ResolveViaSemigroup v -> Bool
/= :: ResolveViaSemigroup v -> ResolveViaSemigroup v -> Bool
Eq, Int -> ResolveViaSemigroup v -> ShowS
[ResolveViaSemigroup v] -> ShowS
ResolveViaSemigroup v -> String
(Int -> ResolveViaSemigroup v -> ShowS)
-> (ResolveViaSemigroup v -> String)
-> ([ResolveViaSemigroup v] -> ShowS)
-> Show (ResolveViaSemigroup v)
forall v. Show v => Int -> ResolveViaSemigroup v -> ShowS
forall v. Show v => [ResolveViaSemigroup v] -> ShowS
forall v. Show v => ResolveViaSemigroup v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> ResolveViaSemigroup v -> ShowS
showsPrec :: Int -> ResolveViaSemigroup v -> ShowS
$cshow :: forall v. Show v => ResolveViaSemigroup v -> String
show :: ResolveViaSemigroup v -> String
$cshowList :: forall v. Show v => [ResolveViaSemigroup v] -> ShowS
showList :: [ResolveViaSemigroup v] -> ShowS
Show)
  deriving newtype (RawBytes -> ResolveViaSemigroup v
ResolveViaSemigroup v -> RawBytes
(ResolveViaSemigroup v -> RawBytes)
-> (RawBytes -> ResolveViaSemigroup v)
-> SerialiseValue (ResolveViaSemigroup v)
forall v. SerialiseValue v => RawBytes -> ResolveViaSemigroup v
forall v. SerialiseValue v => ResolveViaSemigroup v -> RawBytes
forall v. (v -> RawBytes) -> (RawBytes -> v) -> SerialiseValue v
$cserialiseValue :: forall v. SerialiseValue v => ResolveViaSemigroup v -> RawBytes
serialiseValue :: ResolveViaSemigroup v -> RawBytes
$cdeserialiseValue :: forall v. SerialiseValue v => RawBytes -> ResolveViaSemigroup v
deserialiseValue :: RawBytes -> ResolveViaSemigroup v
SerialiseValue)

instance (SerialiseValue v, Semigroup v) => ResolveValue (ResolveViaSemigroup v) where
  resolve :: ResolveViaSemigroup v -> ResolveViaSemigroup v -> ResolveViaSemigroup v
  resolve :: ResolveViaSemigroup v
-> ResolveViaSemigroup v -> ResolveViaSemigroup v
resolve (ResolveViaSemigroup v
v1) (ResolveViaSemigroup v
v2) = v -> ResolveViaSemigroup v
forall v. v -> ResolveViaSemigroup v
ResolveViaSemigroup (v
v1 v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
v2)

{- |
Wrapper that provides an instance of 'ResolveValue' such that 'Database.LSMTree.upsert' behaves as 'Database.LSMTree.insert'.

The name 'ResolveAsFirst' is in reference to the wrapper 'Data.Semigroup.First' from "Data.Semigroup".

prop> resolve = const
-}
newtype ResolveAsFirst v = ResolveAsFirst {forall v. ResolveAsFirst v -> v
unResolveAsFirst:: v}
  deriving stock (ResolveAsFirst v -> ResolveAsFirst v -> Bool
(ResolveAsFirst v -> ResolveAsFirst v -> Bool)
-> (ResolveAsFirst v -> ResolveAsFirst v -> Bool)
-> Eq (ResolveAsFirst v)
forall v. Eq v => ResolveAsFirst v -> ResolveAsFirst v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => ResolveAsFirst v -> ResolveAsFirst v -> Bool
== :: ResolveAsFirst v -> ResolveAsFirst v -> Bool
$c/= :: forall v. Eq v => ResolveAsFirst v -> ResolveAsFirst v -> Bool
/= :: ResolveAsFirst v -> ResolveAsFirst v -> Bool
Eq, Int -> ResolveAsFirst v -> ShowS
[ResolveAsFirst v] -> ShowS
ResolveAsFirst v -> String
(Int -> ResolveAsFirst v -> ShowS)
-> (ResolveAsFirst v -> String)
-> ([ResolveAsFirst v] -> ShowS)
-> Show (ResolveAsFirst v)
forall v. Show v => Int -> ResolveAsFirst v -> ShowS
forall v. Show v => [ResolveAsFirst v] -> ShowS
forall v. Show v => ResolveAsFirst v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> ResolveAsFirst v -> ShowS
showsPrec :: Int -> ResolveAsFirst v -> ShowS
$cshow :: forall v. Show v => ResolveAsFirst v -> String
show :: ResolveAsFirst v -> String
$cshowList :: forall v. Show v => [ResolveAsFirst v] -> ShowS
showList :: [ResolveAsFirst v] -> ShowS
Show)
  deriving newtype (RawBytes -> ResolveAsFirst v
ResolveAsFirst v -> RawBytes
(ResolveAsFirst v -> RawBytes)
-> (RawBytes -> ResolveAsFirst v)
-> SerialiseValue (ResolveAsFirst v)
forall v. SerialiseValue v => RawBytes -> ResolveAsFirst v
forall v. SerialiseValue v => ResolveAsFirst v -> RawBytes
forall v. (v -> RawBytes) -> (RawBytes -> v) -> SerialiseValue v
$cserialiseValue :: forall v. SerialiseValue v => ResolveAsFirst v -> RawBytes
serialiseValue :: ResolveAsFirst v -> RawBytes
$cdeserialiseValue :: forall v. SerialiseValue v => RawBytes -> ResolveAsFirst v
deserialiseValue :: RawBytes -> ResolveAsFirst v
SerialiseValue)

instance ResolveValue (ResolveAsFirst v) where
  resolve :: ResolveAsFirst v -> ResolveAsFirst v -> ResolveAsFirst v
  resolve :: ResolveAsFirst v -> ResolveAsFirst v -> ResolveAsFirst v
resolve = ResolveAsFirst v -> ResolveAsFirst v -> ResolveAsFirst v
forall a b. a -> b -> a
const
  resolveSerialised :: Proxy (ResolveAsFirst v) -> RawBytes -> RawBytes -> RawBytes
  resolveSerialised :: Proxy (ResolveAsFirst v) -> RawBytes -> RawBytes -> RawBytes
resolveSerialised Proxy (ResolveAsFirst v)
_p = RawBytes -> RawBytes -> RawBytes
forall a b. a -> b -> a
const

deriving via (ResolveViaSemigroup (Sum v)) instance (Num v, SerialiseValue v) => ResolveValue (Sum v)