{-# LANGUAGE QuantifiedConstraints, UndecidableInstances #-}

module Blucontrol.Control.Concat (
  ControlConcatT
, runControlConcatT
, (!>)
) where

import Control.Monad.Base
import Control.Monad.Trans
import Control.Monad.Trans.Control

import Blucontrol.Control

newtype ControlConcatT (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *) (m :: * -> *) a = ControlConcatT { ControlConcatT t1 t2 m a -> t2 (t1 m) a
unControlConcatT :: t2 (t1 m) a }
  deriving (Functor (ControlConcatT t1 t2 m)
a -> ControlConcatT t1 t2 m a
Functor (ControlConcatT t1 t2 m)
-> (forall a. a -> ControlConcatT t1 t2 m a)
-> (forall a b.
    ControlConcatT t1 t2 m (a -> b)
    -> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b)
-> (forall a b c.
    (a -> b -> c)
    -> ControlConcatT t1 t2 m a
    -> ControlConcatT t1 t2 m b
    -> ControlConcatT t1 t2 m c)
-> (forall a b.
    ControlConcatT t1 t2 m a
    -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b)
-> (forall a b.
    ControlConcatT t1 t2 m a
    -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a)
-> Applicative (ControlConcatT t1 t2 m)
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
ControlConcatT t1 t2 m (a -> b)
-> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
(a -> b -> c)
-> ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b
-> ControlConcatT t1 t2 m c
forall a. a -> ControlConcatT t1 t2 m a
forall a b.
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
forall a b.
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
forall a b.
ControlConcatT t1 t2 m (a -> b)
-> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
forall a b c.
(a -> b -> c)
-> ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b
-> ControlConcatT t1 t2 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
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *).
Applicative (t2 (t1 m)) =>
Functor (ControlConcatT t1 t2 m)
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Applicative (t2 (t1 m)) =>
a -> ControlConcatT t1 t2 m a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t2 (t1 m)) =>
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t2 (t1 m)) =>
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t2 (t1 m)) =>
ControlConcatT t1 t2 m (a -> b)
-> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b c.
Applicative (t2 (t1 m)) =>
(a -> b -> c)
-> ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b
-> ControlConcatT t1 t2 m c
<* :: ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
$c<* :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t2 (t1 m)) =>
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
*> :: ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
$c*> :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t2 (t1 m)) =>
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
liftA2 :: (a -> b -> c)
-> ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b
-> ControlConcatT t1 t2 m c
$cliftA2 :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b c.
Applicative (t2 (t1 m)) =>
(a -> b -> c)
-> ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b
-> ControlConcatT t1 t2 m c
<*> :: ControlConcatT t1 t2 m (a -> b)
-> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
$c<*> :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t2 (t1 m)) =>
ControlConcatT t1 t2 m (a -> b)
-> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
pure :: a -> ControlConcatT t1 t2 m a
$cpure :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Applicative (t2 (t1 m)) =>
a -> ControlConcatT t1 t2 m a
$cp1Applicative :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *).
Applicative (t2 (t1 m)) =>
Functor (ControlConcatT t1 t2 m)
Applicative, a -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
(a -> b) -> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
(forall a b.
 (a -> b) -> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b)
-> (forall a b.
    a -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a)
-> Functor (ControlConcatT t1 t2 m)
forall a b.
a -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
forall a b.
(a -> b) -> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Functor (t2 (t1 m)) =>
a -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Functor (t2 (t1 m)) =>
(a -> b) -> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
<$ :: a -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
$c<$ :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Functor (t2 (t1 m)) =>
a -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m a
fmap :: (a -> b) -> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
$cfmap :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Functor (t2 (t1 m)) =>
(a -> b) -> ControlConcatT t1 t2 m a -> ControlConcatT t1 t2 m b
Functor, Applicative (ControlConcatT t1 t2 m)
a -> ControlConcatT t1 t2 m a
Applicative (ControlConcatT t1 t2 m)
-> (forall a b.
    ControlConcatT t1 t2 m a
    -> (a -> ControlConcatT t1 t2 m b) -> ControlConcatT t1 t2 m b)
-> (forall a b.
    ControlConcatT t1 t2 m a
    -> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b)
