{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.Monads where



#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad.Exception
import Control.Monad.Identity
import Control.Monad.Reader
import qualified Control.Monad.State.Lazy as L
import Control.Monad.State.Strict
import Control.Monad.Writer



newtype SupplyT m a = SupplyT { SupplyT m a -> StateT Integer m a
unSupplyT :: StateT Integer m a }
  deriving (a -> SupplyT m b -> SupplyT m a
(a -> b) -> SupplyT m a -> SupplyT m b
(forall a b. (a -> b) -> SupplyT m a -> SupplyT m b)
-> (forall a b. a -> SupplyT m b -> SupplyT m a)
-> Functor (SupplyT m)
forall a b. a -> SupplyT m b -> SupplyT m a
forall a b. (a -> b) -> SupplyT m a -> SupplyT m b
forall (m :: * -> *) a b.
Functor m =>
a -> SupplyT m b -> SupplyT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SupplyT m a -> SupplyT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SupplyT m b -> SupplyT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SupplyT m b -> SupplyT m a
fmap :: (a -> b) -> SupplyT m a -> SupplyT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SupplyT m a -> SupplyT m b
Functor, Functor (SupplyT m)
a -> SupplyT m a
Functor (SupplyT m)
-> (forall a. a -> SupplyT m a)
-> (forall a b. SupplyT m (a -> b) -> SupplyT m a -> SupplyT m b)
-> (forall a b c.
    (a -> b -> c) -> SupplyT m a -> SupplyT m b -> SupplyT m c)
-> (forall a b. SupplyT m a -> SupplyT m b -> SupplyT m b)
-> (forall a b. SupplyT m a -> SupplyT m b -> SupplyT m a)
-> Applicative (SupplyT m)
SupplyT m a -> SupplyT m b -> SupplyT m b
SupplyT m a -> SupplyT m b -> SupplyT m a
SupplyT m (a -> b) -> SupplyT m a -> SupplyT m b
(a -> b -> c) -> SupplyT m a -> SupplyT m b -> SupplyT m c
forall a. a -> SupplyT m a
forall a b. SupplyT m a -> SupplyT m b -> SupplyT m a
forall a b. SupplyT m a -> SupplyT m b -> SupplyT m b
forall a b. SupplyT m (a -> b) -> SupplyT m a -> SupplyT m b
forall a b c.
(a -> b -> c) -> SupplyT m a -> SupplyT m b -> SupplyT m c
forall (m :: * -> *). Monad m => Functor (SupplyT m)
forall (m :: * -> *) a. Monad m => a -> SupplyT m a
forall (m :: * -> *) a b.
Monad m =>
SupplyT m a -> SupplyT m b -> SupplyT m a
forall (m :: * -> *) a b.
Monad m =>
SupplyT m a -> SupplyT m b -> SupplyT m b
forall (m :: * -> *) a b.
Monad m =>
SupplyT m (a -> b) -> SupplyT m a -> SupplyT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> SupplyT m a -> SupplyT m b -> SupplyT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SupplyT m a -> SupplyT m b -> SupplyT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
SupplyT m a -> SupplyT m b -> SupplyT m a
*> :: SupplyT m a -> SupplyT m b -> SupplyT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
SupplyT m a -> SupplyT m b -> SupplyT m b
liftA2 :: (a -> b -> c) -> SupplyT m a -> SupplyT m b -> SupplyT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> SupplyT m a -> SupplyT m b -> SupplyT m c
<*> :: SupplyT m (a -> b) -> SupplyT m a -> SupplyT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
SupplyT m (a -> b) -> SupplyT m a -> SupplyT m b
pure :: a -> SupplyT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> SupplyT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (SupplyT m)
Applicative, Applicative (SupplyT m)
a -> SupplyT m a
Applicative (SupplyT m)
-> (forall a b. SupplyT m a -> (a -> SupplyT m b) -> SupplyT m b)
-> (forall a b. SupplyT m a -> SupplyT m b -> SupplyT m b)
-> (forall a. a -> SupplyT m a)
-> Monad (SupplyT m)
SupplyT m a -> (a -> SupplyT m b) -> SupplyT m b
SupplyT m a -> SupplyT m b -> SupplyT m b
forall a. a -> SupplyT m a
forall a b. SupplyT m a -> SupplyT m b -> SupplyT m b
forall a b. SupplyT m a -> (a -> SupplyT m b) -> SupplyT m b
forall (m :: * -> *). Monad m => Applicative (SupplyT m)
forall (m :: * -> *) a. Monad m => a -> SupplyT m a
forall (m :: * -> *) a b.
Monad m =>
SupplyT m a -> SupplyT m b -> SupplyT m b
forall (m :: * -> *) a b.
Monad m =>
SupplyT m a -> (a -> SupplyT m b) -> SupplyT m 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
return :: a -> SupplyT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> SupplyT m a
>> :: SupplyT m a -> SupplyT m b -> SupplyT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
SupplyT m a -> SupplyT m b -> SupplyT m b
>>= :: SupplyT m a -> (a -> SupplyT m b) -> SupplyT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
SupplyT m a -> (a -> SupplyT m b) -> SupplyT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (SupplyT m)
Monad, Monad (SupplyT m)
Monad (SupplyT m)
-> (forall a. (a -> SupplyT m a) -> SupplyT m a)
-> MonadFix (SupplyT m)
(a -> SupplyT m a) -> SupplyT m a
forall a. (a -> SupplyT m a) -> SupplyT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (SupplyT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> SupplyT m a) -> SupplyT m a
mfix :: (a -> SupplyT m a) -> SupplyT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> SupplyT m a) -> SupplyT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (SupplyT m)
MonadFix, Monad (SupplyT m)
Monad (SupplyT m)
-> (forall a. IO a -> SupplyT m a) -> MonadIO (SupplyT m)
IO a -> SupplyT m a
forall a. IO a -> SupplyT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (SupplyT m)
forall (m :: * -> *) a. MonadIO m => IO a -> SupplyT m a
liftIO :: IO a -> SupplyT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SupplyT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (SupplyT m)
MonadIO, m a -> SupplyT m a
(forall (m :: * -> *) a. Monad m => m a -> SupplyT m a)
-> MonadTrans SupplyT
forall (m :: * -> *) a. Monad m => m a -> SupplyT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SupplyT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> SupplyT m a
MonadTrans)

