{-# LANGUAGE UndecidableInstances #-} module Blucontrol.Main.Control ( ControlT , runControlT , loopRecolor , ConfigControl (..) ) where import Control.Monad.Base import Control.Monad.Trans.Control import Control.Monad.Reader import Control.Monad.State.Strict import Blucontrol.Control import Blucontrol.Gamma import Blucontrol.Recolor import Blucontrol.RGB newtype ControlT c m a = ControlT { ControlT c m a -> m a unControlT :: m a } deriving (Functor (ControlT c m) a -> ControlT c m a Functor (ControlT c m) -> (forall a. a -> ControlT c m a) -> (forall a b. ControlT c m (a -> b) -> ControlT c m a -> ControlT c m b) -> (forall a b c. (a -> b -> c) -> ControlT c m a -> ControlT c m b -> ControlT c m c) -> (forall a b. ControlT c m a -> ControlT c m b -> ControlT c m b) -> (forall a b. ControlT c m a -> ControlT c m b -> ControlT c m a) -> Applicative (ControlT c m) ControlT c m a -> ControlT c m b -> ControlT c m b ControlT c m a -> ControlT c m b -> ControlT c m a ControlT c m (a -> b) -> ControlT c m a -> ControlT c m b (a -> b -> c) -> ControlT c m a -> ControlT c m b -> ControlT c m c forall a. a -> ControlT c m a forall a b. ControlT c m a -> ControlT c m b -> ControlT c m a forall a b. ControlT c m a -> ControlT c m b -> ControlT c m b forall a b. ControlT c m (a -> b) -> ControlT c m a -> ControlT c m b forall a b c. (a -> b -> c) -> ControlT c m a -> ControlT c m b -> ControlT c m c forall c (m :: * -> *). Applicative m => Functor (ControlT c m) forall c (m :: * -> *) a. Applicative m => a -> ControlT c m a forall c (m :: * -> *) a b. Applicative m => ControlT c m a -> ControlT c m b -> ControlT c m a forall c (m :: * -> *) a b. Applicative m => ControlT c m a -> ControlT c m b -> ControlT c m b forall c (m :: * -> *) a b. Applicative m => ControlT c m (a -> b) -> ControlT c m a -> ControlT c m b forall c (m :: * -> *) a b c. Applicative m => (a -> b -> c) -> ControlT c m a -> ControlT c m b -> ControlT c 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 <* :: ControlT c m a -> ControlT c m b -> ControlT c m a $c<* :: forall c (m :: * -> *) a b. Applicative m => ControlT c m a -> ControlT c m b -> ControlT c m a *> :: ControlT c m a -> ControlT c m b -> ControlT c m b $c*> :: forall c (m :: * -> *) a b. Applicative m => ControlT c m a -> ControlT c m b -> ControlT c m b liftA2 :: (a -> b -> c) -> ControlT c m a -> ControlT c m b -> ControlT c m c $cliftA2 :: forall c (m :: * -> *) a b c. Applicative m => (a -> b -> c) -> ControlT c m a -> ControlT c m b -> ControlT c m c <*> :: ControlT c m (a -> b) -> ControlT c m a -> ControlT c m b $c<*> :: forall c (m :: * -> *) a b. Applicative m => ControlT c m (a -> b) -> ControlT c m a -> ControlT c m b pure :: a -> ControlT c m a $cpure :: forall c (m :: * -> *) a. Applicative m => a -> ControlT c m a $cp1Applicative :: forall c (m :: * -> *). Applicative m => Functor (ControlT c m) Applicative, a -> ControlT c m b -> ControlT c m a (a -> b) -> ControlT c m a -> ControlT c m b (forall a b. (a -> b) -> ControlT c m a -> ControlT c m b) -> (forall a b. a -> ControlT c m b -> ControlT c m a) -> Functor (ControlT c m) forall a b. a -> ControlT c m b -> ControlT c m a forall a b. (a -> b) -> ControlT c m a -> ControlT c m b forall c (m :: * -> *) a b. Functor m => a -> ControlT c m b -> ControlT c m a forall c (m :: * -> *) a b. Functor m => (a -> b) -> ControlT c m a -> ControlT c m b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> ControlT c m b -> ControlT c m a $c<$ :: forall c (m :: * -> *) a b. Functor m => a -> ControlT c m b -> ControlT c m a fmap :: (a -> b) -> ControlT c m a -> ControlT c m b $cfmap :: forall c (m :: * -> *) a b. Functor m => (a -> b) -> ControlT c m a -> ControlT c m b Functor, Applicative (ControlT c m) a -> ControlT c m a Applicative (ControlT c m) -> (forall a b. ControlT c m a -> (a -> ControlT c m b) -> ControlT c m b) -> (forall a b. ControlT c m a -> ControlT c m b -> ControlT c m b) -> (forall a. a -> ControlT c m a) -> Monad (ControlT c m) ControlT c m a -> (a -> ControlT c m b) -> ControlT c m b ControlT c m a -> ControlT c m b -> ControlT c m b forall a. a -> ControlT c m a forall a b. ControlT c m a -> ControlT c m b -> ControlT c m b forall a b. ControlT c m a -> (a -> ControlT c m b) -> ControlT c m b forall c (m :: * -> *). Monad m => Applicative (ControlT c m) forall c (m :: * -> *) a. Monad m => a -> ControlT c m a forall c (m :: * -> *) a b. Monad m => ControlT c m a -> ControlT c m b -> ControlT c m b forall c (m :: * -> *) a b. Monad m => ControlT c m a -> (a -> ControlT c m b) -> ControlT c 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 -> ControlT c m a $creturn :: forall c (m :: * -> *) a. Monad m => a -> ControlT c m a >> :: ControlT c m a -> ControlT c m b -> ControlT c m b $c>> :: forall c (m :: * -> *) a b. Monad m => ControlT c m a -> ControlT c m b -> ControlT c m b >>= :: ControlT c m a -> (a -> ControlT c m b) -> ControlT c m b $c>>= :: forall c (m :: * -> *) a b. Monad m => ControlT c m a -> (a -> ControlT c m b) -> ControlT c m b $cp1Monad :: forall c (m :: * -> *). Monad m => Applicative (ControlT c m) Monad, MonadBase b, MonadBaseControl b) instance MonadTrans (ControlT c) where lift :: m a -> ControlT c m a lift = m a -> ControlT c m a forall c (m :: * -> *) a. m a -> ControlT c m a ControlT instance MonadTransControl (ControlT c) where type StT (ControlT c) a = a liftWith :: (Run (ControlT c) -> m a) -> ControlT c m a liftWith Run (ControlT c) -> m a inner = m a -> ControlT c m a forall c (m :: * -> *) a. m a -> ControlT c m a ControlT (m a -> ControlT c m a) -> m a -> ControlT c m a forall a b. (a -> b) -> a -> b $ Run (ControlT c) -> m a inner forall c (m :: * -> *) a. ControlT c m a -> m a Run (ControlT c) unControlT restoreT :: m (StT (ControlT c) a) -> ControlT c m a restoreT = m (StT (ControlT c) a) -> ControlT c m a forall c (m :: * -> *) a. m a -> ControlT c m a ControlT runControlT :: Monad m => ControlT c m a -> m a runControlT :: ControlT c m a -> m a runControlT = ControlT c m a -> m a forall c (m :: * -> *) a. ControlT c m a -> m a unControlT loopRecolor :: (ControlConstraint m (StM g (StM r ())), MonadBaseControl IO g, MonadBaseControl IO r, MonadControl m, MonadGamma c g, MonadRecolor r) => (forall a. g a -> IO (StM g a)) -> (forall a. r a -> g (StM r a)) -> ControlT c m () loopRecolor :: (forall a. g a -> IO (StM g a)) -> (forall a. r a -> g (StM r a)) -> ControlT c m () loopRecolor forall a. g a -> IO (StM g a) runG forall a. r a -> g (StM r a) runR = do StM g (StM r ()) a <- IO (StM g (StM r ())) -> ControlT c m (StM g (StM r ())) forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α liftBase IO (StM g (StM r ())) doRecolorGamma m () -> ControlT c m () forall c (m :: * -> *) a. m a -> ControlT c m a ControlT (m () -> ControlT c m ()) -> m () -> ControlT c m () forall a b. (a -> b) -> a -> b $ StateT (StM g (StM r ())) m () -> StM g (StM r ()) -> m () forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a evalStateT StateT (StM g (StM r ())) m () doLoopRecolor StM g (StM r ()) a where doRecolorGamma :: IO (StM g (StM r ())) doRecolorGamma = g (StM r ()) -> IO (StM g (StM r ())) forall a. g a -> IO (StM g a) 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 Trichromaticity rgb <- c -> Trichromaticity forall c. RGB c => c -> Trichromaticity toRGB (c -> Trichromaticity) -> g c -> g Trichromaticity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> g c forall c (m :: * -> *). MonadGamma c m => m c gamma r () -> g (StM r ()) forall a. r a -> g (StM r a) runR (r () -> g (StM r ())) -> r () -> g (StM r ()) forall a b. (a -> b) -> a -> b $ Trichromaticity -> r () forall (m :: * -> *). MonadRecolor m => Trichromaticity -> m () recolor Trichromaticity rgb doLoopRecolor :: StateT (StM g (StM r ())) m () doLoopRecolor = do StM g (StM r ()) a' <- StateT (StM g (StM r ())) m (StM g (StM r ())) forall s (m :: * -> *). MonadState s m => m s get m () -> StateT (StM g (StM r ())) m () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m () -> StateT (StM g (StM r ())) m ()) -> m () -> StateT (StM g (StM r ())) m () forall a b. (a -> b) -> a -> b $ StM g (StM r ()) -> m () forall (m :: * -> *) a. (MonadControl m, ControlConstraint m a) => a -> m () doInbetween StM g (StM r ()) a' StM g (StM r ()) a'' <- IO (StM g (StM r ())) -> StateT (StM g (StM r ())) m (StM g (StM r ())) forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α liftBase IO (StM g (StM r ())) doRecolorGamma StM g (StM r ()) -> StateT (StM g (StM r ())) m () forall s (m :: * -> *). MonadState s m => s -> m () put StM g (StM r ()) a'' StateT (StM g (StM r ())) m () doLoopRecolor data ConfigControl m g r = ConfigControl { ConfigControl m g r -> forall a. m a -> IO a runControl :: forall a. m a -> IO a , ConfigControl m g r -> forall a. g a -> IO (StM g a) runGamma :: forall a. g a -> IO (StM g a) , ConfigControl m g r -> forall a. r a -> g (StM r a) runRecolor :: forall a. r a -> g (StM r a) }