content: {-# LANGUAGE 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.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 { localCore    :: Core st
                    , localCopy    :: IORef st
                    }
  
  -- | 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 initialState
      = do core <- mkCore (eventsToMethods acidEvents) initialState
           ref  <- newIORef initialState
           return $ toAcidState MemoryState { localCore = core, localCopy = 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 acidState event
      = do mvar <- newEmptyMVar
           modifyCoreState_ (localCore acidState) $ \st ->
             do let !(result, !st') = runState hotMethod st
                writeIORef (localCopy acidState) st'
                putMVar mvar result
                return st'
           return mvar
      where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event
  
  scheduleMemoryColdUpdate :: MemoryState st -> Tagged ByteString -> IO (MVar ByteString)
  scheduleMemoryColdUpdate acidState event
      = do mvar <- newEmptyMVar
           modifyCoreState_ (localCore acidState) $ \st ->
             do let !(result, !st') = runState coldMethod st
                writeIORef (localCopy acidState) st'
                putMVar mvar result
                return st'
           return mvar
      where coldMethod = lookupColdMethod (localCore acidState) 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 acidState event
      = do st <- readIORef (localCopy acidState)
           let (result, _st) = runState hotMethod st
           return result
      where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event
  
  memoryQueryCold  :: MemoryState st -> Tagged ByteString -> IO ByteString
  memoryQueryCold acidState event
      = do st <- readIORef (localCopy acidState)
           let (result, _st) = runState coldMethod st
           return result
      where coldMethod = lookupColdMethod (localCore acidState) event
  
  -- | This is a nop with the memory backend.
  createMemoryCheckpoint :: MemoryState st -> IO ()
  createMemoryCheckpoint acidState
      = return ()
  
  -- | This is a nop with the memory backend.
  createMemoryArchive :: MemoryState st -> IO ()
  createMemoryArchive acidState
      = return ()
  
  -- | Close an AcidState and associated logs.
  --   Any subsequent usage of the AcidState will throw an exception.
  closeMemoryState :: MemoryState st -> IO ()
  closeMemoryState acidState
      = closeCore (localCore acidState)
  
  toAcidState :: IsAcidic st => MemoryState st -> AcidState st
  toAcidState memory
    = AcidState { _scheduleUpdate    = scheduleMemoryUpdate memory
                , scheduleColdUpdate = scheduleMemoryColdUpdate memory
                , _query             = memoryQuery memory
                , queryCold          = memoryQueryCold memory
                , createCheckpoint   = createMemoryCheckpoint memory
                , createArchive      = createMemoryArchive memory
                , closeAcidState     = closeMemoryState memory
                , acidSubState       = mkAnyState memory
                }
  