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

import Control.Arrow (second)
import Control.Monad (forM_)
import Control.Monad.Writer (tell, execWriter)
import Data.List (sortBy)
import Data.Maybe (mapMaybe)
import Data.Ord (comparing)
import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
import Rahm.Desktop.Layout.Draw (drawLayout)
import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (spawnPipe)
import XMonad (X)
import Rahm.Desktop.Workspaces (getPopulatedWorkspaces, WorkspaceState(..))
import Text.Printf
import Rahm.Desktop.Logger
import Rahm.Desktop.Theater (getCurrentTheaterName)

import qualified XMonad as X
import qualified Rahm.Desktop.StackSet as S

data 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)


-- XMonad Log Hook meant to be used with the XMonad config logHook.
xMobarLogHook :: XMobarLog -> X ()
xMobarLogHook (XMobarLog xmproc) = do
  (_, _, layoutXpm) <- drawLayout

  loglevel <- getLogLevel
  currentTheater <- getCurrentTheaterName

  winset <- X.gets X.windowset
  title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
  let wss = getPopulatedWorkspaces winset

  let log = trunc 80 $ execWriter $ do
              tell " "
              tell (toChangeLayoutAction layoutXpm)
              tell " "
              tell $ logLevelToXMobar loglevel

              case currentTheater of
                Just theater -> do
                  tell "<fn=1><fc=#ffffff>["
                  tell theater
                  tell "]  </fc></fn>"

                Nothing -> tell " "

              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

    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 _ = ""

-- 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)