{-# LANGUAGE CPP #-}

-- | Phantom State Transformer type and functions.
module Control.Applicative.PhantomState (
    PhantomStateT
  , PhantomState
  , useState
  , changeState
  , useAndChangeState
  , runPhantomStateT
  , runPhantomState
  ) where

import Control.Applicative
import Data.Functor.Identity
-- Conditional imports
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid (..))
#endif
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,10,0)
import Data.Semigroup (Semigroup (..))
#endif

-- | The Phantom State Transformer is like the
--   State Monad Transformer, but it does not hold
--   any value. Therefore, it automatically discards
--   the result of any computation. Only changes in
--   the state and effects will remain. This transformer
--   produces a new 'Applicative' functor from any 'Monad'.
--   The primitive operations in this functor are:
--
-- * 'useState': Performs effects. State is unchanged.
-- * 'changeState': Changes state. No effect is performed.
-- * 'useAndChangeState': Changes state and performs effects.
--
--   Although 'useState' and 'changeState' are defined in
--   terms of 'useAndChangeState':
--
-- >    useState f = useAndChangeState (\s -> f s *> pure s)
-- > changeState f = useAndChangeState (pure . f)
--
--   So 'useAndChangeState' is the only actual primitive.
--
--   Use 'runPhantomStateT' (or 'runPhantomState') to get
--   the result of a phantom state computation.
--
newtype PhantomStateT s m a = PhantomStateT (s -> m s)

-- | Type synonym of 'PhantomStateT' where the underlying 'Monad' is the 'Identity' monad.
type PhantomState s = PhantomStateT s Identity

-- | Perform an applicative action using the current state, leaving
--   the state unchanged. The result will be discarded, so only the
--   effect will remain.
useState :: Applicative m => (s -> m a) -> PhantomStateT s m ()
{-# INLINE useState #-}
useState :: forall (m :: * -> *) s a.
Applicative m =>
(s -> m a) -> PhantomStateT s m ()
useState s -> m a
f = forall s (m :: * -> *). (s -> m s) -> PhantomStateT s m ()
useAndChangeState forall a b. (a -> b) -> a -> b
$ \s
s -> s -> m a
f s
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s

-- | Modify the state using a pure function. No effect will be produced,
--   only the state will be modified.
changeState :: Applicative m => (s -> s) -> PhantomStateT s m ()
{-# INLINE changeState #-}
changeState :: forall (m :: * -> *) s.
Applicative m =>
(s -> s) -> PhantomStateT s m ()
changeState s -> s
f = forall s (m :: * -> *). (s -> m s) -> PhantomStateT s m ()
useAndChangeState forall a b. (a -> b) -> a -> b
$ \s
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> s
f s
s)

-- | Combination of 'useState' and 'changeState'. It allows you to change the state while
--   performing any effects. The new state will be the result of applying the argument
--   function to the old state. The following equations hold:
--
-- >    useState f *> changeState g }
-- >                                } = useAndChangeState (\s -> f s *> g s)
-- > changeState g *>    useState f }
--
useAndChangeState :: (s -> m s) -> PhantomStateT s m ()
{-# INLINE useAndChangeState #-}
useAndChangeState :: forall s (m :: * -> *). (s -> m s) -> PhantomStateT s m ()
useAndChangeState = forall s (m :: * -> *) a. (s -> m s) -> PhantomStateT s m a
PhantomStateT

-- | Perform a phantom state computation by setting an initial state
--   and running all the actions from there.
runPhantomStateT :: PhantomStateT s m a -- ^ Phantom state computation
                 -> s -- ^ Initial state
                 -> m s -- ^ Final result
{-# INLINE runPhantomStateT #-}
runPhantomStateT :: forall s (m :: * -> *) a. PhantomStateT s m a -> s -> m s
runPhantomStateT (PhantomStateT s -> m s
f) s
x = s -> m s
f s
x

-- | Specialized version of 'runPhantomStateT' where the underlying
--   'Monad' is the 'Identity' monad.
runPhantomState :: PhantomState s a -- ^ Phantom state computation
                -> s -- ^ Initial state
                -> s -- ^ Final result
{-# INLINE runPhantomState #-}
runPhantomState :: forall s a. PhantomState s a -> s -> s
runPhantomState PhantomState s a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. PhantomStateT s m a -> s -> m s
runPhantomStateT PhantomState s a
f

-- Instances

instance Functor (PhantomStateT s m) where
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> PhantomStateT s m a -> PhantomStateT s m b
fmap a -> b
_ (PhantomStateT s -> m s
f) = forall s (m :: * -> *) a. (s -> m s) -> PhantomStateT s m a
PhantomStateT s -> m s
f

instance Monad m => Applicative (PhantomStateT s m) where
  {-# INLINE pure #-}
  pure :: forall a. a -> PhantomStateT s m a
pure a
_ = forall s (m :: * -> *) a. (s -> m s) -> PhantomStateT s m a
PhantomStateT forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE (<*>) #-}
  PhantomStateT s -> m s
f <*> :: forall a b.
PhantomStateT s m (a -> b)
-> PhantomStateT s m a -> PhantomStateT s m b
<*> PhantomStateT s -> m s
g = forall s (m :: * -> *) a. (s -> m s) -> PhantomStateT s m a
PhantomStateT (\s
x -> s -> m s
f s
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m s
g)
  {-# INLINE  (*>) #-}
  PhantomStateT s -> m s
f  *> :: forall a b.
PhantomStateT s m a -> PhantomStateT s m b -> PhantomStateT s m b
*> PhantomStateT s -> m s
g = forall s (m :: * -> *) a. (s -> m s) -> PhantomStateT s m a
PhantomStateT (\s
x -> s -> m s
f s
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m s
g)
  {-# INLINE (<*) #-}
  PhantomStateT s -> m s
f <* :: forall a b.
PhantomStateT s m a -> PhantomStateT s m b -> PhantomStateT s m a
<*  PhantomStateT s -> m s
g = forall s (m :: * -> *) a. (s -> m s) -> PhantomStateT s m a
PhantomStateT (\s
x -> s -> m s
f s
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m s
g)

instance (Monad m, Alternative m) => Alternative (PhantomStateT s m) where
  {-# INLINE empty #-}
  empty :: forall a. PhantomStateT s m a
empty = forall s (m :: * -> *) a. (s -> m s) -> PhantomStateT s m a
PhantomStateT (forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
empty)
  {-# INLINE (<|>) #-}
  PhantomStateT s -> m s
f <|> :: forall a.
PhantomStateT s m a -> PhantomStateT s m a -> PhantomStateT s m a
<|> PhantomStateT s -> m s
g = forall s (m :: * -> *) a. (s -> m s) -> PhantomStateT s m a
PhantomStateT (\s
x -> s -> m s
f s
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> s -> m s
g s
x)

instance Monad m => Monoid (PhantomStateT s m a) where
  {-# INLINE mempty #-}
  mempty :: PhantomStateT s m a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. HasCallStack => a
undefined

#if MIN_VERSION_base(4,9,0)
instance Monad m => Semigroup (PhantomStateT s m a) where
  {-# INLINE (<>) #-}
  <> :: PhantomStateT s m a -> PhantomStateT s m a -> PhantomStateT s m a
(<>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
#endif