-----------------------------------------------------------------------------
--
-- Module      :  Data.Journal.File
-- Copyright   :  (c) 2017 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <consult@brianwbush.info>
-- Stability   :  Stable
-- Portability :  Portable
--
-- | A file-backed journal that does no logging.
--
-----------------------------------------------------------------------------


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards  #-}
{-# LANGUAGE TupleSections    #-}


module Data.Journal.File (
  -- * Types
  FileJournal
  -- * Construction
, openJournal
, openJournalIO
) where


import Control.Arrow (second)
import Control.Monad (when, void)
import Control.Monad.Except (MonadError, MonadIO, runExceptT)
import Control.Monad.Except.Util (guardIO, eitherError)
import Control.Monad.Util (collectWhile)
import Data.ByteString.Char8 as BS (head, hGet, hPut, length, singleton)
import Data.Journal (Entry, Journal(..), Key)
import Data.Map.Lazy as M (filter, fromList, map, toList)
import Data.Maybe (fromJust, isJust)
import Data.Serialize (decode, encode)
import Data.Word (Word32)
import System.IO (BufferMode(..), Handle, IOMode(..), SeekMode(..), hClose, hFlush, hGetPosn, hIsEOF, hSeek, hSetBuffering, hSetFileSize, hSetPosn, openFile)


-- | A file-backed journal.
data FileJournal =
  FileJournal
  {
    file   :: FilePath -- ^ The file name.
  , handle :: Handle   -- ^ The handle to the file.
  }
    deriving (Eq, Show)

instance Journal FileJournal where

  append FileJournal{..} = guardIO  . save handle . second Just
      
  erase FileJournal{..} = guardIO . save handle . (, Nothing)
      
  replay compact FileJournal{..} =
    guardIO
      $ do
        hSeek handle AbsoluteSeek 0
        keyEntries <-
          M.toList
          . M.map fromJust
          . M.filter isJust
          . M.fromList
          <$> collectWhile (load handle) (hasNext handle)
        when compact
          $ do -- FIXME: Make this atomic.
            hSeek handle AbsoluteSeek 0
            hSetFileSize handle 0
            mapM_ (save handle . second Just) keyEntries
        return keyEntries

  clear FileJournal{..} =
    guardIO
      $ do
        hSeek handle AbsoluteSeek 0
        hSetFileSize handle 0

  close FileJournal{..} = guardIO $ hClose handle


-- | Determine whether there is a valid next entry in the journal.
hasNext :: Handle  -- ^ The file handle for the journal.
        -> IO Bool -- ^ An action to determine whether there is a valid next entry.
hasNext h =
  do
    e <- hIsEOF h
    if e
      then return False
      else do
             i <- hGetPosn h
             flag <- hGetEnum h
             hSetPosn i
             return flag


-- | Get a one-byte enum.
hGetEnum :: Enum a
         => Handle -- ^ The file handle.
         -> IO a   -- ^ An action to read the enum.
hGetEnum h = toEnum . fromEnum . BS.head <$> BS.hGet h 1


-- | Put a one-byte enum.
hPutEnum :: Enum a
         => Handle -- ^ The file handle.
         -> a      -- ^ The enum.
         -> IO ()  -- ^ An action to write the enum.
hPutEnum h = BS.hPut h . BS.singleton . toEnum . fromEnum


-- | Write an entry to a journal.
save :: Handle             -- ^ The file handle for the journal.
     -> (Key, Maybe Entry) -- ^ The entry, or whose lack of an entry indicates deletion.
     -> IO ()              -- ^ An action to write the entry.
save h (key, entry) =
  do
    i <- hGetPosn h
    hPutEnum h False
    let
      payload = encode (key, entry)
      n = (toEnum :: Int -> Word32) $ BS.length payload
      n' = encode n
    BS.hPut h n'
    BS.hPut h payload
    j <- hGetPosn h
    hSetPosn i
    hPutEnum h True
    hSetPosn j
    hFlush h


-- | Read an entry from a journal.
load :: Handle                -- ^ The file handle for the journal.
     -> IO (Key, Maybe Entry) -- ^ An action to read the entry, or whose lack of an entry indicates deletion.
load h =
  do
    void $ BS.hGet h 1
    n' <- BS.hGet h 4
    n <- eitherError (fromEnum :: Word32 -> Int) $ decode n'
    payload <- BS.hGet h n
    eitherError id $ decode payload
             

-- | Open a journal.      
openJournal :: (MonadIO m, MonadError String m)
            => FilePath      -- ^ The location of the journal file.
            -> m FileJournal -- ^ An action to open the journal.
openJournal file =
  guardIO
    $ do
      handle <- openFile file ReadWriteMode
      hSetBuffering handle $ BlockBuffering Nothing
      hSeek handle SeekFromEnd 0
      return FileJournal{..}


-- | Open a journal.
openJournalIO :: FilePath       -- ^ The location of the journal file.
              -> IO FileJournal -- ^ An IO action to open the journal.
openJournalIO = (eitherError id =<<) . runExceptT . openJournal