module Blucontrol.Main.Control (
loopRecolor
) where
import Control.Monad
import Control.Monad.Base
import Control.Monad.Trans.Control
import Unsafe.Coerce
import Blucontrol.Monad.Control
import Blucontrol.Monad.Gamma
import Blucontrol.Monad.Recolor
loopRecolor :: (MonadBaseControl IO m, MonadBaseControl IO g, MonadBaseControl IO r, MonadControl m, MonadGamma g, MonadRecolor r, ControlConstraint m (StM g (StM r ())))
=> RunInBase m IO
-> RunInBase g IO
-> RunInBase r IO
-> (GammaValue g -> RecolorValue r)
-> IO ()
loopRecolor :: RunInBase m IO
-> RunInBase g IO
-> RunInBase r IO
-> (GammaValue g -> RecolorValue r)
-> IO ()
loopRecolor RunInBase m IO
runC RunInBase g IO
runG RunInBase r IO
runR GammaValue g -> RecolorValue r
coerceValue = do
let doRecolorGamma :: StM m (StM g (StM r Any)) -> IO (StM m (StM g (StM r Any)))
doRecolorGamma StM m (StM g (StM r Any))
x =
m (StM g (StM r Any)) -> IO (StM m (StM g (StM r Any)))
RunInBase m IO
runC (m (StM g (StM r Any)) -> IO (StM m (StM g (StM r Any))))
-> m (StM g (StM r Any)) -> IO (StM m (StM g (StM r Any)))
forall a b. (a -> b) -> a -> b
$ do
StM g (StM r Any)
x1 <- StM m (StM g (StM r Any)) -> m (StM g (StM r Any))
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m (StM g (StM r Any))
x
StM g (StM r Any)
x4 <- IO (StM g (StM r Any)) -> m (StM g (StM r Any))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (StM g (StM r Any)) -> m (StM g (StM r Any)))
-> IO (StM g (StM r Any)) -> m (StM g (StM r Any))
forall a b. (a -> b) -> a -> b
$ do
g (StM r Any) -> IO (StM g (StM r Any))
RunInBase g IO
runG (g (StM r Any) -> IO (StM g (StM r Any)))
-> g (StM r Any) -> IO (StM g (StM r Any))
forall a b. (a -> b) -> a -> b
$ do
StM r Any
x2 <- StM g (StM r Any) -> g (StM r Any)
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM g (StM r Any)
x1
RecolorValue r
value <- GammaValue g -> RecolorValue r
coerceValue (GammaValue g -> RecolorValue r)
-> g (GammaValue g) -> g (RecolorValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (GammaValue g)
forall (m :: * -> *). MonadGamma m => m (GammaValue m)
gamma
IO (StM r Any) -> g (StM r Any)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (StM r Any) -> g (StM r Any))
-> IO (StM r Any) -> g (StM r Any)
forall a b. (a -> b) -> a -> b
$ r Any -> IO (StM r Any)
RunInBase r IO
runR (r Any -> IO (StM r Any)) -> r Any -> IO (StM r Any)
forall a b. (a -> b) -> a -> b
$ do
Any
x3 <- StM r Any -> r Any
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM r Any
x2
RecolorValue r -> r ()
forall (m :: * -> *). MonadRecolor m => RecolorValue m -> m ()
recolor RecolorValue r
value
Any -> r Any
forall (f :: * -> *) a. Applicative f => a -> f a
pure Any
x3
let currentRecolorValue :: IO (StM g (StM r ()))
currentRecolorValue =
g (StM r ()) -> IO (StM g (StM r ()))
RunInBase g IO
runG (g (StM r ()) -> IO (StM g (StM r ())))
-> g (StM r ()) -> IO (StM g (StM r ()))
forall a b. (a -> b) -> a -> b
$ do
StM r Any
x5 <- StM g (StM r Any) -> g (StM r Any)
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM (StM g (StM r Any) -> g (StM r Any))
-> StM g (StM r Any) -> g (StM r Any)
forall a b. (a -> b) -> a -> b
$ StM g (StM r Any) -> StM g (StM r Any)
forall a b. a -> b
unsafeCoerce StM g (StM r Any)
x4
IO (StM r ()) -> g (StM r ())
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (StM r ()) -> g (StM r ())) -> IO (StM r ()) -> g (StM r ())
forall a b. (a -> b) -> a -> b
$ r () -> IO (StM r ())
RunInBase r IO
runR (r () -> IO (StM r ())) -> r () -> IO (StM r ())
forall a b. (a -> b) -> a -> b
$ r Any -> r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (r Any -> r ()) -> r Any -> r ()
forall a b. (a -> b) -> a -> b
$ StM r Any -> r Any
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM r Any
x5
StM g (StM r ())
currentRecolorValue' <- IO (StM g (StM r ())) -> m (StM g (StM r ()))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO (StM g (StM r ()))
currentRecolorValue
StM g (StM r ()) -> m ()
forall (m :: * -> *) a.
(MonadControl m, ControlConstraint m a) =>
a -> m ()
doInbetween StM g (StM r ())
currentRecolorValue'
StM g (StM r Any) -> m (StM g (StM r Any))
forall (f :: * -> *) a. Applicative f => a -> f a
pure StM g (StM r Any)
x4
doLoopRecolor :: StM m (StM g (StM r Any)) -> IO ()
doLoopRecolor StM m (StM g (StM r Any))
x = StM m (StM g (StM r Any)) -> IO ()
doLoopRecolor (StM m (StM g (StM r Any)) -> IO ())
-> IO (StM m (StM g (StM r Any))) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (StM m (StM g (StM r Any))) -> IO (StM m (StM g (StM r Any)))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (StM m (StM g (StM r Any)) -> IO (StM m (StM g (StM r Any)))
doRecolorGamma StM m (StM g (StM r Any))
x)
StM m (StM g (StM r Any))
initStM <- m (StM g (StM r Any)) -> IO (StM m (StM g (StM r Any)))
RunInBase m IO
runC (m (StM g (StM r Any)) -> IO (StM m (StM g (StM r Any))))
-> m (StM g (StM r Any)) -> IO (StM m (StM g (StM r Any)))
forall a b. (a -> b) -> a -> b
$ IO (StM g (StM r Any)) -> m (StM g (StM r Any))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (StM g (StM r Any)) -> m (StM g (StM r Any)))
-> IO (StM g (StM r Any)) -> m (StM g (StM r Any))
forall a b. (a -> b) -> a -> b
$ g (StM r Any) -> IO (StM g (StM r Any))
RunInBase g IO
runG (g (StM r Any) -> IO (StM g (StM r Any)))
-> g (StM r Any) -> IO (StM g (StM r Any))
forall a b. (a -> b) -> a -> b
$ IO (StM r Any) -> g (StM r Any)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (StM r Any) -> g (StM r Any))
-> IO (StM r Any) -> g (StM r Any)
forall a b. (a -> b) -> a -> b
$ r Any -> IO (StM r Any)
RunInBase r IO
runR (r Any -> IO (StM r Any)) -> r Any -> IO (StM r Any)
forall a b. (a -> b) -> a -> b
$ Any -> r Any
forall (f :: * -> *) a. Applicative f => a -> f a
pure Any
forall a. HasCallStack => a
undefined
StM m (StM g (StM r Any)) -> IO ()
doLoopRecolor (StM m (StM g (StM r Any)) -> IO ())
-> StM m (StM g (StM r Any)) -> IO ()
forall a b. (a -> b) -> a -> b
$ StM m (StM g (StM r Any)) -> StM m (StM g (StM r Any))
forall a b. a -> b
unsafeCoerce StM m (StM g (StM r Any))
initStM