-- boilerplate {{{
{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances, ViewPatterns, LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Config.Dmwit
-- Description :  Daniel Wagner's xmonad configuration.
--
------------------------------------------------------------------------
module XMonad.Config.Dmwit {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} where

-- system imports
import Control.Monad.Trans
import Data.Map (Map, fromList)
import Data.Ratio
import Data.Word
import GHC.Real
import System.Environment
import System.Exit
import System.IO
import System.Process

-- xmonad core
import XMonad
import XMonad.StackSet hiding (workspaces)

-- xmonad contrib
import XMonad.Actions.SpawnOn
import XMonad.Actions.Warp
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Layout.Grid
import XMonad.Layout.IndependentScreens hiding (withScreen)
import XMonad.Layout.Magnifier
import XMonad.Layout.NoBorders
import XMonad.Prelude hiding (fromList)
import XMonad.Util.Dzen hiding (x, y)
import XMonad.Util.SpawnOnce
-- }}}
-- volume {{{
outputOf :: String -> IO String
outputOf :: String -> IO String
outputOf String
s = do
    IO ()
forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers
    (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
p) <- String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
s
    (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
hClose [Handle
hIn, Handle
hErr]
    Handle -> IO String
hGetContents Handle
hOut IO String -> IO ExitCode -> IO String
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p IO String -> IO () -> IO String
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO ()
forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers

geomMean :: Floating a => [a] -> a
geomMean :: forall a. Floating a => [a] -> a
geomMean [a]
xs = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a]
xs a -> a -> a
forall a. Floating a => a -> a -> a
** (a -> a
forall a. Fractional a => a -> a
recip (a -> a) -> ([a] -> a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> ([a] -> Int) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ [a]
xs)

arithMean :: Floating a => [a] -> a
arithMean :: forall a. Floating a => [a] -> a
arithMean [a]
xs = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
xs a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)

namedNumbers :: String -> String -> [String]
namedNumbers String
n String
s = do
    String
l <- String -> [String]
lines String
s
    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
sentinel String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l)
    String -> [String]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sentinel) String
l)
    where sentinel :: String
sentinel = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" #"

-- Data.List.Split.splitOn ":", but without involving an extra dependency
splitColon :: String -> [String]
splitColon String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') String
xs of
    (String
a, Char
':':String
b) -> String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitColon String
b
    (String
a, String
_)     -> [String
a]

parse :: String -> a
parse String
s = [a] -> a
forall a. Floating a => [a] -> a
arithMean ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ do
    String
l <- String -> [String]
lines String
s
    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
"\tVolume: " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l)
    String
