content: {-# LANGUAGE RankNTypes, TypeFamilies, GADTs, CPP #-}
  module Data.Acid.Abstract
      ( AcidState(..)
      , scheduleUpdate
      , groupUpdates
      , update
      , update'
      , query
      , query'
      , mkAnyState
      , downcast
      ) where
  
  import Data.Acid.Common
  import Data.Acid.Core
  
  import Control.Concurrent      ( MVar, takeMVar )
  import Data.ByteString.Lazy    ( ByteString )
  import Control.Monad           ( void )
  import Control.Monad.Trans     ( MonadIO(liftIO) )
  import Data.Typeable           ( Typeable, gcast, typeOf )
  
  data AnyState st where
    AnyState :: Typeable sub_st => sub_st st -> AnyState st
  
  -- Haddock doesn't get the types right on its own.
  {-| 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 unexpected
                      system shutdowns (both those caused by hardware and software).
  -}
  data AcidState st
    = AcidState {
                  _scheduleUpdate :: forall event. (UpdateEvent event, EventState event ~ st) => event -> IO (MVar (EventResult event))
                , scheduleColdUpdate :: Tagged ByteString -> IO (MVar ByteString)
                , _query :: forall event. (QueryEvent event, EventState event ~ st) => event -> IO (EventResult event)
                , queryCold :: Tagged ByteString -> IO ByteString
                ,
  -- | 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.
                  createCheckpoint :: IO ()
  -- | Move all log files that are no longer necessary for state restoration into the 'Archive'
  --   folder in the state directory. This folder can then be backed up or thrown out as you see fit.
  --   Reverting to a state before the last checkpoint will not be possible if the 'Archive' folder
  --   has been thrown out.
  --
  --   This method is idempotent and does not block the normal operation of the AcidState.
                , createArchive :: IO ()
                ,
  -- | Close an AcidState and associated resources.
  --   Any subsequent usage of the AcidState will throw an exception.
                  closeAcidState :: IO ()
                , acidSubState :: AnyState st
                }
  
  -- | 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
  --   @
  scheduleUpdate :: UpdateEvent event => AcidState (EventState event) -> event -> IO (MVar (EventResult event))
  scheduleUpdate acid = _scheduleUpdate acid -- Redirection to make Haddock happy.
  
  -- | Schedule multiple Update events and wait for them to be durable, but
  --   throw away their results. This is useful for importing existing
  --   datasets into an AcidState.
  groupUpdates :: UpdateEvent event => AcidState (EventState event) -> [event] -> IO ()
  groupUpdates acidState events
    = go events
    where
      go []     = return ()
      go [x]    = void $ update acidState x
      go (x:xs) = scheduleUpdate acidState x >> go xs
  
  -- | Issue an Update event and wait for its result. Once this call returns, you are
  --   guaranteed that the changes to the state are durable. Events may be issued in
  --   parallel.
  --
  --   It's a run-time error to issue events that aren't supported by the AcidState.
  update :: UpdateEvent event => AcidState (EventState event) -> event -> IO (EventResult event)
  update acidState event = takeMVar =<< scheduleUpdate acidState event
  
  -- | Same as 'update' but lifted into any monad capable of doing IO.
  update' :: (UpdateEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)
  update' acidState event = liftIO (update acidState event)
  
  -- | Issue a Query event and wait for its result. Events may be issued in parallel.
  query :: QueryEvent event => AcidState (EventState event) -> event -> IO (EventResult event)
  query acid = _query acid -- Redirection to make Haddock happy.
  
  -- | Same as 'query' but lifted into any monad capable of doing IO.
  query' :: (QueryEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)
  query' acidState event = liftIO (query acidState event)
  
  mkAnyState :: Typeable sub_st => sub_st st -> AnyState st
  mkAnyState = AnyState
  
  downcast :: (Typeable sub, Typeable st) => AcidState st -> sub st
  downcast AcidState{acidSubState = AnyState sub}
    = r
   where
     r = case gcast (Just sub) of
           Just (Just x) -> x
           _ ->
             error $
              "Data.Acid.Abstract: Invalid subtype cast: " ++ show (typeOf sub) ++ " -> " ++ show (typeOf r)
  