-> (forall a. a -> ControlConcatT t1 t2 m a)
-> Monad (ControlConcatT t1 t2 m)
ControlConcatT t1 t2 m a
-> (a -> ControlConcatT t1 t2 m b) -> ControlConcatT t1 t2 m b
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
forall a. a -> ControlConcatT t1 t2 m a
forall a b.
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
forall a b.
ControlConcatT t1 t2 m a
-> (a -> ControlConcatT t1 t2 m b) -> ControlConcatT t1 t2 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
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *).
Monad (t2 (t1 m)) =>
Applicative (ControlConcatT t1 t2 m)
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Monad (t2 (t1 m)) =>
a -> ControlConcatT t1 t2 m a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Monad (t2 (t1 m)) =>
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Monad (t2 (t1 m)) =>
ControlConcatT t1 t2 m a
-> (a -> ControlConcatT t1 t2 m b) -> ControlConcatT t1 t2 m b
return :: a -> ControlConcatT t1 t2 m a
$creturn :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Monad (t2 (t1 m)) =>
a -> ControlConcatT t1 t2 m a
>> :: ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
$c>> :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Monad (t2 (t1 m)) =>
ControlConcatT t1 t2 m a
-> ControlConcatT t1 t2 m b -> ControlConcatT t1 t2 m b
>>= :: ControlConcatT t1 t2 m a
-> (a -> ControlConcatT t1 t2 m b) -> ControlConcatT t1 t2 m b
$c>>= :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Monad (t2 (t1 m)) =>
ControlConcatT t1 t2 m a
-> (a -> ControlConcatT t1 t2 m b) -> ControlConcatT t1 t2 m b
$cp1Monad :: forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *).
Monad (t2 (t1 m)) =>
Applicative (ControlConcatT t1 t2 m)
Monad, MonadBase b, MonadBaseControl b)

instance (forall m. Monad m => Monad (t1 m), MonadTrans t1, MonadTrans t2) => MonadTrans (ControlConcatT t1 t2) where
  lift :: m a -> ControlConcatT t1 t2 m a
lift = t2 (t1 m) a -> ControlConcatT t1 t2 m a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
t2 (t1 m) a -> ControlConcatT t1 t2 m a
ControlConcatT (t2 (t1 m) a -> ControlConcatT t1 t2 m a)
-> (m a -> t2 (t1 m) a) -> m a -> ControlConcatT t1 t2 m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t1 m a -> t2 (t1 m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t1 m a -> t2 (t1 m) a) -> (m a -> t1 m a) -> m a -> t2 (t1 m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> t1 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (forall m. Monad m => Monad (t1 m), MonadTransControl t1, MonadTransControl t2) => MonadTransControl (ControlConcatT t1 t2) where
  type StT (ControlConcatT t1 t2) a = StT t1 (StT t2 a)
  liftWith :: (Run (ControlConcatT t1 t2) -> m a) -> ControlConcatT t1 t2 m a
liftWith Run (ControlConcatT t1 t2) -> m a
inner = t2 (t1 m) a -> ControlConcatT t1 t2 m a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
t2 (t1 m) a -> ControlConcatT t1 t2 m a
ControlConcatT (t2 (t1 m) a -> ControlConcatT t1 t2 m a)
-> t2 (t1 m) a -> ControlConcatT t1 t2 m a
forall a b. (a -> b) -> a -> b
$
    (Run t2 -> t1 m a) -> t2 (t1 m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run t2 -> t1 m a) -> t2 (t1 m) a)
-> (Run t2 -> t1 m a) -> t2 (t1 m) a
forall a b. (a -> b) -> a -> b
$ \ Run t2
runT2 ->
      (Run t1 -> m a) -> t1 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run t1 -> m a) -> t1 m a) -> (Run t1 -> m a) -> t1 m a
forall a b. (a -> b) -> a -> b
$ \ Run t1
runT1 ->
        Run (ControlConcatT t1 t2) -> m a