part <- String -> [String]
splitColon String
l
    (a
n,Char
'%':String
_) <- ReadS a
forall a. Read a => ReadS a
reads String
part
    a -> [a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return a
n

modVolume :: String -> Integer -> IO Double
modVolume :: String -> Integer -> IO Double
modVolume String
kind Integer
n = do
    [String]
is <- String -> String -> [String]
namedNumbers String
parseKind (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
outputOf String
listCommand
    [String] -> (String -> IO String) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
is (String -> IO String
outputOf (String -> IO String) -> (String -> String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
setCommand)
    String -> Double
forall {a}. (Floating a, Read a) => String -> a
parse (String -> Double) -> IO String -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
outputOf String
listCommand
    where
    sign :: String
sign | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = String
"+" | Bool
otherwise = String
"-"
    ctlKind :: String
ctlKind      = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'-' else Char
c) String
kind
    parseKind :: String
parseKind    = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String -> NonEmpty Char
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Char
c :| String
cs) -> Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
kind
    setCommand :: String -> String
setCommand String
i = String
"pactl set-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctlKind String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-volume " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sign String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"%"
    listCommand :: String
listCommand  = String
"pactl list " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctlKind String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
-- }}}
-- convenient actions {{{
centerMouse :: X ()
centerMouse = Rational -> Rational -> X ()
warpToWindow (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)
statusBarMouse :: X ()
statusBarMouse = ScreenId -> Rational -> Rational -> X ()
warpToScreen ScreenId
0 (Rational
5Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
1600) (Rational
5Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
1200)
withScreen :: ScreenId -> (String -> WindowSet -> WindowSet) -> X ()
withScreen ScreenId
s String -> WindowSet -> WindowSet
f = ScreenId -> X (Maybe String)
screenWorkspace ScreenId
s X (Maybe String) -> (Maybe String -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe String -> (String -> X ()) -> X ())
-> (String -> X ()) -> Maybe String -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe String -> (String -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (String -> WindowSet -> WindowSet) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WindowSet -> WindowSet
f)

makeLauncher :: String -> String -> String -> String -> String
makeLauncher String
yargs String
run String
exec String
close = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [String
"exe=`yeganesh ", String
yargs, String
"` && ", String
run, String
" ", String
exec, String
"$exe", String
close]
launcher :: String
launcher     = String -> String -> String -> String -> String
makeLauncher String
"" String
"eval" String
"\"exec " String
"\""
termLauncher :: String
termLauncher = String -> String -> String -> String -> String
makeLauncher String
"-p withterm" String
"exec urxvt -e" String
"" String
""
viewShift :: i -> StackSet i l a s sd -> StackSet i l a s sd
viewShift  i
i = i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view i
i (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> StackSet i l a s sd -> StackSet i l a s sd
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift i
i
floatAll :: [String] -> Query (Endo WindowSet)
floatAll     = [Query (Endo WindowSet)] -> Query (Endo WindowSet)
forall m. Monoid m => [m] -> m
composeAll ([Query (Endo WindowSet)] -> Query (Endo WindowSet))
-> ([String] -> [Query (Endo WindowSet)])
-> [String]
-> Query (Endo WindowSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Query (Endo WindowSet))
-> [String] -> [Query (Endo WindowSet)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> Query String
className Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
s Query Bool -> Query (Endo WindowSet) -> Query (Endo WindowSet)
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> Query (Endo WindowSet)
doFloat)
sinkFocus :: StackSet i l a s sd -> StackSet i l a s sd
sinkFocus    = StackSet i l a s sd -> Maybe a
forall i l a s sd. StackSet i l a s sd -> Maybe a
peek (StackSet i l a s sd -> Maybe a)
-> (Maybe a -> StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a b.
(StackSet i l a s sd -> a)
-> (a -> StackSet i l a s sd -> b) -> StackSet i l a s sd -> b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StackSet i l a s sd -> StackSet i l a s sd)
-> (a -> StackSet i l a s sd -> StackSet i l a s sd)
-> Maybe a
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StackSet i l a s sd -> StackSet i l a s sd
forall a. a -> a
id a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
sink
showMod :: String -> Integer -> X ()
showMod  String
k Integer
n = IO Double -> X Double
forall a. IO a -> X a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Integer -> IO Double
modVolume String
k Integer
n) X Double -> (Double -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> X ()
volumeDzen (String -> X ()) -> (Double -> String) -> Double -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (Double -> Integer) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round
volumeDzen :: String -> X ()
volumeDzen   = DzenConfig -> String -> X ()
dzenConfig (DzenConfig -> String -> X ()) -> DzenConfig -> String -> X ()
forall a b. (a -> b) -> a -> b
$ (ScreenId -> DzenConfig) -> DzenConfig
onCurr (Int -> Int -> ScreenId -> DzenConfig
center Int
170 Int
66) DzenConfig -> DzenConfig -> DzenConfig
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> DzenConfig
font String
"-*-helvetica-*-r-*-*-64-*-*-*-*-*-*-*,-*-terminus-*-*-*-*-64-*-*-*-*-*-*-*"
-- }}}
altMask :: KeyMask
altMask = KeyMask
mod1Mask
bright :: String
bright  = String
"#80c0ff"
dark :: String
dark    = String
"#13294e"
-- manage hooks for mplayer {{{
fullscreen43on169 :: RationalRect
fullscreen43on169 = RationalRect -> RationalRect
expand (RationalRect -> RationalRect) -> RationalRect -> RationalRect
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
RationalRect Rational
0 (-Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
6) Rational
1 (Rational
4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
3) where
    expand :: RationalRect -> RationalRect
expand (RationalRect Rational
x Rational
y Rational
w Rational
h) = Rational -> Rational -> Rational -> Rational -> RationalRect
RationalRect (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
forall {a}. Fractional a => a
bwx) (Rational
y Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
forall {a}. Fractional a => a
bwy) (Rational
w Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
forall {a}. Fractional a => a
bwx) (Rational
h Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
forall {a}. Fractional a => a
bwy)
    bwx :: a
bwx = a
2 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1920 -- borderwidth
    bwy :: a
bwy = a
2 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1080

fullscreenMPlayer :: Query (Endo WindowSet)
fullscreenMPlayer = Query String
className Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
"MPlayer" Query Bool -> Query (Endo WindowSet) -> Query (Endo WindowSet)
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> do
    Display
dpy   <- X Display -> Query Display
forall a. X a -> Query a
liftX (X Display -> Query Display) -> X Display -> Query Display
forall a b. (a -> b) -> a -> b
$ (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    Window
win   <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
    SizeHints
hints <- IO SizeHints -> Query SizeHints
forall a. IO a -> Query a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SizeHints -> Query SizeHints)
-> IO SizeHints -> Query SizeHints
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO SizeHints
getWMNormalHints Display
dpy Window
win
    case (((Dimension, Dimension), (Dimension, Dimension)) -> Rational)
-> Maybe ((Dimension, Dimension), (Dimension, Dimension))
-> Maybe Rational
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Dimension, Dimension) -> Rational
forall {a} {a}. (Integral a, Integral a) => (a, a) -> Rational
approx ((Dimension, Dimension) -> Rational)
-> (((Dimension, Dimension), (Dimension, Dimension))
    -> (Dimension, Dimension))
-> ((Dimension, Dimension), (Dimension, Dimension))
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Dimension, Dimension), (Dimension, Dimension))
-> (Dimension, Dimension)
forall a b. (a, b) -> a
fst) (SizeHints -> Maybe ((Dimension, Dimension), (Dimension, Dimension))
sh_aspect SizeHints
hints) of
        Just ( Integer
4 :% Integer
3)  -> ScreenId -> String -> Window -> Query (Endo WindowSet)
forall {t} {s} {l} {sd}.
(Ord t, Eq s) =>
ScreenId -> String -> t -> Query (Endo (StackSet String l t s sd))
viewFullOn ScreenId
0 String
"5" Window
win
        Just (Integer
16 :% Integer
9)  -> ScreenId -> String -> Window -> Query (Endo WindowSet)
forall {t} {s} {l} {sd}.
(Ord t, Eq s) =>
ScreenId -> String -> t -> Query (Endo (StackSet String l t s sd))
viewFullOn ScreenId
1 String
"5" Window
win
        Maybe Rational
