From c97e1e27f90b2c05bf4fdffe877a7f29fd227da3 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Sun, 23 Sep 2007 23:59:56 +0200 Subject: rename LayoutHelpers to LayoutModifier. darcs-hash:20070923215956-72aca-af065b4b5a9aaf57adca7eb93aa72ae843656cd1.gz --- LayoutModifier.hs | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 LayoutModifier.hs (limited to 'LayoutModifier.hs') diff --git a/LayoutModifier.hs b/LayoutModifier.hs new file mode 100644 index 0000000..8b60b4d --- /dev/null +++ b/LayoutModifier.hs @@ -0,0 +1,55 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.LayoutModifier +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- A module for writing easy Layouts +----------------------------------------------------------------------------- + +module XMonadContrib.LayoutModifier ( + -- * Usage + -- $usage + LayoutModifier(..), ModifiedLayout(..) + ) where + +import Graphics.X11.Xlib ( Rectangle ) +import XMonad +import StackSet ( Stack ) +import Operations ( UnDoLayout(UnDoLayout) ) + +-- $usage +-- Use LayoutHelpers to help write easy Layouts. + +class (Show (m a), Read (m a)) => LayoutModifier m a where + modifyModify :: m a -> SomeMessage -> X (Maybe (m l)) + modifyModify m mess | Just UnDoLayout <- fromMessage mess = do unhook m; return Nothing + | otherwise = return Nothing + redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)] + -> X ([(a, Rectangle)], Maybe (m l)) + redoLayout m _ _ wrs = do hook m; return (wrs, Nothing) + hook :: m a -> X () + hook _ = return () + unhook :: m a -> X () + unhook _ = return () + +instance (LayoutModifier m a, Layout l a) => Layout (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'') + modifyLayout (ModifiedLayout m l) mess = + do ml' <- modifyLayout l mess + mm' <- modifyModify m mess + return $ case mm' of + Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' + Nothing -> (ModifiedLayout m) `fmap` ml' + +data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show ) -- cgit v1.2.3