-- 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
    forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers
    (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
p) <- String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
s
    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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers

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

arithMean :: Floating a => [a] -> a
arithMean :: forall a. Floating a => [a] -> a
arithMean [a]
xs = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
xs forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (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
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
sentinel forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sentinel) String
l)
    where sentinel :: String
sentinel = String
n forall a. [a] -> [a] -> [a]
++ String
" #"

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

parse :: String -> a
parse String
s = forall a. Floating a => [a] -> a
arithMean forall a b. (a -> b) -> a -> b
$ do
    String
l <- String -> [String]
lines String
s
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
"\tVolume: " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l)
    String
part <- String -> [String]
splitColon String
l
    (a
n,Char
'%':String
_) <- forall a. Read a => ReadS a
reads String
part
    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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
outputOf String
listCommand
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
is (String -> IO String
outputOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
setCommand)
    forall {a}. (Floating a, Read a) => String -> a
parse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
outputOf String
listCommand
    where
    sign :: String
sign | Integer
n forall a. Ord a => a -> a -> Bool
> Integer
0 = String
"+" | Bool
otherwise = String
"-"
    ctlKind :: String
ctlKind      = forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'-' else Char
c) String
kind
    parseKind :: String
parseKind    = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Char
c :| String
cs) -> Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: String
cs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
kind
    setCommand :: String -> String
setCommand String
i = String
"pactl set-" forall a. [a] -> [a] -> [a]
++ String
ctlKind forall a. [a] -> [a] -> [a]
++ String
"-volume " forall a. [a] -> [a] -> [a]
++ String
i forall a. [a] -> [a] -> [a]
++ String
" -- " forall a. [a] -> [a] -> [a]
++ String
sign forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Num a => a -> a
abs Integer
n) forall a. [a] -> [a] -> [a]
++ String
"%"
    listCommand :: String
