diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,11 @@
 # Revision history for blucontrol
 
+## 0.3.2.0 *04 Jun 2021*
+
+* New module `Blucontrol.RGB.Brightness`.
+* Introduce strictness to improve performance.
+* Allow `runGamma` to directly run in the `IO` monad instead of `g` with `MonadGamma c g`.
+
 ## 0.3.1.0 *30 May 2021*
 
 * New module `Blucontrol.Gamma.Modifier`.
diff --git a/blucontrol.cabal b/blucontrol.cabal
--- a/blucontrol.cabal
+++ b/blucontrol.cabal
@@ -1,5 +1,5 @@
 name:                blucontrol
-version:             0.3.1.0
+version:             0.3.2.0
 synopsis:            Configurable blue light filter
 description:         This application is a blue light filter, with the main focus on
                      configurability.
@@ -41,6 +41,7 @@
                        Blucontrol.Recolor.Print
                        Blucontrol.Recolor.X
                        Blucontrol.RGB
+                       Blucontrol.RGB.Brightness
                        Blucontrol.RGB.Temperature
   other-modules:       Blucontrol.Main.GHC.Internal
                        Blucontrol.Recolor.X.Internal
@@ -69,7 +70,8 @@
   c-sources:           include/XrandrGamma.c
                        include/XrandrGamma.h
   default-language:    Haskell2010
-  default-extensions:  ConstraintKinds
+  default-extensions:  BangPatterns
+                       ConstraintKinds
                        DataKinds
                        DeriveGeneric
                        FlexibleContexts
@@ -106,7 +108,8 @@
                      , QuickCheck   >= 2.13.2  && < 2.15
                      , time
   default-language:    Haskell2010
-  default-extensions:  ConstraintKinds
+  default-extensions:  BangPatterns
+                       ConstraintKinds
                        DataKinds
                        DeriveGeneric
                        FlexibleContexts
diff --git a/src/Blucontrol/Control/Count.hs b/src/Blucontrol/Control/Count.hs
--- a/src/Blucontrol/Control/Count.hs
+++ b/src/Blucontrol/Control/Count.hs
@@ -24,17 +24,11 @@
 instance MonadTrans ControlCountT where
   lift = ControlCountT . lift . lift
 
--- TODO: workaround for ghc-9.0.1
-defaultLiftWith2' :: (Monad m)
-                  => (Run ControlCountT -> m a)
-                  -> ControlCountT m a
-defaultLiftWith2' f = ControlCountT $ liftWith $ \run -> liftWith $ \run' -> f $ run' . run . unControlCountT
-
 instance MonadTransControl ControlCountT where
   type StT ControlCountT a = StT (ReaderT ConfigCount) (StT (StateT Natural) a)
   -- TODO: workaround for ghc-9.0.1
   --liftWith = defaultLiftWith2 ControlCountT unControlCountT
-  liftWith = defaultLiftWith2'
+  liftWith f = ControlCountT $ liftWith $ \run -> liftWith $ \run' -> f $ run' . run . unControlCountT
   restoreT = defaultRestoreT2 ControlCountT
 
 instance MonadBaseControl IO m => MonadControl (ControlCountT m) where
@@ -49,7 +43,7 @@
                         else return ()
 
 runControlCountT :: Monad m => ConfigCount -> ControlCountT m a -> m a
-runControlCountT conf tma = runReaderT (evalStateT (unControlCountT tma) 0) conf
+runControlCountT !conf tma = runReaderT (evalStateT (unControlCountT tma) 0) conf
 
 newtype ConfigCount = ConfigCount { maxCount :: Natural
                                   }
diff --git a/src/Blucontrol/Control/Wait.hs b/src/Blucontrol/Control/Wait.hs
--- a/src/Blucontrol/Control/Wait.hs
+++ b/src/Blucontrol/Control/Wait.hs
@@ -25,7 +25,7 @@
   doInbetween _ = liftBase . threadDelay . interval =<< ControlWaitT ask
 
 runControlWaitT :: ConfigWait -> ControlWaitT m a -> m a
-runControlWaitT conf tma = runReaderT (unControlWaitT tma) conf
+runControlWaitT !conf tma = runReaderT (unControlWaitT tma) conf
 
 newtype ConfigWait = ConfigWait { interval :: Microseconds
                                 }
diff --git a/src/Blucontrol/Gamma/Const.hs b/src/Blucontrol/Gamma/Const.hs
--- a/src/Blucontrol/Gamma/Const.hs
+++ b/src/Blucontrol/Gamma/Const.hs
@@ -25,4 +25,4 @@
   gamma = GammaConstT ask
 
 runGammaConstT :: RGB c => c -> GammaConstT c m a -> m a
-runGammaConstT rgb tma = runReaderT (unGammaConstT tma) rgb
+runGammaConstT !rgb tma = runReaderT (unGammaConstT tma) rgb
diff --git a/src/Blucontrol/Gamma/Linear.hs b/src/Blucontrol/Gamma/Linear.hs
--- a/src/Blucontrol/Gamma/Linear.hs
+++ b/src/Blucontrol/Gamma/Linear.hs
@@ -26,6 +26,7 @@
 
 import Blucontrol.Gamma
 import Blucontrol.RGB