type Supply = SupplyT Identity

class Monad m => MonadSupply m
  where
    -- | Create a fresh variable identifier
    fresh :: m Integer
    default fresh :: (m ~ t n, MonadTrans t, MonadSupply n) => m Integer
    fresh = n Integer -> t n Integer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Integer
forall (m :: * -> *). MonadSupply m => m Integer
fresh

instance Monad m => MonadSupply (SupplyT m)
  where
    fresh :: SupplyT m Integer
fresh = do
        Integer
v <- StateT Integer m Integer -> SupplyT m Integer
forall (m :: * -> *) a. StateT Integer m a -> SupplyT m a
SupplyT StateT Integer m Integer
forall s (m :: * -> *). MonadState s m => m s
get
        StateT Integer m () -> SupplyT m ()
forall (m :: * -> *) a. StateT Integer m a -> SupplyT m a
SupplyT (StateT Integer m () -> SupplyT m ())
-> StateT Integer m () -> SupplyT m ()
forall a b. (a -> b) -> a -> b
$ Integer -> StateT Integer m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)
        Integer -> SupplyT m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v

instance MonadSupply m             => MonadSupply (ExceptionT m)
instance MonadSupply m             => MonadSupply (ReaderT  r m)
instance MonadSupply m             => MonadSupply (L.StateT s m)
instance MonadSupply m             => MonadSupply (StateT   s m)
instance (MonadSupply m, Monoid w) => MonadSupply (WriterT  w m)