_               -> Query (Endo WindowSet)
doFloat
    where
    approx :: (a, a) -> Rational
approx (a
n, a
d)    = Double -> Double -> Rational
forall a. RealFrac a => a -> a -> Rational
approxRational (a -> Double
forall a b. (Integral a, Num b) => a -> b
fi a
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ a -> Double
forall a b. (Integral a, Num b) => a -> b
fi a
d) (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
100)

operationOn :: (t -> StackSet String l t s sd -> StackSet String l t s sd)
-> ScreenId
-> String
-> t
-> Query (Endo (StackSet String l t s sd))
operationOn t -> StackSet String l t s sd -> StackSet String l t s sd
f ScreenId
s String
n t
w = do
    let ws :: String
ws = ScreenId -> String -> String
marshall ScreenId
s String
n
    Maybe String
currws <- X (Maybe String) -> Query (Maybe String)
forall a. X a -> Query a
liftX (X (Maybe String) -> Query (Maybe String))
-> X (Maybe String) -> Query (Maybe String)
forall a b. (a -> b) -> a -> b
$ ScreenId -> X (Maybe String)
screenWorkspace ScreenId
s
    (StackSet String l t s sd -> StackSet String l t s sd)
-> Query (Endo (StackSet String l t s sd))
forall s. (s -> s) -> Query (Endo s)
doF ((StackSet String l t s sd -> StackSet String l t s sd)
 -> Query (Endo (StackSet String l t s sd)))
-> (StackSet String l t s sd -> StackSet String l t s sd)
-> Query (Endo (StackSet String l t s sd))
forall a b. (a -> b) -> a -> b
$ String -> StackSet String l t s sd -> StackSet String l t s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view String
ws (StackSet String l t s sd -> StackSet String l t s sd)
-> (StackSet String l t s sd -> StackSet String l t s sd)
-> StackSet String l t s sd
-> StackSet String l t s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StackSet String l t s sd -> StackSet String l t s sd)
-> (String -> StackSet String l t s sd -> StackSet String l t s sd)
-> Maybe String
-> StackSet String l t s sd
-> StackSet String l t s sd
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StackSet String l t s sd -> StackSet String l t s sd
forall a. a -> a
id String -> StackSet String l t s sd -> StackSet String l t s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view Maybe String
currws (StackSet String l t s sd -> StackSet String l t s sd)
-> (StackSet String l t s sd -> StackSet String l t s sd)
-> StackSet String l t s sd
-> StackSet String l t s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> t -> StackSet String l t s sd -> StackSet String l t s sd
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftWin String
ws t
w (StackSet String l t s sd -> StackSet String l t s sd)
-> (StackSet String l t s sd -> StackSet String l t s sd)
-> StackSet String l t s sd
-> StackSet String l t s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> StackSet String l t s sd -> StackSet String l t s sd
f t
w

