blucontrol 0.3.0.0 → 0.3.0.1

raw patch · 8 files changed

+33/−19 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• blucontrol.cabal +1/−1
• src/Blucontrol/Gamma.hs +3/−3
• src/Blucontrol/Gamma/Const.hs +2/−2
• src/Blucontrol/Gamma/Linear.hs +3/−3
• src/Blucontrol/Main.hs +1/−1
• src/Blucontrol/Main/Control.hs +9/−8
• src/Blucontrol/Recolor/X.hs +10/−1

@@ -1,5 +1,9 @@ # Revision history for blucontrol +## 0.3.0.1 *28 Apr 2021*++* Support GHC 9.0.1.+ ## 0.3.0.0 *18 Apr 2021*  * Add `RGB` class.

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

@@ -4,10 +4,10 @@  import Blucontrol.RGB -class Monad m => MonadGamma m where+class (Monad m, RGB c) => MonadGamma c m | m -> c where -  {- | Calculate a 'Trichromaticity'.+  {- | Calculate an 'RGB' value.      This is a monadic function, to allow the value to be dependent on side effects like time and      location.   -}-  gamma :: m Trichromaticity+  gamma :: m c

@@ -21,8 +21,8 @@   local f tma = liftWith $ \ run ->     local f $ run tma -instance (Monad m, RGB c) => MonadGamma (GammaConstT c m) where-  gamma = toRGB <$> GammaConstT ask+instance (Monad m, RGB c) => MonadGamma c (GammaConstT c m) where+  gamma = GammaConstT ask  runGammaConstT :: RGB c => c -> GammaConstT c m a -> m a runGammaConstT rgb tma = runReaderT (unGammaConstT tma) rgb

@@ -36,11 +36,11 @@   local f tma = liftWith $ \ run ->     local f $ run tma -instance MonadBase IO m => MonadGamma (GammaLinearT Trichromaticity m) where+instance MonadBase IO m => MonadGamma Trichromaticity (GammaLinearT Trichromaticity m) where   gamma = calculateRGB weightedAverageTrichromaticity . zonedTimeToLocalTime =<< liftBase getZonedTime -instance MonadBase IO m => MonadGamma (GammaLinearT Temperature m) where-  gamma = fmap toRGB $ calculateRGB weightedAverageTemperature . zonedTimeToLocalTime =<< liftBase getZonedTime+instance MonadBase IO m => MonadGamma Temperature (GammaLinearT Temperature m) where+  gamma = calculateRGB weightedAverageTemperature . zonedTimeToLocalTime =<< liftBase getZonedTime  nextTimeRGB :: M.Map TimeOfDay c -> LocalTime -> Maybe (LocalTime,c) nextTimeRGB m time = catchError (toLocalTimeToday <$> M.lookupGT (localTimeOfDay time) m) $

@@ -11,7 +11,7 @@ import Blucontrol.Gamma import Blucontrol.Recolor -blucontrol :: (ControlConstraint m (StM g (StM r ())), MonadControl m, MonadBaseControl IO g, MonadBaseControl IO r, MonadGamma g, MonadRecolor r)+blucontrol :: (ControlConstraint m (StM g (StM r ())), MonadControl m, MonadBaseControl IO g, MonadBaseControl IO r, MonadGamma c g, MonadRecolor r)            => ConfigControl m g r            -> IO () blucontrol c = do launch

@@ -15,32 +15,33 @@ import Blucontrol.Control import Blucontrol.Gamma import Blucontrol.Recolor+import Blucontrol.RGB -newtype ControlT m a = ControlT { unControlT :: m a }+newtype ControlT c m a = ControlT { unControlT :: m a }   deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b) -instance MonadTrans ControlT where+instance MonadTrans (ControlT c) where   lift = ControlT -instance MonadTransControl ControlT where-  type StT ControlT a = a+instance MonadTransControl (ControlT c) where+  type StT (ControlT c) a = a   liftWith inner = ControlT $ inner unControlT   restoreT = ControlT  runControlT :: Monad m-            => ControlT m a+            => ControlT c m a             -> m a runControlT = unControlT -loopRecolor :: (ControlConstraint m (StM g (StM r ())), MonadBaseControl IO g, MonadBaseControl IO r, MonadControl m, MonadGamma g, MonadRecolor r)+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 m ()+            -> ControlT c m () loopRecolor runG runR = do   a <- liftBase doRecolorGamma   ControlT $ evalStateT doLoopRecolor a   where doRecolorGamma = runG $ do-          rgb <- gamma+          rgb <- toRGB <$> gamma           runR $ recolor rgb         doLoopRecolor = do           a' <- get

@@ -31,9 +31,18 @@ instance MonadTrans RecolorXT where   lift = RecolorXT . lift . lift +-- TODO: ghc-9.0.1 can't unify 'Run RecolorXT' and 'RunDefault2 RecolorXT n n'', when using 'defaultLiftWith2'+-- current solution is the exact same on the value level, but uses 'Run RecolorXT' on the type level+defaultLiftWith2' :: Monad n+                  => (Run RecolorXT -> n a)+                  -> RecolorXT n a+defaultLiftWith2' f = RecolorXT $ liftWith $ \run -> liftWith $ \run' -> f $ run' . run . unRecolorXT+ instance MonadTransControl RecolorXT where   type StT RecolorXT a = StT (ReaderT Display) (StT (ExceptT XError) a)-  liftWith = defaultLiftWith2 RecolorXT unRecolorXT+  -- TODO: broken by ghc-9.0.1+  -- liftWith = defaultLiftWith2' RecolorXT unRecolorXT+  liftWith = defaultLiftWith2'   restoreT = defaultRestoreT2 RecolorXT  instance MonadBaseControl IO m => MonadRecolor (RecolorXT m) where