instance MonadException m => MonadException (SupplyT m)
  where
    throw :: e -> SupplyT m a
throw = m a -> SupplyT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> SupplyT m a) -> (e -> m a) -> e -> SupplyT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
    catch :: SupplyT m a -> (e -> SupplyT m a) -> SupplyT m a
catch SupplyT m a
m e -> SupplyT m a
h = StateT Integer m a -> SupplyT m a
forall (m :: * -> *) a. StateT Integer m a -> SupplyT m a
SupplyT (StateT Integer m a -> SupplyT m a)
-> StateT Integer m a -> SupplyT m a
forall a b. (a -> b) -> a -> b
$ StateT Integer m a
-> (e -> StateT Integer m a) -> StateT Integer m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catch (SupplyT m a -> StateT Integer m a
forall (m :: * -> *) a. SupplyT m a -> StateT Integer m a
unSupplyT SupplyT m a
m) (SupplyT m a -> StateT Integer m a
forall (m :: * -> *) a. SupplyT m a -> StateT Integer m a
unSupplyT (SupplyT m a -> StateT Integer m a)
-> (e -> SupplyT m a) -> e -> StateT Integer m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SupplyT m a
h)

instance MonadReader r m => MonadReader r (SupplyT m)
  where
    ask :: SupplyT m r
ask     = m r -> SupplyT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: (r -> r) -> SupplyT m a -> SupplyT m a
local r -> r
f = StateT Integer m a -> SupplyT m a
forall (m :: * -> *) a. StateT Integer m a -> SupplyT m a
SupplyT (StateT Integer m a -> SupplyT m a)
-> (SupplyT m a -> StateT Integer m a)
-> SupplyT m a
-> SupplyT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> StateT Integer m a -> StateT Integer m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (StateT Integer m a -> StateT Integer m a)
-> (SupplyT m a -> StateT Integer m a)
-> SupplyT m a
-> StateT Integer m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SupplyT m a -> StateT Integer m a
forall (m :: * -> *) a. SupplyT m a -> StateT Integer m a
unSupplyT

instance MonadState s m => MonadState s (SupplyT m)
  where
    get :: SupplyT m s
get = m s -> SupplyT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> SupplyT m ()
put = m () -> SupplyT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SupplyT m ()) -> (s -> m ()) -> s -> SupplyT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance MonadWriter w m => MonadWriter w (SupplyT m)
  where
    tell :: w -> SupplyT m ()
tell   = StateT Integer m () -> SupplyT m ()
forall (m :: * -> *) a. StateT Integer m a -> SupplyT m a
SupplyT (StateT Integer m () -> SupplyT m ())
-> (w -> StateT Integer m ()) -> w -> SupplyT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> StateT Integer m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: SupplyT m a -> SupplyT m (a, w)
listen = StateT Integer m (a, w) -> SupplyT m (a, w)
forall (m :: * -> *) a. StateT Integer m a -> SupplyT m a
SupplyT (StateT Integer m (a, w) -> SupplyT m (a, w))
-> (SupplyT m a -> StateT Integer m (a, w))
-> SupplyT m a
-> SupplyT m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Integer m a -> StateT Integer m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (StateT Integer m a -> StateT Integer m (a, w))
-> (SupplyT m a -> StateT Integer m a)
-> SupplyT m a
-> StateT Integer m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SupplyT m a -> StateT Integer m a
forall (m :: * -> *) a. SupplyT m a -> StateT Integer m a
unSupplyT
    pass :: SupplyT m (a, w -> w) -> SupplyT m a