viewFullOn :: ScreenId -> String -> t -> Query (Endo (StackSet String l t s sd))
viewFullOn = (t -> StackSet String l t s sd -> StackSet String l t s sd)
-> ScreenId
-> String
-> t
-> Query (Endo (StackSet String l t s sd))
forall {t} {s} {l} {sd}.
(Ord t, Eq s) =>
(t -> StackSet String l t s sd -> StackSet String l t s sd)
-> ScreenId
-> String
-> t
-> Query (Endo (StackSet String l t s sd))
operationOn t -> StackSet String l t s sd -> StackSet String l t s sd
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
sink
centerWineOn :: ScreenId -> String -> t -> Query (Endo (StackSet String l t s sd))
centerWineOn = (t -> StackSet String l t s sd -> StackSet String l t s sd)
-> ScreenId
-> String
-> t
-> Query (Endo (StackSet String l t s sd))
forall {t} {s} {l} {sd}.
(Ord t, Eq s) =>
(t -> StackSet String l t s sd -> StackSet String l t s sd)
-> ScreenId
-> String
-> t
-> Query (Endo (StackSet String l t s sd))
operationOn (t
-> RationalRect
-> StackSet String l t s sd
-> StackSet String l t s sd
forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
`XMonad.StackSet.float` Rational -> Rational -> Rational -> Rational -> RationalRect
RationalRect (Rational
79Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
960) (-Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
540) (Rational
401Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
480) (Rational
271Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
270))
-- }}}
-- debugging {{{
class Show a => PPrint a where
    pprint :: Int -> a -> String
    pprint Int
_ = a -> String
forall a. Show a => a -> String
show

data PPrintable = forall a. PPrint a => P a
instance Show   PPrintable where show :: PPrintable -> String
show     (P a
x) = a -> String
forall a. Show a => a -> String
show a
x
instance PPrint PPrintable where pprint :: Int -> PPrintable -> String
pprint Int
n (P a
x) = Int -> a -> String
forall a. PPrint a => Int -> a -> String
pprint Int
n a
x

record :: String -> Int -> [(String, PPrintable)] -> String
record :: String -> Int -> [(String, PPrintable)] -> String
record String
s Int
n [(String, PPrintable)]
xs = String
preamble String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
newline [String]
fields String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
postlude where
    indentation :: String
indentation = Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'\t'
    preamble :: String
preamble    = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" {" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
indentation
    postlude :: String
postlude    = String
indentation String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
    newline :: String
newline     = Char
',' Char -> String -> String
forall a. a -> [a] -> [a]
: String
indentation
    fields :: [String]
fields      = ((String, PPrintable) -> String)
-> [(String, PPrintable)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, PPrintable
value) -> String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> PPrintable -> String
forall a. PPrint a => Int -> a -> String
pprint (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) PPrintable
value) [(String, PPrintable)]
xs

instance PPrint a => PPrint (Maybe a) where
    pprint :: Int -> Maybe a -> String
pprint Int
n (Just a
x) = String
"Just (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> a -> String
forall a. PPrint a => Int -> a -> String
pprint Int
n a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    pprint Int
_ Maybe a
x        = Maybe a -> String
forall a. Show a => a -> String
show Maybe a
x

instance PPrint a => PPrint [a] where
    pprint :: Int -> [a] -> String
pprint Int
_ [] = String
"[]"
    pprint Int
n [a]
xs = String
preamble String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
newline [String]
allLines String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
postlude where
        indentation :: String
indentation = Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'\t'
        preamble :: String
preamble    = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
indentation
        allLines :: [String]
allLines    = (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> a -> String
forall a. PPrint a => Int -> a -> String
pprint (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) [a]
xs
        newline :: String
newline     = Char
',' Char -> String -> String
forall a. a -> [a] -> [a]
: String
indentation
        postlude :: String
postlude    = String
indentation String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

instance PPrint Rectangle where
    pprint :: Int -> Rectangle -> String
pprint Int
n Rectangle
x = String -> Int -> [(String, PPrintable)] -> String
record String
"Rectangle" Int
n [
        (String
"rect_x", Position -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Rectangle -> Position
rect_x Rectangle
x)),
        (String
"rect_y", Position -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Rectangle -> Position
rect_y Rectangle
x)),
        (String
"rect_width", Dimension -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Rectangle -> Dimension
rect_width Rectangle
x)),
        (String
"rect_height", Dimension -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Rectangle -> Dimension
rect_height Rectangle
x))
        ]

