withRsCache :: (FilePath -> IO a) -> X a
withRsCache action = do
cd <- asks (cacheDir . directories)
let filename = (cd </> "redshift-level")
catchIO (touchFile filename)
io (action filename)
myLogHook :: X ()
myLogHook = do
rsLevel <- readMaybe <$> withRsCache readFile
forM_ rsLevel adjustLight
adjustLight :: Int -> X ()
adjustLight level = do
withRsCache (`writeFile` (show level))
t <- io $ localTimeOfDay .: utcToLocalTime <$> getCurrentTimeZone <*> getCurrentTime
let time = (todHour t, todMin t)
withWindowSet
( mapM_
( \s ->
let nbrWindows = length . integrate' . stack . workspace $ s
in if nbrWindows == 0
then spawn (redshiftCmd (darken (screen s) time) level)
else spawn (redshiftCmd (lighten (screen s)) level)
)
. screens
)
where
darken (S n) t = ["-m", "randr:crtc=" <> show n, "-b", darkShade t]
darken _ _ = []
darkShade (h, m) =
show $
if h > startHour
then 1 - (0.7 * min 1 (fromIntegral diff / fromIntegral duration))
else 1
where
startHour = 15
duration = 6 * 60
diff = abs (startHour * 60 - (h * 60 + m))
lighten (S n) = ["-m", "randr:crtc=" <> show n, "-b", "1"]
lighten _ = []
redshiftCmd :: [String] -> Int -> String
redshiftCmd params level =
"redshift "
<> intercalate " " params
<> " -PO "
<> show (1000 * (6 - level))
<> " /dev/null 2>&1"