{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
module XMonad.Config.Prime (
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
>> :: Arr x y -> Arr y z -> Arr x z
(>>) Arr x y
x Arr y z
y x
c = IO y -> Arr y z -> IO z
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 :: 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 :: (a -> IO (XConfig l)) -> IO ()
xmonad a -> IO (XConfig l)
prime = IO (XConfig l) -> (XConfig l -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (a -> IO (XConfig l)
prime a
forall a. Default a => a
def) XConfig l -> IO ()
forall (l :: * -> *).
(LayoutClass l Window, Read (l Window)) =>
XConfig l -> IO ()
X.xmonad
nothing :: Prime l l
nothing :: Prime l l
nothing = Prime l l
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 =: :: s c -> y -> Arr c c
=: y
y = s c
s s c -> (x -> y) -> Arr c c
forall (s :: * -> *) x y c.
UpdateableClass s x y =>
s c -> (x -> y) -> Arr c c
=. y -> x -> y
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 =. :: Settable x c -> (x -> x) -> Arr c c
=. x -> x
f) c
c = Arr c c
forall (m :: * -> *) a. Monad m => a -> m a
return Arr c c -> Arr c c
forall a b. (a -> b) -> a -> b
$ x -> c -> c
s (x -> x
f (x -> x) -> x -> x
forall a b. (a -> b) -> a -> b
$ c -> x
g c
c) c
c
normalBorderColor :: Settable String (XConfig l)
normalBorderColor :: Settable String (XConfig l)
normalBorderColor = (XConfig l -> String)
-> (String -> XConfig l -> XConfig l)
-> Settable String (XConfig l)
forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable XConfig l -> String
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 :: Settable String (XConfig l)
focusedBorderColor = (XConfig l -> String)
-> (String -> XConfig l -> XConfig l)
-> Settable String (XConfig l)
forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable XConfig l -> String
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 :: Settable String (XConfig l)
terminal = (XConfig l -> String)
-> (String -> XConfig l -> XConfig l)
-> Settable String (XConfig l)
forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable XConfig l -> String
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 :: Settable KeyMask (XConfig l)
modMask = (XConfig l -> KeyMask)
-> (KeyMask -> XConfig l -> XConfig l)
-> Settable KeyMask (XConfig l)
forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable XConfig l -> KeyMask
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 :: Settable Dimension (XConfig l)
borderWidth = (XConfig l -> Dimension)
-> (Dimension -> XConfig l -> XConfig l)
-> Settable Dimension (XConfig l)
forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable XConfig l -> Dimension
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 :: Settable Bool (XConfig l)
focusFollowsMouse = (XConfig l -> Bool)
-> (Bool -> XConfig l -> XConfig l) -> Settable Bool (XConfig l)
forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable XConfig l -> Bool
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 :: Settable Bool (XConfig l)
clickJustFocuses = (XConfig l -> Bool)
-> (Bool -> XConfig l -> XConfig l) -> Settable Bool (XConfig l)
forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable XConfig l -> Bool
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
_ =. :: Summable x y c -> (x -> x) -> Arr c c
=. x -> x
f) c
c = Arr c c
forall (m :: * -> *) a. Monad m => a -> m a
return Arr c c -> Arr c c
forall a b. (a -> b) -> a -> b
$ x -> c -> c
s (x -> x
f (x -> x) -> x -> x
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 =+ :: Summable x y c -> y -> Arr c c
=+ y
y) c
c = Arr c c
forall (m :: * -> *) a. Monad m => a -> m a
return Arr c c -> Arr c c
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 :: Summable ManageHook ManageHook (XConfig l)
manageHook = (XConfig l -> ManageHook)
-> (ManageHook -> XConfig l -> XConfig l)
-> (ManageHook -> ManageHook -> ManageHook)
-> Summable ManageHook ManageHook (XConfig l)
forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable XConfig l -> ManageHook
forall (l :: * -> *). XConfig l -> ManageHook
X.manageHook (\ManageHook
x XConfig l
c -> XConfig l
c { manageHook :: ManageHook
X.manageHook = ManageHook
x }) ManageHook -> ManageHook -> ManageHook
forall m. Monoid m => m -> m -> m
(<+>)
handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l)
handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l)
handleEventHook = (XConfig l -> Event -> X All)
-> ((Event -> X All) -> XConfig l -> XConfig l)
-> ((Event -> X All) -> (Event -> X All) -> Event -> X All)
-> Summable (Event -> X All) (Event -> X All) (XConfig l)
forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable XConfig l -> Event -> X All
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 }) (Event -> X All) -> (Event -> X All) -> Event -> X All
forall m. Monoid m => m -> m -> m
(<+>)
workspaces :: Summable [String] [String] (XConfig l)
workspaces :: Summable [String] [String] (XConfig l)
workspaces = (XConfig l -> [String])
-> ([String] -> XConfig l -> XConfig l)
-> ([String] -> [String] -> [String])
-> Summable [String] [String] (XConfig l)
forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable XConfig l -> [String]
forall (l :: * -> *). XConfig l -> [String]
X.workspaces (\[String]
x XConfig l
c -> XConfig l
c { workspaces :: [String]
X.workspaces = [String]
x }) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++)
logHook :: Summable (X ()) (X ()) (XConfig l)
logHook :: Summable (X ()) (X ()) (XConfig l)
logHook = (XConfig l -> X ())
-> (X () -> XConfig l -> XConfig l)
-> (X () -> X () -> X ())
-> Summable (X ()) (X ()) (XConfig l)
forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
X.logHook (\X ()
x XConfig l
c -> XConfig l
c { logHook :: X ()
X.logHook = X ()
x }) X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>)
startupHook :: Summable (X ()) (X ()) (XConfig l)
startupHook :: Summable (X ()) (X ()) (XConfig l)
startupHook = (XConfig l -> X ())
-> (X () -> XConfig l -> XConfig l)
-> (X () -> X () -> X ())
-> Summable (X ()) (X ()) (XConfig l)
forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
X.startupHook (\X ()
x XConfig l
c -> XConfig l
c { startupHook :: X ()
X.startupHook = X ()
x }) X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>)
clientMask :: Summable EventMask EventMask (XConfig l)
clientMask :: Summable Window Window (XConfig l)
clientMask = (XConfig l -> Window)
-> (Window -> XConfig l -> XConfig l)
-> (Window -> Window -> Window)
-> Summable Window Window (XConfig l)
forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable XConfig l -> Window
forall (l :: * -> *). XConfig l -> Window
X.clientMask (\Window
x XConfig l
c -> XConfig l
c { clientMask :: Window
X.clientMask = Window
x }) Window -> Window -> Window
forall a. Bits a => a -> a -> a
(.|.)
rootMask :: Summable EventMask EventMask (XConfig l)
rootMask :: Summable Window Window (XConfig l)
rootMask = (XConfig l -> Window)
-> (Window -> XConfig l -> XConfig l)
-> (Window -> Window -> Window)
-> Summable Window Window (XConfig l)
forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable XConfig l -> Window
forall (l :: * -> *). XConfig l -> Window
X.rootMask (\Window
x XConfig l
c -> XConfig l
c { rootMask :: Window
X.rootMask = Window
x }) Window -> Window -> Window
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 { Keys c -> [(String, X ())] -> c -> c
kAdd :: [(String, X ())] -> c -> 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 } =+ :: Keys c -> [(String, X ())] -> Arr c c
=+ [(String, X ())]
newKeys = Arr c c
forall (m :: * -> *) a. Monad m => a -> m a
return Arr c c -> (c -> c) -> Arr c c
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 } =- :: Keys c -> [String] -> Arr c c
=- [String]
sadKeys = Arr c c
forall (m :: * -> *) a. Monad m => a -> m a
return Arr c c -> (c -> c) -> Arr c c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> c -> c
r [String]
sadKeys
keys :: Keys (XConfig l)
keys :: Keys (XConfig l)
keys = Keys :: forall c.
([(String, X ())] -> c -> c) -> ([String] -> c -> c) -> Keys c
Keys {
kAdd :: [(String, X ())] -> XConfig l -> XConfig l
kAdd = \[(String, X ())]
newKeys XConfig l
c -> (XConfig l
c XConfig l -> [(String, X ())] -> XConfig l
forall (l :: * -> *). XConfig l -> [(String, X ())] -> XConfig l
`additionalKeysP` [(String, X ())]
newKeys) { startupHook :: X ()
X.startupHook = X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>) (XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
X.startupHook XConfig l
c) (XConfig l -> [(String, X ())] -> X ()
forall (l :: * -> *) a. XConfig l -> [(String, a)] -> X ()
checkKeymap XConfig l
c [(String, X ())]
newKeys) },
kRemove :: [String] -> XConfig l -> XConfig l
kRemove = (XConfig l -> [String] -> XConfig l)
-> [String] -> XConfig l -> XConfig l
forall a b c. (a -> b -> c) -> b -> a -> c
flip XConfig l -> [String] -> XConfig l
forall (l :: * -> *). XConfig l -> [String] -> XConfig l
removeKeysP
}
data MouseBindings c = MouseBindings { MouseBindings c
-> [((KeyMask, Dimension), Window -> X ())] -> c -> c
mAdd :: [((ButtonMask, Button), Window -> X ())] -> c -> 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 } =+ :: MouseBindings c
-> [((KeyMask, Dimension), Window -> X ())] -> Arr c c
=+ [((KeyMask, Dimension), Window -> X ())]
newBindings = Arr c c
forall (m :: * -> *) a. Monad m => a -> m a
return Arr c c -> (c -> c) -> Arr c c
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 } =- :: MouseBindings c -> [(KeyMask, Dimension)] -> Arr c c
=- [(KeyMask, Dimension)]
sadBindings = Arr c c
forall (m :: * -> *) a. Monad m => a -> m a
return Arr c c -> (c -> c) -> Arr c c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(KeyMask, Dimension)] -> c -> c
r [(KeyMask, Dimension)]
sadBindings
mouseBindings :: MouseBindings (XConfig l)
mouseBindings :: MouseBindings (XConfig l)
mouseBindings = MouseBindings :: forall c.
([((KeyMask, Dimension), Window -> X ())] -> c -> c)
-> ([(KeyMask, Dimension)] -> c -> c) -> MouseBindings c
MouseBindings {
mAdd :: [((KeyMask, Dimension), Window -> X ())] -> XConfig l -> XConfig l
mAdd = (XConfig l
-> [((KeyMask, Dimension), Window -> X ())] -> XConfig l)
-> [((KeyMask, Dimension), Window -> X ())]
-> XConfig l
-> XConfig l
forall a b c. (a -> b -> c) -> b -> a -> c
flip XConfig l -> [((KeyMask, Dimension), Window -> X ())] -> XConfig l
forall (a :: * -> *).
XConfig a -> [((KeyMask, Dimension), Window -> X ())] -> XConfig a
additionalMouseBindings,
mRemove :: [(KeyMask, Dimension)] -> XConfig l -> XConfig l
mRemove = (XConfig l -> [(KeyMask, Dimension)] -> XConfig l)
-> [(KeyMask, Dimension)] -> XConfig l -> XConfig l
forall a b c. (a -> b -> c) -> b -> a -> c
flip XConfig l -> [(KeyMask, Dimension)] -> XConfig l
forall (a :: * -> *).
XConfig a -> [(KeyMask, Dimension)] -> XConfig a
removeMouseBindings
}
withWorkspaces :: Arr WorkspaceConfig WorkspaceConfig -> Prime l l
withWorkspaces :: Arr WorkspaceConfig WorkspaceConfig -> Prime l l
withWorkspaces Arr WorkspaceConfig WorkspaceConfig
wsarr XConfig l
xconf = IO WorkspaceConfig
-> (WorkspaceConfig -> IO (XConfig l)) -> IO (XConfig l)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (Arr WorkspaceConfig WorkspaceConfig
wsarr WorkspaceConfig
forall a. Default a => a
def) ((WorkspaceConfig -> IO (XConfig l)) -> IO (XConfig l))
-> (WorkspaceConfig -> IO (XConfig l)) -> IO (XConfig l)
forall a b. (a -> b) -> a -> b
$ \WorkspaceConfig
wsconf -> WorkspaceConfig -> Prime l l
forall (l :: * -> *). WorkspaceConfig -> Prime l l
wsprime WorkspaceConfig
wsconf XConfig l
xconf
where wsprime :: WorkspaceConfig -> Prime l l
wsprime :: WorkspaceConfig -> Prime l l
wsprime WorkspaceConfig
wsconf =
(Summable [String] [String] (XConfig l)
forall (l :: * -> *). Summable [String] [String] (XConfig l)
workspaces Summable [String] [String] (XConfig l) -> [String] -> Prime l l
forall (s :: * -> *) x y c.
SettableClass s x y =>
s c -> y -> Arr c c
=: [String]
allNames) Prime l l -> Prime l l -> Prime l l
forall x y z. Arr x y -> Arr y z -> Arr x z
>>
(Keys (XConfig l)
forall (l :: * -> *). Keys (XConfig l)
keys Keys (XConfig l) -> [(String, X ())] -> Prime l l
forall (s :: * -> *) y c. SummableClass s y => s c -> y -> Arr c c
=+ [(String
mod String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key, String -> X ()
action String
name) | (String
name, String
key) <- [String] -> [String] -> [(String, String)]
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 = (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
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 (t a -> Bool
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 :: [String]
-> [String] -> [(String, String -> X ())] -> WorkspaceConfig
WorkspaceConfig {
wsNames_ :: [String]
wsNames_ = String -> [String]
forall a. a -> [a]
repeat String
"",
wsKeys_ :: [String]
wsKeys_ = (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) [Char
'1'..Char
'9'],
wsActions_ :: [(String, String -> X ())]
wsActions_ = [(String
"M-", (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
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 ((WindowSet -> WindowSet) -> X ())
-> (String -> WindowSet -> WindowSet) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
W.shift)]
}
wsNames :: Settable [String] WorkspaceConfig
wsNames :: Settable [String] WorkspaceConfig
wsNames = (WorkspaceConfig -> [String])
-> ([String] -> WorkspaceConfig -> WorkspaceConfig)
-> Settable [String] WorkspaceConfig
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 = (WorkspaceConfig -> [String])
-> ([String] -> WorkspaceConfig -> WorkspaceConfig)
-> ([String] -> [String] -> [String])
-> Summable [String] [String] WorkspaceConfig
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 }) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++)
wsActions :: Summable [(String, String -> X ())] [(String, String -> X ())] WorkspaceConfig
wsActions :: Summable
[(String, String -> X ())]
[(String, String -> X ())]
WorkspaceConfig
wsActions = (WorkspaceConfig -> [(String, String -> X ())])
-> ([(String, String -> X ())]
-> WorkspaceConfig -> WorkspaceConfig)
-> ([(String, String -> X ())]
-> [(String, String -> X ())] -> [(String, String -> X ())])
-> Summable
[(String, String -> X ())]
[(String, String -> X ())]
WorkspaceConfig
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 }) [(String, String -> X ())]
-> [(String, String -> X ())] -> [(String, String -> 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 Settable [String] WorkspaceConfig
-> ([String] -> [String]) -> Arr WorkspaceConfig WorkspaceConfig
forall (s :: * -> *) x y c.
UpdateableClass s x y =>
s c -> (x -> y) -> Arr c c
=. (Int -> String -> String) -> [Int] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Int, String) -> String) -> Int -> String -> String
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) = String
newName
| Bool
otherwise = String
oldName
withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
withScreens Arr ScreenConfig ScreenConfig
sarr XConfig l
xconf = IO ScreenConfig
-> (ScreenConfig -> IO (XConfig l)) -> IO (XConfig l)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (Arr ScreenConfig ScreenConfig
sarr ScreenConfig
forall a. Default a => a
def) ((ScreenConfig -> IO (XConfig l)) -> IO (XConfig l))
-> (ScreenConfig -> IO (XConfig l)) -> IO (XConfig l)
forall a b. (a -> b) -> a -> b
$ \ScreenConfig
sconf -> ScreenConfig -> Prime l l
forall (l :: * -> *). ScreenConfig -> Prime l l
sprime ScreenConfig
sconf XConfig l
xconf
where sprime :: ScreenConfig -> Prime l l
sprime :: ScreenConfig -> Prime l l
sprime ScreenConfig
sconf =
Keys (XConfig l)
forall (l :: * -> *). Keys (XConfig l)
keys Keys (XConfig l) -> [(String, X ())] -> Prime l l
forall (s :: * -> *) y c. SummableClass s y => s c -> y -> Arr c c
=+ [(String
mod String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key, ScreenId -> X ()
action ScreenId
sid) | (ScreenId
sid, String
key) <- [ScreenId] -> [String] -> [(ScreenId, String)]
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 :: [String] -> [(String, ScreenId -> X ())] -> ScreenConfig
ScreenConfig {
sKeys_ :: [String]
sKeys_ = [String
"w", String
"e", String
"r"],
sActions_ :: [(String, ScreenId -> X ())]
sActions_ = [(String
"M-", (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (ScreenId -> WindowSet -> WindowSet) -> ScreenId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> WindowSet -> WindowSet)
-> ScreenId -> WindowSet -> WindowSet
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 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
W.view),
(String
"M-S-", (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (ScreenId -> WindowSet -> WindowSet) -> ScreenId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> WindowSet -> WindowSet)
-> ScreenId -> WindowSet -> WindowSet
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 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
W.shift)]
}
sKeys :: Summable [String] [String] ScreenConfig
sKeys :: Summable [String] [String] ScreenConfig
sKeys = (ScreenConfig -> [String])
-> ([String] -> ScreenConfig -> ScreenConfig)
-> ([String] -> [String] -> [String])
-> Summable [String] [String] ScreenConfig
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 }) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++)
sActions :: Summable [(String, ScreenId -> X ())] [(String, ScreenId -> X ())] ScreenConfig
sActions :: Summable
[(String, ScreenId -> X ())]
[(String, ScreenId -> X ())]
ScreenConfig
sActions = (ScreenConfig -> [(String, ScreenId -> X ())])
-> ([(String, ScreenId -> X ())] -> ScreenConfig -> ScreenConfig)
-> ([(String, ScreenId -> X ())]
-> [(String, ScreenId -> X ())] -> [(String, ScreenId -> X ())])
-> Summable
[(String, ScreenId -> X ())]
[(String, ScreenId -> X ())]
ScreenConfig
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 }) [(String, ScreenId -> X ())]
-> [(String, ScreenId -> X ())] -> [(String, ScreenId -> 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 :: (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 = (StackSet i l a s sd -> StackSet i l a s sd)
-> (i -> StackSet i l a s sd -> StackSet i l a s sd)
-> Maybe i
-> 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 i -> StackSet i l a s sd -> StackSet i l a s sd
f (s -> StackSet i l a s sd -> Maybe i
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 :: r Window -> Prime l (Choose l r)
addLayout r Window
r XConfig l
c = XConfig (Choose l r) -> IO (XConfig (Choose l r))
forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
c { layoutHook :: Choose l r Window
X.layoutHook = XConfig l -> l Window
forall (l :: * -> *). XConfig l -> l Window
X.layoutHook XConfig l
c l Window -> r Window -> Choose l r Window
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 :: r Window -> Prime l r
resetLayout r Window
r XConfig l
c = XConfig r -> IO (XConfig r)
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 :: (l Window -> r Window) -> Prime l r
modifyLayout l Window -> r Window
f XConfig l
c = XConfig r -> IO (XConfig r)
forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
c { layoutHook :: r Window
X.layoutHook = l Window -> r Window
f (l Window -> r Window) -> l Window -> r Window
forall a b. (a -> b) -> a -> b
$ XConfig l -> l Window
forall (l :: * -> *). XConfig l -> l Window
X.layoutHook XConfig l
c }
startWith :: XConfig l' -> Prime l l'
startWith :: XConfig l' -> Prime l l'
startWith = IO (XConfig l') -> Prime l l'
forall a b. a -> b -> a
const (IO (XConfig l') -> Prime l l')
-> (XConfig l' -> IO (XConfig l')) -> XConfig l' -> Prime l l'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig l' -> IO (XConfig l')
forall (m :: * -> *) a. Monad m => a -> m a
return
apply :: (XConfig l -> XConfig l') -> Prime l l'
apply :: (XConfig l -> XConfig l') -> Prime l l'
apply XConfig l -> XConfig l'
f = XConfig l' -> IO (XConfig l')
forall (m :: * -> *) a. Monad m => a -> m a
return (XConfig l' -> IO (XConfig l'))
-> (XConfig l -> XConfig l') -> Prime l l'
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 :: (XConfig l -> IO (XConfig l')) -> XConfig l -> IO (XConfig l')
applyIO = (XConfig l -> IO (XConfig l')) -> XConfig l -> IO (XConfig l')
forall a. a -> a
id