module Database.LSMTree.Common (
    -- * IOLike
    IOLike
    -- * Exceptions
  , Internal.SessionDirDoesNotExistError (..)
  , Internal.SessionDirLockedError (..)
  , Internal.SessionDirCorruptedError (..)
  , Internal.SessionClosedError (..)
  , Internal.TableClosedError (..)
  , Internal.TableCorruptedError (..)
  , Internal.TableTooLargeError (..)
  , Internal.TableUnionNotCompatibleError (..)
  , Internal.SnapshotExistsError (..)
  , Internal.SnapshotDoesNotExistError (..)
  , Internal.SnapshotCorruptedError (..)
  , Internal.SnapshotNotCompatibleError (..)
  , Internal.BlobRefInvalidError (..)
  , Internal.CursorClosedError (..)
  , Internal.FileFormat (..)
  , Internal.FileCorruptedError (..)
  , Internal.InvalidSnapshotNameError (..)
    -- * Tracing
  , Internal.LSMTreeTrace (..)
  , Internal.TableTrace (..)
  , Internal.MergeTrace (..)
    -- * Sessions
  , Session
  , withSession
  , openSession
  , closeSession
    -- * Serialisation constraints
  , SerialiseKey (..)
  , SerialiseValue (..)
    -- * Small types
  , Internal.Range (..)
    -- * Snapshots
  , Internal.SnapshotLabel (..)
  , Internal.SnapshotTableType (..)
  , deleteSnapshot
  , listSnapshots
    -- ** Snapshot names
  , SnapshotName
  , Internal.toSnapshotName
  , Internal.isValidSnapshotName
    -- * Blob references
  , BlobRef (..)
    -- * Table configuration
  , Internal.TableConfig (..)
  , Internal.defaultTableConfig
  , Internal.SizeRatio (..)
  , Internal.MergePolicy (..)
  , Internal.WriteBufferAlloc (..)
  , Internal.NumEntries (..)
  , Internal.BloomFilterAlloc (..)
  , Internal.defaultBloomFilterAlloc
  , Internal.FencePointerIndexType (..)
  , Internal.DiskCachePolicy (..)
  , Internal.MergeSchedule (..)
  , Internal.defaultMergeSchedule
    -- * Table configuration override
  , Internal.TableConfigOverride
  , Internal.configNoOverride
  , Internal.configOverrideDiskCachePolicy
    -- * Unions
  , UnionDebt (..)
  , UnionCredits (..)
  ) where

import           Control.Concurrent.Class.MonadMVar.Strict
import           Control.Concurrent.Class.MonadSTM (STM)
import           Control.Monad.Class.MonadAsync
import           Control.Monad.Class.MonadST
import           Control.Monad.Class.MonadThrow
import           Control.Monad.Primitive (PrimMonad)
import           Control.Tracer (Tracer)
import           Data.Kind (Type)
import           Data.Typeable (Typeable)
import qualified Database.LSMTree.Internal as Internal
import qualified Database.LSMTree.Internal.BlobRef as Internal
import qualified Database.LSMTree.Internal.Config as Internal
import qualified Database.LSMTree.Internal.Entry as Internal
import qualified Database.LSMTree.Internal.MergeSchedule as Internal
import           Database.LSMTree.Internal.Paths (SnapshotName)
import qualified Database.LSMTree.Internal.Paths as Internal
import qualified Database.LSMTree.Internal.Range as Internal
import           Database.LSMTree.Internal.Serialise.Class
import qualified Database.LSMTree.Internal.Snapshot as Internal
import           System.FS.API (FsPath, HasFS)
import           System.FS.BlockIO.API (HasBlockIO)
import           System.FS.IO (HandleIO)

{-------------------------------------------------------------------------------
  IOLike
-------------------------------------------------------------------------------}

-- | Utility class for grouping @io-classes@ constraints.
type IOLike m = (
      MonadAsync m, MonadMVar m, MonadThrow (STM m), MonadThrow m
    , MonadCatch m , MonadMask m, PrimMonad m, MonadST m
    )

