module XMonad.Util.Keyboard ( KbLayout (..)
, showKBLayout
, xmobarKbLayout
, parseKB
, setLang
, tibetan
, accented
, français
, deutsch
, dansk
, dzongkha
, defaultKbLayout
) where
import Control.Composition
import System.Process
import XMonad
data KbLayout = Simple String | Regional String String
xmobarColor :: String
-> String
-> String
-> String
xmobarColor fg bg contents = "<fc=" ++ fg ++ "," ++ bg ++ ">" ++ contents ++ "</fc>"
xmobarKbLayout :: KbLayout -> String
xmobarKbLayout (Simple "us") = "US"
xmobarKbLayout (Simple "layout") = "US"
xmobarKbLayout (Regional "cn" "tib") = xmobarColor "yellow" "black" "Tibetan"
xmobarKbLayout (Simple "bt") = xmobarColor "yellow" "black" "Dzongkha"
xmobarKbLayout (Regional "us" "altgr-intl") = "US Extended"
xmobarKbLayout (Simple "fr") = "Fr"
xmobarKbLayout (Simple "de") = "De"
xmobarKbLayout (Simple "dk") = "Dk"
xmobarKbLayout _ = xmobarColor "red" "black" "ERROR"
defaultKbLayout :: KbLayout
defaultKbLayout = Simple "us"
showKBLayout :: IO String
showKBLayout = xmobarKbLayout <$> parseKB
parseKB :: IO KbLayout
parseKB = do
out <- lines <$> readCreateProcess (shell "setxkbmap -query") ""
let strip = dropWhile (==' ') . drop 1 . dropWhile (/=':') .* (!!)
line = strip out
if length out == 3
then pure (Simple (line 2))
else pure (Regional (line 2) (line 3))
tibetan :: KbLayout
tibetan = Regional "cn" "tib"
français :: KbLayout
français = Simple "fr"
deutsch :: KbLayout
deutsch = Simple "de"
dansk :: KbLayout
dansk = Simple "dk"
dzongkha :: KbLayout
dzongkha = Simple "bt"
accented :: KbLayout
accented = Regional "us" "altgr-intl"
setLang :: KbLayout -> X ()
setLang (Simple lc) = spawn $ "setxkbmap " ++ lc
setLang (Regional lc r) = spawn $ "setxkbmap -layout " ++ lc ++ " -variant " ++ r