+import Blucontrol.RGB.Brightness
 import Blucontrol.RGB.Temperature
 
 newtype GammaLinearT c m a = GammaLinearT { unGammaLinearT :: ReaderT (M.Map TimeOfDay c) m a }
@@ -42,6 +43,20 @@
 instance MonadBase IO m => MonadGamma Temperature (GammaLinearT Temperature m) where
   gamma = calculateRGB weightedAverageTemperature . zonedTimeToLocalTime =<< liftBase getZonedTime
 
+instance (RGB Trichromaticity, MonadBase IO m) => MonadGamma (WithBrightness Trichromaticity) (GammaLinearT (WithBrightness Trichromaticity) m) where
+  gamma = calculateRGB weightedAverage . zonedTimeToLocalTime =<< liftBase getZonedTime
+    where weightedAverage w WithBrightness { brightness = b1, rgb = tc1 } WithBrightness { brightness = b2, rgb = tc2 } =
+            WithBrightness { brightness = weightedAverageBrightness w b1 b2
+                           , rgb = weightedAverageTrichromaticity w tc1 tc2
+                           }
+
+instance (RGB Temperature, MonadBase IO m) => MonadGamma (WithBrightness Temperature) (GammaLinearT (WithBrightness Temperature) m) where
+  gamma = calculateRGB weightedAverage . zonedTimeToLocalTime =<< liftBase getZonedTime
+    where weightedAverage w WithBrightness { brightness = b1, rgb = tc1 } WithBrightness { brightness = b2, rgb = tc2 } =
+            WithBrightness { brightness = weightedAverageBrightness w b1 b2
+                           , rgb = weightedAverageTemperature w tc1 tc2
+                           }
+
 nextTimeRGB :: M.Map TimeOfDay c -> LocalTime -> Maybe (LocalTime,c)
 nextTimeRGB m time = catchError (toLocalTimeToday <$> M.lookupGT (localTimeOfDay time) m) $
                      const (toLocalTimeTomorrow <$> M.lookupMin m)
@@ -86,9 +101,12 @@
 weightedAverageTemperature :: Rational -> Temperature -> Temperature -> Temperature
 weightedAverageTemperature w t1 t2 = fromRational $ toRational t1 + w * (toRational t2 - toRational t1)
 
+weightedAverageBrightness :: Rational -> Brightness -> Brightness -> Brightness
+weightedAverageBrightness w b1 b2 = fromRational $ toRational b1 + w * (toRational b2 - toRational b1)
+
 -- TODO: maybe remove RGB constraint
 runGammaLinearT' :: RGB c => M.Map TimeOfDay c -> GammaLinearT c m a -> m a
-runGammaLinearT' rgbs tma = runReaderT (unGammaLinearT tma) rgbs
+runGammaLinearT' !rgbs tma = runReaderT (unGammaLinearT tma) rgbs
 
 -- TODO: maybe remove RGB constraint
 runGammaLinearT :: RGB c => N.NonEmpty (TimeOfDay,c) -> GammaLinearT c m a -> m a
diff --git a/src/Blucontrol/Main.hs b/src/Blucontrol/Main.hs
--- a/src/Blucontrol/Main.hs
+++ b/src/Blucontrol/Main.hs
@@ -15,4 +15,4 @@
            => ConfigControl m g r
            -> IO ()
 blucontrol c = do launch
-                  runControl c . runControlT $ loopRecolor (runGamma c) (runRecolor c)
+                  runControl c $ loopRecolor (runGamma c) (runRecolor c)
diff --git a/src/Blucontrol/Main/Control.hs b/src/Blucontrol/Main/Control.hs
--- a/src/Blucontrol/Main/Control.hs
+++ b/src/Blucontrol/Main/Control.hs
@@ -1,9 +1,5 @@
-{-# LANGUAGE UndecidableInstances #-}
-
 module Blucontrol.Main.Control (
-  ControlT
-, runControlT
-, loopRecolor
+  loopRecolor
 , ConfigControl (..)
 ) where
 
@@ -17,40 +13,44 @@
 import Blucontrol.Recolor
 import Blucontrol.RGB
 
-newtype ControlT c m a = ControlT { unControlT :: m a }
-  deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b)
-
-instance MonadTrans (ControlT c) where
-  lift = ControlT
-
-instance MonadTransControl (ControlT c) where
-  type StT (ControlT c) a = a
-  liftWith inner = ControlT $ inner unControlT
-  restoreT = ControlT
-
-runControlT :: Monad m
-            => ControlT c m a
-            -> m a
-runControlT = unControlT
-
+-- | 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 c g, MonadRecolor r)
             => (forall a. g a -> IO (StM g a))