instance PPrint a => PPrint (Stack a) where
    pprint :: Int -> Stack a -> String
pprint Int
n Stack a
x = String -> Int -> [(String, PPrintable)] -> String
record String
"Stack" Int
n [
        (String
"focus", a -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Stack a -> a
forall a. Stack a -> a
XMonad.StackSet.focus Stack a
x)),
        (String
"up", [a] -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
x)),
        (String
"down", [a] -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Stack a -> [a]
forall a. Stack a -> [a]
down Stack a
x))
        ]

instance (PPrint i, PPrint l, PPrint a) => PPrint (Workspace i l a) where
    pprint :: Int -> Workspace i l a -> String
pprint Int
n Workspace i l a
x = String -> Int -> [(String, PPrintable)] -> String
record String
"Workspace" Int
n [
        (String
"tag", i -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag Workspace i l a
x)),
        (String
"layout", l -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Workspace i l a -> l
forall i l a. Workspace i l a -> l
layout Workspace i l a
x)),
        (String
"stack", Maybe (Stack a) -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace i l a
x))
        ]

instance PPrint ScreenDetail where
    pprint :: Int -> ScreenDetail -> String
pprint Int
n ScreenDetail
x = String -> Int -> [(String, PPrintable)] -> String
record String
"SD" Int
n [(String
"screenRect", Rectangle -> PPrintable
forall a. PPrint a => a -> PPrintable
P (ScreenDetail -> Rectangle
screenRect ScreenDetail
x))]

instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (XMonad.StackSet.Screen i l a sid sd) where
    pprint :: Int -> Screen i l a sid sd -> String
pprint Int
n Screen i l a sid sd
x = String -> Int -> [(String, PPrintable)] -> String
record String
"Screen" Int
n [
        (String
"workspace", Workspace i l a -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Screen i l a sid sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace Screen i l a sid sd
x)),
        (String
"screen", sid -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Screen i l a sid sd -> sid
forall i l a sid sd. Screen i l a sid sd -> sid
screen Screen i l a sid sd
x)),
        (String
"screenDetail", sd -> PPrintable
forall a. PPrint a => a -> PPrintable
P (Screen i l a sid sd -> sd
forall i l a sid sd. Screen i l a sid sd -> sd
screenDetail Screen i l a sid sd
x))
        ]

instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (StackSet i l a sid sd) where
    pprint :: Int -> StackSet i l a sid sd -> String
