module Rahm.Desktop.DMenu
  ( menuCommand,
    menuCommandString,
    runDMenu,
    runDMenuPrompt,
    runDMenuPromptWithMap,
    runDMenuPromptWithMapMulti,
  )
where

import Control.Monad (void)
import Data.List (intercalate)
import Data.Maybe (mapMaybe)
import Data.Map (Map)
import qualified Data.Map as Map
import Text.Printf (printf)
import XMonad (X, MonadIO)
import XMonad.Util.Dmenu (menuMapArgs)
import XMonad.Util.Run (runProcessWithInput, safeSpawn)

data Colors
  = Colors
      { fg :: String,
        bg :: String
      }
  | DefaultColors

menuCommand :: [String]
menuCommand = ["rofi", "-monitor", "-4", "-i", "-dmenu", "-sort", "-levenshtein-sort"]

menuCommandString :: String
menuCommandString = unwords menuCommand

runDMenu :: X ()
runDMenu =
  void $
    safeSpawn
      "rofi"
      ["-monitor", "-4", "-display-run", "Execute", "-show", "run"]

runDMenuPrompt :: String -> Maybe String -> [String] -> X String
runDMenuPrompt prompt color select =
  let realColor = maybe [] (\c -> ["-sb", c, "-nf", c]) color
   in runProcessWithInput
        "/home/rahm/.local/bin/dmenu_debug.sh"
        ( [ "-p",
            prompt,
            "-l",
            "12",
            "-dim",
            "0.4"
          ]
            ++ realColor
        )
        (intercalate "\n" select)

-- | Like 'menu' but also takes a list of command line arguments.
menuMultiArgs :: MonadIO m => String -> [String] -> [String] -> m [String]
menuMultiArgs menuCmd args opts =
  lines <$> runProcessWithInput menuCmd args (unlines opts)

-- | Like 'menuMap' but also takes a list of command line arguments.
menuMapMultiArgs :: MonadIO m => String -> [String] -> Map String a ->
               m [a]
menuMapMultiArgs menuCmd args selectionMap = do
  selection <- menuFunction (Map.keys selectionMap)
  return $ mapMaybe (`Map.lookup`selectionMap) selection
      where
        menuFunction = menuMultiArgs menuCmd args


runDMenuPromptWithMapMulti :: String -> Maybe String -> Map String a -> X [a]
runDMenuPromptWithMapMulti prompt color map = do
  let realColor =
        maybe
          []
          ( \c -> ["-theme-str", printf "* {theme-color: %s;}" c]
          )
          color
  menuMapMultiArgs
    (head menuCommand)
    ("-multi-select" : (tail menuCommand ++ ["-p", prompt] ++ realColor))
    map

runDMenuPromptWithMap :: String -> Maybe String -> Map String a -> X (Maybe a)
runDMenuPromptWithMap prompt color map = do
  let realColor =
        maybe
          []
          ( \c -> ["-theme-str", printf "* {theme-color: %s;}" c]
          )
          color
  menuMapArgs
    (head menuCommand)
    (tail menuCommand ++ ["-p", prompt] ++ realColor)
    map