{-------------------------------------------------------------------------------
  Sessions
-------------------------------------------------------------------------------}

-- | A session provides context that is shared across multiple tables.
--
-- Sessions are needed to support sharing between multiple table instances.
-- Sharing occurs when tables are duplicated using 'duplicate', or when tables
-- are combined using 'union'. Sharing is not fully preserved by snapshots:
-- existing runs are shared, but ongoing merges are not. As such, restoring of
-- snapshots (using 'open') is expensive, but snapshotting (using 'snapshot') is
-- relatively cheap.
--
-- The \"monoidal\" table types support a 'union' operation, which has the
-- constraint that the two input tables must be from the same 'Session'.
--
-- Each session places files for table data under a given directory. It is
-- not permitted to open multiple sessions for the same directory at once.
-- Instead a session should be opened once and shared for all uses of
-- tables. This restriction implies that tables cannot be shared between OS
-- processes. The restriction is enforced using file locks.
--
-- Sessions support both related and unrelated tables. Related tables are
-- created using 'duplicate', while unrelated tables can be created using 'new'.
-- It is possible to have multiple unrelated tables with different configuration
-- and key and value types in the same session. Similarly, a session can have
-- both \"normal\" and \"monoidal\" tables. For unrelated tables (that are not
-- involved in a 'union') one has a choice between using multiple sessions or a
-- shared session. Using multiple sessions requires using separate directories,
-- while a shared session will place all files under one directory.
--
type Session :: (Type -> Type) -> Type
type Session = Internal.Session'

