LayoutCombinator class: code clean up

- ComboType becomes CombboChooser
- removed the stupid doFirst
- better comboDescription default implemenation
This commit is contained in:
Andrea Rossato 2008-01-29 22:49:52 +00:00
parent 055a6b1232
commit 2797c0d71b
2 changed files with 12 additions and 15 deletions

View File

@ -43,7 +43,7 @@ module XMonad.Layout.LayoutCombinators
, JumpToLayout(JumpToLayout) , JumpToLayout(JumpToLayout)
, LayoutCombinator (..) , LayoutCombinator (..)
, CombinedLayout (..) , CombinedLayout (..)
, ComboType (..) , ComboChooser (..)
) where ) where
import Data.Maybe ( fromMaybe, isJust, isNothing ) import Data.Maybe ( fromMaybe, isJust, isNothing )
@ -222,15 +222,13 @@ when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
when' f a b = do a1 <- a; if f a1 then b else return a1 when' f a b = do a1 <- a; if f a1 then b else return a1
data ComboType = DoFirst | DoSecond | DoBoth deriving ( Eq, Show ) data ComboChooser = DoFirst | DoSecond | DoBoth deriving ( Eq, Show )
class (Read (lc a), Show (lc a)) => LayoutCombinator lc a where class (Read (lc a), Show (lc a)) => LayoutCombinator lc a where
chooser :: lc a -> X ComboType chooser :: lc a -> X ComboChooser
chooser lc = return $ pureChooser lc chooser lc = return $ pureChooser lc
pureChooser :: lc a -> ComboType pureChooser :: lc a -> ComboChooser
pureChooser _ = DoFirst pureChooser _ = DoFirst
-- doFirst lc = if (chooser lc) == DoSecond then False else True
doFirst :: lc a -> Bool
combineResult :: lc a -> [(a,Rectangle)] -> [(a,Rectangle)] -> [(a,Rectangle)] combineResult :: lc a -> [(a,Rectangle)] -> [(a,Rectangle)] -> [(a,Rectangle)]
combineResult _ wrs1 wrs2 = wrs1 ++ wrs2 combineResult _ wrs1 wrs2 = wrs1 ++ wrs2
comboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> X (lc a) comboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> X (lc a)
@ -239,10 +237,10 @@ class (Read (lc a), Show (lc a)) => LayoutCombinator lc a where
pureComboHandleMess lc _ _ _ = lc pureComboHandleMess lc _ _ _ = lc
sendToOther :: (LayoutClass l a) => lc a -> l a -> SomeMessage sendToOther :: (LayoutClass l a) => lc a -> l a -> SomeMessage
sendToOther _ _ = SomeMessage Hide sendToOther _ _ = SomeMessage Hide
comboName :: lc a -> String comboDescription :: lc a -> String
comboName = show comboDescription _ = "Combine"
comboDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String combineDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String
comboDescription lc l1 l2 = show lc <> if doFirst lc then description l1 else description l2 combineDescription lc l1 l2 = comboDescription lc <> description l1 <> description l2
where "" <> x = x where "" <> x = x
x <> y = x ++ " " ++ y x <> y = x ++ " " ++ y
@ -270,7 +268,7 @@ instance (LayoutClass l1 a, LayoutClass l2 a, LayoutCombinator lc a) => LayoutCl
_ -> do (wrs, nl1) <- emptyLayout l1 r _ -> do (wrs, nl1) <- emptyLayout l1 r
return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2) return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2)
handleMessage (CombinedLayout lc l1 l2) m = do handleMessage (CombinedLayout lc l1 l2) m = do
nc <- comboHandleMess lc l1 l2 m nc <- comboHandleMess lc l1 l2 m
choose <- chooser nc choose <- chooser nc
case choose of case choose of
DoFirst -> do nl1 <- handleMessage l1 m DoFirst -> do nl1 <- handleMessage l1 m
@ -283,4 +281,4 @@ instance (LayoutClass l1 a, LayoutClass l2 a, LayoutCombinator lc a) => LayoutCl
nl2 <- handleMessage l2 m nl2 <- handleMessage l2 m
return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2) return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2)
description (CombinedLayout lc l1 l2) = comboDescription lc l1 l2 description (CombinedLayout lc l1 l2) = combineDescription lc l1 l2

View File

@ -62,7 +62,7 @@ onWorkspace :: WorkspaceId -- ^ tags of workspaces to match
-> (l1 a) -- ^ layout to use on matched workspaces -> (l1 a) -- ^ layout to use on matched workspaces
-> (l2 a) -- ^ layout to use everywhere else -> (l2 a) -- ^ layout to use everywhere else
-> CombinedLayout PerWorkspace l1 l2 a -> CombinedLayout PerWorkspace l1 l2 a
onWorkspace wsId l1 l2 = CombinedLayout (PerWorkspace [wsId]) l1 l2 onWorkspace wsId = CombinedLayout (PerWorkspace [wsId])
-- | Specify one layout to use on a particular set of workspaces, and -- | Specify one layout to use on a particular set of workspaces, and
-- another to use on all other workspaces. -- another to use on all other workspaces.
@ -70,7 +70,7 @@ onWorkspaces :: [WorkspaceId] -- ^ tags of workspaces to match
-> (l1 a) -- ^ layout to use on matched workspaces -> (l1 a) -- ^ layout to use on matched workspaces
-> (l2 a) -- ^ layout to use everywhere else -> (l2 a) -- ^ layout to use everywhere else
-> CombinedLayout PerWorkspace l1 l2 a -> CombinedLayout PerWorkspace l1 l2 a
onWorkspaces wsIds l1 l2 = CombinedLayout (PerWorkspace wsIds) l1 l2 onWorkspaces wsIds = CombinedLayout (PerWorkspace wsIds)
-- | Structure for representing a workspace-specific layout along with -- | Structure for representing a workspace-specific layout along with
-- a layout for all other workspaces. We store the tags of workspaces -- a layout for all other workspaces. We store the tags of workspaces
@ -86,7 +86,6 @@ instance LayoutCombinator PerWorkspace a where
chooser (PerWorkspace wsIds) = do chooser (PerWorkspace wsIds) = do
t <- getCurrentTag t <- getCurrentTag
return $ if t `elem` wsIds then DoFirst else DoSecond return $ if t `elem` wsIds then DoFirst else DoSecond
doFirst (PerWorkspace _) = True
-- | Get the tag of the currently active workspace. Note that this -- | Get the tag of the currently active workspace. Note that this
-- is only guaranteed to be the same workspace for which doLayout -- is only guaranteed to be the same workspace for which doLayout