listCommand  = String
"pactl list " forall a. [a] -> [a] -> [a]
++ String
ctlKind forall a. [a] -> [a] -> [a]
++ String
"s"
-- }}}
-- convenient actions {{{
centerMouse :: X ()
centerMouse = Rational -> Rational -> X ()
warpToWindow (Rational
1forall a. Fractional a => a -> a -> a
/Rational
2) (Rational
1forall a. Fractional a => a -> a -> a
/Rational
2)
statusBarMouse :: X ()
statusBarMouse = ScreenId -> Rational -> Rational -> X ()
warpToScreen ScreenId
0 (Rational
5forall a. Fractional a => a -> a -> a
/Rational
1600) (Rational
5forall 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows 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 = 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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     = forall m. Monoid m => [m] -> m
composeAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
s 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    = forall i l a s sd. StackSet i l a s sd -> Maybe a
peek forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Integer -> IO Double
modVolume String
k Integer
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> X ()
volumeDzen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round
volumeDzen :: String -> X ()
volumeDzen   = DzenConfig -> String -> X ()
dzenConfig forall a b. (a -> b) -> a -> b
$ (ScreenId -> DzenConfig) -> DzenConfig
onCurr (Int -> Int -> ScreenId -> DzenConfig
center Int
170 Int
66) 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 forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
RationalRect Rational
0 (-Rational
1forall a. Fractional a => a -> a -> a
/Rational
6) Rational
1 (Rational
4forall 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 forall a. Num a => a -> a -> a
- forall {a}. Fractional a => a
bwx) (Rational
y forall a. Num a => a -> a -> a
- forall {a}. Fractional a => a
bwy) (Rational
w forall a. Num a => a -> a -> a
+ Rational
2 forall a. Num a => a -> a -> a
* forall {a}. Fractional a => a
bwx) (Rational
h forall a. Num a => a -> a -> a
+ Rational
2 forall a. Num a => a -> a -> a
* forall {a}. Fractional a => a
bwy)
    bwx :: a
bwx = a
2 forall a. Fractional a => a -> a -> a
/ a
1920 -- borderwidth
    bwy :: a
bwy = a
2 forall a. Fractional a => a -> a -> a
/ a
1080

fullscreenMPlayer :: Query (Endo WindowSet)
fullscreenMPlayer = Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
"MPlayer" forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> do
    Display
dpy   <- forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    Word64
win   <- forall r (m :: * -> *). MonadReader r m => m r
ask
    SizeHints
hints <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Word64 -> IO SizeHints
getWMNormalHints Display
dpy Word64
win
    case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a} {a}. (Integral a, Integral a) => (a, a) -> Rational
approx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (SizeHints -> Maybe ((Dimension, Dimension), (Dimension, Dimension))
sh_aspect SizeHints
hints) of
        Just ( Integer
4 :% Integer
3)  -> 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" Word64
win
        Just (Integer
16 :% Integer
9)  -> 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" Word64
win
        Maybe Rational
_               -> Query (Endo WindowSet)
doFloat
    where
    approx :: (a, a) -> Rational
approx (a
n, a
d)    = forall a. RealFrac a => a -> a -> Rational
approxRational (forall a b. (Integral a, Num b) => a -> b
fi a
n forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fi a
d) (Double
1forall 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 <- forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ ScreenId -> X (Maybe String)
screenWorkspace ScreenId
s
    forall s. (s -> s) -> Query (Endo s)
doF forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 = 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 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 = 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 (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
79forall a. Fractional a => a -> a -> a
/Rational
960) (-Rational
1forall a. Fractional a => a -> a -> a
/Rational
540) (Rational
401forall a. Fractional a => a -> a -> a
/Rational
480) (Rational
271forall a. Fractional a => a -> a -> a
/Rational
270))
-- }}}
-- debugging {{{
class Show a => PPrint a where
    pprint :: Int -> a -> String
    pprint Int
_ = 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) = forall a. Show a => a -> String
show a
x
instance PPrint PPrintable where pprint :: Int -> PPrintable -> String
pprint Int
n (P a
x) = 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 forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
newline [String]
fields forall a. [a] -> [a] -> [a]
++ String
postlude where
    indentation :: String
indentation = Char
'\n' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
n Char
'\t'
    preamble :: String
preamble    = String
s forall a. [a] -> [a] -> [a]
++ String
" {" forall a. [a] -> [a] -> [a]
++ String
indentation
    postlude :: String
postlude    = String
indentation forall a. [a] -> [a] -> [a]
++ String
"}"
    newline :: String
newline     = Char
',' forall a. a -> [a] -> [a]
: String
indentation
    fields :: [String]
fields      = forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, PPrintable
value) -> String
name forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. PPrint a => Int -> a -> String
pprint (Int
nforall 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 (" forall a. [a] -> [a] -> [a]
++ forall a. PPrint a => Int -> a -> String
pprint Int
n a
x forall a. [a] -> [a] -> [a]
++ String
")"
    pprint Int
_ Maybe a
x        = 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 forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
newline [String]
allLines forall a. [a] -> [a] -> [a]
++ String
postlude where
        indentation :: String
indentation = Char
'\n' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
n Char
'\t'
        preamble :: String
preamble    = String
"[" forall a. [a] -> [a] -> [a]
++ String
indentation
        allLines :: [String]
allLines    = forall a b. (a -> b) -> [a] -> [b]
map (forall a. PPrint a => Int -> a -> String
pprint (Int
nforall a. Num a => a -> a -> a
+Int
1)) [a]
xs
        newline :: String
newline     = Char
',' forall a. a -> [a] -> [a]
: String
indentation
        postlude :: String
postlude    = String
indentation 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", forall a. PPrint a => a -> PPrintable
P (Rectangle -> Position
rect_x Rectangle
x)),
        (String
"rect_y", forall a. PPrint a => a -> PPrintable
P (Rectangle -> Position
rect_y Rectangle
x)),
        (String
"rect_width", forall a. PPrint a => a -> PPrintable
P (Rectangle -> Dimension
rect_width Rectangle
x)),
        (String
"rect_height", 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", forall a. PPrint a => a -> PPrintable
P (forall a. Stack a -> a
XMonad.StackSet.focus Stack a
x)),
        (String
"up", forall a. PPrint a => a -> PPrintable
P (forall a. Stack a -> [a]
up Stack a
x)),
        (String
"down", forall a. PPrint a => a -> PPrintable
P (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", forall a. PPrint a => a -> PPrintable
P (forall i l a. Workspace i l a -> i
tag Workspace i l a
x)),
        (String
"layout", forall a. PPrint a => a -> PPrintable
P (forall i l a. Workspace i l a -> l
layout Workspace i l a
x)),
        (String
"stack", forall a. PPrint a => a -> PPrintable
P (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", 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", forall a. PPrint a => a -> PPrintable
P (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", forall a. PPrint a => a -> PPrintable
P (forall i l a sid sd. Screen i l a sid sd -> sid
screen Screen i l a sid sd
x)),
        (String
"screenDetail", forall a. PPrint a => a -> PPrintable
P (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", forall a. PPrint a => a -> PPrintable
P (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", forall a. PPrint a => a -> PPrintable
P (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", forall a. PPrint a => a -> PPrintable
P (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", forall a. PPrint a => a -> PPrintable
P (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 = forall (a :: * -> *). XConfig a -> XConfig a
docks forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
    borderWidth :: Dimension
borderWidth             = Dimension
2,
    workspaces :: [String]
workspaces              = ScreenId -> [String] -> [String]
withScreens ScreenId
nScreens (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Integer
1..Integer
5]),
    terminal :: String
terminal                = String
"urxvt",
    normalBorderColor :: String
normalBorderColor       = String
dark,
    focusedBorderColor :: String
focusedBorderColor      = String
bright,
    modMask :: KeyMask
modMask                 = KeyMask
mod4Mask,
    keys :: XConfig Layout -> Map (KeyMask, Word64) (X ())
keys                    = XConfig Layout -> Map (KeyMask, Word64) (X ())
keyBindings,
    layoutHook :: ModifiedLayout
  Magnifier
  (Choose
     (ModifiedLayout AvoidStruts Grid) (ModifiedLayout WithBorder Full))
  Word64
layoutHook              = forall (l :: * -> *) a. l a -> ModifiedLayout Magnifier l a
magnifierOff forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout AvoidStruts l a
avoidStruts (forall a. Double -> Grid a
GridRatio Double
0.9) forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall (l :: * -> *).
LayoutClass l Word64 =>
l Word64 -> ModifiedLayout WithBorder l Word64
noBorders forall a. Full a
Full,
    manageHook :: Query (Endo WindowSet)
manageHook              =     (Query String
title forall a. Eq a => Query a -> a -> Query Bool
=? String
"CGoban: Main Window" forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> forall s. (s -> s) -> Query (Endo s)
doF forall {a} {i} {l} {s} {sd}.
Ord a =>
StackSet i l a s sd -> StackSet i l a s sd
sinkFocus)
                              forall a. Semigroup a => a -> a -> a
<> (Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
"Wine" forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Query String
appName forall a. Eq a => Query a -> a -> Query Bool
=? String
"hl2.exe" forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> Query String
appName forall a. Eq a => Query a -> a -> Query Bool
=? String
"portal2.exe") forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {t} {s} {l} {sd}.
(Ord t, Eq s) =>
ScreenId -> String -> t -> Query (Endo (StackSet String l t s sd))
viewFullOn {-centerWineOn-} ScreenId
1 String
"5")
                              forall a. Semigroup a => a -> a -> a
<> (Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
"VirtualBox" forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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")
                              forall a. Semigroup a => a -> a -> a
<> (Query Bool
isFullscreen forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> Query (Endo WindowSet)
doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <> compared to) this one
                              forall a. Semigroup a => a -> a -> a
<> (Query String
appName forall a. Eq a => Query a -> a -> Query Bool
=? String
"huludesktop" forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> RationalRect -> Query (Endo WindowSet)
doRectFloat RationalRect
fullscreen43on169)
                              forall a. Semigroup a => a -> a -> a
<> Query (Endo WindowSet)
fullscreenMPlayer
                              forall a. Semigroup a => a -> a -> a
<> [String] -> Query (Endo WindowSet)
floatAll [String
"Gimp", String
"Wine"]
                              forall a. Semigroup a => a -> a -> a
<> Query (Endo WindowSet)
manageSpawn,
    logHook :: X ()
logHook                 = ScreenId -> X ()
allPPs ScreenId
nScreens,
    startupHook :: X ()
startupHook             = X ()
refresh
                           forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> X ()
spawnOnce forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenId -> String
xmobarCommand) [ScreenId
0 .. ScreenId
nScreensforall a. Num a => a -> a -> a
-ScreenId
1]
    }

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

xmobarCommand :: ScreenId -> String
xmobarCommand (S Int
s) = [String] -> String
unwords [String
"xmobar",
    String
"-x", forall a. Show a => a -> String
show Int
s,
    String
"-t", 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 \"" forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => String -> a -> String
pipeName String
"focus"      Int
s forall a. [a] -> [a] -> [a]
++ String
"\" \"focus\",\
        \Run PipeReader \"" forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => String -> a -> String
pipeName String
"workspaces" Int
s forall a. [a] -> [a] -> [a]
++ String
"\" \"workspaces\"\
        \]'"

allPPs :: ScreenId -> X ()
allPPs ScreenId
nScreens = 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
nScreensforall 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 forall a. Default a => a
def {
    ppOrder :: [String] -> [String]
ppOrder  = \case{ String
_:String
_:String
windowTitle:[String]
_ -> [String
windowTitle]; [String]
_ -> [] },
    ppOutput :: String -> IO ()
ppOutput = String -> String -> IO ()
appendFile (forall {a}. Show a => String -> a -> String
pipeName String
"focus" Int
s_) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
"\n")
    }

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