{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Fresh where
import Control.Monad.Cont (ContT, MonadCont (..))
import Control.Monad.Except (ExceptT, MonadError (..))
import Control.Monad.Fix (MonadFix (..))
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Identity (Identity (..), IdentityT)
import Control.Monad.Morph (MFunctor (..))
import Control.Monad.RWS (RWST)
import Control.Monad.Reader (MonadReader (..), ReaderT, asks, runReaderT)
import Control.Monad.State (MonadState (..), StateT, evalStateT, modify)
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Writer (MonadWriter (..), WriterT)
import GHC.Base (Alternative (..), MonadPlus (..))
import Hedgehog (MonadGen (..), distributeT)
newtype Successor a = Successor {forall a. Successor a -> a -> a
suc :: a -> a}
newtype FreshT e m a = FreshT {forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT :: ReaderT (Successor e) (StateT e m) a}
deriving (forall a b. a -> FreshT e m b -> FreshT e m a
forall a b. (a -> b) -> FreshT e m a -> FreshT e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> FreshT e m b -> FreshT e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> FreshT e m a -> FreshT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FreshT e m b -> FreshT e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> FreshT e m b -> FreshT e m a
fmap :: forall a b. (a -> b) -> FreshT e m a -> FreshT e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> FreshT e m a -> FreshT e m b
Functor)
instance Monad m => MonadFresh e (FreshT e m) where
fresh :: FreshT e m e
fresh = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ do
e
e <- forall s (m :: * -> *). MonadState s m => m s
get
e -> e
s <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. Successor a -> a -> a
suc
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify e -> e
s
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
e
instance Monad m => Monad (FreshT e m) where
return :: forall a. a -> FreshT e m a
return = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
(FreshT ReaderT (Successor e) (StateT e m) a
m) >>= :: forall a b. FreshT e m a -> (a -> FreshT e m b) -> FreshT e m b
>>= a -> FreshT e m b
f = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ ReaderT (Successor e) (StateT e m) a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FreshT e m b
f
instance MonadPlus m => MonadPlus (FreshT e m) where
mzero :: forall a. FreshT e m a
mzero = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall (m :: * -> *) a. MonadPlus m => m a
mzero
mplus :: forall a. FreshT e m a -> FreshT e m a -> FreshT e m a
mplus (FreshT ReaderT (Successor e) (StateT e m) a
m) (FreshT ReaderT (Successor e) (StateT e m) a
m') = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus ReaderT (Successor e) (StateT e m) a
m ReaderT (Successor e) (StateT e m) a
m'
instance (Functor f, Monad f) => Applicative (FreshT e f) where
pure :: forall a. a -> FreshT e f a
pure = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
(FreshT ReaderT (Successor e) (StateT e f) (a -> b)
f) <*> :: forall a b. FreshT e f (a -> b) -> FreshT e f a -> FreshT e f b
<*> (FreshT ReaderT (Successor e) (StateT e f) a
a) = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ ReaderT (Successor e) (StateT e f) (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (Successor e) (StateT e f) a
a
instance (Monad m, Functor m, MonadPlus m) => Alternative (FreshT e m) where
empty :: forall a. FreshT e m a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. FreshT e m a -> FreshT e m a -> FreshT e m a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
type Fresh e = FreshT e Identity
instance MonadTrans (FreshT e) where
lift :: forall (m :: * -> *) a. Monad m => m a -> FreshT e m a
lift = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadReader r m => MonadReader r (FreshT e m) where
local :: forall a. (r -> r) -> FreshT e m a -> FreshT e m a
local r -> r
f FreshT e m a
m = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT FreshT e m a
m)
ask :: FreshT e m r
ask = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask)
instance MonadState s m => MonadState s (FreshT e m) where
get :: FreshT e m s
get = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> FreshT e m ()
put = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance (MonadWriter w m) => MonadWriter w (FreshT e m) where
tell :: w -> FreshT e m ()
tell w
m = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell w
m
listen :: forall a. FreshT e m a -> FreshT e m (a, w)
listen = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT
pass :: forall a. FreshT e m (a, w -> w) -> FreshT e m a
pass = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT
instance MonadFix m => MonadFix (FreshT e m) where
mfix :: forall a. (a -> FreshT e m a) -> FreshT e m a
mfix = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
instance MonadIO m => MonadIO (FreshT e m) where
liftIO :: forall a. IO a -> FreshT e m a
liftIO = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadCont m => MonadCont (FreshT e m) where
callCC :: forall a b. ((a -> FreshT e m b) -> FreshT e m a) -> FreshT e m a
callCC (a -> FreshT e m b) -> FreshT e m a
f = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> FreshT e m b) -> FreshT e m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
.))
instance MonadError e m => MonadError e (FreshT e' m) where
throwError :: forall a. e -> FreshT e' m a
throwError = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: forall a. FreshT e' m a -> (e -> FreshT e' m a) -> FreshT e' m a
catchError FreshT e' m a
m e -> FreshT e' m a
h = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT FreshT e' m a
m) (forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> FreshT e' m a
h)
instance MFunctor (FreshT e) where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> FreshT e m b -> FreshT e n b
hoist forall a. m a -> n a
nat FreshT e m b
m = forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall a b. (a -> b) -> a -> b
$ forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
nat) (forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT FreshT e m b
m)
instance MonadGen m => MonadGen (FreshT e m) where
type GenBase (FreshT e m) = FreshT e (GenBase m)
toGenT :: forall a. FreshT e m a -> GenT (GenBase (FreshT e m)) a
toGenT = forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall e (m :: * -> *) a.
ReaderT (Successor e) (StateT e m) a -> FreshT e m a
FreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
(m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
(m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT
fromGenT :: forall a. GenT (GenBase (FreshT e m)) a -> FreshT e m a
fromGenT = forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
(m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT
successor :: forall e. (e -> e) -> Successor e
successor :: forall e. (e -> e) -> Successor e
successor = forall e. (e -> e) -> Successor e
Successor
enumSucc :: forall e. Enum e => Successor e
enumSucc :: forall e. Enum e => Successor e
enumSucc = forall e. (e -> e) -> Successor e
Successor forall a. Enum a => a -> a
succ
runFreshT :: forall e m a. (Enum e, Monad m) => FreshT e m a -> m a
runFreshT :: forall e (m :: * -> *) a. (Enum e, Monad m) => FreshT e m a -> m a
runFreshT = forall e (m :: * -> *) a.
(Monad m, Enum e) =>
e -> FreshT e m a -> m a
runFreshTFrom (forall a. Enum a => Int -> a
toEnum Int
0)
runFresh :: forall e a. Enum e => Fresh e a -> a
runFresh :: forall e a. Enum e => Fresh e a -> a
runFresh = forall e a. Enum e => e -> Fresh e a -> a
runFreshFrom (forall a. Enum a => Int -> a
toEnum Int
0)
runFreshTFrom :: forall e m a. (Monad m, Enum e) => e -> FreshT e m a -> m a
runFreshTFrom :: forall e (m :: * -> *) a.
(Monad m, Enum e) =>
e -> FreshT e m a -> m a
runFreshTFrom = forall e (m :: * -> *) a.
Monad m =>
Successor e -> e -> FreshT e m a -> m a
runFreshTWith forall e. Enum e => Successor e
enumSucc
runFreshFrom :: forall e a. Enum e => e -> Fresh e a -> a
runFreshFrom :: forall e a. Enum e => e -> Fresh e a -> a
runFreshFrom = forall e a. Successor e -> e -> Fresh e a -> a
runFreshWith forall e. Enum e => Successor e
enumSucc
runFreshTWith :: forall e m a. Monad m => Successor e -> e -> FreshT e m a -> m a
runFreshTWith :: forall e (m :: * -> *) a.
Monad m =>
Successor e -> e -> FreshT e m a -> m a
runFreshTWith Successor e
s e
e =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT e
e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Successor e
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a.
FreshT e m a -> ReaderT (Successor e) (StateT e m) a
unFreshT
runFreshWith :: forall e a. Successor e -> e -> Fresh e a -> a
runFreshWith :: forall e a. Successor e -> e -> Fresh e a -> a
runFreshWith Successor e
s e
e = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a.
Monad m =>
Successor e -> e -> FreshT e m a -> m a
runFreshTWith Successor e
s e
e
class Monad m => MonadFresh e m | m -> e where
fresh :: m e
instance MonadFresh e m => MonadFresh e (IdentityT m) where
fresh :: IdentityT m e
fresh = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall e (m :: * -> *). MonadFresh e m => m e
fresh
instance MonadFresh e m => MonadFresh e (StateT s m) where
fresh :: StateT s m e
fresh = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall e (m :: * -> *). MonadFresh e m => m e
fresh
instance MonadFresh e m => MonadFresh e (ReaderT s m) where
fresh :: ReaderT s m e
fresh = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall e (m :: * -> *). MonadFresh e m => m e
fresh
instance (MonadFresh e m, Monoid s) => MonadFresh e (WriterT s m) where
fresh :: WriterT s m e
fresh = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall e (m :: * -> *). MonadFresh e m => m e
fresh
instance MonadFresh e m => MonadFresh e (MaybeT m) where
fresh :: MaybeT m e
fresh = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall e (m :: * -> *). MonadFresh e m => m e
fresh
instance MonadFresh e m => MonadFresh e (ContT r m) where
fresh :: ContT r m e
fresh = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall e (m :: * -> *). MonadFresh e m => m e
fresh
instance (Monoid w, MonadFresh e m) => MonadFresh e (RWST r w s m) where
fresh :: RWST r w s m e
fresh = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall e (m :: * -> *). MonadFresh e m => m e
fresh
instance (MonadFresh e m) => MonadFresh e (ExceptT e' m) where
fresh :: ExceptT e' m e
fresh = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall e (m :: * -> *). MonadFresh e m => m e
fresh