content: {-# LANGUAGE AllowAmbiguousTypes #-}
  
  -- |
  -- Module:       Control.Monad.Freer.State
  -- Description:  State effects, for state-carrying computations.
  -- Copyright:    (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King
  -- License:      BSD3
  -- Maintainer:   Alexis King <lexi.lambda@gmail.com>
  -- Stability:    experimental
  -- Portability:  GHC specific language extensions.
  --
  -- Composable handler for 'State' effects. Handy for passing an updatable state
  -- through a computation.
  --
  -- Some computations may not require the full power of 'State' effect:
  --
  -- * For a read-only state, see "Control.Monad.Freer.Reader".
  -- * To accumulate a value without using it on the way, see
  --   "Control.Monad.Freer.Writer".
  --
  -- Using <http://okmij.org/ftp/Haskell/extensible/Eff1.hs> as a starting point.
  module Control.Monad.Freer.State
    ( -- * State Effect
      State(..)
  
      -- * State Operations
    , get
    , put
    , modify
    , gets
  
      -- * State Handlers
    , runState
    , evalState
    , execState
  
      -- * State Utilities
    , transactionState
    , transactionState'
    ) where
  
  import Data.Proxy (Proxy)
  
  import Control.Monad.Freer (Eff, Member, send)
  import Control.Monad.Freer.Internal (Arr, handleRelayS, interposeS)
  
  -- | Strict 'State' effects: one can either 'Get' values or 'Put' them.
  data State s r where
    Get :: State s s
    Put :: !s -> State s ()
  
  -- | Retrieve the current value of the state of type @s :: *@.
  get :: forall s effs. Member (State s) effs => Eff effs s
  get = send Get
  
  -- | Set the current state to a specified value of type @s :: *@.
  put :: forall s effs. Member (State s) effs => s -> Eff effs ()
  put s = send (Put s)
  
  -- | Modify the current state of type @s :: *@ using provided function
  -- @(s -> s)@.
  modify :: forall s effs. Member (State s) effs => (s -> s) -> Eff effs ()
  modify f = fmap f get >>= put
  
  -- | Retrieve a specific component of the current state using the provided
  -- projection function.
  gets :: forall s a effs. Member (State s) effs => (s -> a) -> Eff effs a
  gets f = f <$> get
  
  -- | Handler for 'State' effects.
  runState :: forall s effs a. s -> Eff (State s ': effs) a -> Eff effs (a, s)
  runState s0 = handleRelayS s0 (\s x -> pure (x, s)) $ \s x k -> case x of
    Get -> k s s
    Put s' -> k s' ()
  
  -- | Run a 'State' effect, returning only the final state.
  execState :: forall s effs a. s -> Eff (State s ': effs) a -> Eff effs s
  execState s = fmap snd . runState s
  
  -- | Run a State effect, discarding the final state.
  evalState :: forall s effs a. s -> Eff (State s ': effs) a -> Eff effs a
  evalState s = fmap fst . runState s
  
  -- | An encapsulated State handler, for transactional semantics. The global
  -- state is updated only if the 'transactionState' finished successfully.
  --
  -- GHC cannot infer the @s@ type parameter for this function, so it must be
  -- specified explicitly with @TypeApplications@. Alternatively, it can be
  -- specified by supplying a 'Proxy' to 'transactionState''.
  transactionState
    :: forall s effs a
     . Member (State s) effs
    => Eff effs a
    -> Eff effs a
  transactionState m = do
      s0 <- get @s
      (x, s) <- interposeS s0 (\s x -> pure (x, s)) handle m
      put s
      pure x
    where
      handle :: s -> State s v -> (s -> Arr effs v b) -> Eff effs b
      handle s x k = case x of
        Get -> k s s
        Put s' -> k s' ()
  
  -- | Like 'transactionState', but @s@ is specified by providing a 'Proxy'
  -- instead of requiring @TypeApplications@.
  transactionState'
    :: forall s effs a
     . Member (State s) effs
    => Proxy s
    -> Eff effs a
    -> Eff effs a
  transactionState' _ = transactionState @s
  {-# INLINE transactionState' #-}
  