{-# 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.
