    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving, GADTs #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Acid.Common
    -- Copyright   :  PublicDomain
    --
    -- Maintainer  :  lemmih@gmail.com
    -- Portability :  non-portable (uses GHC extensions)
    --
    -- Common structures used by the various backends (local, memory).
    --
    module Data.Acid.Common where

    import Data.Acid.Core

    import Control.Monad
    import Control.Monad.State   (MonadState, get, State)
    import Control.Monad.Reader  (MonadReader, Reader, runReader)

    class IsAcidic st where
        acidEvents :: [Event st]
          -- ^ List of events capable of updating or querying the state.

    -- | Context monad for Update events.
    newtype Update st a = Update { forall st a. Update st a -> State st a
    unUpdate :: State st a }
        deriving (Applicative (Update st)
    Applicative (Update st) =>
    (forall a b. Update st a -> (a -> Update st b) -> Update st b)
    -> (forall a b. Update st a -> Update st b -> Update st b)
    -> (forall a. a -> Update st a)
    -> Monad (Update st)
    forall st. Applicative (Update st)
    forall a. a -> Update st a
    forall st a. a -> Update st a
    forall a b. Update st a -> Update st b -> Update st b
    forall a b. Update st a -> (a -> Update st b) -> Update st b
    forall st a b. Update st a -> Update st b -> Update st b
    forall st a b. Update st a -> (a -> Update st b) -> Update st b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall st a b. Update st a -> (a -> Update st b) -> Update st b
    >>= :: forall a b. Update st a -> (a -> Update st b) -> Update st b
    $c>> :: forall st a b. Update st a -> Update st b -> Update st b
    >> :: forall a b. Update st a -> Update st b -> Update st b
    $creturn :: forall st a. a -> Update st a
    return :: forall a. a -> Update st a
    Monad, (forall a b. (a -> b) -> Update st a -> Update st b)
    -> (forall a b. a -> Update st b -> Update st a)
    -> Functor (Update st)
    forall a b. a -> Update st b -> Update st a
    forall a b. (a -> b) -> Update st a -> Update st b
    forall st a b. a -> Update st b -> Update st a
    forall st a b. (a -> b) -> Update st a -> Update st b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall st a b. (a -> b) -> Update st a -> Update st b
    fmap :: forall a b. (a -> b) -> Update st a -> Update st b
    $c<$ :: forall st a b. a -> Update st b -> Update st a
    <$ :: forall a b. a -> Update st b -> Update st a
    Functor, MonadState st)

    -- mtl pre-2.0 doesn't have these instances to newtype-derive, but they're
    -- simple enough.
    instance Applicative (Update st) where
        pure :: forall a. a -> Update st a
    pure = a -> Update st a
    forall a. a -> Update st a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        <*> :: forall a b. Update st (a -> b) -> Update st a -> Update st b
    (<*>) = Update st (a -> b) -> Update st a -> Update st b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    -- | Context monad for Query events.
    newtype Query st a  = Query { forall st a. Query st a -> Reader st a
    unQuery :: Reader st a }
        deriving (Applicative (Query st)
    Applicative (Query st) =>
    (forall a b. Query st a -> (a -> Query st b) -> Query st b)
    -> (forall a b. Query st a -> Query st b -> Query st b)
    -> (forall a. a -> Query st a)
    -> Monad (Query st)
    forall st. Applicative (Query st)
    forall a. a -> Query st a
    forall st a. a -> Query st a
    forall a b. Query st a -> Query st b -> Query st b
    forall a b. Query st a -> (a -> Query st b) -> Query st b
    forall st a b. Query st a -> Query st b -> Query st b
    forall st a b. Query st a -> (a -> Query st b) -> Query st b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall st a b. Query st a -> (a -> Query st b) -> Query st b
    >>= :: forall a b. Query st a -> (a -> Query st b) -> Query st b
    $c>> :: forall st a b. Query st a -> Query st b -> Query st b
    >> :: forall a b. Query st a -> Query st b -> Query st b
    $creturn :: forall st a. a -> Query st a
    return :: forall a. a -> Query st a
    Monad, (forall a b. (a -> b) -> Query st a -> Query st b)
    -> (forall a b. a -> Query st b -> Query st a)
    -> Functor (Query st)
    forall a b. a -> Query st b -> Query st a
    forall a b. (a -> b) -> Query st a -> Query st b
    forall st a b. a -> Query st b -> Query st a
    forall st a b. (a -> b) -> Query st a -> Query st b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall st a b. (a -> b) -> Query st a -> Query st b
    fmap :: forall a b. (a -> b) -> Query st a -> Query st b
    $c<$ :: forall st a b. a -> Query st b -> Query st a
    <$ :: forall a b. a -> Query st b -> Query st a
    Functor, MonadReader st)

    instance Applicative (Query st) where
        pure :: forall a. a -> Query st a
    pure = a -> Query st a
    forall a. a -> Query st a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        <*> :: forall a b. Query st (a -> b) -> Query st a -> Query st b
    (<*>) = Query st (a -> b) -> Query st a -> Query st b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    -- | Run a query in the Update Monad.
    liftQuery :: Query st a -> Update st a
    liftQuery :: forall st a. Query st a -> Update st a
    liftQuery Query st a
    query
        = do st <- Update st st
    forall s (m :: * -> *). MonadState s m => m s
    get
             return (runReader (unQuery query) st)

    -- | Events return the same thing as Methods. The exact type of 'EventResult'
    --   depends on the event.
    type EventResult ev = MethodResult ev

    type EventState ev = MethodState ev

    -- | We distinguish between events that modify the state and those that do not.
    --
    --   UpdateEvents are executed in a MonadState context and have to be serialized
    --   to disk before they are considered durable.
    --
    --   QueryEvents are executed in a MonadReader context and obviously do not have
    --   to be serialized to disk.
    data Event st where
        UpdateEvent :: UpdateEvent ev => (ev -> Update (EventState ev) (EventResult ev)) -> MethodSerialiser ev -> Event (EventState ev)
        QueryEvent  :: QueryEvent  ev => (ev -> Query (EventState ev) (EventResult ev)) -> MethodSerialiser ev -> Event (EventState ev)

    -- | All UpdateEvents are also Methods.
    class Method ev => UpdateEvent ev
    -- | All QueryEvents are also Methods.
    class Method ev => QueryEvent ev

    eventsToMethods :: [Event st] -> [MethodContainer st]
    eventsToMethods :: forall st. [Event st] -> [MethodContainer st]
    eventsToMethods = (Event st -> MethodContainer st)
    -> [Event st] -> [MethodContainer st]
    forall a b. (a -> b) -> [a] -> [b]
    map Event st -> MethodContainer st
    forall st. Event st -> MethodContainer st
    worker
        where worker :: Event st -> MethodContainer st
              worker :: forall st. Event st -> MethodContainer st
    worker (UpdateEvent ev -> Update (MethodState ev) (EventResult ev)
    fn MethodSerialiser ev
    ms) = MethodBody ev
    -> MethodSerialiser ev -> MethodContainer (MethodState ev)
    forall method.
    Method method =>
    MethodBody method
    -> MethodSerialiser method -> MethodContainer (MethodState method)
    Method (Update st (EventResult ev) -> State st (EventResult ev)
    forall st a. Update st a -> State st a
    unUpdate (Update st (EventResult ev) -> State st (EventResult ev))
    -> (ev -> Update st (EventResult ev))
    -> ev
    -> State st (EventResult ev)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ev -> Update st (EventResult ev)
    ev -> Update (MethodState ev) (EventResult ev)
    fn) MethodSerialiser ev
    ms
              worker (QueryEvent  ev -> Query (MethodState ev) (EventResult ev)
    fn MethodSerialiser ev
    ms) = MethodBody ev
    -> MethodSerialiser ev -> MethodContainer (MethodState ev)
    forall method.
    Method method =>
    MethodBody method
    -> MethodSerialiser method -> MethodContainer (MethodState method)
    Method (\ev
    ev -> do st <- StateT st Identity st
    forall s (m :: * -> *). MonadState s m => m s
    get
                                                             return (runReader (unQuery $ fn ev) st)
                                                  ) MethodSerialiser ev
    ms