pass   = StateT Integer m a -> SupplyT m a
forall (m :: * -> *) a. StateT Integer m a -> SupplyT m a
SupplyT (StateT Integer m a -> SupplyT m a)
-> (SupplyT m (a, w -> w) -> StateT Integer m a)
-> SupplyT m (a, w -> w)
-> SupplyT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Integer m (a, w -> w) -> StateT Integer m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass   (StateT Integer m (a, w -> w) -> StateT Integer m a)
-> (SupplyT m (a, w -> w) -> StateT Integer m (a, w -> w))
-> SupplyT m (a, w -> w)
-> StateT Integer m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SupplyT m (a, w -> w) -> StateT Integer m (a, w -> w)
forall (m :: * -> *) a. SupplyT m a -> StateT Integer m a
unSupplyT

runSupplyT :: Monad m => SupplyT m a -> m a
runSupplyT :: SupplyT m a -> m a
runSupplyT = (StateT Integer m a -> Integer -> m a)
-> Integer -> StateT Integer m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Integer m a -> Integer -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Integer
0 (StateT Integer m a -> m a)
-> (SupplyT m a -> StateT Integer m a) -> SupplyT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SupplyT m a -> StateT Integer m a
forall (m :: * -> *) a. SupplyT m a -> StateT Integer m a
unSupplyT

runSupply :: Supply a -> a
runSupply :: Supply a -> a
runSupply = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (Supply a -> Identity a) -> Supply a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Supply a -> Identity a
forall (m :: * -> *) a. Monad m => SupplyT m a -> m a
runSupplyT



-- | Program location
type Loc = Integer

-- | Tick monad
newtype TickT m a = TickT { TickT m a -> StateT Integer m a
unTickT :: StateT Loc m a }
  deriving (a -> TickT m b -> TickT m a
(a -> b) -> TickT m a -> TickT m b
(forall a b. (a -> b) -> TickT m a -> TickT m b)
-> (forall a b. a -> TickT m b -> TickT m a) -> Functor (TickT m)
forall a b. a -> TickT m b -> TickT m a
forall a b. (a -> b) -> TickT m a -> TickT m b
forall (m :: * -> *) a b. Functor m => a -> TickT m b -> TickT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TickT m a -> TickT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TickT m b -> TickT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> TickT m b -> TickT m a
fmap :: (a -> b) -> TickT m a -> TickT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TickT m a -> TickT m b
Functor, Functor (TickT m)
a -> TickT m a
Functor (TickT m)
-> (forall a. a -> TickT m a)
-> (forall a b. TickT m (a -> b) -> TickT m a -> TickT m b)
-> (forall a b c.
    (a -> b -> c) -> TickT m a -> TickT m b -> TickT m c)
-> (forall a b. TickT m a -> TickT m b -> TickT m b)
-> (forall a b. TickT m a -> TickT m b -> TickT m a)
-> Applicative (TickT m)
TickT m a -> TickT m b -> TickT m b
TickT m a -> TickT m b -> TickT m a
TickT m (a -> b) -> TickT m a -> TickT m b
(a -> b -> c) -> TickT m a -> TickT m b -> TickT m c
forall a. a -> TickT m a
forall a b. TickT m a -> TickT m b -> TickT m a
forall a b. TickT m a -> TickT m b -> TickT m b
forall a b. TickT m (a -> b) -> TickT m a -> TickT m b
forall a b c. (a -> b -> c) -> TickT m a -> TickT m b -> TickT m c
forall (m :: * -> *). Monad m => Functor (TickT m)
forall (m :: * -> *) a. Monad m => a -> TickT m a
forall (m :: * -> *) a b.
Monad m =>
TickT m a -> TickT m b -> TickT m a
forall (m :: * -> *) a b.
Monad m =>
TickT m a -> TickT m b -> TickT m b
forall (m :: * -> *) a b.
Monad m =>
TickT m (a -> b) -> TickT m a -> TickT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TickT m a -> TickT m b -> TickT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: TickT m a -> TickT m b -> TickT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
TickT m a -> TickT m b -> TickT m a
*> :: TickT m a -> TickT m b -> TickT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
TickT m a -> TickT m b -> TickT m b
liftA2 :: (a -> b -> c) -> TickT m a -> TickT m b -> TickT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TickT m a -> TickT m b -> TickT m c
<*> :: TickT m (a -> b) -> TickT m a -> TickT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
TickT m (a -> b) -> TickT m a -> TickT m b
pure :: a -> TickT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> TickT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (TickT m)
Applicative, Applicative (TickT m)
a -> TickT m a
Applicative (TickT m)
-> (forall a b. TickT m a -> (a -> TickT m b) -> TickT m b)
-> (forall a b. TickT m a -> TickT m b -> TickT m b)
-> (forall a. a -> TickT m a)
-> Monad (TickT m)
TickT m a -> (a -> TickT m b) -> TickT m b
TickT m a -> TickT m b -> TickT m b
forall a. a -> TickT m a
forall a b. TickT m a -> TickT m b -> TickT m b
forall a b. TickT m a -> (a -> TickT m b) -> TickT m b
forall (m :: * -> *). Monad m => Applicative (TickT m)
forall (m :: * -> *) a. Monad m => a -> TickT m a
forall (m :: * -> *) a b.
Monad m =>
TickT m a -> TickT m b -> TickT m b
forall (m :: * -> *) a b.
Monad m =>
TickT m a -> (a -> TickT m b) -> TickT m 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
return :: a -> TickT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> TickT m a
>> :: TickT m a -> TickT m b -> TickT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
TickT m a -> TickT m b -> TickT m b
>>= :: TickT m a -> (a -> TickT m b) -> TickT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
TickT m a -> (a -> TickT m b) -> TickT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (TickT m)
Monad, Monad (TickT m)
Monad (TickT m)
-> (forall a. (a -> TickT m a) -> TickT m a) -> MonadFix (TickT m)
(a -> TickT m a) -> TickT m a
forall a. (a -> TickT m a) -> TickT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (TickT m)
forall (m :: * -> *) a. MonadFix m => (a -> TickT m a) -> TickT m a
mfix :: (a -> TickT m a) -> TickT m a
$cmfix :: forall (m :: * -> *) a. MonadFix m => (a -> TickT m a) -> TickT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (TickT m)
MonadFix, m a -> TickT m a
(forall (m :: * -> *) a. Monad m => m a -> TickT m a)
-> MonadTrans TickT
forall (m :: * -> *) a. Monad m => m a -> TickT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> TickT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> TickT m a
MonadTrans)

