module Rahm.Desktop.XMobarLog (XMobarLog, spawnXMobar, xMobarLogHook) where

import Control.Monad (forM_, unless)
import Control.Monad.Writer (execWriter, tell)
import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace)
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Maybe (isJust)
import Rahm.Desktop.Layout.Draw (drawLayout)
import Rahm.Desktop.Logger
  ( LogLevel (Debug, Error, Fatal, Trace, Warn),
    getLogLevel,
    logs,
  )
import qualified Rahm.Desktop.StackSet as S
  ( Workspace (tag),
    peek,
  )
import Rahm.Desktop.Theater (getTheaters)
import Rahm.Desktop.Workspaces
  ( WorkspaceState (..),
    getPopulatedWorkspaces,
  )
import Rahm.Desktop.XMobarLog.PendingBuffer (getPendingBuffer)
import System.IO (Handle, hPutStrLn, hSetEncoding, utf8)
import Text.Printf (printf)
import XMonad (X)
import qualified XMonad as X (XState (windowset), gets, io)
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (runProcessWithInput, spawnPipe)

newtype XMobarLog = XMobarLog Handle

-- The log hook for XMobar. This is a custom log hook that does not use any
-- of the Xmonad dynamic log libraries.
--
-- This is because the given dynamic log libraries don't handle unicode properly
-- and this has been causing issues. It is also more flexible and frankly easier
-- to just DIY.

spawnXMobar :: IO XMobarLog
spawnXMobar = do
  pipe <- spawnPipe "xmobar"
  hSetEncoding pipe utf8
  return (XMobarLog pipe)

-- getUname :: X String
-- getUname = do
--   readProcess

-- XMonad Log Hook meant to be used with the XMonad config logHook.
xMobarLogHook :: IO (XMobarLog -> X ())
xMobarLogHook = do
  unameRef <- newIORef Nothing

  -- (_, uname, _) <- readProcessWithExitCode "/usr/bin/uname" ["-r"] ""
  -- putStrLn $ "Uname " ++ uname

  return $ \(XMobarLog xmproc) -> do
    (_, _, layoutXpm) <- drawLayout

    loglevel <- getLogLevel
    theaters <- filter (\(j, _, _) -> isJust j) <$> getTheaters

    winset <- X.gets X.windowset
    title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
    pendingBuffer'' <- getPendingBuffer

    uname <- getUname unameRef

    let pendingBufferSize = max 10 $ length uname

    let (pendingBufferColor, pendingBuffer') =
          if null pendingBuffer''
            then ("#a0a0a0", uname)
            else ("#f0a0a0,#202020", pendingBuffer'')
    let pendingBuffer =
          take pendingBufferSize $
            reverse
              ( take pendingBufferSize (reverse pendingBuffer')
              )
              ++ repeat ' '

    let wss = getPopulatedWorkspaces winset

    let log = trunc 80 $
          execWriter $ do
            tell $ printf "<fc=%s><fn=3> " pendingBufferColor
            tell pendingBuffer
            tell "</fn></fc>"

            tell " "
            tell (toChangeLayoutAction layoutXpm)
            tell " "
            tell $ logLevelToXMobar loglevel

            forM_ theaters $ \case
              (Just n, _, True) -> do
                tell "<fn=1><fc=#ffffff>"
                tell $ toTheaterAction n
                tell " </fc></fn>"
              (Just n, _, False) -> do
                tell "<fn=2><fc=#888888>"
                tell $ toTheaterAction n
                tell " </fc></fn>"
              _ -> return ()

            unless (null theaters) $ do
              tell "<fc=#888888>| </fc>"

            forM_ wss $ \(t, ws) -> do
              case t of
                Current -> tell "<fn=1><fc=#ff8888>"
                Visible -> tell "<fn=6><fc=#8888ff>"
                Hidden -> tell "<fn=2><fc=#888888>"
              tell $ toAction $ S.tag ws
              tell "</fc></fn> "

            tell "<fc=#888888>| </fc>"
            tell "<fc=#ff8888><fn=3>"
            tell title
            tell "</fn></fc>"

    logs Trace "XMobar: %s" log
    X.io $ hPutStrLn xmproc log
  where
    toAction [ch]
      | isAsciiUpper ch
          || isAsciiLower ch
          || isDigit ch =
        printf "<action=`xdotool key 'Hyper_L+g' '%s'` button=1><action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
    toAction ch = ch

    toTheaterAction [ch]
      | isAsciiUpper ch
          || isAsciiLower ch
          || isDigit ch =
        printf "<action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=1>%s</action>" [ch] [ch]
    toTheaterAction ch = ch

    toChangeLayoutAction :: String -> String
    toChangeLayoutAction =
      printf
        "<action=`xdotool key Hyper_L+space n` button=1>\
        \<action=`xdotool key p` button=3>%s</action></action>"

    logLevelToXMobar Trace = "<fn=3><fc=#88ffff>[Trace]</fc></fn>   "
    logLevelToXMobar Debug = "<fn=3><fc=#ff88ff>[Debug]</fc></fn>   "
    logLevelToXMobar Warn = "<fn=3><fc=#ffff88>[Warn] </fc></fn>   "
    logLevelToXMobar Error = "<fn=3><fc=#ff8888>[Error]</fc></fn>   "
    logLevelToXMobar Fatal = "<fn=3><fc=#888888>[Fatal]</fc></fn>   "
    logLevelToXMobar _ = ""

    getUname ref = X.io $ do
      s <- readIORef ref
      case s of
        Nothing -> do
          uname' <- runProcessWithInput "uname" ["-r"] ""

          let uname = dropWhile isSpace (reverse $ dropWhile isSpace $ reverse uname')

          writeIORef ref $ Just uname
          return uname
        Just uname -> return uname

-- Truncate an XMobar string to the provided number of _visible_ characters.
-- This is to keep long window titles from overrunning the whole bar.
trunc :: Int -> String -> String
trunc amt str = reverse $ trunc' False amt str []
  where
    trunc' _ _ [] acc = acc
    trunc' ignore amt (a : as) acc =
      case a of
        '<' -> trunc' True amt as (a : acc)
        '>' -> trunc' False amt as (a : acc)
        _ ->
          if ignore
            then trunc' True amt as (a : acc)
            else case amt of
              0 -> trunc' False 0 as acc
              3 -> trunc' False 0 as ("..." ++ acc)
              _ -> trunc' False (amt - 1) as (a : acc)