blucontrol 0.5.1.1 → 0.6.0.0

raw patch · 7 files changed

+65/−47 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• Main.hs +1/−1
• blucontrol.cabal +1/−1
• src/Blucontrol/Main.hs +8/−4
• src/Blucontrol/Main/Control.hs +41/−37
• src/Blucontrol/Monad/Control/Concat.hs +6/−2
• src/Blucontrol/Monad/Control/Count.hs +2/−2

@@ -1,5 +1,11 @@ # Revision history for blucontrol +## 0.6.0.0 *24 Jun 2021*++* `runControl` is now a regular monad runner, that also returns the monadic state.+* `blucontrol` now returns the monadic state.+* Changes to the control flow in `Blucontrol.Main.Control` improve how monadic state is handled.+ ## 0.5.1.1 *21 Jun 2021*  * Allow building against new versions of X11.

@@ -11,7 +11,7 @@ import Blucontrol.Value.RGB.Temperature  main :: IO ()-main = blucontrol configControl+main = print =<< blucontrol configControl   where configControl = ConfigControl { runControl = runControlPrintT !> runControlCountT def !> runControlWaitT def                                       , runGamma = runGammaLinearT @Temperature rgbMap                                       , runRecolor = runRecolorXTIO def

@@ -1,5 +1,5 @@ name:                blucontrol-version:             0.5.1.1+version:             0.6.0.0 synopsis:            Configurable blue light filter description:         This application is a blue light filter, with the main focus on                      configurability.

@@ -25,11 +25,15 @@  blucontrol :: BlucontrolConstraints m g r            => ConfigControl m g r-           -> IO ()-blucontrol c = do launch-                  runControl c $ loopRecolor (runGamma c) (runRecolor c) convertValue+           -> IO (StM m (StM g (StM r ())))+blucontrol ConfigControl { runControl, runGamma, runRecolor } = do+  launch+  runControl $ liftBaseWith $ \ runC ->+    runGamma $ liftBaseWith $ \ runG ->+      runRecolor $ liftBaseWith $ \ runR ->+        loopRecolor runC runG runR convertValue -data ConfigControl m g r = ConfigControl { runControl :: forall a. m a -> IO a+data ConfigControl m g r = ConfigControl { runControl :: forall a. m a -> IO (StM m a)                                          , runGamma   :: forall a. g a -> IO (StM g a)                                          , runRecolor :: forall a. r a -> IO (StM r a)                                          }

@@ -2,51 +2,55 @@   loopRecolor ) where +import Control.Monad import Control.Monad.Base import Control.Monad.Trans.Control-import Control.Monad.Reader-import Control.Monad.State.Strict+import Unsafe.Coerce  import Blucontrol.Monad.Control import Blucontrol.Monad.Gamma import Blucontrol.Monad.Recolor  -- | Run the loop, using `gamma`, `recolor` and `doInbetween`.--- The arguments are the actual monad runners.-loopRecolor :: (ControlConstraint m (StM g (StM r ())), MonadBaseControl IO g, MonadBaseControl IO r, MonadControl m, MonadGamma g, MonadRecolor r)-            => (forall a. g a -> IO (StM g a))-            -> (forall a. r a -> IO (StM r a))+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)-            -> m ()-loopRecolor runG runR coerceValue = void $-  liftBaseWith $ \ runCIO ->-    runR $ liftBaseWith $ \ runRIO ->-      runG $ liftBaseWith $ \ runGIO -> do-        firstResult <- doRecolorGamma runGIO runRIO coerceValue-        evalStateT (doLoopRecolor runCIO runGIO runRIO coerceValue) firstResult+            -> IO ()+loopRecolor runC runG runR coerceValue = do --- | Use `gamma` and give the result to `recolor`.--- The arguments are runners from `liftBaseWith`.-doRecolorGamma :: (MonadBaseControl IO g, MonadBaseControl IO r, MonadGamma g, MonadRecolor r)-               => (forall a. g a -> IO (StM g a))-               -> (forall a. r a -> IO (StM r a))-               -> (GammaValue g -> RecolorValue r)-               -> IO (StM g (StM r ()))-doRecolorGamma runGIO runRIO coerceValue = runGIO $ do-  value <- coerceValue <$> gamma-  liftBase $ runRIO $ recolor value+      -- Use `gamma` and give the result to `recolor`.+      -- Then use the result of `recolor` and give it to `doInbetween` including the monadic state.+      -- The argument is an initial monadic state.+  let doRecolorGamma x =+        runC $ do+          x1 <- restoreM x+          x4 <- liftBase $ do+            runG $ do+              x2 <- restoreM x1+              value <- coerceValue <$> gamma+              liftBase $ runR $ do+                x3 <- restoreM x2+                recolor value+                pure x3+          let currentRecolorValue =+                runG $ do+                  -- TODO: `unsafeCoerce` is necessary because of GHC limitations with type families.+                  -- `unsafeCoerce` will act like `id`.+                  x5 <- restoreM $ unsafeCoerce x4+                  liftBase $ runR $ void $ restoreM x5+          currentRecolorValue' <- liftBase currentRecolorValue+          doInbetween currentRecolorValue'+          pure x4 --- | A single iteration of `loopRecolor`.--- The arguments are runners from `liftBaseWith`.-doLoopRecolor :: (ControlConstraint m (StM g (StM r ())), MonadBaseControl IO g, MonadBaseControl IO r, MonadControl m, MonadGamma g, MonadRecolor r)-              => (forall a. m a -> IO (StM m a))-              -> (forall a. g a -> IO (StM g a))-              -> (forall a. r a -> IO (StM r a))-              -> (GammaValue g -> RecolorValue r)-              -> StateT (StM g (StM r ())) IO ()-doLoopRecolor runCIO runGIO runRIO coerceValue = do-  lastResult <- get-  void $ liftBase $ runCIO $ doInbetween lastResult-  nextResult <- liftBase $ doRecolorGamma runGIO runRIO coerceValue-  put nextResult-  doLoopRecolor runCIO runGIO runRIO coerceValue+      -- Run `doLoopRecolor` in a recursive loop while passing the monadic state explicitly.+      doLoopRecolor x = doLoopRecolor =<< liftBase (doRecolorGamma x)++  -- Initialize the monadic state.+  initStM <- runC $ liftBase $ runG $ liftBase $ runR $ pure undefined++  -- Start an infinite loop.+  -- TODO: `unsafeCoerce` is necessary because of GHC limitations with type families.+  -- `unsafeCoerce` will act like `id`.+  doLoopRecolor $ unsafeCoerce initStM