type Tick = TickT Identity

class Monad m => MonadTick m
  where
    tick :: m ()
    default tick :: (m ~ t n, MonadTrans t, MonadTick n) => m ()
    tick = n () -> t n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n ()
forall (m :: * -> *). MonadTick m => m ()
tick
    loc  :: m Loc
    default loc :: (m ~ t n, MonadTrans t, MonadTick n) => m Loc
    loc = n Integer -> t n Integer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Integer
forall (m :: * -> *). MonadTick m => m Integer
loc

instance Monad m => MonadTick (TickT m)
  where
    tick :: TickT m ()
tick = do Integer
l <- TickT m Integer
forall (m :: * -> *). MonadTick m => m Integer
loc; StateT Integer m () -> TickT m ()
forall (m :: * -> *) a. StateT Integer m a -> TickT m a
TickT (StateT Integer m () -> TickT m ())
-> StateT Integer m () -> TickT m ()
forall a b. (a -> b) -> a -> b
$ Integer -> StateT Integer m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Integer
lInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)
    loc :: TickT m Integer
loc  = StateT Integer m Integer -> TickT m Integer
forall (m :: * -> *) a. StateT Integer m a -> TickT m a
TickT StateT Integer m Integer
forall s (m :: * -> *). MonadState s m => m s
get

instance MonadTick m             => MonadTick (ReaderT  r m)
instance MonadTick m             => MonadTick (L.StateT s m)
instance MonadTick m             => MonadTick (StateT   s m)
instance (MonadTick m, Monoid w) => MonadTick (WriterT  w m)

