{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
module XMonad.Config.Prime {-# DEPRECATED "This module is a perpetual draft and will therefore be removed from xmonad-contrib in the near future." #-} (
xmonad,
nothing,
normalBorderColor,
focusedBorderColor,
terminal,
modMask,
borderWidth,
focusFollowsMouse,
clickJustFocuses,
SettableClass(..),
UpdateableClass(..),
manageHook,
handleEventHook,
workspaces,
logHook,
startupHook,
clientMask,
rootMask,
SummableClass(..),
keys,
mouseBindings,
RemovableClass(..),
withWorkspaces,
wsNames,
wsKeys,
wsActions,
wsSetName,
withScreens,
sKeys,
sActions,
onScreens,
addLayout,
resetLayout,
modifyLayout,
startWith,
apply,
applyIO,
module XMonad,
module Prelude,
Prime,
Arr,
(>>),
ifThenElse,
) where
import Prelude hiding ((>>), mod)
import qualified Prelude as P ((>>=), (>>))
import XMonad.Prelude (All)
import XMonad hiding (xmonad, XConfig(..))
import XMonad (XConfig(XConfig))
import qualified XMonad.StackSet as W
import qualified XMonad as X (xmonad, XConfig(..))
import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings)
type Prime l l' = Arr (XConfig l) (XConfig l')
type Arr x y = x -> IO y
(>>) :: Arr x y -> Arr y z -> Arr x z
>> :: forall x y z. Arr x y -> Arr y z -> Arr x z
(>>) Arr x y
x Arr y z
y x
c = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (Arr x y
x x
c) Arr y z
y
ifThenElse :: Bool -> a -> a -> a
ifThenElse :: forall a. Bool -> a -> a -> a
ifThenElse Bool
True a
a a
_ = a
a
ifThenElse Bool
False a
_ a
b = a
b
xmonad :: (Default a, Read (l Window), LayoutClass l Window) =>
(a -> IO (XConfig l)) -> IO ()
xmonad :: forall a (l :: * -> *).
(Default a, Read (l Window), LayoutClass l Window) =>
(a -> IO (XConfig l)) -> IO ()
xmonad a -> IO (XConfig l)
prime = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (a -> IO (XConfig l)
prime forall a. Default a => a
def) forall (l :: * -> *).
(LayoutClass l Window, Read (l Window)) =>
XConfig l -> IO ()
X.xmonad
nothing :: Prime l l
nothing :: forall (l :: * -> *). Prime l l
nothing = forall (m :: * -> *) a. Monad m => a -> m a
return
class UpdateableClass s x y | s -> x y where
(=.) :: s c -> (x -> y) -> Arr c c
class SettableClass s x y | s -> x y where
(=:) :: s c -> y -> Arr c c
instance UpdateableClass s x y => SettableClass s x y where
s c
s =: :: forall c. s c -> y -> Arr c c
=: y
y = s c
s forall (s :: * -> *) x y c.
UpdateableClass s x y =>
s c -> (x -> y) -> Arr c c
=. forall a b. a -> b -> a
const y
y
data Settable x c = Settable (c -> x)
(x -> c -> c)
instance UpdateableClass (Settable x) x x where
(Settable c -> x
g x -> c -> c
s =. :: forall c. Settable x c -> (x -> x) -> Arr c c
=. x -> x
f) c
c = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ x -> c -> c
s (x -> x
f forall a b. (a -> b) -> a -> b
$ c -> x
g c
c) c
c
normalBorderColor :: Settable String (XConfig l)
normalBorderColor :: forall (l :: * -> *). Settable String (XConfig l)
normalBorderColor = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> String
X.normalBorderColor (\String
x XConfig l
c -> XConfig l
c { normalBorderColor :: String
X.normalBorderColor = String
x })
focusedBorderColor :: Settable String (XConfig l)
focusedBorderColor :: forall (l :: * -> *). Settable String (XConfig l)
focusedBorderColor = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> String
X.focusedBorderColor (\String
x XConfig l
c -> XConfig l
c { focusedBorderColor :: String
X.focusedBorderColor = String
x })
terminal :: Settable String (XConfig l)
terminal :: forall (l :: * -> *). Settable String (XConfig l)
terminal = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> String
X.terminal (\String
x XConfig l
c -> XConfig l
c { terminal :: String
X.terminal = String
x })
modMask :: Settable KeyMask (XConfig l)
modMask :: forall (l :: * -> *). Settable KeyMask (XConfig l)
modMask = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> KeyMask
X.modMask (\KeyMask
x XConfig l
c -> XConfig l
c { modMask :: KeyMask
X.modMask = KeyMask
x })
borderWidth :: Settable Dimension (XConfig l)
borderWidth :: forall (l :: * -> *). Settable Dimension (XConfig l)
borderWidth = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> Dimension
X.borderWidth (\Dimension
x XConfig l
c -> XConfig l
c { borderWidth :: Dimension
X.borderWidth = Dimension
x })
focusFollowsMouse :: Settable Bool (XConfig l)
focusFollowsMouse :: forall (l :: * -> *). Settable Bool (XConfig l)
focusFollowsMouse = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> Bool
X.focusFollowsMouse (\Bool
x XConfig l
c -> XConfig l
c { focusFollowsMouse :: Bool
X.focusFollowsMouse = Bool
x })
clickJustFocuses :: Settable Bool (XConfig l)
clickJustFocuses :: forall (l :: * -> *). Settable Bool (XConfig l)
clickJustFocuses = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> Bool
X.clickJustFocuses (\Bool
x XConfig l
c -> XConfig l
c { clickJustFocuses :: Bool
X.clickJustFocuses = Bool
x })
class SummableClass s y | s -> y where
(=+) :: s c -> y -> Arr c c
infix 0 =+
data Summable x y c = Summable (c -> x)
(x -> c -> c)
(x -> y -> x)
instance UpdateableClass (Summable x y) x x where
(Summable c -> x
g x -> c -> c
s x -> y -> x
_ =. :: forall c. Summable x y c -> (x -> x) -> Arr c c
=. x -> x
f) c
c = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ x -> c -> c
s (x -> x
f forall a b. (a -> b) -> a -> b
$ c -> x
g c
c) c
c
instance SummableClass (Summable x y) y where
(Summable c -> x
g x -> c -> c
s x -> y -> x
a =+ :: forall c. Summable x y c -> y -> Arr c c
=+ y
y) c
c = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ x -> c -> c
s (c -> x
g c
c x -> y -> x
`a` y
y) c
c
manageHook :: Summable ManageHook ManageHook (XConfig l)
manageHook :: forall (l :: * -> *). Summable ManageHook ManageHook (XConfig l)
manageHook = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> ManageHook
X.manageHook (\ManageHook
x XConfig l
c -> XConfig l
c { manageHook :: ManageHook
X.manageHook = ManageHook
x }) forall a. Semigroup a => a -> a -> a
(<>)
handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l)
handleEventHook :: forall (l :: * -> *).
Summable (Event -> X All) (Event -> X All) (XConfig l)
handleEventHook = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> Event -> X All
X.handleEventHook (\Event -> X All
x XConfig l
c -> XConfig l
c { handleEventHook :: Event -> X All
X.handleEventHook = Event -> X All
x }) forall a. Semigroup a => a -> a -> a
(<>)
workspaces :: Summable [String] [String] (XConfig l)
workspaces :: forall (l :: * -> *). Summable [String] [String] (XConfig l)
workspaces = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> [String]
X.workspaces (\[String]
x XConfig l
c -> XConfig l
c { workspaces :: [String]
X.workspaces = [String]
x }) forall a. [a] -> [a] -> [a]
(++)
logHook :: Summable (X ()) (X ()) (XConfig l)
logHook :: forall (l :: * -> *). Summable (X ()) (X ()) (XConfig l)
logHook = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> X ()
X.logHook (\X ()
x XConfig l
c -> XConfig l
c { logHook :: X ()
X.logHook = X ()
x }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>)
startupHook :: Summable (X ()) (X ()) (XConfig l)
startupHook :: forall (l :: * -> *). Summable (X ()) (X ()) (XConfig l)
startupHook = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> X ()
X.startupHook (\X ()
x XConfig l
c -> XConfig l
c { startupHook :: X ()
X.startupHook = X ()
x }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>)
clientMask :: Summable EventMask EventMask (XConfig l)
clientMask :: forall (l :: * -> *). Summable Window Window (XConfig l)
clientMask = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> Window
X.clientMask (\Window
x XConfig l
c -> XConfig l
c { clientMask :: Window
X.clientMask = Window
x }) forall a. Bits a => a -> a -> a
(.|.)
rootMask :: Summable EventMask EventMask (XConfig l)
rootMask :: forall (l :: * -> *). Summable Window Window (XConfig l)
rootMask = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> Window
X.rootMask (\Window
x XConfig l
c -> XConfig l
c { rootMask :: Window
X.rootMask = Window
x }) forall a. Bits a => a -> a -> a
(.|.)
class RemovableClass r y | r -> y where
(=-) :: r c -> y -> Arr c c
infix 0 =-
data Keys c = Keys { forall c. Keys c -> [(String, X ())] -> c -> c
kAdd :: [(String, X ())] -> c -> c,
forall c. Keys c -> [String] -> c -> c
kRemove :: [String] -> c -> c }
instance SummableClass Keys [(String, X ())] where
Keys { kAdd :: forall c. Keys c -> [(String, X ())] -> c -> c
kAdd = [(String, X ())] -> c -> c
a } =+ :: forall c. Keys c -> [(String, X ())] -> Arr c c
=+ [(String, X ())]
newKeys = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, X ())] -> c -> c
a [(String, X ())]
newKeys
instance RemovableClass Keys [String] where
Keys { kRemove :: forall c. Keys c -> [String] -> c -> c
kRemove = [String] -> c -> c
r } =- :: forall c. Keys c -> [String] -> Arr c c
=- [String]
sadKeys = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> c -> c
r [String]
sadKeys
keys :: Keys (XConfig l)
keys :: forall (l :: * -> *). Keys (XConfig l)
keys = Keys {
kAdd :: [(String, X ())] -> XConfig l -> XConfig l
kAdd = \[(String, X ())]
newKeys XConfig l
c -> (XConfig l
c forall (l :: * -> *). XConfig l -> [(String, X ())] -> XConfig l
`additionalKeysP` [(String, X ())]
newKeys) { startupHook :: X ()
X.startupHook = forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>) (forall (l :: * -> *). XConfig l -> X ()
X.startupHook XConfig l
c) (forall (l :: * -> *) a. XConfig l -> [(String, a)] -> X ()
checkKeymap XConfig l
c [(String, X ())]
newKeys) },
kRemove :: [String] -> XConfig l -> XConfig l
kRemove = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (l :: * -> *). XConfig l -> [String] -> XConfig l
removeKeysP
}
data MouseBindings c = MouseBindings { forall c.
MouseBindings c
-> [((KeyMask, Dimension), Window -> X ())] -> c -> c
mAdd :: [((ButtonMask, Button), Window -> X ())] -> c -> c,
forall c. MouseBindings c -> [(KeyMask, Dimension)] -> c -> c
mRemove :: [(ButtonMask, Button)] -> c -> c }
instance SummableClass MouseBindings [((ButtonMask, Button), Window -> X ())] where
MouseBindings { mAdd :: forall c.
MouseBindings c
-> [((KeyMask, Dimension), Window -> X ())] -> c -> c
mAdd = [((KeyMask, Dimension), Window -> X ())] -> c -> c
a } =+ :: forall c.
MouseBindings c
-> [((KeyMask, Dimension), Window -> X ())] -> Arr c c
=+ [((KeyMask, Dimension), Window -> X ())]
newBindings = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((KeyMask, Dimension), Window -> X ())] -> c -> c
a [((KeyMask, Dimension), Window -> X ())]
newBindings
instance RemovableClass MouseBindings [(ButtonMask, Button)] where
MouseBindings { mRemove :: forall c. MouseBindings c -> [(KeyMask, Dimension)] -> c -> c
mRemove = [(KeyMask, Dimension)] -> c -> c
r } =- :: forall c. MouseBindings c -> [(KeyMask, Dimension)] -> Arr c c
=- [(KeyMask, Dimension)]
sadBindings = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(KeyMask, Dimension)] -> c -> c
r [(KeyMask, Dimension)]
sadBindings
mouseBindings :: MouseBindings (XConfig l)
mouseBindings :: forall (l :: * -> *). MouseBindings (XConfig l)
mouseBindings = MouseBindings {
mAdd :: [((KeyMask, Dimension), Window -> X ())] -> XConfig l -> XConfig l
mAdd = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: * -> *).
XConfig a -> [((KeyMask, Dimension), Window -> X ())] -> XConfig a
additionalMouseBindings,
mRemove :: [(KeyMask, Dimension)] -> XConfig l -> XConfig l
mRemove = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: * -> *).
XConfig a -> [(KeyMask, Dimension)] -> XConfig a
removeMouseBindings
}
withWorkspaces :: Arr WorkspaceConfig WorkspaceConfig -> Prime l l
withWorkspaces :: forall (l :: * -> *).
Arr WorkspaceConfig WorkspaceConfig -> Prime l l
withWorkspaces Arr WorkspaceConfig WorkspaceConfig
wsarr XConfig l
xconf = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (Arr WorkspaceConfig WorkspaceConfig
wsarr forall a. Default a => a
def) forall a b. (a -> b) -> a -> b
$ \WorkspaceConfig
wsconf -> forall (l :: * -> *). WorkspaceConfig -> Prime l l
wsprime WorkspaceConfig
wsconf XConfig l
xconf
where wsprime :: WorkspaceConfig -> Prime l l
wsprime :: forall (l :: * -> *). WorkspaceConfig -> Prime l l
wsprime WorkspaceConfig
wsconf =
(forall (l :: * -> *). Summable [String] [String] (XConfig l)
workspaces forall (s :: * -> *) x y c.
SettableClass s x y =>
s c -> y -> Arr c c
=: [String]
allNames) forall x y z. Arr x y -> Arr y z -> Arr x z
>>
(forall (l :: * -> *). Keys (XConfig l)
keys forall (s :: * -> *) y c. SummableClass s y => s c -> y -> Arr c c
=+ [(String
mod forall a. [a] -> [a] -> [a]
++ String
key, String -> X ()
action String
name) | (String
name, String
key) <- forall a b. [a] -> [b] -> [(a, b)]
zip [String]
allNames (WorkspaceConfig -> [String]
wsKeys_ WorkspaceConfig
wsconf),
(String
mod, String -> X ()
action) <- WorkspaceConfig -> [(String, String -> X ())]
wsActions_ WorkspaceConfig
wsconf])
where allNames :: [String]
allNames = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t :: * -> *} {a}. Foldable t => t a -> t a -> t a
chooseName (WorkspaceConfig -> [String]
wsNames_ WorkspaceConfig
wsconf) (WorkspaceConfig -> [String]
wsKeys_ WorkspaceConfig
wsconf)
chooseName :: t a -> t a -> t a
chooseName t a
name t a
keyspec = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
name) then t a
name else t a
keyspec
data WorkspaceConfig = WorkspaceConfig {
WorkspaceConfig -> [String]
wsNames_ :: [String],
WorkspaceConfig -> [String]
wsKeys_ :: [String],
WorkspaceConfig -> [(String, String -> X ())]
wsActions_ :: [(String, String -> X ())]
}
instance Default WorkspaceConfig where
def :: WorkspaceConfig
def = WorkspaceConfig {
wsNames_ :: [String]
wsNames_ = forall a. a -> [a]
repeat String
"",
wsKeys_ :: [String]
wsKeys_ = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) [Char
'1'..Char
'9'],
wsActions_ :: [(String, String -> X ())]
wsActions_ = [(String
"M-", (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView),
(String
"M-S-", (WindowSet -> WindowSet) -> X ()
windows 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
W.shift)]
}
wsNames :: Settable [String] WorkspaceConfig
wsNames :: Settable [String] WorkspaceConfig
wsNames = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable WorkspaceConfig -> [String]
wsNames_ (\[String]
x WorkspaceConfig
c -> WorkspaceConfig
c { wsNames_ :: [String]
wsNames_ = [String]
x })
wsKeys :: Summable [String] [String] WorkspaceConfig
wsKeys :: Summable [String] [String] WorkspaceConfig
wsKeys = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable WorkspaceConfig -> [String]
wsKeys_ (\[String]
x WorkspaceConfig
c -> WorkspaceConfig
c { wsKeys_ :: [String]
wsKeys_ = [String]
x }) forall a. [a] -> [a] -> [a]
(++)
wsActions :: Summable [(String, String -> X ())] [(String, String -> X ())] WorkspaceConfig
wsActions :: Summable
[(String, String -> X ())]
[(String, String -> X ())]
WorkspaceConfig
wsActions = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable WorkspaceConfig -> [(String, String -> X ())]
wsActions_ (\[(String, String -> X ())]
x WorkspaceConfig
c -> WorkspaceConfig
c { wsActions_ :: [(String, String -> X ())]
wsActions_ = [(String, String -> X ())]
x }) forall a. [a] -> [a] -> [a]
(++)
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
wsSetName Int
index String
newName = Settable [String] WorkspaceConfig
wsNames forall (s :: * -> *) x y c.
UpdateableClass s x y =>
s c -> (x -> y) -> Arr c c
=. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Int, String) -> String
maybeSet) [Int
0..]
where maybeSet :: (Int, String) -> String
maybeSet (Int
i, String
oldName) | Int
i forall a. Eq a => a -> a -> Bool
== (Int
index forall a. Num a => a -> a -> a
- Int
1) = String
newName
| Bool
otherwise = String
oldName
withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
withScreens :: forall (l :: * -> *). Arr ScreenConfig ScreenConfig -> Prime l l
withScreens Arr ScreenConfig ScreenConfig
sarr XConfig l
xconf = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (Arr ScreenConfig ScreenConfig
sarr forall a. Default a => a
def) forall a b. (a -> b) -> a -> b
$ \ScreenConfig
sconf -> forall (l :: * -> *). ScreenConfig -> Prime l l
sprime ScreenConfig
sconf XConfig l
xconf
where sprime :: ScreenConfig -> Prime l l
sprime :: forall (l :: * -> *). ScreenConfig -> Prime l l
sprime ScreenConfig
sconf =
forall (l :: * -> *). Keys (XConfig l)
keys forall (s :: * -> *) y c. SummableClass s y => s c -> y -> Arr c c
=+ [(String
mod forall a. [a] -> [a] -> [a]
++ String
key, ScreenId -> X ()
action ScreenId
sid) | (ScreenId
sid, String
key) <- forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId
0..] (ScreenConfig -> [String]
sKeys_ ScreenConfig
sconf),
(String
mod, ScreenId -> X ()
action) <- ScreenConfig -> [(String, ScreenId -> X ())]
sActions_ ScreenConfig
sconf]
data ScreenConfig = ScreenConfig {
ScreenConfig -> [String]
sKeys_ :: [String],
ScreenConfig -> [(String, ScreenId -> X ())]
sActions_ :: [(String, ScreenId -> X ())]
}
instance Default ScreenConfig where
def :: ScreenConfig
def = ScreenConfig {
sKeys_ :: [String]
sKeys_ = [String
"w", String
"e", String
"r"],
sActions_ :: [(String, ScreenId -> X ())]
sActions_ = [(String
"M-", (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
Eq s =>
(i -> StackSet i l a s sd -> StackSet i l a s sd)
-> s -> StackSet i l a s sd -> StackSet i l a s sd
onScreens forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view),
(String
"M-S-", (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
Eq s =>
(i -> StackSet i l a s sd -> StackSet i l a s sd)
-> s -> StackSet i l a s sd -> StackSet i l a s sd
onScreens 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
W.shift)]
}
sKeys :: Summable [String] [String] ScreenConfig
sKeys :: Summable [String] [String] ScreenConfig
sKeys = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable ScreenConfig -> [String]
sKeys_ (\[String]
x ScreenConfig
c -> ScreenConfig
c { sKeys_ :: [String]
sKeys_ = [String]
x }) forall a. [a] -> [a] -> [a]
(++)
sActions :: Summable [(String, ScreenId -> X ())] [(String, ScreenId -> X ())] ScreenConfig
sActions :: Summable
[(String, ScreenId -> X ())]
[(String, ScreenId -> X ())]
ScreenConfig
sActions = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable ScreenConfig -> [(String, ScreenId -> X ())]
sActions_ (\[(String, ScreenId -> X ())]
x ScreenConfig
c -> ScreenConfig
c { sActions_ :: [(String, ScreenId -> X ())]
sActions_ = [(String, ScreenId -> X ())]
x }) forall a. [a] -> [a] -> [a]
(++)
onScreens :: Eq s => (i -> W.StackSet i l a s sd -> W.StackSet i l a s sd) ->
s -> W.StackSet i l a s sd -> W.StackSet i l a s sd
onScreens :: forall s i l a sd.
Eq s =>
(i -> StackSet i l a s sd -> StackSet i l a s sd)
-> s -> StackSet i l a s sd -> StackSet i l a s sd
onScreens i -> StackSet i l a s sd -> StackSet i l a s sd
f s
sc StackSet i l a s sd
ws = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id i -> StackSet i l a s sd -> StackSet i l a s sd
f (forall s i l a sd. Eq s => s -> StackSet i l a s sd -> Maybe i
W.lookupWorkspace s
sc StackSet i l a s sd
ws) StackSet i l a s sd
ws
addLayout :: (LayoutClass l Window, LayoutClass r Window) => r Window -> Prime l (Choose l r)
addLayout :: forall (l :: * -> *) (r :: * -> *).
(LayoutClass l Window, LayoutClass r Window) =>
r Window -> Prime l (Choose l r)
addLayout r Window
r XConfig l
c = forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
c { layoutHook :: Choose l r Window
X.layoutHook = forall (l :: * -> *). XConfig l -> l Window
X.layoutHook XConfig l
c forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| r Window
r }
resetLayout :: (LayoutClass r Window) => r Window -> Prime l r
resetLayout :: forall (r :: * -> *) (l :: * -> *).
LayoutClass r Window =>
r Window -> Prime l r
resetLayout r Window
r XConfig l
c = forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
c { layoutHook :: r Window
X.layoutHook = r Window
r }
modifyLayout :: (LayoutClass r Window) => (l Window -> r Window) -> Prime l r
modifyLayout :: forall (r :: * -> *) (l :: * -> *).
LayoutClass r Window =>
(l Window -> r Window) -> Prime l r
modifyLayout l Window -> r Window
f XConfig l
c = forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
c { layoutHook :: r Window
X.layoutHook = l Window -> r Window
f forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> l Window
X.layoutHook XConfig l
c }
startWith :: XConfig l' -> Prime l l'
startWith :: forall (l' :: * -> *) (l :: * -> *). XConfig l' -> Prime l l'
startWith = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
apply :: (XConfig l -> XConfig l') -> Prime l l'
apply :: forall (l :: * -> *) (l' :: * -> *).
(XConfig l -> XConfig l') -> Prime l l'
apply XConfig l -> XConfig l'
f = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig l -> XConfig l'
f
applyIO :: (XConfig l -> IO (XConfig l')) -> Prime l l'
applyIO :: forall (l :: * -> *) (l' :: * -> *).
(XConfig l -> IO (XConfig l')) -> XConfig l -> IO (XConfig l')
applyIO = forall a. a -> a
id