{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TupleSections #-}

-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Layout.LayoutModifier
-- Description :  A module for writing layout modifiers.
-- 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 XMonad.Prelude

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.Renamed"
--
-- * "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 m a
_ = forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout

    -- | 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 a
m Workspace WorkspaceId (l a) a
w Rectangle
r = (, forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a (l :: * -> *).
(LayoutModifier m a, LayoutClass l a) =>
m a
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout m a
m Workspace WorkspaceId (l a) a
w Rectangle
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 a
m SomeMessage
mess | Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess             = forall {a}. X (Maybe a)
doUnhook
                      | Just LayoutMessages
ReleaseResources <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = forall {a}. X (Maybe a)
doUnhook
                      | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> Maybe (m a)
pureMess m a
m SomeMessage
mess
     where doUnhook :: X (Maybe a)
doUnhook = do forall (m :: * -> *) a. LayoutModifier m a => m a -> X ()
unhook m a
m; forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
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 a
m SomeMessage
mess = do Maybe (m a)
mm' <- forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> X (Maybe (m a))
handleMess m a
m SomeMessage
mess
                                          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (m a)
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 m a
_ SomeMessage
_ = forall a. Maybe a
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 a
m Rectangle
r Maybe (Stack a)
ms [(a, Rectangle)]
wrs = do forall (m :: * -> *) a. LayoutModifier m a => m a -> X ()
hook m a
m; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
LayoutModifier m a =>
m a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> ([(a, Rectangle)], Maybe (m a))
pureModifier m a
m Rectangle
r Maybe (Stack a)
ms [(a, Rectangle)]
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 m a
_ Rectangle
_ Maybe (Stack a)
_ [(a, Rectangle)]
wrs = ([(a, Rectangle)]
wrs, forall a. Maybe a
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 m a
_ = forall (m :: * -> *) a. Monad m => a -> m a
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 m a
_ = forall (m :: * -> *) a. Monad m => a -> m a
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.StatusBar" user).
    modifierDescription :: m a -> String
    modifierDescription = forall a b. a -> b -> a
const WorkspaceId
""

    -- | '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 a
m l a
l = forall (m :: * -> *) a. LayoutModifier m a => m a -> WorkspaceId
modifierDescription m a
m WorkspaceId -> WorkspaceId -> WorkspaceId
`add` forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> WorkspaceId
description l a
l
        where WorkspaceId
"" add :: WorkspaceId -> WorkspaceId -> WorkspaceId
`add` WorkspaceId
x = WorkspaceId
x
              WorkspaceId
x `add` WorkspaceId
y = WorkspaceId
x forall a. [a] -> [a] -> [a]
++ WorkspaceId
" " forall a. [a] -> [a] -> [a]
++ WorkspaceId
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, Typeable m) => LayoutClass (ModifiedLayout m l) a where
    runLayout :: Workspace WorkspaceId (ModifiedLayout m l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (ModifiedLayout m l a))
runLayout (Workspace WorkspaceId
i (ModifiedLayout m a
m l a
l) Maybe (Stack a)
ms) Rectangle
r =
        do (([(a, Rectangle)]
ws, Maybe (l a)
ml'),Maybe (m a)
mm')  <- forall (m :: * -> *) a (l :: * -> *).
(LayoutModifier m a, LayoutClass l a) =>
m a
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X (([(a, Rectangle)], Maybe (l a)), Maybe (m a))
modifyLayoutWithUpdate m a
m (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace WorkspaceId
i l a
l Maybe (Stack a)
ms) Rectangle
r
           ([(a, Rectangle)]
ws', Maybe (m a)
mm'') <- forall (m :: * -> *) a.
LayoutModifier m a =>
m a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (m a))
redoLayout (forall a. a -> Maybe a -> a
fromMaybe m a
m Maybe (m a)
mm') Rectangle
r Maybe (Stack a)
ms [(a, Rectangle)]
ws
           let ml'' :: Maybe (ModifiedLayout m l a)
ml'' = case Maybe (m a)
mm'' forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (m a)
mm' of
                        Just m a
m' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout m a
m' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe l a
l Maybe (l a)
ml'
                        Maybe (m a)
Nothing -> forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout m a
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l a)
ml'
           forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
ws', Maybe (ModifiedLayout m l a)
ml'')

    handleMessage :: ModifiedLayout m l a
-> SomeMessage -> X (Maybe (ModifiedLayout m l a))
handleMessage (ModifiedLayout m a
m l a
l) SomeMessage
mess =
        do Maybe (Either (m a) SomeMessage)
mm' <- forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt m a
m SomeMessage
mess
           Maybe (l a)
ml' <- case Maybe (Either (m a) SomeMessage)
mm' of
                  Just (Right SomeMessage
mess') -> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
mess'
                  Maybe (Either (m a) SomeMessage)
_ -> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
mess
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Either (m a) SomeMessage)
mm' of
                    Just (Left m a
m') -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout m a
m' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe l a
l Maybe (l a)
ml'
                    Maybe (Either (m a) SomeMessage)
_ -> forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout m a
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l a)
ml'
    description :: ModifiedLayout m l a -> WorkspaceId
description (ModifiedLayout m a
m l a
l) = forall (m :: * -> *) a (l :: * -> *).
(LayoutModifier m a, LayoutClass l a) =>
m a -> l a -> WorkspaceId
modifyDescription m a
m l a
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 ( ReadPrec [ModifiedLayout m l a]
ReadPrec (ModifiedLayout m l a)
ReadS [ModifiedLayout m l a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadPrec [ModifiedLayout m l a]
forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadPrec (ModifiedLayout m l a)
forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
Int -> ReadS (ModifiedLayout m l a)
forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadS [ModifiedLayout m l a]
readListPrec :: ReadPrec [ModifiedLayout m l a]
$creadListPrec :: forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadPrec [ModifiedLayout m l a]
readPrec :: ReadPrec (ModifiedLayout m l a)
$creadPrec :: forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadPrec (ModifiedLayout m l a)
readList :: ReadS [ModifiedLayout m l a]
$creadList :: forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadS [ModifiedLayout m l a]
readsPrec :: Int -> ReadS (ModifiedLayout m l a)
$creadsPrec :: forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
Int -> ReadS (ModifiedLayout m l a)
Read, Int -> ModifiedLayout m l a -> WorkspaceId -> WorkspaceId
forall a.
(Int -> a -> WorkspaceId -> WorkspaceId)
-> (a -> WorkspaceId)
-> ([a] -> WorkspaceId -> WorkspaceId)
-> Show a
forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
Int -> ModifiedLayout m l a -> WorkspaceId -> WorkspaceId
forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
[ModifiedLayout m l a] -> WorkspaceId -> WorkspaceId
forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
ModifiedLayout m l a -> WorkspaceId
showList :: [ModifiedLayout m l a] -> WorkspaceId -> WorkspaceId
$cshowList :: forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
[ModifiedLayout m l a] -> WorkspaceId -> WorkspaceId
show :: ModifiedLayout m l a -> WorkspaceId
$cshow :: forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
ModifiedLayout m l a -> WorkspaceId
showsPrec :: Int -> ModifiedLayout m l a -> WorkspaceId -> WorkspaceId
$cshowsPrec :: forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
Int -> ModifiedLayout m l a -> WorkspaceId -> WorkspaceId
Show )