    {-# LANGUAGE BangPatterns, CPP #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Acid.Local
    -- Copyright   :  PublicDomain
    --
    -- Maintainer  :  lemmih@gmail.com
    -- Portability :  non-portable (uses GHC extensions)
    --
    -- AcidState container using a transaction log on disk. The term \'Event\' is
    -- loosely used for transactions with ACID guarantees. \'Method\' is loosely
    -- used for state operations without ACID guarantees (see "Data.Acid.Core").
    --

    module Data.Acid.Local
        ( openLocalState
        , openLocalStateFrom
        , openLocalStateWithSerialiser
        , prepareLocalState
        , prepareLocalStateFrom
        , prepareLocalStateWithSerialiser
        , defaultStateDirectory
        , scheduleLocalUpdate'
        , scheduleLocalColdUpdate'
        , createCheckpointAndClose
        , LocalState(..)
        , Checkpoint(..)
        , SerialisationLayer(..)
        , defaultSerialisationLayer
        , mkEventsLogKey
        , mkCheckpointsLogKey
        ) where

    import Data.Acid.Archive
    import Data.Acid.Log as Log
    import Data.Acid.Core
    import Data.Acid.Common
    import Data.Acid.Abstract

    import Control.Concurrent             ( newEmptyMVar, putMVar, takeMVar, MVar )
    import Control.Exception              ( onException, evaluate, Exception, throwIO )
    import Control.Monad.State            ( runState )
    import Control.Monad                  ( join )
    import Data.ByteString.Lazy           ( ByteString )
    import qualified Data.ByteString.Lazy as Lazy ( length )

    import Data.Serialize                 ( runPutLazy, runGetLazy )
    import Data.SafeCopy                  ( SafeCopy(..), safeGet, safePut
                                          , primitive, contain )
    import Data.Typeable                  ( Typeable, typeOf )
    import Data.IORef
    import System.FilePath                ( (</>), takeDirectory )
    import System.FileLock
    import System.Directory               ( createDirectoryIfMissing )

    {-| State container offering full ACID (Atomicity, Consistency, Isolation and Durability)
        guarantees.

        [@Atomicity@]  State changes are all-or-nothing. This is what you'd expect of any state
                       variable in Haskell and AcidState doesn't change that.

        [@Consistency@] No event or set of events will break your data invariants.

        [@Isolation@] Transactions cannot interfere with each other even when issued in parallel.

        [@Durability@] Successful transaction are guaranteed to survive system failure (both
                       hardware and software).
    -}
    data LocalState st
        = LocalState { forall st. LocalState st -> Core st
    localCore        :: Core st
                     , forall st. LocalState st -> IORef st
    localCopy        :: IORef st
                     , forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents      :: FileLog (Tagged ByteString)
                     , forall st. LocalState st -> FileLog (Checkpoint st)
    localCheckpoints :: FileLog (Checkpoint st)
                     , forall st. LocalState st -> FileLock
    localLock        :: FileLock
                     }

    newtype StateIsLocked = StateIsLocked FilePath deriving (Int -> StateIsLocked -> ShowS
    [StateIsLocked] -> ShowS
    StateIsLocked -> String
    (Int -> StateIsLocked -> ShowS)
    -> (StateIsLocked -> String)
    -> ([StateIsLocked] -> ShowS)
    -> Show StateIsLocked
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> StateIsLocked -> ShowS
    showsPrec :: Int -> StateIsLocked -> ShowS
    $cshow :: StateIsLocked -> String
    show :: StateIsLocked -> String
    $cshowList :: [StateIsLocked] -> ShowS
    showList :: [StateIsLocked] -> ShowS
    Show)

    instance Exception StateIsLocked

    -- | Issue an Update event and return immediately. The event is not durable
    --   before the MVar has been filled but the order of events is honored.
    --   The behavior in case of exceptions is exactly the same as for 'update'.
    --
    --   If EventA is scheduled before EventB, EventA /will/ be executed before EventB:
    --
    --   @
    --do scheduleUpdate acid EventA
    --   scheduleUpdate acid EventB
    --   @
    scheduleLocalUpdate :: UpdateEvent event => LocalState (EventState event) -> event -> IO (MVar (EventResult event))
    scheduleLocalUpdate :: forall event.
    UpdateEvent event =>
    LocalState (EventState event)
    -> event -> IO (MVar (EventResult event))
    scheduleLocalUpdate LocalState (EventState event)
    acidState event
    event
        = do mvar <- IO (MVar (MethodResult event))
    forall a. IO (MVar a)
    newEmptyMVar
             let encoded = MethodSerialiser event -> event -> ByteString
    forall method. MethodSerialiser method -> method -> ByteString
    encodeMethod MethodSerialiser event
    ms event
    event

             -- It is important that we encode the event now so that we can catch
             -- any exceptions (see nestedStateError in examples/errors/Exceptions.hs)
             evaluate (Lazy.length encoded)

             modifyCoreState_ (localCore acidState) $ \EventState event
    st ->
               do let !(MethodResult event
    result, !EventState event
    st') = State (EventState event) (MethodResult event)
    -> EventState event -> (MethodResult event, EventState event)
    forall s a. State s a -> s -> (a, s)
    runState State (EventState event) (MethodResult event)
    hotMethod EventState event
    st
                  -- Schedule the log entry. Very important that it happens when 'localCore' is locked
                  -- to ensure that events are logged in the same order that they are executed.
                  FileLog (Tagged ByteString) -> Tagged ByteString -> IO () -> IO ()
    forall object. FileLog object -> object -> IO () -> IO ()
    pushEntry (LocalState (EventState event) -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState (EventState event)
    acidState) (event -> ByteString
    forall ev. Method ev => ev -> ByteString
    methodTag event
    event, ByteString
    encoded) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do IORef (EventState event) -> EventState event -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (LocalState (EventState event) -> IORef (EventState event)
    forall st. LocalState st -> IORef st
    localCopy LocalState (EventState event)
    acidState) EventState event
    st'
                                                                                    MVar (MethodResult event) -> MethodResult event -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar (MethodResult event)
    mvar MethodResult event
    result
                  EventState event -> IO (EventState event)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EventState event
    st'
             return mvar
        where (State (EventState event) (MethodResult event)
    hotMethod, MethodSerialiser event
    ms) = MethodMap (EventState event)
    -> event
    -> (State (EventState event) (MethodResult event),
        MethodSerialiser event)
    forall method.
    Method method =>
    MethodMap (MethodState method)
    -> method
    -> (State (MethodState method) (MethodResult method),
        MethodSerialiser method)
    lookupHotMethodAndSerialiser (Core (EventState event) -> MethodMap (EventState event)
    forall st. Core st -> MethodMap st
    coreMethods (LocalState (EventState event) -> Core (EventState event)
    forall st. LocalState st -> Core st
    localCore LocalState (EventState event)
    acidState)) event
    event

    -- | Same as scheduleLocalUpdate but does not immediately change the localCopy
    -- and return the result mvar - returns an IO action to do this instead. Take
    -- care to run actions of multiple Updates in the correct order as otherwise
    -- Queries will operate on outdated state.
    scheduleLocalUpdate' :: UpdateEvent event => LocalState (EventState event) -> event -> MVar (EventResult event) -> IO (IO ())
    scheduleLocalUpdate' :: forall event.
    UpdateEvent event =>
    LocalState (EventState event)
    -> event -> MVar (EventResult event) -> IO (IO ())
    scheduleLocalUpdate' LocalState (EventState event)
    acidState event
    event MVar (EventResult event)
    mvar
        = do
             let encoded :: ByteString
    encoded = MethodSerialiser event -> event -> ByteString
    forall method. MethodSerialiser method -> method -> ByteString
    encodeMethod MethodSerialiser event
    ms event
    event

             -- It is important that we encode the event now so that we can catch
             -- any exceptions (see nestedStateError in examples/errors/Exceptions.hs)
             Int64 -> IO Int64
    forall a. a -> IO a
    evaluate (ByteString -> Int64
    Lazy.length ByteString
    encoded)

             act <- Core (EventState event)
    -> (EventState event -> IO (EventState event, IO ())) -> IO (IO ())
    forall st a. Core st -> (st -> IO (st, a)) -> IO a
    modifyCoreState (LocalState (EventState event) -> Core (EventState event)
    forall st. LocalState st -> Core st
    localCore LocalState (EventState event)
    acidState) ((EventState event -> IO (EventState event, IO ())) -> IO (IO ()))
    -> (EventState event -> IO (EventState event, IO ())) -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ \EventState event
    st ->
               do let !(EventResult event
    result, !EventState event
    st') = State (EventState event) (EventResult event)
    -> EventState event -> (EventResult event, EventState event)
    forall s a. State s a -> s -> (a, s)
    runState State (EventState event) (EventResult event)
    hotMethod EventState event
    st
                  -- Schedule the log entry. Very important that it happens when 'localCore' is locked
                  -- to ensure that events are logged in the same order that they are executed.
                  FileLog (Tagged ByteString) -> Tagged ByteString -> IO () -> IO ()
    forall object. FileLog object -> object -> IO () -> IO ()
    pushEntry (LocalState (EventState event) -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState (EventState event)
    acidState) (event -> ByteString
    forall ev. Method ev => ev -> ByteString
    methodTag event
    event, ByteString
    encoded) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                  let action :: IO ()
    action = do IORef (EventState event) -> EventState event -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (LocalState (EventState event) -> IORef (EventState event)
    forall st. LocalState st -> IORef st
    localCopy LocalState (EventState event)
    acidState) EventState event
    st'
                                  MVar (EventResult event) -> EventResult event -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar (EventResult event)
    mvar EventResult event
    result
                  (EventState event, IO ()) -> IO (EventState event, IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EventState event
    st', IO ()
    action)
             -- this is the action to update state for queries and release the
             -- result into the supplied mvar
             return act
        where (State (EventState event) (EventResult event)
    hotMethod, MethodSerialiser event
    ms) = MethodMap (EventState event)
    -> event
    -> (State (EventState event) (EventResult event),
        MethodSerialiser event)
    forall method.
    Method method =>
    MethodMap (MethodState method)
    -> method
    -> (State (MethodState method) (MethodResult method),
        MethodSerialiser method)
    lookupHotMethodAndSerialiser (Core (EventState event) -> MethodMap (EventState event)
    forall st. Core st -> MethodMap st
    coreMethods (LocalState (EventState event) -> Core (EventState event)
    forall st. LocalState st -> Core st
    localCore LocalState (EventState event)
    acidState)) event
    event

    scheduleLocalColdUpdate :: LocalState st -> Tagged ByteString -> IO (MVar ByteString)
    scheduleLocalColdUpdate :: forall st.
    LocalState st -> Tagged ByteString -> IO (MVar ByteString)
    scheduleLocalColdUpdate LocalState st
    acidState Tagged ByteString
    event
        = do mvar <- IO (MVar ByteString)
    forall a. IO (MVar a)
    newEmptyMVar
             modifyCoreState_ (localCore acidState) $ \st
    st ->
               do let !(ByteString
    result, !st
    st') = State st ByteString -> st -> (ByteString, st)
    forall s a. State s a -> s -> (a, s)
    runState State st ByteString
    coldMethod st
    st
                  -- Schedule the log entry. Very important that it happens when 'localCore' is locked
                  -- to ensure that events are logged in the same order that they are executed.
                  FileLog (Tagged ByteString) -> Tagged ByteString -> IO () -> IO ()
    forall object. FileLog object -> object -> IO () -> IO ()
    pushEntry (LocalState st -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState st
    acidState) Tagged ByteString
    event (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do IORef st -> st -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (LocalState st -> IORef st
    forall st. LocalState st -> IORef st
    localCopy LocalState st
    acidState) st
    st'
                                                               MVar ByteString -> ByteString -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ByteString
    mvar ByteString
    result
                  st -> IO st
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return st
    st'
             return mvar
        where coldMethod :: State st ByteString
    coldMethod = Core st -> Tagged ByteString -> State st ByteString
    forall st. Core st -> Tagged ByteString -> State st ByteString
    lookupColdMethod (LocalState st -> Core st
    forall st. LocalState st -> Core st
    localCore LocalState st
    acidState) Tagged ByteString
    event

    -- | Same as scheduleLocalColdUpdate but does not immediately change the
    -- localCopy and return the result mvar - returns an IO action to do this
    -- instead. Take care to run actions of multiple Updates in the correct order as
    -- otherwise Queries will operate on outdated state.
    scheduleLocalColdUpdate' :: LocalState st -> Tagged ByteString -> MVar ByteString -> IO (IO ())
    scheduleLocalColdUpdate' :: forall st.
    LocalState st -> Tagged ByteString -> MVar ByteString -> IO (IO ())
    scheduleLocalColdUpdate' LocalState st
    acidState Tagged ByteString
    event MVar ByteString
    mvar
        = do act <- Core st -> (st -> IO (st, IO ())) -> IO (IO ())
    forall st a. Core st -> (st -> IO (st, a)) -> IO a
    modifyCoreState (LocalState st -> Core st
    forall st. LocalState st -> Core st
    localCore LocalState st
    acidState) ((st -> IO (st, IO ())) -> IO (IO ()))
    -> (st -> IO (st, IO ())) -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ \st
    st ->
               do let !(ByteString
    result, !st
    st') = State st ByteString -> st -> (ByteString, st)
    forall s a. State s a -> s -> (a, s)
    runState State st ByteString
    coldMethod st
    st
                  -- Schedule the log entry. Very important that it happens when 'localCore' is locked
                  -- to ensure that events are logged in the same order that they are executed.
                  FileLog (Tagged ByteString) -> Tagged ByteString -> IO () -> IO ()
    forall object. FileLog object -> object -> IO () -> IO ()
    pushEntry (LocalState st -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState st
    acidState) Tagged ByteString
    event (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                  let action :: IO ()
    action = do IORef st -> st -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (LocalState st -> IORef st
    forall st. LocalState st -> IORef st
    localCopy LocalState st
    acidState) st
    st'
                                  MVar ByteString -> ByteString -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ByteString
    mvar ByteString
    result
                  (st, IO ()) -> IO (st, IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (st
    st', IO ()
    action)
             return act
        where coldMethod :: State st ByteString
    coldMethod = Core st -> Tagged ByteString -> State st ByteString
    forall st. Core st -> Tagged ByteString -> State st ByteString
    lookupColdMethod (LocalState st -> Core st
    forall st. LocalState st -> Core st
    localCore LocalState st
    acidState) Tagged ByteString
    event

    -- | Issue a Query event and wait for its result. Events may be issued in parallel.
    localQuery  :: QueryEvent event  => LocalState (EventState event) -> event -> IO (EventResult event)
    localQuery :: forall event.
    QueryEvent event =>
    LocalState (EventState event) -> event -> IO (EventResult event)
    localQuery LocalState (EventState event)
    acidState event
    event
        = do st <- IORef (EventState event) -> IO (EventState event)
    forall a. IORef a -> IO a
    readIORef (LocalState (EventState event) -> IORef (EventState event)
    forall st. LocalState st -> IORef st
    localCopy LocalState (EventState event)
    acidState)
             let (result, _st) = runState hotMethod st
             return result
        where hotMethod :: State (EventState event) (MethodResult event)
    hotMethod = MethodMap (EventState event)
    -> event -> State (EventState event) (MethodResult event)
    forall method.
    Method method =>
    MethodMap (MethodState method)
    -> method -> State (MethodState method) (MethodResult method)
    lookupHotMethod (Core (EventState event) -> MethodMap (EventState event)
    forall st. Core st -> MethodMap st
    coreMethods (LocalState (EventState event) -> Core (EventState event)
    forall st. LocalState st -> Core st
    localCore LocalState (EventState event)
    acidState)) event
    event

    -- Whoa, a buttload of refactoring is needed here. 2011-11-02
    localQueryCold  :: LocalState st -> Tagged ByteString -> IO ByteString
    localQueryCold :: forall st. LocalState st -> Tagged ByteString -> IO ByteString
    localQueryCold LocalState st
    acidState Tagged ByteString
    event
        = do st <- IORef st -> IO st
    forall a. IORef a -> IO a
    readIORef (LocalState st -> IORef st
    forall st. LocalState st -> IORef st
    localCopy LocalState st
    acidState)
             let (result, _st) = runState coldMethod st
             return result
        where coldMethod :: State st ByteString
    coldMethod = Core st -> Tagged ByteString -> State st ByteString
    forall st. Core st -> Tagged ByteString -> State st ByteString
    lookupColdMethod (LocalState st -> Core st
    forall st. LocalState st -> Core st
    localCore LocalState st
    acidState) Tagged ByteString
    event

    -- | Take a snapshot of the state and save it to disk. Creating checkpoints
    --   makes it faster to resume AcidStates and you're free to create them as
    --   often or seldom as fits your needs. Transactions can run concurrently
    --   with this call.
    --
    --   This call will not return until the operation has succeeded.
    createLocalCheckpoint :: IsAcidic st => LocalState st -> IO ()
    createLocalCheckpoint :: forall st. IsAcidic st => LocalState st -> IO ()
    createLocalCheckpoint LocalState st
    acidState
        = do FileLog (Tagged ByteString) -> IO Int
    forall object. FileLog object -> IO Int
    cutFileLog (LocalState st -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState st
    acidState)
             mvar <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
             withCoreState (localCore acidState) $ \st
    st ->
               do eventId <- FileLog (Tagged ByteString) -> IO Int
    forall object. FileLog object -> IO Int
    askCurrentEntryId (LocalState st -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState st
    acidState)
                  pushAction (localEvents acidState) $
                    pushEntry (localCheckpoints acidState) (Checkpoint eventId st) (putMVar mvar ())
             takeMVar mvar

    -- | Save a snapshot to disk and close the AcidState as a single atomic
    --   action. This is useful when you want to make sure that no events
    --   are saved to disk after a checkpoint.
    createCheckpointAndClose :: (IsAcidic st, Typeable st) => AcidState st -> IO ()
    createCheckpointAndClose :: forall st. (IsAcidic st, Typeable st) => AcidState st -> IO ()
    createCheckpointAndClose AcidState st
    abstract_state
        = do mvar <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
             closeCore' (localCore acidState) $ \st
    st ->
               do eventId <- FileLog (Tagged ByteString) -> IO Int
    forall object. FileLog object -> IO Int
    askCurrentEntryId (LocalState st -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState st
    acidState)
                  pushAction (localEvents acidState) $
                    pushEntry (localCheckpoints acidState) (Checkpoint eventId st) (putMVar mvar ())
             takeMVar mvar
             closeFileLog (localEvents acidState)
             closeFileLog (localCheckpoints acidState)
             unlockFile (localLock acidState)
      where acidState :: LocalState st
    acidState = AcidState st -> LocalState st
    forall (sub :: * -> *) st.
    (Typeable sub, Typeable st) =>
    AcidState st -> sub st
    downcast AcidState st
    abstract_state

    data Checkpoint s = Checkpoint EntryId s

    -- | Previous versions of @acid-state@ had
    --
    -- > data Checkpoint = Checkpoint EntryId ByteString
    --
    -- where the 'ByteString' is the @safecopy@-serialization of the
    -- original checkpoint data.  Thus we give a 'SafeCopy' instance that
    -- is backwards-compatible with this by making nested calls to
    -- 'safePut' and 'safeGet'.
    --
    -- Note that if the inner data cannot be deserialised, 'getCopy' will
    -- not report an error immediately but will return a 'Checkpoint'
    -- whose payload is an error thunk.  This means consumers can skip
    -- deserialising intermediate checkpoint data when they care only
    -- about the last checkpoint in a file.  However, they must be sure to
    -- force the returned data promptly.
    instance SafeCopy s => SafeCopy (Checkpoint s) where
        kind :: Kind (Checkpoint s)
    kind = Kind (Checkpoint s)
    forall a. Kind a
    primitive
        putCopy :: Checkpoint s -> Contained Put
    putCopy (Checkpoint Int
    eventEntryId s
    content)
            = Put -> Contained Put
    forall a. a -> Contained a
    contain (Put -> Contained Put) -> Put -> Contained Put
    forall a b. (a -> b) -> a -> b
    $
              do Int -> Put
    forall a. SafeCopy a => a -> Put
    safePut Int
    eventEntryId
                 ByteString -> Put
    forall a. SafeCopy a => a -> Put
    safePut (Put -> ByteString
    runPutLazy (s -> Put
    forall a. SafeCopy a => a -> Put
    safePut s
    content))
        getCopy :: Contained (Get (Checkpoint s))
    getCopy = Get (Checkpoint s) -> Contained (Get (Checkpoint s))
    forall a. a -> Contained a
    contain (Get (Checkpoint s) -> Contained (Get (Checkpoint s)))
    -> Get (Checkpoint s) -> Contained (Get (Checkpoint s))
    forall a b. (a -> b) -> a -> b
    $ Int -> s -> Checkpoint s
    forall s. Int -> s -> Checkpoint s
    Checkpoint (Int -> s -> Checkpoint s) -> Get Int -> Get (s -> Checkpoint s)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Int
    forall a. SafeCopy a => Get a
    safeGet Get (s -> Checkpoint s) -> Get s -> Get (Checkpoint s)
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (ByteString -> s
    forall {a}. SafeCopy a => ByteString -> a
    fromNested (ByteString -> s) -> Get ByteString -> Get s
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    forall a. SafeCopy a => Get a
    safeGet)
          where
            fromNested :: ByteString -> a
    fromNested ByteString
    b = case Get a -> ByteString -> Either String a
    forall a. Get a -> ByteString -> Either String a
    runGetLazy Get a
    forall a. SafeCopy a => Get a
    safeGet ByteString
    b of
                             Left String
    msg -> String -> a
    forall {a}. String -> a
    checkpointRestoreError String
    msg
                             Right a
    v  -> a
    v
        errorTypeName :: Proxy (Checkpoint s) -> String
    errorTypeName Proxy (Checkpoint s)
    s = String
    "Checkpoint " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Proxy (Checkpoint s) -> String
    forall a. SafeCopy a => Proxy a -> String
    errorTypeName Proxy (Checkpoint s)
    s

    -- | Create an AcidState given an initial value.
    --
    --   This will create or resume a log found in the \"state\/[typeOf state]\/\" directory.
    openLocalState :: (Typeable st, IsAcidic st, SafeCopy st)
                  => st                          -- ^ Initial state value. This value is only used if no checkpoint is
                                                 --   found.
                  -> IO (AcidState st)
    openLocalState :: forall st.
    (Typeable st, IsAcidic st, SafeCopy st) =>
    st -> IO (AcidState st)
    openLocalState st
    initialState =
      String -> st -> IO (AcidState st)
    forall st.
    (IsAcidic st, SafeCopy st) =>
    String -> st -> IO (AcidState st)
    openLocalStateFrom (st -> String
    forall st. Typeable st => st -> String
    defaultStateDirectory st
    initialState) st
    initialState

    -- | Create an AcidState given an initial value.
    --
    --   This will create or resume a log found in the \"state\/[typeOf state]\/\" directory.
    --   The most recent checkpoint will be loaded immediately but the AcidState will not be opened
    --   until the returned function is executed.
    prepareLocalState :: (Typeable st, IsAcidic st, SafeCopy st)
                      => st                          -- ^ Initial state value. This value is only used if no checkpoint is
                                                     --   found.
                      -> IO (IO (AcidState st))
    prepareLocalState :: forall st.
    (Typeable st, IsAcidic st, SafeCopy st) =>
    st -> IO (IO (AcidState st))
    prepareLocalState st
    initialState =
      String -> st -> IO (IO (AcidState st))
    forall st.
    (IsAcidic st, SafeCopy st) =>
    String -> st -> IO (IO (AcidState st))
    prepareLocalStateFrom (st -> String
    forall st. Typeable st => st -> String
    defaultStateDirectory st
    initialState) st
    initialState

    -- | Directory to load the state from unless otherwise specified,
    -- namely \"state\/[typeOf state]\/\".
    defaultStateDirectory :: Typeable st => st -> FilePath
    defaultStateDirectory :: forall st. Typeable st => st -> String
    defaultStateDirectory st
    initialState = String
    "state" String -> ShowS
    </> TypeRep -> String
    forall a. Show a => a -> String
    show (st -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf st
    initialState)

    -- | Create an AcidState given a log directory and an initial value.
    --
    --   This will create or resume a log found in @directory@.
    --   Running two AcidState's from the same directory is an error
    --   but will not result in dataloss.
    openLocalStateFrom :: (IsAcidic st, SafeCopy st)
                      => FilePath            -- ^ Location of the checkpoint and transaction files.
                      -> st                  -- ^ Initial state value. This value is only used if no checkpoint is
                                             --   found.
                      -> IO (AcidState st)
    openLocalStateFrom :: forall st.
    (IsAcidic st, SafeCopy st) =>
    String -> st -> IO (AcidState st)
    openLocalStateFrom String
    directory st
    initialState =
      String -> st -> SerialisationLayer st -> IO (AcidState st)
    forall st.
    IsAcidic st =>
    String -> st -> SerialisationLayer st -> IO (AcidState st)
    openLocalStateWithSerialiser String
    directory st
    initialState SerialisationLayer st
    forall st. SafeCopy st => SerialisationLayer st
    defaultSerialisationLayer

    -- | Create an AcidState given a log directory, an initial value and a serialisation layer.
    --
    --   This will create or resume a log found in @directory@.
    --   Running two AcidState's from the same directory is an error
    --   but will not result in dataloss.
    openLocalStateWithSerialiser :: (IsAcidic st)
                      => FilePath            -- ^ Location of the checkpoint and transaction files.
                      -> st                  -- ^ Initial state value. This value is only used if no checkpoint is
                                             --   found.
                      -> SerialisationLayer st -- ^ Serialisation layer to use for checkpoints, events and archives.
                      -> IO (AcidState st)
    openLocalStateWithSerialiser :: forall st.
    IsAcidic st =>
    String -> st -> SerialisationLayer st -> IO (AcidState st)
    openLocalStateWithSerialiser String
    directory st
    initialState SerialisationLayer st
    serialisationLayer =
      IO (IO (AcidState st)) -> IO (AcidState st)
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (IO (AcidState st)) -> IO (AcidState st))
    -> IO (IO (AcidState st)) -> IO (AcidState st)
    forall a b. (a -> b) -> a -> b
    $ String
    -> st -> Bool -> SerialisationLayer st -> IO (IO (AcidState st))
    forall st.
    IsAcidic st =>
    String
    -> st -> Bool -> SerialisationLayer st -> IO (IO (AcidState st))
    resumeLocalStateFrom String
    directory st
    initialState Bool
    False SerialisationLayer st
    serialisationLayer

    -- | Create an AcidState given a log directory and an initial value.
    --
    --   This will create or resume a log found in @directory@.
    --   The most recent checkpoint will be loaded immediately but the AcidState will not be opened
    --   until the returned function is executed.
    prepareLocalStateFrom :: (IsAcidic st, SafeCopy st)
                      => FilePath            -- ^ Location of the checkpoint and transaction files.
                      -> st                  -- ^ Initial state value. This value is only used if no checkpoint is
                                             --   found.
                      -> IO (IO (AcidState st))
    prepareLocalStateFrom :: forall st.
    (IsAcidic st, SafeCopy st) =>
    String -> st -> IO (IO (AcidState st))
    prepareLocalStateFrom String
    directory st
    initialState =
      String -> st -> SerialisationLayer st -> IO (IO (AcidState st))
    forall st.
    IsAcidic st =>
    String -> st -> SerialisationLayer st -> IO (IO (AcidState st))
    prepareLocalStateWithSerialiser String
    directory st
    initialState SerialisationLayer st
    forall st. SafeCopy st => SerialisationLayer st
    defaultSerialisationLayer

    -- | Create an AcidState given a log directory, an initial value and a serialisation layer.
    --
    --   This will create or resume a log found in @directory@.
    --   The most recent checkpoint will be loaded immediately but the AcidState will not be opened
    --   until the returned function is executed.
    prepareLocalStateWithSerialiser :: (IsAcidic st)
                      => FilePath            -- ^ Location of the checkpoint and transaction files.
                      -> st                  -- ^ Initial state value. This value is only used if no checkpoint is
                                             --   found.
                      -> SerialisationLayer st -- ^ Serialisation layer to use for checkpoints, events and archives.
                      -> IO (IO (AcidState st))
    prepareLocalStateWithSerialiser :: forall st.
    IsAcidic st =>
    String -> st -> SerialisationLayer st -> IO (IO (AcidState st))
    prepareLocalStateWithSerialiser String
    directory st
    initialState SerialisationLayer st
    serialisationLayer =
      String
    -> st -> Bool -> SerialisationLayer st -> IO (IO (AcidState st))
    forall st.
    IsAcidic st =>
    String
    -> st -> Bool -> SerialisationLayer st -> IO (IO (AcidState st))
    resumeLocalStateFrom String
    directory st
    initialState Bool
    True SerialisationLayer st
    serialisationLayer

    data SerialisationLayer st =
        SerialisationLayer
            {  forall st. SerialisationLayer st -> Serialiser (Checkpoint st)
    checkpointSerialiser :: Serialiser (Checkpoint st)
                -- ^ Serialisation strategy for checkpoints.
                --
                -- Use 'safeCopySerialiser' for the backwards-compatible
                -- implementation using "Data.SafeCopy".

            , forall st. SerialisationLayer st -> Serialiser (Tagged ByteString)
    eventSerialiser :: Serialiser (Tagged ByteString)
                -- ^ Serialisation strategy for events.
                --
                -- Use 'safeCopySerialiser' for the backwards-compatible
                -- implementation using "Data.SafeCopy".

            , forall st. SerialisationLayer st -> Archiver
    archiver :: Archiver
                -- ^ Serialisation strategy for archive log files.
                --
                -- Use 'defaultArchiver' for the backwards-compatible
                -- implementation using "Data.Serialize".
            }

    -- | Standard (and historically the only) serialisation layer, using
    -- 'safeCopySerialiser' and 'defaultArchiver'.
    defaultSerialisationLayer :: SafeCopy st => SerialisationLayer st
    defaultSerialisationLayer :: forall st. SafeCopy st => SerialisationLayer st
    defaultSerialisationLayer = Serialiser (Checkpoint st)
    -> Serialiser (Tagged ByteString)
    -> Archiver
    -> SerialisationLayer st
    forall st.
    Serialiser (Checkpoint st)
    -> Serialiser (Tagged ByteString)
    -> Archiver
    -> SerialisationLayer st
    SerialisationLayer Serialiser (Checkpoint st)
    forall a. SafeCopy a => Serialiser a
    safeCopySerialiser Serialiser (Tagged ByteString)
    forall a. SafeCopy a => Serialiser a
    safeCopySerialiser Archiver
    defaultArchiver

    mkEventsLogKey :: FilePath -> SerialisationLayer object -> LogKey (Tagged ByteString)
    mkEventsLogKey :: forall object.
    String -> SerialisationLayer object -> LogKey (Tagged ByteString)
    mkEventsLogKey String
    directory SerialisationLayer object
    serialisationLayer =
      LogKey { logDirectory :: String
    logDirectory = String
    directory
             , logPrefix :: String
    logPrefix = String
    "events"
             , logSerialiser :: Serialiser (Tagged ByteString)
    logSerialiser = SerialisationLayer object -> Serialiser (Tagged ByteString)
    forall st. SerialisationLayer st -> Serialiser (Tagged ByteString)
    eventSerialiser SerialisationLayer object
    serialisationLayer
             , logArchiver :: Archiver
    logArchiver   = SerialisationLayer object -> Archiver
    forall st. SerialisationLayer st -> Archiver
    archiver SerialisationLayer object
    serialisationLayer }

    mkCheckpointsLogKey :: FilePath -> SerialisationLayer object -> LogKey (Checkpoint object)
    mkCheckpointsLogKey :: forall object.
    String -> SerialisationLayer object -> LogKey (Checkpoint object)
    mkCheckpointsLogKey String
    directory SerialisationLayer object
    serialisationLayer =
      LogKey { logDirectory :: String
    logDirectory = String
    directory
             , logPrefix :: String
    logPrefix = String
    "checkpoints"
             , logSerialiser :: Serialiser (Checkpoint object)
    logSerialiser = SerialisationLayer object -> Serialiser (Checkpoint object)
    forall st. SerialisationLayer st -> Serialiser (Checkpoint st)
    checkpointSerialiser SerialisationLayer object
    serialisationLayer
             , logArchiver :: Archiver
    logArchiver = SerialisationLayer object -> Archiver
    forall st. SerialisationLayer st -> Archiver
    archiver SerialisationLayer object
    serialisationLayer }

    resumeLocalStateFrom :: (IsAcidic st)
                      => FilePath            -- ^ Location of the checkpoint and transaction files.
                      -> st                  -- ^ Initial state value. This value is only used if no checkpoint is
                                             --   found.
                      -> Bool                -- ^ True => load checkpoint before acquiring the lock.
                      -> SerialisationLayer st -- ^ Serialisation layer to use for checkpoints, events and archives.
                      -> IO (IO (AcidState st))
    resumeLocalStateFrom :: forall st.
    IsAcidic st =>
    String
    -> st -> Bool -> SerialisationLayer st -> IO (IO (AcidState st))
    resumeLocalStateFrom String
    directory st
    initialState Bool
    delayLocking SerialisationLayer st
    serialisationLayer =
      case Bool
    delayLocking of
        Bool
    True -> do
          (n, st) <- IO (Int, st)
    loadCheckpoint
          return $ do
            lock  <- maybeLockFile lockFile
            replayEvents lock n st
        Bool
    False -> do
          lock    <- String -> IO FileLock
    maybeLockFile String
    lockFile
          (n, st) <- loadCheckpoint `onException` unlockFile lock
          return $ do
            replayEvents lock n st
      where
        lockFile :: String
    lockFile = String
    directory String -> ShowS
    </> String
    "open.lock"
        eventsLogKey :: LogKey (Tagged ByteString)
    eventsLogKey = String -> SerialisationLayer st -> LogKey (Tagged ByteString)
    forall object.
    String -> SerialisationLayer object -> LogKey (Tagged ByteString)
    mkEventsLogKey String
    directory SerialisationLayer st
    serialisationLayer
        checkpointsLogKey :: LogKey (Checkpoint st)
    checkpointsLogKey = String -> SerialisationLayer st -> LogKey (Checkpoint st)
    forall object.
    String -> SerialisationLayer object -> LogKey (Checkpoint object)
    mkCheckpointsLogKey String
    directory SerialisationLayer st
    serialisationLayer
        loadCheckpoint :: IO (Int, st)
    loadCheckpoint = do
          mbLastCheckpoint <- LogKey (Checkpoint st) -> IO (Maybe (Checkpoint st))
    forall object. LogKey object -> IO (Maybe object)
    Log.newestEntry LogKey (Checkpoint st)
    checkpointsLogKey
          case mbLastCheckpoint of
            Maybe (Checkpoint st)
    Nothing ->
              (Int, st) -> IO (Int, st)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    0, st
    initialState)
            Just (Checkpoint Int
    eventCutOff !st
    val) ->
              -- N.B. We must be strict in val so that we force any
              -- lurking deserialisation error immediately.
              (Int, st) -> IO (Int, st)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    eventCutOff, st
    val)
        replayEvents :: FileLock -> Int -> st -> IO (AcidState st)
    replayEvents FileLock
    lock Int
    n st
    st = do
          core <- [MethodContainer st] -> st -> IO (Core st)
    forall st. [MethodContainer st] -> st -> IO (Core st)
    mkCore ([Event st] -> [MethodContainer st]
    forall st. [Event st] -> [MethodContainer st]
    eventsToMethods [Event st]
    forall st. IsAcidic st => [Event st]
    acidEvents) st
    st

          eventsLog <- openFileLog eventsLogKey
          events <- readEntriesFrom eventsLog n
          mapM_ (runColdMethod core) events
          ensureLeastEntryId eventsLog n
          checkpointsLog <- openFileLog checkpointsLogKey
          stateCopy <- newIORef undefined
          withCoreState core (writeIORef stateCopy)

          return $ toAcidState LocalState { localCore = core
                                          , localCopy = stateCopy
                                          , localEvents = eventsLog
                                          , localCheckpoints = checkpointsLog
                                          , localLock = lock
                                          }
        maybeLockFile :: String -> IO FileLock
    maybeLockFile String
    path = do
          Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True (ShowS
    takeDirectory String
    path)
          IO FileLock
    -> (FileLock -> IO FileLock) -> Maybe FileLock -> IO FileLock
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (StateIsLocked -> IO FileLock
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> StateIsLocked
    StateIsLocked String
    path))
                                FileLock -> IO FileLock
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe FileLock -> IO FileLock)
    -> IO (Maybe FileLock) -> IO FileLock
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> SharedExclusive -> IO (Maybe FileLock)
    tryLockFile String
    path SharedExclusive
    Exclusive

    checkpointRestoreError :: String -> a
    checkpointRestoreError String
    msg
        = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not parse saved checkpoint due to the following error: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg

    -- | Close an AcidState and associated logs.
    --   Any subsequent usage of the AcidState will throw an exception.
    closeLocalState :: LocalState st -> IO ()
    closeLocalState :: forall st. LocalState st -> IO ()
    closeLocalState LocalState st
    acidState
        = do Core st -> IO ()
    forall st. Core st -> IO ()
    closeCore (LocalState st -> Core st
    forall st. LocalState st -> Core st
    localCore LocalState st
    acidState)
             FileLog (Tagged ByteString) -> IO ()
    forall object. FileLog object -> IO ()
    closeFileLog (LocalState st -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState st
    acidState)
             FileLog (Checkpoint st) -> IO ()
    forall object. FileLog object -> IO ()
    closeFileLog (LocalState st -> FileLog (Checkpoint st)
    forall st. LocalState st -> FileLog (Checkpoint st)
    localCheckpoints LocalState st
    acidState)
             FileLock -> IO ()
    unlockFile (LocalState st -> FileLock
    forall st. LocalState st -> FileLock
    localLock LocalState st
    acidState)

    createLocalArchive :: LocalState st -> IO ()
    createLocalArchive :: forall st. LocalState st -> IO ()
    createLocalArchive LocalState st
    state
      = do -- We need to look at the last checkpoint saved to disk. Since checkpoints can be written
           -- in parallel with this call, we can't guarantee that the checkpoint we get really is the
           -- last one but that's alright.
           currentCheckpointId <- FileLog (Checkpoint st) -> IO Int
    forall object. FileLog object -> IO Int
    cutFileLog (LocalState st -> FileLog (Checkpoint st)
    forall st. LocalState st -> FileLog (Checkpoint st)
    localCheckpoints LocalState st
    state)
           -- 'currentCheckpointId' is the ID of the next checkpoint that will be written to disk.
           -- 'currentCheckpointId-1' must then be the ID of a checkpoint on disk (or -1, of course).
           let durableCheckpointId = Int
    currentCheckpointIdInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1
           checkpoints <- readEntriesFrom (localCheckpoints state) durableCheckpointId
           case checkpoints of
             []      -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
             (Checkpoint Int
    entryId st
    _content : [Checkpoint st]
    _)
               -> do -- 'entryId' is the lowest entryId that didn't contribute to the checkpoint.
                     -- 'archiveFileLog' moves all files that are lower than this entryId to the archive.
                     FileLog (Tagged ByteString) -> Int -> IO ()
    forall object. FileLog object -> Int -> IO ()
    archiveFileLog (LocalState st -> FileLog (Tagged ByteString)
    forall st. LocalState st -> FileLog (Tagged ByteString)
    localEvents LocalState st
    state) Int
    entryId
                     -- In the same style as above, we archive all log files that came before the log file
                     -- which contains our checkpoint.
                     FileLog (Checkpoint st) -> Int -> IO ()
    forall object. FileLog object -> Int -> IO ()
    archiveFileLog (LocalState st -> FileLog (Checkpoint st)
    forall st. LocalState st -> FileLog (Checkpoint st)
    localCheckpoints LocalState st
    state) Int
    durableCheckpointId

    toAcidState :: IsAcidic st => LocalState st -> AcidState st
    toAcidState :: forall st. IsAcidic st => LocalState st -> AcidState st
    toAcidState LocalState st
    local
      = AcidState { _scheduleUpdate :: forall event.
    (UpdateEvent event, EventState event ~ st) =>
    event -> IO (MVar (EventResult event))
    _scheduleUpdate = LocalState (EventState event)
    -> event -> IO (MVar (EventResult event))
    forall event.
    UpdateEvent event =>
    LocalState (EventState event)
    -> event -> IO (MVar (EventResult event))
    scheduleLocalUpdate LocalState st
    LocalState (EventState event)
    local
                  , scheduleColdUpdate :: Tagged ByteString -> IO (MVar ByteString)
    scheduleColdUpdate = LocalState st -> Tagged ByteString -> IO (MVar ByteString)
    forall st.
    LocalState st -> Tagged ByteString -> IO (MVar ByteString)
    scheduleLocalColdUpdate LocalState st
    local
                  , _query :: forall event.
    (QueryEvent event, EventState event ~ st) =>
    event -> IO (EventResult event)
    _query = LocalState (EventState event) -> event -> IO (EventResult event)
    forall event.
    QueryEvent event =>
    LocalState (EventState event) -> event -> IO (EventResult event)
    localQuery LocalState st
    LocalState (EventState event)
    local
                  , queryCold :: Tagged ByteString -> IO ByteString
    queryCold = LocalState st -> Tagged ByteString -> IO ByteString
    forall st. LocalState st -> Tagged ByteString -> IO ByteString
    localQueryCold LocalState st
    local
                  , createCheckpoint :: IO ()
    createCheckpoint = LocalState st -> IO ()
    forall st. IsAcidic st => LocalState st -> IO ()
    createLocalCheckpoint LocalState st
    local
                  , createArchive :: IO ()
    createArchive = LocalState st -> IO ()
    forall st. LocalState st -> IO ()
    createLocalArchive LocalState st
    local
                  , closeAcidState :: IO ()
    closeAcidState = LocalState st -> IO ()
    forall st. LocalState st -> IO ()
    closeLocalState LocalState st
    local
                  , acidSubState :: AnyState st
    acidSubState = LocalState st -> AnyState st
    forall (sub_st :: * -> *) st.
    Typeable sub_st =>
    sub_st st -> AnyState st
    mkAnyState LocalState st
    local
                  }