{-# SPECIALISE withSession ::
     Tracer IO Internal.LSMTreeTrace
  -> HasFS IO HandleIO
  -> HasBlockIO IO HandleIO
  -> FsPath
  -> (Session IO -> IO a)
  -> IO a #-}
-- | (Asynchronous) exception-safe, bracketed opening and closing of a session.
--
-- If possible, it is recommended to use this function instead of 'openSession'
-- and 'closeSession'.
withSession ::
     (IOLike m, Typeable h)
  => Tracer m Internal.LSMTreeTrace
  -> HasFS m h
  -> HasBlockIO m h
  -> FsPath
  -> (Session m -> m a)
  -> m a
withSession :: forall (m :: * -> *) h a.
(IOLike m, Typeable h) =>
Tracer m LSMTreeTrace
-> HasFS m h
-> HasBlockIO m h
-> FsPath
-> (Session m -> m a)
-> m a
withSession Tracer m LSMTreeTrace
tr HasFS m h
hfs HasBlockIO m h
hbio FsPath
dir Session m -> m a
action = Tracer m LSMTreeTrace
-> HasFS m h
-> HasBlockIO m h
-> FsPath
-> (Session m h -> m a)
-> m a
forall (m :: * -> *) h a.
(MonadMask m, MonadSTM m, MonadMVar m, PrimMonad m) =>
Tracer m LSMTreeTrace
-> HasFS m h
-> HasBlockIO m h
-> FsPath
-> (Session m h -> m a)
-> m a
Internal.withSession Tracer m LSMTreeTrace
tr HasFS m h
hfs HasBlockIO m h
hbio FsPath
dir (Session m -> m a
action (Session m -> m a)
-> (Session m h -> Session m) -> Session m h -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session m h -> Session m
forall (m :: * -> *) h. Typeable h => Session m h -> Session' m
Internal.Session')

{-# SPECIALISE openSession ::
     Tracer IO Internal.LSMTreeTrace
  -> HasFS IO HandleIO
  -> HasBlockIO IO HandleIO
  -> FsPath
  -> IO (Session IO) #-}
-- | Create either a new empty table session or open an existing table session,
-- given the path to the session directory.
--
-- A new empty table session is created if the given directory is entirely
-- empty. Otherwise it is intended to open an existing table session.
--
-- Sessions should be closed using 'closeSession' when no longer needed.
-- Consider using 'withSession' instead.
--
-- Exceptions:
--
-- * Throws an exception if the directory does not exist (regardless of whether
--   it is empty or not).
--
-- * This can throw exceptions if the directory does not have the expected file
--   layout for a table session
--
-- * It will throw an exception if the session is already open (in the current
--   process or another OS process)
openSession ::
     forall m h. (IOLike m, Typeable h)
  => Tracer m Internal.LSMTreeTrace
  -> HasFS m h
  -> HasBlockIO m h -- TODO: could we prevent the user from having to pass this in?
  -> FsPath -- ^ Path to the session directory
  -> m (Session m)
openSession :: forall (m :: * -> *) h.
(IOLike m, Typeable h) =>
Tracer m LSMTreeTrace
-> HasFS m h -> HasBlockIO m h -> FsPath -> m (Session m)
openSession Tracer m LSMTreeTrace
tr HasFS m h
hfs HasBlockIO m h
hbio FsPath
dir = Session m h -> Session' m
forall (m :: * -> *) h. Typeable h => Session m h -> Session' m
Internal.Session' (Session m h -> Session' m) -> m (Session m h) -> m (Session' m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tracer m LSMTreeTrace
-> HasFS m h -> HasBlockIO m h -> FsPath -> m (Session m h)
forall (m :: * -> *) h.
(MonadSTM m, MonadMVar m, PrimMonad m, MonadMask m) =>
Tracer m LSMTreeTrace
-> HasFS m h -> HasBlockIO m h -> FsPath -> m (Session m h)
Internal.openSession Tracer m LSMTreeTrace
tr HasFS m h
hfs HasBlockIO m h
hbio FsPath
dir

{-# SPECIALISE closeSession :: Session IO -> IO () #-}
-- | Close the table session. 'closeSession' is idempotent. All subsequent
-- operations on the session or the tables within it will throw an exception.
--
-- This also closes any open tables and cursors in the session. It would
-- typically be good practice however to close all tables first rather
-- than relying on this for cleanup.
--
-- Closing a table session allows the session to be opened again elsewhere, for
-- example in a different process. Note that the session will be closed
-- automatically if the process is terminated (in particular the session file
-- lock will be released).
--
closeSession :: IOLike m => Session m -> m ()
closeSession :: forall (m :: * -> *). IOLike m => Session m -> m ()
closeSession (Internal.Session' Session m h
sesh) = Session m h -> m ()
forall (m :: * -> *) h.
(MonadMask m, MonadSTM m, MonadMVar m, PrimMonad m) =>
Session m h -> m ()
Internal.closeSession Session m h
sesh

{-------------------------------------------------------------------------------
  Snapshots
-------------------------------------------------------------------------------}

{-# SPECIALISE deleteSnapshot ::
     Session IO
  -> SnapshotName
  -> IO () #-}
-- | Delete a named snapshot.
--
-- NOTE: has similar behaviour to 'removeDirectory'.
--
-- Exceptions:
--
-- * Deleting a snapshot that doesn't exist is an error.
deleteSnapshot ::
     IOLike m
  => Session m
  -> SnapshotName
  -> m ()
deleteSnapshot :: forall (m :: * -> *). IOLike m => Session m -> SnapshotName -> m ()
deleteSnapshot (Internal.Session' Session m h
sesh) = Session m h -> SnapshotName -> m ()
forall (m :: * -> *) h.
(MonadMask m, MonadSTM m) =>
Session m h -> SnapshotName -> m ()
Internal.deleteSnapshot Session m h
sesh

{-# SPECIALISE listSnapshots ::
     Session IO
  -> IO [SnapshotName] #-}
-- | List snapshots by name.
listSnapshots ::
     IOLike m
  => Session m
  -> m [SnapshotName]
listSnapshots :: forall (m :: * -> *). IOLike m => Session m -> m [SnapshotName]
listSnapshots (Internal.Session' Session m h
sesh) = Session m h -> m [SnapshotName]
forall (m :: * -> *) h.
(MonadMask m, MonadSTM m) =>
Session m h -> m [SnapshotName]
Internal.listSnapshots Session m h
sesh

{-------------------------------------------------------------------------------
  Blob references
-------------------------------------------------------------------------------}

-- | A handle-like reference to an on-disk blob. The blob can be retrieved based
-- on the reference.
--
-- Blob comes from the acronym __Binary Large OBject (BLOB)__ and in many
-- database implementations refers to binary data that is larger than usual
-- values and is handled specially. In our context we will allow optionally a
-- blob associated with each value in the table.
--
-- Though blob references are handle-like, they /do not/ keep files open. As
-- such, when a blob reference is returned by a lookup, modifying the
-- corresponding table, cursor, or session /may/ cause the blob reference
-- to be invalidated (i.e.., the blob has gone missing because the blob file was
-- removed). These operations include:
--
-- * Updates (e.g., inserts, deletes, mupserts)
-- * Closing tables
-- * Closing cursors
-- * Closing sessions
--
-- An invalidated blob reference will throw an exception when used to look up a
-- blob. Note that operations such as snapshotting, duplication and cursor reads
-- do /not/ invalidate blob references. These operations do not modify the
-- logical contents or state of a table.
--
-- [Blob reference validity] as long as the table or cursor that the blob
-- reference originated from is not updated or closed, the blob reference will
-- be valid.
--
-- Exception: currently the 'snapshot' operation /also/ invalidates 'BlobRef's,
-- but it should not do. See <https://github.com/IntersectMBO/lsm-tree/issues/392>
--
-- TODO: get rid of the @m@ parameter?
type BlobRef :: (Type -> Type) -> Type -> Type
type role BlobRef nominal nominal
data BlobRef m b where
    BlobRef :: Typeable h
            => Internal.WeakBlobRef m h
            -> BlobRef m b

instance Show (BlobRef m b) where
    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

{-------------------------------------------------------------------------------
  Unions
-------------------------------------------------------------------------------}

-- | The /current/ upper bound on the number of 'UnionCredits' that have to be
-- supplied before a @union@ is completed.
--
-- The union debt is the number of merging steps that need to be performed /at
-- most/ until the delayed work of performing a @union@ is completed. This
-- includes the cost of completing merges that were part of the union's input
-- tables.
newtype UnionDebt = UnionDebt Int
  deriving stock (Int -> UnionDebt -> ShowS
[UnionDebt] -> ShowS
UnionDebt -> String
(Int -> UnionDebt -> ShowS)
-> (UnionDebt -> String)
-> ([UnionDebt] -> ShowS)
-> Show UnionDebt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnionDebt -> ShowS
showsPrec :: Int -> UnionDebt -> ShowS
$cshow :: UnionDebt -> String
show :: UnionDebt -> String
$cshowList :: [UnionDebt] -> ShowS
showList :: [UnionDebt] -> ShowS
Show, UnionDebt -> UnionDebt -> Bool
(UnionDebt -> UnionDebt -> Bool)
-> (UnionDebt -> UnionDebt -> Bool) -> Eq UnionDebt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnionDebt -> UnionDebt -> Bool
== :: UnionDebt -> UnionDebt -> Bool
$c/= :: UnionDebt -> UnionDebt -> Bool
/= :: UnionDebt -> UnionDebt -> Bool
Eq, Eq UnionDebt
Eq UnionDebt =>
(UnionDebt -> UnionDebt -> Ordering)
-> (UnionDebt -> UnionDebt -> Bool)
-> (UnionDebt -> UnionDebt -> Bool)
-> (UnionDebt -> UnionDebt -> Bool)
-> (UnionDebt -> UnionDebt -> Bool)
-> (UnionDebt -> UnionDebt -> UnionDebt)
-> (UnionDebt -> UnionDebt -> UnionDebt)
-> Ord UnionDebt
UnionDebt -> UnionDebt -> Bool
UnionDebt -> UnionDebt -> Ordering
UnionDebt -> UnionDebt -> UnionDebt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnionDebt -> UnionDebt -> Ordering
compare :: UnionDebt -> UnionDebt -> Ordering
$c< :: UnionDebt -> UnionDebt -> Bool
< :: UnionDebt -> UnionDebt -> Bool
$c<= :: UnionDebt -> UnionDebt -> Bool
<= :: UnionDebt -> UnionDebt -> Bool
$c> :: UnionDebt -> UnionDebt -> Bool
> :: UnionDebt -> UnionDebt -> Bool
$c>= :: UnionDebt -> UnionDebt -> Bool
>= :: UnionDebt -> UnionDebt -> Bool
$cmax :: UnionDebt -> UnionDebt -> UnionDebt
max :: UnionDebt -> UnionDebt -> UnionDebt
$cmin :: UnionDebt -> UnionDebt -> UnionDebt
min :: UnionDebt -> UnionDebt -> UnionDebt
Ord)

-- | Credits are used to pay off 'UnionDebt', completing a @union@ in the
-- process.
--
-- A union credit corresponds to a single merging step being performed.
newtype UnionCredits = UnionCredits Int
  deriving stock (Int -> UnionCredits -> ShowS
[UnionCredits] -> ShowS
UnionCredits -> String
(Int -> UnionCredits -> ShowS)
-> (UnionCredits -> String)
-> ([UnionCredits] -> ShowS)
-> Show UnionCredits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnionCredits -> ShowS
showsPrec :: Int -> UnionCredits -> ShowS
$cshow :: UnionCredits -> String
show :: UnionCredits -> String
$cshowList :: [UnionCredits] -> ShowS
showList :: [UnionCredits] -> ShowS
Show, UnionCredits -> UnionCredits -> Bool
(UnionCredits -> UnionCredits -> Bool)
-> (UnionCredits -> UnionCredits -> Bool) -> Eq UnionCredits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnionCredits -> UnionCredits -> Bool
== :: UnionCredits -> UnionCredits -> Bool
$c/= :: UnionCredits -> UnionCredits -> Bool
/= :: UnionCredits -> UnionCredits -> Bool
Eq, Eq UnionCredits
Eq UnionCredits =>
(UnionCredits -> UnionCredits -> Ordering)
-> (UnionCredits -> UnionCredits -> Bool)
-> (UnionCredits -> UnionCredits -> Bool)
-> (UnionCredits -> UnionCredits -> Bool)
-> (UnionCredits -> UnionCredits -> Bool)
-> (UnionCredits -> UnionCredits -> UnionCredits)
-> (UnionCredits -> UnionCredits -> UnionCredits)
-> Ord UnionCredits
UnionCredits -> UnionCredits -> Bool
UnionCredits -> UnionCredits -> Ordering
UnionCredits -> UnionCredits -> UnionCredits
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnionCredits -> UnionCredits -> Ordering
compare :: UnionCredits -> UnionCredits -> Ordering
$c< :: UnionCredits -> UnionCredits -> Bool
< :: UnionCredits -> UnionCredits -> Bool
$c<= :: UnionCredits -> UnionCredits -> Bool
<= :: UnionCredits -> UnionCredits -> Bool
$c> :: UnionCredits -> UnionCredits -> Bool
> :: UnionCredits -> UnionCredits -> Bool
$c>= :: UnionCredits -> UnionCredits -> Bool
>= :: UnionCredits -> UnionCredits -> Bool
$cmax :: UnionCredits -> UnionCredits -> UnionCredits
max :: UnionCredits -> UnionCredits -> UnionCredits
$cmin :: UnionCredits -> UnionCredits -> UnionCredits
min :: UnionCredits -> UnionCredits -> UnionCredits
Ord)