inner (Run (ControlConcatT t1 t2) -> m a)
-> Run (ControlConcatT t1 t2) -> m a
forall a b. (a -> b) -> a -> b
$ t1 n (StT t2 b) -> n (StT t1 (StT t2 b))
Run t1
runT1 (t1 n (StT t2 b) -> n (StT t1 (StT t2 b)))
-> (ControlConcatT t1 t2 n b -> t1 n (StT t2 b))
-> ControlConcatT t1 t2 n b
-> n (StT t1 (StT t2 b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 (t1 n) b -> t1 n (StT t2 b)
Run t2
runT2 (t2 (t1 n) b -> t1 n (StT t2 b))
-> (ControlConcatT t1 t2 n b -> t2 (t1 n) b)
-> ControlConcatT t1 t2 n b
-> t1 n (StT t2 b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlConcatT t1 t2 n b -> t2 (t1 n) b
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
ControlConcatT t1 t2 m a -> t2 (t1 m) a
unControlConcatT
  restoreT :: m (StT (ControlConcatT t1 t2) a) -> ControlConcatT t1 t2 m a
restoreT = t2 (t1 m) a -> ControlConcatT t1 t2 m a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
t2 (t1 m) a -> ControlConcatT t1 t2 m a
ControlConcatT (t2 (t1 m) a -> ControlConcatT t1 t2 m a)
-> (m (StT t1 (StT t2 a)) -> t2 (t1 m) a)
-> m (StT t1 (StT t2 a))
-> ControlConcatT t1 t2 m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t1 m (StT t2 a) -> t2 (t1 m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (t1 m (StT t2 a) -> t2 (t1 m) a)
-> (m (StT t1 (StT t2 a)) -> t1 m (StT t2 a))
-> m (StT t1 (StT t2 a))
-> t2 (t1 m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (StT t1 (StT t2 a)) -> t1 m (StT t2 a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

instance (MonadControl (t1 m), MonadControl (t2 (t1 m)), MonadTrans t2) => MonadControl (ControlConcatT t1 t2 m) where
  type ControlConstraint (ControlConcatT t1 t2 m) a = (ControlConstraint (t1 m) a, ControlConstraint (t2 (t1 m)) a)
  doInbetween :: a -> ControlConcatT t1 t2 m ()
doInbetween a
a = do t2 (t1 m) () -> ControlConcatT t1 t2 m ()
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
t2 (t1 m) a -> ControlConcatT t1 t2 m a
ControlConcatT (t2 (t1 m) () -> ControlConcatT t1 t2 m ())
-> (t1 m () -> t2 (t1 m) ())
-> t1 m ()
-> ControlConcatT t1 t2 m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t1 m () -> t2 (t1 m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t1 m () -> ControlConcatT t1 t2 m ())
-> t1 m () -> ControlConcatT t1 t2 m ()
forall a b. (a -> b) -> a -> b
$ a -> t1 m ()
forall (m :: * -> *) a.
(MonadControl m, ControlConstraint m a) =>
a -> m ()
doInbetween a
a
                     t2 (t1 m) () -> ControlConcatT t1 t2 m ()
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
t2 (t1 m) a -> ControlConcatT t1 t2 m a
ControlConcatT (t2 (t1 m) () -> ControlConcatT t1 t2 m ())
-> t2 (t1 m) () -> ControlConcatT t1 t2 m ()
forall a b. (a -> b) -> a -> b
$ a -> t2 (t1 m) ()
forall (m :: * -> *) a.
(MonadControl m, ControlConstraint m a) =>
a -> m ()
doInbetween a
a

runControlConcatT :: (t1 m a -> m a) -> (t2 (t1 m) a -> t1 m a) -> ControlConcatT t1 t2 m a -> m a
runControlConcatT :: (t1 m a -> m a)
-> (t2 (t1 m) a -> t1 m a) -> ControlConcatT t1 t2 m a -> m a
runControlConcatT t1 m a -> m a
runT1 t2 (t1 m) a -> t1 m a
runT2 = t1 m a -> m a
runT1 (t1 m a -> m a)
-> (ControlConcatT t1 t2 m a -> t1 m a)
-> ControlConcatT t1 t2 m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 (t1 m) a -> t1 m a
runT2 (t2 (t1 m) a -> t1 m a)
-> (ControlConcatT t1 t2 m a -> t2 (t1 m) a)
-> ControlConcatT t1 t2 m a
-> t1 m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlConcatT t1 t2 m a -> t2 (t1 m) a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
ControlConcatT t1 t2 m a -> t2 (t1 m) a
unControlConcatT

infixr 5 !>
(!>) :: (t1 m a -> m a) -> (t2 (t1 m) a -> t1 m a) -> (ControlConcatT t1 t2 m a -> m a)
!> :: (t1 m a -> m a)
-> (t2 (t1 m) a -> t1 m a) -> ControlConcatT t1 t2 m a -> m a
(!>) = (t1 m a -> m a)
-> (t2 (t1 m) a -> t1 m a) -> ControlConcatT t1 t2 m a -> m a
forall (t1 :: (* -> *) -> * -> *) (m :: * -> *) a
       (t2 :: (* -> *) -> * -> *).
(t1 m a -> m a)
-> (t2 (t1 m) a -> t1 m a) -> ControlConcatT t1 t2 m a -> m a
runControlConcatT