From 4866f2e367dfcf22a9591231ba40948826a1b438 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 21:10:59 +0100 Subject: Hierarchify darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz --- LayoutModifier.hs | 69 ------------------------------------------------------- 1 file changed, 69 deletions(-) delete mode 100644 LayoutModifier.hs (limited to 'LayoutModifier.hs') diff --git a/LayoutModifier.hs b/LayoutModifier.hs deleted file mode 100644 index 16bdbcb..0000000 --- a/LayoutModifier.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} - ------------------------------------------------------------------------------ --- | --- 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 XMonad.StackSet ( Stack ) - --- $usage --- Use LayoutHelpers to help write easy Layouts. - -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 ) -- cgit v1.2.3