aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Layout/LayoutModifier.hs
blob: a1db7a3baf3131563d440c0cea4b0953d5a8dcf7 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Layout.LayoutModifier
-- Copyright    : (c) David Roundy <droundy@darcs.net>
-- License      : BSD
--
-- Maintainer   : none
-- Stability    : unstable
-- Portability  : portable
--
-- A module for writing easy layout modifiers, which do not define a
-- layout in and of themselves, but modify the behavior of or add new
-- functionality to other layouts.  If you ever find yourself writing
-- a layout which takes another layout as a parameter, chances are you
-- should be writing a LayoutModifier instead!
--
-- In case it is not clear, this module is not intended to help you
-- configure xmonad, it is to help you write other extension modules.
-- So get hacking!
-----------------------------------------------------------------------------

module XMonad.Layout.LayoutModifier (
    -- * Usage
    -- $usage

    -- * The 'LayoutModifier' class
    LayoutModifier(..), ModifiedLayout(..)
    ) where

import Control.Monad

import XMonad
import XMonad.StackSet ( Stack, Workspace (..) )

-- $usage
--
-- The 'LayoutModifier' class is provided to help extension developers
-- write easy layout modifiers.  End users won't find much of interest
-- here. =)
--
-- To write a layout modifier using the 'LayoutModifier' class, define
-- a data type to represent the layout modification (storing any
-- necessary state), define an instance of 'LayoutModifier', and
-- export an appropriate function for applying the modifier.  For example:
--
-- > data MyModifier a = MyModifier MyState
-- >   deriving (Show, Read)
-- >
-- > instance LayoutModifier MyModifier a where
-- >   -- override whatever methods from LayoutModifier you like
-- >
-- > modify :: l a -> ModifiedLayout MyModifier l a
-- > modify = ModifiedLayout (MyModifier initialState)
--
-- When defining an instance of 'LayoutModifier', you are free to
-- override as many or as few of the methods as you see fit.  See the
-- documentation below for specific information about the effect of
-- overriding each method.  Every method has a default implementation;
-- an instance of 'LayoutModifier' which did not provide a non-default
-- implementation of any of the methods would simply act as the
-- identity on any layouts to which it is applied.
--
-- For more specific usage examples, see
--
-- * "XMonad.Layout.WorkspaceDir"
--
-- * "XMonad.Layout.Magnifier"
--
-- * "XMonad.Layout.NoBorders"
--
-- * "XMonad.Layout.Reflect"
--
-- * "XMonad.Layout.Named"
--
-- * "XMonad.Layout.WindowNavigation"
--
-- and several others.  You probably want to start by looking at some
-- of the above examples; the documentation below is detailed but
-- possibly confusing, and in many cases the creation of a
-- 'LayoutModifier' is actually quite simple.
--
-- /Important note/: because of the way the 'LayoutModifier' class is
-- intended to be used, by overriding any of its methods and keeping
-- default implementations for all the others, 'LayoutModifier'
-- methods should never be called explicitly.  It is likely that such
-- explicit calls will not have the intended effect.  Rather, the
-- 'LayoutModifier' methods should only be called indirectly through
-- the 'LayoutClass' instance for 'ModifiedLayout', since it is this
-- instance that defines the semantics of overriding the various
-- 'LayoutModifier' methods.

