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

import Control.Arrow (second)
import Control.Monad (forM_, unless)
import Control.Monad.Writer (execWriter, tell)
import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace)
import Data.IORef
import Data.List (sortBy)
import Data.Maybe (isJust, mapMaybe)
import Data.Ord (comparing)
import Rahm.Desktop.Layout.Draw (drawLayout)
import Rahm.Desktop.Logger
import qualified Rahm.Desktop.StackSet as S
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 System.Process
import Text.Printf
import XMonad (X)
import qualified XMonad as X
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=#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)