pprint Int
n StackSet i l a sid sd
x = String -> Int -> [(String, PPrintable)] -> String
record String
"StackSet" Int
n [
        (String
"current", Screen i l a sid sd -> PPrintable
forall a. PPrint a => a -> PPrintable
P (StackSet i l a sid sd -> Screen i l a sid sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a sid sd
x)),
        (String
"visible", [Screen i l a sid sd] -> PPrintable
forall a. PPrint a => a -> PPrintable
P (StackSet i l a sid sd -> [Screen i l a sid sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a sid sd
x)),
        (String
"hidden", [Workspace i l a] -> PPrintable
forall a. PPrint a => a -> PPrintable
P (StackSet i l a sid sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a sid sd
x)),
        (String
"floating", Map a RationalRect -> PPrintable
forall a. PPrint a => a -> PPrintable
P (StackSet i l a sid sd -> Map a RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
floating StackSet i l a sid sd
x))
        ]

instance PPrint (Layout a)
instance PPrint Int
instance PPrint XMonad.Screen
instance PPrint Integer
instance PPrint Position
instance PPrint Dimension
instance PPrint Char
instance PPrint Word64
instance PPrint ScreenId
instance (Show a, Show b) => PPrint (Map a b)
-- }}}
-- main {{{
dmwitConfig :: ScreenId
-> XConfig
     (ModifiedLayout
        Magnifier
        (Choose
           (ModifiedLayout AvoidStruts Grid)
           (ModifiedLayout WithBorder Full)))
dmwitConfig ScreenId
nScreens = XConfig
  (ModifiedLayout
     Magnifier
     (Choose
        (ModifiedLayout AvoidStruts Grid)
        (ModifiedLayout WithBorder Full)))
-> XConfig
     (ModifiedLayout
        Magnifier
        (Choose
           (ModifiedLayout AvoidStruts Grid)
           (ModifiedLayout WithBorder Full)))
forall (a :: * -> *). XConfig a -> XConfig a
docks (XConfig
   (ModifiedLayout
      Magnifier
      (Choose
         (ModifiedLayout AvoidStruts Grid)
         (ModifiedLayout WithBorder Full)))
 -> XConfig
      (ModifiedLayout
         Magnifier
         (Choose
            (ModifiedLayout AvoidStruts Grid)
            (ModifiedLayout WithBorder Full))))
-> XConfig
     (ModifiedLayout
        Magnifier
        (Choose
           (ModifiedLayout AvoidStruts Grid)
           (ModifiedLayout WithBorder Full)))
-> XConfig
     (ModifiedLayout
        Magnifier
        (Choose
           (ModifiedLayout AvoidStruts Grid)
           (ModifiedLayout WithBorder Full)))
forall a b. (a -> b) -> a -> b
$ XConfig (Choose Tall (Choose (Mirror Tall) Full))
forall a. Default a => a
def {
    borderWidth             = 2,
    workspaces              = withScreens nScreens (map show [1..5]),
    terminal                = "urxvt",
    normalBorderColor       = dark,
    focusedBorderColor      = bright,
    modMask                 = mod4Mask,
    keys                    = keyBindings,
    layoutHook              = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full,
    manageHook              =     (title =? "CGoban: Main Window" --> doF sinkFocus)
                              <> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")
                              <> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")
                              <> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <> compared to) this one
                              <> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)
                              <> fullscreenMPlayer
                              <> floatAll ["Gimp", "Wine"]
                              <> manageSpawn,
    logHook                 = allPPs nScreens,
    startupHook             = refresh
                           >> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1]
    }

