{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}

module Control.Monad.RevState.Class
  ( MonadRevState (..)
  , modify
  , gets
  ) where

import Control.Monad (liftM)
import Control.Monad.Fix (MonadFix)

import qualified Control.Monad.Trans.RevState as Rev


class (MonadFix m) => MonadRevState s m | m -> s where
  {-# MINIMAL get, put | state #-}

  get :: m s
  get = (s -> (s, s)) -> m s
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadRevState s m => (s -> (a, s)) -> m a
state ((s -> (s, s)) -> m s) -> (s -> (s, s)) -> m s
forall a b. (a -> b) -> a -> b
$ \s
s -> (s
s, s
s)

  put :: s -> m ()
  put s
s = (s -> ((), s)) -> m ()
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadRevState s m => (s -> (a, s)) -> m a
state ((s -> ((), s)) -> m ()) -> (s -> ((), s)) -> m ()
forall a b. (a -> b) -> a -> b
$ \s
_ -> ((), s
s)

  state :: (s -> (a, s)) -> m a
  state s -> (a, s)
f = do
    rec
      let ~(a
a, s
s') = s -> (a, s)
f s
s
      s -> m ()
forall s (m :: * -> *). MonadRevState s m => s -> m ()
put s
s'
      s
s <- m s
forall s (m :: * -> *). MonadRevState s m => m s
get
    a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a


modify :: MonadRevState s m => (s -> s) -> m ()
modify :: forall s (m :: * -> *). MonadRevState s m => (s -> s) -> m ()
modify s -> s
f = (s -> ((), s)) -> m ()
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadRevState s m => (s -> (a, s)) -> m a
state ((s -> ((), s)) -> m ()) -> (s -> ((), s)) -> m ()
forall a b. (a -> b) -> a -> b
$ \s
s -> ((), s -> s
f s
s)

gets :: MonadRevState s m => (s -> a) -> m a
gets :: forall s (m :: * -> *) a. MonadRevState s m => (s -> a) -> m a
gets s -> a
f = s -> a
f (s -> a) -> m s -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m s
forall s (m :: * -> *). MonadRevState s m => m s
get


instance MonadFix m => MonadRevState s (Rev.StateT s m) where
  get :: StateT s m s
get = StateT s m s
forall (m :: * -> *) s. Applicative m => StateT s m s
Rev.get
  put :: s -> StateT s m ()
put = s -> StateT s m ()
forall (m :: * -> *) s. Applicative m => s -> StateT s m ()
Rev.put
  state :: forall a. (s -> (a, s)) -> StateT s m a
state = (s -> (a, s)) -> StateT s m a
forall (m :: * -> *) s a.
Applicative m =>
(s -> (a, s)) -> StateT s m a
Rev.state