-            -> (forall a. r a -> g (StM r a))
-            -> ControlT c m ()
-loopRecolor runG runR = do
-  a <- liftBase doRecolorGamma
-  ControlT $ evalStateT doLoopRecolor a
-  where doRecolorGamma = runG $ do
-          rgb <- toRGB <$> gamma
-          runR $ recolor rgb
-        doLoopRecolor = do
-          a' <- get
-          lift $ doInbetween a'
-          a'' <- liftBase doRecolorGamma
-          put a''
-          doLoopRecolor
+            -> (forall a. r a -> IO (StM r a))
+            -> m ()
+loopRecolor runG runR = void $
+  liftBaseWith $ \ runCIO ->
+    runR $ liftBaseWith $ \ runRIO ->
+      runG $ liftBaseWith $ \ runGIO -> do
+        firstResult <- doRecolorGamma runGIO runRIO
+        evalStateT (doLoopRecolor runCIO runGIO runRIO) firstResult
 
+-- | Use `gamma` and give the result to `recolor`.
+-- The arguments are runners from `liftBaseWith`.
+doRecolorGamma :: (MonadBaseControl IO g, MonadBaseControl IO r, MonadGamma c g, MonadRecolor r)
+               => (forall a. g a -> IO (StM g a))
+               -> (forall a. r a -> IO (StM r a))
+               -> IO (StM g (StM r ()))
+doRecolorGamma runGIO runRIO = runGIO $ do
+  rgb <- toRGB <$> gamma
+  liftBase $ runRIO $ recolor rgb
+
+-- | 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 c 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))
+              -> StateT (StM g (StM r ())) IO ()
+doLoopRecolor runCIO runGIO runRIO = do
+  lastResult <- get
+  void $ liftBase $ runCIO $ doInbetween lastResult
+  nextResult <- liftBase $ doRecolorGamma runGIO runRIO
+  put nextResult
+  doLoopRecolor runCIO runGIO runRIO
+
 data ConfigControl m g r = ConfigControl { runControl :: forall a. m a -> IO a
                                          , runGamma   :: forall a. g a -> IO (StM g a)
-                                         , runRecolor :: forall a. r a -> g (StM r a)
+                                         , runRecolor :: forall a. r a -> IO (StM r a)
                                          }
diff --git a/src/Blucontrol/RGB/Brightness.hs b/src/Blucontrol/RGB/Brightness.hs
new file mode 100644
--- /dev/null
+++ b/src/Blucontrol/RGB/Brightness.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Blucontrol.RGB.Brightness (
+  Brightness
+, WithBrightness (..)
+) where
+
+import Control.DeepSeq
+import Data.Default
+import GHC.Generics
+
+import Blucontrol.RGB
+
+-- | Arbitrary precision brightness between 0 and 1
+newtype Brightness = Brightness Rational
+  deriving (Enum, Eq, Fractional, Generic, Num, Ord, Read, Real, RealFrac, Show)
+
+instance NFData Brightness
+
+instance Bounded Brightness where
+  minBound = 0
+  maxBound = 1
+
+instance Default Brightness where
+  def = 1
+
+-- | Parametric RGB value with an associated brightness
+data WithBrightness a = WithBrightness { brightness :: Brightness
+                                       , rgb :: a
+                                       }
+  deriving (Eq, Generic, Ord, Read, Show)
+
+instance NFData a => NFData (WithBrightness a)
+
+instance Default a => Default (WithBrightness a) where
+  def = WithBrightness { brightness = def
+                       , rgb = def
+                       }
+
+-- TODO: maybe create separate instances for Trichromaticity and Temperature
+instance RGB a => RGB (WithBrightness a) where
+  toRGB WithBrightness {..} = mapChromaticity applyBrightness $ toRGB rgb
+      where applyBrightness = truncate . (toRational brightness *) . toRational
+
+mapChromaticity :: (Chromaticity -> Chromaticity) -> Trichromaticity -> Trichromaticity
+mapChromaticity f rgb = Trichromaticity { red = f $ red rgb
+                                        , green = f $ green rgb
+                                        , blue = f $ blue rgb
+                                        }
diff --git a/src/Blucontrol/Recolor/X.hs b/src/Blucontrol/Recolor/X.hs
--- a/src/Blucontrol/Recolor/X.hs
+++ b/src/Blucontrol/Recolor/X.hs
@@ -31,18 +31,11 @@
 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)
   -- TODO: broken by ghc-9.0.1
-  -- liftWith = defaultLiftWith2' RecolorXT unRecolorXT
-  liftWith = defaultLiftWith2'
+  -- liftWith = defaultLiftWith2 RecolorXT unRecolorXT
+  liftWith f = RecolorXT $ liftWith $ \run -> liftWith $ \run' -> f $ run' . run . unRecolorXT
   restoreT = defaultRestoreT2 RecolorXT
 
 instance MonadBaseControl IO m => MonadRecolor (RecolorXT m) where
@@ -83,7 +76,7 @@
   where throwXError (SomeException _) = throwError xError
 
 runRecolorXTIO :: MonadBaseControl IO m => ConfigX -> RecolorXT m a -> m (Either XError a)
-runRecolorXTIO conf tma = runExceptT $ bracket open close run
+runRecolorXTIO !conf tma = runExceptT $ bracket open close run
   where open = liftXIO XErrorOpenDisplay $ openDisplay $ showDisplay conf
         close display = liftXIO XErrorCloseDisplay $ closeDisplay display
         run display = restoreT $ runRecolorXT display tma