allow layout modifiers to modify a Message in transit.

This is a helpful feature (for, e.g. WindowNavigation) that
allows modifiers (if they so choose... the old API remains
supported) to easily send a single Message to the modified
layout in response to a Message.
This commit is contained in:
David Roundy
2007-10-20 19:15:42 +00:00
parent ba006db696
commit 73a5299fbe

View File

@@ -34,6 +34,9 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
| 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)
@@ -53,11 +56,13 @@ instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m
Nothing -> ModifiedLayout m `fmap` ml'
return (ws', ml'')
handleMessage (ModifiedLayout m l) mess =
do ml' <- handleMessage l mess
mm' <- handleMess m mess
do mm' <- handleMessOrMaybeModifyIt m mess
ml' <- case mm' of
Just (Right mess') -> handleMessage l mess'
_ -> handleMessage l mess
return $ case mm' of
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
Nothing -> (ModifiedLayout m) `fmap` ml'
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