class (Show (m a), Read (m a)) => LayoutModifier m a where

    -- | 'modifyLayout' allows you to intercept a call to 'runLayout'
    --   /before/ it is called on the underlying layout, in order to
    --   perform some effect in the X monad, and\/or modify some of
    --   the parameters before passing them on to the 'runLayout'
    --   method of the underlying layout.
    --
    --   The default implementation of 'modifyLayout' simply calls
    --   'runLayout' on the underlying layout.
    modifyLayout :: (LayoutClass l a) =>
                    m a                             -- ^ the layout modifier
                 -> Workspace WorkspaceId (l a) a   -- ^ current workspace
                 -> Rectangle                       -- ^ screen rectangle
                 -> X ([(a, Rectangle)], Maybe (l a))
    modifyLayout _ w r = runLayout w r

    -- | Similar to 'modifyLayout', but this function also allows you
    -- update the state of your layout modifier(the second value in the
    -- outer tuple).
    --
    -- If both 'modifyLayoutWithUpdate' and 'redoLayout' return a
    -- modified state of the layout modifier, 'redoLayout' takes
    -- precedence. If this function returns a modified state, this
    -- state will internally be used in the subsequent call to
    -- 'redoLayout' as well.
    modifyLayoutWithUpdate :: (LayoutClass l a) =>
                              m a
                           -> Workspace WorkspaceId (l a) a
                           -> Rectangle
                           -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a))
    modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r

    -- | 'handleMess' allows you to spy on messages to the underlying
    --   layout, in order to have an effect in the X monad, or alter
    --   the layout modifier state in some way (by returning @Just
    --   nm@, where @nm@ is a new modifier).  In all cases, the
    --   underlying layout will also receive the message as usual,
    --   after the message has been processed by 'handleMess'.
    --
    --   If you wish to possibly modify a message before it reaches
    --   the underlying layout, you should use
    --   'handleMessOrMaybeModifyIt' instead.  If you do not need to
    --   modify messages or have access to the X monad, you should use
    --   'pureMess' instead.
    --
    --   The default implementation of 'handleMess' calls 'unhook'
    --   when receiving a 'Hide' or 'ReleaseResources' method (after
    --   which it returns @Nothing@), and otherwise passes the message
    --   on to 'pureMess'.
    handleMess :: m a -> SomeMessage -> X (Maybe (m a))
    handleMess m mess | Just Hide <- fromMessage mess             = doUnhook
                      | Just ReleaseResources <- fromMessage mess = doUnhook
                      | otherwise = return $ pureMess m mess
     where doUnhook = do unhook m; return Nothing

    -- | 'handleMessOrMaybeModifyIt' allows you to intercept messages
    --   sent to the underlying layout, in order to have an effect in
    --   the X monad, alter the layout modifier state, or produce a
    --   modified message to be passed on to the underlying layout.
    --
    --   The default implementation of 'handleMessOrMaybeModifyIt'
    --   simply passes on the message to 'handleMess'.
    handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
    handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
                                          return (Left `fmap` mm')

    -- | 'pureMess' allows you to spy on messages sent to the
    --   underlying layout, in order to possibly change the layout
    --   modifier state.
    --
    --   The default implementation of 'pureMess' ignores messages
    --   sent to it, and returns @Nothing@ (causing the layout
    --   modifier to remain unchanged).
    pureMess :: m a -> SomeMessage -> Maybe (m a)
    pureMess _ _ = Nothing

    -- | 'redoLayout' allows you to intercept a call to 'runLayout' on
    --   workspaces with at least one window, /after/ it is called on
    --   the underlying layout, in order to perform some effect in the
    --   X monad, possibly return a new layout modifier, and\/or
    --   modify the results of 'runLayout' before returning them.
    --
    --   If you don't need access to the X monad, use 'pureModifier'
    --   instead.  Also, if the behavior you need can be cleanly
    --   separated into an effect in the X monad, followed by a pure
    --   transformation of the results of 'runLayout', you should
    --   consider implementing 'hook' and 'pureModifier' instead of
    --   'redoLayout'.
    --
    --   On empty workspaces, the Stack is Nothing.
    --
    --   The default implementation of 'redoLayout' calls 'hook' and
    --   then 'pureModifier'.
    redoLayout :: m a               -- ^ the layout modifier
               -> Rectangle         -- ^ screen rectangle
               -> Maybe (Stack a)   -- ^ current window stack
               -> [(a, Rectangle)]  -- ^ (window,rectangle) pairs returned
                                    -- by the underlying layout
               -> X ([(a, Rectangle)], Maybe (m a))
    redoLayout m r ms wrs = do hook m; return $ pureModifier m r ms wrs

    -- | 'pureModifier' allows you to intercept a call to 'runLayout'
    --   /after/ it is called on the underlying layout, in order to
    --   modify the list of window\/rectangle pairings it has returned,
    --   and\/or return a new layout modifier.
    --
    --   The default implementation of 'pureModifier' returns the
    --   window rectangles unmodified.
    pureModifier :: m a               -- ^ the layout modifier
                 -> Rectangle         -- ^ screen rectangle
                 -> Maybe (Stack a)   -- ^ current window stack
                 -> [(a, Rectangle)]  -- ^ (window, rectangle) pairs returned
                                      -- by the underlying layout
                 -> ([(a, Rectangle)], Maybe (m a))
    pureModifier _ _ _ wrs = (wrs, Nothing)

    -- | 'hook' is called by the default implementation of
    --   'redoLayout', and as such represents an X action which is to
    --   be run each time 'runLayout' is called on the underlying
    --   layout, /after/ 'runLayout' has completed.  Of course, if you
    --   override 'redoLayout', then 'hook' will not be called unless
    --   you explicitly call it.
    --
    --   The default implementation of 'hook' is @return ()@ (i.e., it
    --   has no effect).
    hook :: m a -> X ()
    hook _ = return ()

    -- | 'unhook' is called by the default implementation of
    --   'handleMess' upon receiving a 'Hide' or a 'ReleaseResources'
    --   message.
    --
    --   The default implementation, of course, does nothing.
    unhook :: m a -> X ()
    unhook _ = return ()

    -- | 'modifierDescription' is used to give a String description to
    --   this layout modifier.  It is the empty string by default; you
    --   should only override this if it is important that the
    --   presence of the layout modifier be displayed in text
    --   representations of the layout (for example, in the status bar
    --   of a "XMonad.Hooks.DynamicLog" user).
    modifierDescription :: m a -> String
    modifierDescription = const ""

    -- | 'modifyDescription' gives a String description for the entire
    --   layout (modifier + underlying layout).  By default, it is
    --   derived from the concatenation of the 'modifierDescription'
    --   with the 'description' of the underlying layout, with a
    --   \"smart space\" in between (the space is not included if the
    --   'modifierDescription' is empty).
    modifyDescription :: (LayoutClass l a) => m a -> l a -> String
    modifyDescription m l = modifierDescription m <> description l
        where "" <> x = x
              x <> y = x ++ " " ++ y

-- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the
--   semantics of a 'LayoutModifier' applied to an underlying layout.
instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
    runLayout (Workspace i (ModifiedLayout m l) ms) r =
        do ((ws, ml'),mm')  <- modifyLayoutWithUpdate m (Workspace i l ms) r
           (ws', mm'') <- redoLayout (maybe m id mm') r ms ws
           let ml'' = case mm'' `mplus` mm' of
                        Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
                        Nothing -> ModifiedLayout m `fmap` ml'
           return (ws', ml'')

    handleMessage (ModifiedLayout m l) mess =
        do mm' <- handleMessOrMaybeModifyIt m mess
           ml' <- case mm' of
                  Just (Right mess') -> handleMessage l mess'
                  _ -> handleMessage l mess
           return $ case mm' of
                    Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
                    _ -> (ModifiedLayout m) `fmap` ml'
    description (ModifiedLayout m l) = modifyDescription m l

-- | A 'ModifiedLayout' is simply a container for a layout modifier
--   combined with an underlying layout.  It is, of course, itself a
--   layout (i.e. an instance of 'LayoutClass').
data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )

-- N.B. I think there is a Haddock bug here; the Haddock output for
-- the above does not parenthesize (m a) and (l a), which is obviously
-- incorrect.