instance MonadReader r m => MonadReader r (TickT m)
  where
    ask :: TickT m r
ask     = m r -> TickT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: (r -> r) -> TickT m a -> TickT m a
local r -> r
f = StateT Integer m a -> TickT m a
forall (m :: * -> *) a. StateT Integer m a -> TickT m a
TickT (StateT Integer m a -> TickT m a)
-> (TickT m a -> StateT Integer m a) -> TickT m a -> TickT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> StateT Integer m a -> StateT Integer m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (StateT Integer m a -> StateT Integer m a)
-> (TickT m a -> StateT Integer m a)
-> TickT m a
-> StateT Integer m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickT m a -> StateT Integer m a
forall (m :: * -> *) a. TickT m a -> StateT Integer m a
unTickT

instance MonadState s m => MonadState s (TickT m)
  where
    get :: TickT m s
get = m s -> TickT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> TickT m ()
put = m () -> TickT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TickT m ()) -> (s -> m ()) -> s -> TickT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance MonadWriter w m => MonadWriter w (TickT m)
  where
    tell :: w -> TickT m ()
tell   = StateT Integer m () -> TickT m ()
forall (m :: * -> *) a. StateT Integer m a -> TickT m a
TickT (StateT Integer m () -> TickT m ())
-> (w -> StateT Integer m ()) -> w -> TickT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> StateT Integer m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: TickT m a -> TickT m (a, w)
listen = StateT Integer m (a, w) -> TickT m (a, w)
forall (m :: * -> *) a. StateT Integer m a -> TickT m a
TickT (StateT Integer m (a, w) -> TickT m (a, w))
-> (TickT m a -> StateT Integer m (a, w))
-> TickT m a
-> TickT m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Integer m a -> StateT Integer m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (StateT Integer m a -> StateT Integer m (a, w))
-> (TickT m a -> StateT Integer m a)
-> TickT m a
-> StateT Integer m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickT m a -> StateT Integer m a
forall (m :: * -> *) a. TickT m a -> StateT Integer m a
unTickT
    pass :: TickT m (a, w -> w) -> TickT m a
pass   = StateT Integer m a -> TickT m a
forall (m :: * -> *) a. StateT Integer m a -> TickT m a
TickT (StateT Integer m a -> TickT m a)
-> (TickT m (a, w -> w) -> StateT Integer m a)
-> TickT m (a, w -> w)
-> TickT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Integer m (a, w -> w) -> StateT Integer m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass   (StateT Integer m (a, w -> w) -> StateT Integer m a)
-> (TickT m (a, w -> w) -> StateT Integer m (a, w -> w))
-> TickT m (a, w -> w)
-> StateT Integer m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickT m (a, w -> w) -> StateT Integer m (a, w -> w)
forall (m :: * -> *) a. TickT m a -> StateT Integer m a
unTickT

runTickT :: Monad m => TickT m a -> m a
runTickT :: TickT m a -> m a
runTickT = (StateT Integer m a -> Integer -> m a)
-> Integer -> StateT Integer m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Integer m a -> Integer -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Integer
0 (StateT Integer m a -> m a)
-> (TickT m a -> StateT Integer m a) -> TickT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickT m a -> StateT Integer m a
forall (m :: * -> *) a. TickT m a -> StateT Integer m a
unTickT

runTick :: Tick a -> a
runTick :: Tick a -> a
runTick = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (Tick a -> Identity a) -> Tick a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tick a -> Identity a
forall (m :: * -> *) a. Monad m => TickT m a -> m a
runTickT

-- | Create a fresh string identifier with the given prefix
freshStr :: MonadSupply m => String -> m String
freshStr :: String -> m String
freshStr String
prefix = (Integer -> String) -> m Integer -> m String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) m Integer
forall (m :: * -> *). MonadSupply m => m Integer
fresh