module XMonad.Layout.LayoutModifier (
LayoutModifier(..), ModifiedLayout(..)
) where
import XMonad
import XMonad.StackSet ( Stack )
class (Show (m a), Read (m a)) => LayoutModifier m a where
handleMess :: m a -> SomeMessage -> X (Maybe (m a))
handleMess m mess | Just Hide <- fromMessage mess = doUnhook
| Just ReleaseResources <- fromMessage mess = doUnhook
| otherwise = return Nothing
where doUnhook = do unhook m; return Nothing
handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
return (Left `fmap` mm')
redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (m a))
redoLayout m _ _ wrs = do hook m; return (wrs, Nothing)
hook :: m a -> X ()
hook _ = return ()
unhook :: m a -> X ()
unhook _ = return ()
modifierDescription :: m a -> String
modifierDescription = const ""
instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
doLayout (ModifiedLayout m l) r s =
do (ws, ml') <- doLayout l r s
(ws', mm') <- redoLayout m r s ws
let ml'' = case 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) = modifierDescription m <> description l
where "" <> x = x
x <> y = x ++ " " ++ y
data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )