-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Prompt.Theme
-- Description :  A prompt for changing the theme of the current workspace.
-- Copyright   :  (C) 2007 Andrea Rossato
-- License     :  BSD3
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A prompt for changing the theme of the current workspace
-----------------------------------------------------------------------------

module XMonad.Prompt.Theme
    ( -- * Usage
      -- $usage
      themePrompt,
      ThemePrompt,
    ) where

import Control.Arrow ( (&&&) )
import qualified Data.Map as M
import XMonad.Prelude ( fromMaybe )
import XMonad
import XMonad.Prompt
import XMonad.Layout.Decoration
import XMonad.Util.Themes

-- $usage
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Prompt
-- > import XMonad.Prompt.Theme
--
-- in your keybindings add:
--
-- >   , ((modm .|. controlMask, xK_t), themePrompt def)
--
-- For detailed instruction on editing the key binding see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

data ThemePrompt = ThemePrompt

instance XPrompt ThemePrompt where
    showXPrompt :: ThemePrompt -> String
showXPrompt ThemePrompt
ThemePrompt = String
"Select a theme: "
    commandToComplete :: ThemePrompt -> String -> String
commandToComplete ThemePrompt
_ String
c = String
c
    nextCompletion :: ThemePrompt -> String -> [String] -> String
nextCompletion      ThemePrompt
_ = String -> [String] -> String
getNextCompletion

themePrompt :: XPConfig -> X ()
themePrompt :: XPConfig -> X ()
themePrompt XPConfig
c = ThemePrompt
-> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt ThemePrompt
ThemePrompt XPConfig
c (XPConfig -> [String] -> ComplFunction
mkComplFunFromList' XPConfig
c ([String] -> ComplFunction)
-> ([ThemeInfo] -> [String]) -> [ThemeInfo] -> ComplFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ThemeInfo -> String) -> [ThemeInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ThemeInfo -> String
ppThemeInfo ([ThemeInfo] -> ComplFunction) -> [ThemeInfo] -> ComplFunction
forall a b. (a -> b) -> a -> b
$ [ThemeInfo]
listOfThemes) String -> X ()
changeTheme
    where changeTheme :: String -> X ()
changeTheme String
t = DecorationMsg -> X ()
forall a. Message a => a -> X ()
sendMessage (DecorationMsg -> X ())
-> (Maybe Theme -> DecorationMsg) -> Maybe Theme -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Theme -> DecorationMsg
SetTheme (Theme -> DecorationMsg)
-> (Maybe Theme -> Theme) -> Maybe Theme -> DecorationMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Theme -> Maybe Theme -> Theme
forall a. a -> Maybe a -> a
fromMaybe Theme
forall a. Default a => a
def (Maybe Theme -> X ()) -> Maybe Theme -> X ()
forall a b. (a -> b) -> a -> b
$ String -> Map String Theme -> Maybe Theme
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
t Map String Theme
mapOfThemes

mapOfThemes :: M.Map String Theme
mapOfThemes :: Map String Theme
mapOfThemes = [(String, Theme)] -> Map String Theme
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Theme)] -> Map String Theme)
-> ([ThemeInfo] -> [(String, Theme)])
-> [ThemeInfo]
-> Map String Theme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [Theme] -> [(String, Theme)])
-> ([String], [Theme]) -> [(String, Theme)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String] -> [Theme] -> [(String, Theme)]
forall a b. [a] -> [b] -> [(a, b)]
zip (([String], [Theme]) -> [(String, Theme)])
-> ([ThemeInfo] -> ([String], [Theme]))
-> [ThemeInfo]
-> [(String, Theme)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ThemeInfo -> String) -> [ThemeInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ThemeInfo -> String
ppThemeInfo ([ThemeInfo] -> [String])
-> ([ThemeInfo] -> [Theme]) -> [ThemeInfo] -> ([String], [Theme])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (ThemeInfo -> Theme) -> [ThemeInfo] -> [Theme]
forall a b. (a -> b) -> [a] -> [b]
map ThemeInfo -> Theme
theme) ([ThemeInfo] -> Map String Theme)
-> [ThemeInfo] -> Map String Theme
forall a b. (a -> b) -> a -> b
$ [ThemeInfo]
listOfThemes