main :: IO ()
main = IO ScreenId
forall (m :: * -> *) i. (MonadIO m, Integral i) => m i
countScreens IO ScreenId -> (ScreenId -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= XConfig
  (ModifiedLayout
     Magnifier
     (Choose
        (ModifiedLayout AvoidStruts Grid)
        (ModifiedLayout WithBorder Full)))
-> IO ()
forall (l :: * -> *).
(LayoutClass l Window, Read (l Window)) =>
XConfig l -> IO ()
xmonad (XConfig
   (ModifiedLayout
      Magnifier
      (Choose
         (ModifiedLayout AvoidStruts Grid)
         (ModifiedLayout WithBorder Full)))
 -> IO ())
-> (ScreenId
    -> XConfig
         (ModifiedLayout
            Magnifier
            (Choose
               (ModifiedLayout AvoidStruts Grid)
               (ModifiedLayout WithBorder Full))))
-> ScreenId
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenId
-> XConfig
     (ModifiedLayout
        Magnifier
        (Choose
           (ModifiedLayout AvoidStruts Grid)
           (ModifiedLayout WithBorder Full)))
dmwitConfig
-- }}}
-- keybindings {{{
keyBindings :: XConfig Layout -> Map (KeyMask, Window) (X ())
keyBindings XConfig Layout
conf = let m :: KeyMask
m = XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
conf in [((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ()))
-> ([((KeyMask, Window), X ())] -> [((KeyMask, Window), X ())])
-> [((KeyMask, Window), X ())]
-> Map (KeyMask, Window) (X ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((KeyMask, Window), X ())] -> [((KeyMask, Window), X ())]
forall {b} {b}. [((KeyMask, b), b)] -> [((KeyMask, b), b)]
anyMask ([((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ()))
-> [((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ())
forall a b. (a -> b) -> a -> b
$ [
    ((KeyMask
m                , Window
xK_BackSpace  ), String -> X ()
spawnHere String
"urxvt"),
    ((KeyMask
m                , Window
xK_p          ), String -> X ()
spawnHere String
launcher),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_p          ), String -> X ()
spawnHere String
termLauncher),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_c          ), X ()
kill),
    ((KeyMask
m                , Window
xK_q          ), String -> Bool -> X ()
restart String
"xmonad" Bool
True),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_q          ), IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ()
forall a. IO a
exitSuccess),
    ((KeyMask
m                , Window
xK_grave      ), ChangeLayout -> X ()
forall a. Message a => a -> X ()
sendMessage ChangeLayout
NextLayout),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_grave      ), Layout Window -> X ()
setLayout (Layout Window -> X ()) -> Layout Window -> X ()
forall a b. (a -> b) -> a -> b
$ XConfig Layout -> Layout Window
forall (l :: * -> *). XConfig l -> l Window
layoutHook XConfig Layout
conf),
    ((KeyMask
m                , Window
xK_o          ), MagnifyMsg -> X ()
forall a. Message a => a -> X ()
sendMessage MagnifyMsg
Toggle),
    ((KeyMask
m                , Window
xK_x          ), (Window -> X ()) -> X ()
withFocused ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
sink)),
    ((KeyMask
m                , Window
xK_Home       ), (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
focusUp),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_Home       ), (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
swapUp),
    ((KeyMask
m                , Window
xK_End        ), (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
focusDown),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_End        ), (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
swapDown),
    ((KeyMask
m                , Window
xK_a          ), (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
focusMaster),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_a          ), (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
swapMaster),
    ((KeyMask
m                , Window
xK_Control_L  ), ScreenId -> (String -> WindowSet -> WindowSet) -> X ()
withScreen ScreenId
0 String -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_Control_L  ), ScreenId -> (String -> WindowSet -> WindowSet) -> X ()
withScreen ScreenId
0 String -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
viewShift),
    ((KeyMask
m                , Window
xK_Alt_L      ), ScreenId -> (String -> WindowSet -> WindowSet) -> X ()
withScreen ScreenId
1 String -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_Alt_L      ), ScreenId -> (String -> WindowSet -> WindowSet) -> X ()
withScreen ScreenId
1 String -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
viewShift),
    ((KeyMask
m                , Window
xK_u          ), X ()
centerMouse),
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask  , Window
xK_u          ), X ()
statusBarMouse),
    ((KeyMask
m                , Window
xK_s          ), String -> X ()
spawnHere String
"chromium --password-store=gnome"),
    ((KeyMask
m                , Window
xK_n          ), String -> X ()
spawnHere String
"gvim todo"),
    ((KeyMask
m                , Window
xK_t          ), String -> X ()
spawnHere String
"mpc toggle"),
    ((KeyMask
m                , Window
xK_h          ), String -> X ()
spawnHere String
"urxvt -e alsamixer"),
    ((KeyMask
m                , Window
xK_d          ), String -> X ()
spawnHere String
"wyvern"),
    ((KeyMask
m                , Window
xK_l          ), String -> X ()
spawnHere String
"urxvt -e sup"),
    ((KeyMask
m                , Window
xK_r          ), String -> X ()
spawnHere String
"urxvt -e ncmpcpp"),
    ((KeyMask
m                , Window
xK_c          ), String -> X ()
spawnHere String
"urxvt -e ghci"),
    ((KeyMask
m                , Window
xK_g          ), String -> X ()
spawnHere String
"slock" X () -> X () -> X ()
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> X ()
spawnHere String
"xscreensaver-command -lock"),
    ((KeyMask
m                , Window
xK_f          ), String -> X ()
spawnHere String
"gvim ~/.xmonad/xmonad.hs"),
    ((      KeyMask
noModMask  , Window
xK_F8         ), String -> Integer -> X ()
showMod String
"sink input" (-Integer
4)),
    ((      KeyMask
noModMask  , Window
xK_F9         ), String -> Integer -> X ()
showMod String
"sink input"   Integer
4 ),
    ((      KeyMask
shiftMask  , Window
xK_F8         ), String -> Integer -> X ()
showMod String
"sink"       (-Integer
4)),
    ((      KeyMask
shiftMask  , Window
xK_F9         ), String -> Integer -> X ()
showMod String
"sink"         Integer
4 ),
    ((      KeyMask
noModMask  , Window
xK_Super_L    ), () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) -- make VirtualBox ignore stray hits of the Windows key
    ] [((KeyMask, Window), X ())]
