XMonad darken empty monitors

mail@pastecode.io avatar
unknown
haskell
3 months ago
1.6 kB
63
No Index
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"