    {-# LANGUAGE DeriveDataTypeable, BangPatterns #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Acid.Memory
    -- Copyright   :  PublicDomain
    --
    -- Maintainer  :  lemmih@gmail.com
    -- Portability :  non-portable (uses GHC extensions)
    --
    -- AcidState container without a transaction log. Mostly used for testing.
    -- Supports Atomicity, Consistency and Isolation, but not Durability.
    --

    module Data.Acid.Memory
        ( openMemoryState
        ) where

    import Data.Acid.Core
    import Data.Acid.Common
    import Data.Acid.Abstract

    import Control.Concurrent             ( newEmptyMVar, putMVar, MVar )
    import Control.Monad.State            ( runState )
    import Data.ByteString.Lazy           ( ByteString )
    import Data.Typeable                  ( Typeable )
    import Data.IORef                     ( IORef, newIORef, readIORef, writeIORef )

    {-| 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 MemoryState st
        = MemoryState { forall st. MemoryState st -> Core st
    localCore    :: Core st
                      , forall st. MemoryState st -> IORef st
    localCopy    :: IORef st
                      } deriving (Typeable)

    -- | Create an 'AcidState' given an initial value.  The state is kept only in
    -- memory, so it is not durable.
    openMemoryState :: (IsAcidic st)
                  => st                          -- ^ Initial state value.
                  -> IO (AcidState st)
    openMemoryState :: forall st. IsAcidic st => st -> IO (AcidState st)
    openMemoryState st
    initialState
        = do Core st
    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
    initialState
             IORef st
    ref  <- st -> IO (IORef st)
    forall a. a -> IO (IORef a)
    newIORef st
    initialState
             AcidState st -> IO (AcidState st)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AcidState st -> IO (AcidState st))
    -> AcidState st -> IO (AcidState st)
    forall a b. (a -> b) -> a -> b
    $ MemoryState st -> AcidState st
    forall st. IsAcidic st => MemoryState st -> AcidState st
    toAcidState MemoryState { localCore :: Core st
    localCore = Core st
    core, localCopy :: IORef st
    localCopy = IORef st
    ref }

    -- | Issue an Update event and return immediately. 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
    --   @
    scheduleMemoryUpdate :: UpdateEvent event => MemoryState (EventState event) -> event -> IO (MVar (EventResult event))
    scheduleMemoryUpdate :: forall event.
    UpdateEvent event =>
    MemoryState (EventState event)
    -> event -> IO (MVar (EventResult event))
    scheduleMemoryUpdate MemoryState (EventState event)
    acidState event
    event
        = do MVar (EventResult event)
    mvar <- IO (MVar (EventResult event))
    forall a. IO (MVar a)
    newEmptyMVar
             Core (EventState event)
    -> (EventState event -> IO (EventState event)) -> IO ()
    forall st. Core st -> (st -> IO st) -> IO ()
    modifyCoreState_ (MemoryState (EventState event) -> Core (EventState event)
    forall st. MemoryState st -> Core st
    localCore MemoryState (EventState event)
    acidState) ((EventState event -> IO (EventState event)) -> IO ())
    -> (EventState event -> IO (EventState event)) -> 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
                  IORef (EventState event) -> EventState event -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (MemoryState (EventState event) -> IORef (EventState event)
    forall st. MemoryState st -> IORef st
    localCopy MemoryState (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 (EventState event)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EventState event
    st'
             MVar (EventResult event) -> IO (MVar (EventResult event))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MVar (EventResult event)
    mvar
        where hotMethod :: State (EventState event) (EventResult event)
    hotMethod = MethodMap (EventState event)
    -> event -> State (EventState event) (EventResult 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 (MemoryState (EventState event) -> Core (EventState event)
    forall st. MemoryState st -> Core st
    localCore MemoryState (EventState event)
    acidState)) event
    event

    scheduleMemoryColdUpdate :: MemoryState st -> Tagged ByteString -> IO (MVar ByteString)
    scheduleMemoryColdUpdate :: forall st.
    MemoryState st -> Tagged ByteString -> IO (MVar ByteString)
    scheduleMemoryColdUpdate MemoryState st
    acidState Tagged ByteString
    event
        = do MVar ByteString
    mvar <- IO (MVar ByteString)
    forall a. IO (MVar a)
    newEmptyMVar
             Core st -> (st -> IO st) -> IO ()
    forall st. Core st -> (st -> IO st) -> IO ()
    modifyCoreState_ (MemoryState st -> Core st
    forall st. MemoryState st -> Core st
    localCore MemoryState st
    acidState) ((st -> IO st) -> IO ()) -> (st -> IO st) -> 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
                  IORef st -> st -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (MemoryState st -> IORef st
    forall st. MemoryState st -> IORef st
    localCopy MemoryState 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'
             MVar ByteString -> IO (MVar ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MVar ByteString
    mvar
        where coldMethod :: State st ByteString
    coldMethod = Core st -> Tagged ByteString -> State st ByteString
    forall st. Core st -> Tagged ByteString -> State st ByteString
    lookupColdMethod (MemoryState st -> Core st
    forall st. MemoryState st -> Core st
    localCore MemoryState st
    acidState) Tagged ByteString
    event

    -- | Issue a Query event and wait for its result. Events may be issued in parallel.
    memoryQuery  :: QueryEvent event  => MemoryState (EventState event) -> event -> IO (EventResult event)
    memoryQuery :: forall event.
    QueryEvent event =>
    MemoryState (EventState event) -> event -> IO (EventResult event)
    memoryQuery MemoryState (EventState event)
    acidState event
    event
        = do EventState event
    st <- IORef (EventState event) -> IO (EventState event)
    forall a. IORef a -> IO a
    readIORef (MemoryState (EventState event) -> IORef (EventState event)
    forall st. MemoryState st -> IORef st
    localCopy MemoryState (EventState event)
    acidState)
             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
             EventResult event -> IO (EventResult event)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EventResult event
    result
        where hotMethod :: State (EventState event) (EventResult event)
    hotMethod = MethodMap (EventState event)
    -> event -> State (EventState event) (EventResult 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 (MemoryState (EventState event) -> Core (EventState event)
    forall st. MemoryState st -> Core st
    localCore MemoryState (EventState event)
    acidState)) event
    event

    memoryQueryCold  :: MemoryState st -> Tagged ByteString -> IO ByteString
    memoryQueryCold :: forall st. MemoryState st -> Tagged ByteString -> IO ByteString
    memoryQueryCold MemoryState st
    acidState Tagged ByteString
    event
        = do st
    st <- IORef st -> IO st
    forall a. IORef a -> IO a
    readIORef (MemoryState st -> IORef st
    forall st. MemoryState st -> IORef st
    localCopy MemoryState st
    acidState)
             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
             ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    result
        where coldMethod :: State st ByteString
    coldMethod = Core st -> Tagged ByteString -> State st ByteString
    forall st. Core st -> Tagged ByteString -> State st ByteString
    lookupColdMethod (MemoryState st -> Core st
    forall st. MemoryState st -> Core st
    localCore MemoryState st
    acidState) Tagged ByteString
    event

    -- | This is a nop with the memory backend.
    createMemoryCheckpoint :: MemoryState st -> IO ()
    createMemoryCheckpoint :: forall st. MemoryState st -> IO ()
    createMemoryCheckpoint MemoryState st
    acidState
        = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | This is a nop with the memory backend.
    createMemoryArchive :: MemoryState st -> IO ()
    createMemoryArchive :: forall st. MemoryState st -> IO ()
    createMemoryArchive MemoryState st
    acidState
        = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Close an AcidState and associated logs.
    --   Any subsequent usage of the AcidState will throw an exception.
    closeMemoryState :: MemoryState st -> IO ()
    closeMemoryState :: forall st. MemoryState st -> IO ()
    closeMemoryState MemoryState st
    acidState
        = Core st -> IO ()
    forall st. Core st -> IO ()
    closeCore (MemoryState st -> Core st
    forall st. MemoryState st -> Core st
    localCore MemoryState st
    acidState)

    toAcidState :: IsAcidic st => MemoryState st -> AcidState st
    toAcidState :: forall st. IsAcidic st => MemoryState st -> AcidState st
    toAcidState MemoryState st
    memory
      = AcidState { _scheduleUpdate :: forall event.
    (UpdateEvent event, EventState event ~ st) =>
    event -> IO (MVar (EventResult event))
    _scheduleUpdate    = MemoryState (EventState event)
    -> event -> IO (MVar (MethodResult event))
    forall event.
    UpdateEvent event =>
    MemoryState (EventState event)
    -> event -> IO (MVar (EventResult event))
    scheduleMemoryUpdate MemoryState st
    MemoryState (EventState event)
    memory
                  , scheduleColdUpdate :: Tagged ByteString -> IO (MVar ByteString)
    scheduleColdUpdate = MemoryState st -> Tagged ByteString -> IO (MVar ByteString)
    forall st.
    MemoryState st -> Tagged ByteString -> IO (MVar ByteString)
    scheduleMemoryColdUpdate MemoryState st
    memory
                  , _query :: forall event.
    (QueryEvent event, EventState event ~ st) =>
    event -> IO (EventResult event)
    _query             = MemoryState (EventState event) -> event -> IO (MethodResult event)
    forall event.
    QueryEvent event =>
    MemoryState (EventState event) -> event -> IO (EventResult event)
    memoryQuery MemoryState st
    MemoryState (EventState event)
    memory
                  , queryCold :: Tagged ByteString -> IO ByteString
    queryCold          = MemoryState st -> Tagged ByteString -> IO ByteString
    forall st. MemoryState st -> Tagged ByteString -> IO ByteString
    memoryQueryCold MemoryState st
    memory
                  , createCheckpoint :: IO ()
    createCheckpoint   = MemoryState st -> IO ()
    forall st. MemoryState st -> IO ()
    createMemoryCheckpoint MemoryState st
    memory
                  , createArchive :: IO ()
    createArchive      = MemoryState st -> IO ()
    forall st. MemoryState st -> IO ()
    createMemoryArchive MemoryState st
    memory
                  , closeAcidState :: IO ()
    closeAcidState     = MemoryState st -> IO ()
    forall st. MemoryState st -> IO ()
    closeMemoryState MemoryState st
    memory
                  , acidSubState :: AnyState st
    acidSubState       = MemoryState st -> AnyState st
    forall (sub_st :: * -> *) st.
    Typeable sub_st =>
    sub_st st -> AnyState st
    mkAnyState MemoryState st
    memory
                  }