{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies     #-}

{-# OPTIONS_HADDOCK show-extensions #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Database.Muesli.Backend.Types
-- Copyright   : (c) 2015 Călin Ardelean
-- License     : MIT
--
-- Maintainer  : Călin Ardelean <calinucs@gmail.com>
-- Stability   : experimental
-- Portability : portable
--
-- Generic backend interface types and classes.
--
-- This module is re-exported by other modules, like "Database.Muesli.Handle".
----------------------------------------------------------------------------

module Database.Muesli.Backend.Types
  (
-- * Transaction log records
    TransRecord (..)
  , LogRecord (..)
-- * Generic backend interface
-- | These classes are used by the machinary in "Database.Muesli.State".
--
-- For an implementation, see the "Database.Muesli.Backend.File" module.
  , LogState (..)
  , DataHandle (..)
  , DbPath
  , DbHandle (..)
  ) where

import           Control.Monad.Trans   (MonadIO)
import           Data.ByteString       (ByteString)
import           Database.Muesli.Types (DocAddress, DocSize, DocumentKey,
                                        PropertyKey, SortableKey, TransactionId,
                                        UniqueKey)

-- | Holds the metadata for a given document version.
--
-- Keys collected by the generic scrapper are stored in 'recReferences',
-- 'recSortables', and 'recUniques'. The 'recDocumentKey' is generated by an
-- 'Database.Muesli.IdSupply.IdSupply', while the 'recAddress' and 'recSize'
-- are allocated by 'Database.Muesli.Allocator.alloc'.
-- This work is done either by the primitive queries in "Database.Muesli.Query",
-- or by 'Database.Muesli.Commit.runQuery'.
data LogRecord = LogRecord
  { recTransactionId :: !TransactionId
  , recDocumentKey   :: !DocumentKey
  , recReferences    :: ![(PropertyKey, DocumentKey)]
  , recSortables     :: ![(PropertyKey, SortableKey)]
  , recUniques       :: ![(PropertyKey, UniqueKey)]
  , recAddress       :: !DocAddress
  , recSize          :: !DocSize
  , recDeleted       :: !Bool
  } deriving (Show)

-- | This type represents a line in the transaction log file.
-- There can be multiple lines for a single transaction, and the last one
-- must be a 'Completed' one. Other than that, the lines from multiple
-- transactions can be mixed.
data TransRecord = Pending LogRecord | Completed TransactionId
  deriving (Show)

-- | Generic path type. For instance, this can be a file path or an url.
type DbPath = String

-- | Generic handle interface.
class DbHandle a where
  openDb  :: MonadIO m => DbPath -> m a
  closeDb :: MonadIO m => a -> m ()
  withDb  :: MonadIO m => DbPath -> (a -> IO b) -> m b
  swapDb  :: MonadIO m => DbPath -> DbPath -> m a

-- | Handle used to access serialized document data in the generic data file.
class DbHandle a => DataHandle a where
  readDocument  :: MonadIO m => a -> LogRecord -> m ByteString
  writeDocument :: MonadIO m => LogRecord -> ByteString -> a -> m ()

-- | Provides stateful access to an abstract log file handle.
class (Show a, DbHandle (LogHandleOf a), DataHandle (DataHandleOf a)) => LogState a where
  type LogHandleOf  a :: *
  type DataHandleOf a :: *
  logHandle :: a -> LogHandleOf a
  logInit   :: MonadIO m => LogHandleOf a -> m a
  logAppend :: MonadIO m => a -> [TransRecord] -> m a
  logRead   :: MonadIO m => a -> m (Maybe TransRecord)