-> [((KeyMask, Window), X ())] -> [((KeyMask, Window), X ())]
forall a. [a] -> [a] -> [a]
++ [
    ((KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
e          , Window
key           ), (WindowSet -> WindowSet) -> X ()
windows ((String -> WindowSet -> WindowSet)
-> String -> WindowSet -> WindowSet
forall a. (String -> WindowSet -> a) -> String -> WindowSet -> a
onCurrentScreen String -> WindowSet -> WindowSet
f String
ws))
    | (Window
key, String
ws) <- [Window] -> [String] -> [(Window, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window
xK_1..Window
xK_9] (XConfig Layout -> [String]
forall (l :: * -> *). XConfig l -> [String]
workspaces' XConfig Layout
conf)
    , (KeyMask
e, String -> WindowSet -> WindowSet
f)    <- [(KeyMask
0, String -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view), (KeyMask
shiftMask, String -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
viewShift)]
    ]

atSchool :: b -> b -> m b
atSchool b
school b
home = do
    String
host <- IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO String
getEnv String
"HOST")
    b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ case String
host of
        String
"sorghum"   -> b
home
        String
"buckwheat" -> b
home
        String
_           -> b
school

anyMask :: [((KeyMask, b), b)] -> [((KeyMask, b), b)]
anyMask [((KeyMask, b), b)]
xs = do
    ((KeyMask
mask, b
key), b
action) <- [((KeyMask, b), b)]
xs
    KeyMask
extraMask             <- [KeyMask
0, KeyMask
controlMask, KeyMask
altMask, KeyMask
controlMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
altMask]
    ((KeyMask, b), b) -> [((KeyMask, b), b)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ((KeyMask
mask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
extraMask, b
key), b
action)
-- }}}
-- logHook {{{
pipeName :: String -> a -> String
pipeName String
n a
s = String
"/home/dmwit/.xmonad/pipe-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
s

xmobarCommand :: ScreenId -> String
xmobarCommand (S Int
s) = [String] -> String
unwords [String
"xmobar",
    String
"-x", Int -> String
forall a. Show a => a -> String
show Int
s,
    String
"-t", Int -> String
forall {a}. (Eq a, Num a) => a -> String
template Int
s,
    String
"-C", String
pipeReader
    ]
    where
    template :: a -> String
template a
0 = String
"}%focus%{%workspaces%"
    template a
_ = String
"%date%}%focus%{%workspaces%"
    pipeReader :: String
pipeReader = String
"'[\
        \Run PipeReader \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Int -> String
forall {a}. Show a => String -> a -> String
pipeName String
"focus"      Int
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" \"focus\",\
        \Run PipeReader \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Int -> String
forall {a}. Show a => String -> a -> String
pipeName String
"workspaces" Int
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" \"workspaces\"\
        \]'"

allPPs :: ScreenId -> X ()
allPPs ScreenId
nScreens = [X ()] -> X ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [PP -> X ()
dynamicLogWithPP (ScreenId -> PP
pp ScreenId
s) | ScreenId
s <- [ScreenId
0..ScreenId
nScreensScreenId -> ScreenId -> ScreenId
forall a. Num a => a -> a -> a
-ScreenId
1], ScreenId -> PP
pp <- [ScreenId -> PP
ppFocus, ScreenId -> PP
ppWorkspaces]]
color :: String -> String -> String
color String
c = String -> String -> String -> String
xmobarColor String
c String
""

ppFocus :: ScreenId -> PP
ppFocus s :: ScreenId
s@(S Int
s_) = ScreenId -> PP -> PP
whenCurrentOn ScreenId
s PP
forall a. Default a => a
def {
    ppOrder  = \case{ String
_:String
_:String
windowTitle:[String]
_ -> [String
windowTitle]; [String]
_ -> [] },
    ppOutput = appendFile (pipeName "focus" s_) . (++ "\n")
    }

ppWorkspaces :: ScreenId -> PP
ppWorkspaces s :: ScreenId
s@(S Int
s_) = ScreenId -> PP -> PP
marshallPP ScreenId
s PP
forall a. Default a => a
def {
    ppCurrent           = color "white",
    ppVisible           = color "white",
    ppHiddenNoWindows   = color dark,
    ppUrgent            = color "red",
    ppSep               = "",
    ppOrder             = \case{ String
wss:String
_layout:String
_title:[String]
_ -> [String
wss]; [String]
_ -> [] },
    ppOutput            = appendFile (pipeName "workspaces" s_) . (++"\n")
    }
-- }}}