@@ -32,9 +32,13 @@   doInbetween a = do ControlConcatT . lift $ doInbetween a                      ControlConcatT $ doInbetween a -runControlConcatT :: (t1 m a -> m a) -> (t2 (t1 m) a -> t1 m a) -> ControlConcatT t1 t2 m a -> m a+runControlConcatT :: (forall a. t1 m a -> m (StT t1 a))+                  -> (forall a. t2 (t1 m) a -> t1 m (StT t2 a))+                  -> (forall a. ControlConcatT t1 t2 m a -> m (StT t1 (StT t2 a))) runControlConcatT runT1 runT2 = runT1 . runT2 . unControlConcatT  infixr 5 !>-(!>) :: (t1 m a -> m a) -> (t2 (t1 m) a -> t1 m a) -> (ControlConcatT t1 t2 m a -> m a)+(!>) :: (forall a. t1 m a -> m (StT t1 a))+     -> (forall a. t2 (t1 m) a -> t1 m (StT t2 a))+     -> (forall a. ControlConcatT t1 t2 m a -> m (StT t1 (StT t2 a))) (!>) = runControlConcatT

@@ -34,8 +34,8 @@                         then error $ "failed after " <> show limit <> " consecutive tries"                         else return () -runControlCountT :: Monad m => ConfigCount -> ControlCountT m a -> m a-runControlCountT !conf tma = runReaderT (evalStateT (unControlCountT tma) 0) conf+runControlCountT :: Monad m => ConfigCount -> ControlCountT m a -> m (a, Natural)+runControlCountT !conf tma = runReaderT (runStateT (unControlCountT tma) 0) conf  newtype ConfigCount = ConfigCount { maxCount :: Natural                                   }