
Damn it, you tricked me into writing it:
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses
#-}
import Control.Arrow
import XMonad
import XMonad.StackSet
data Flippy a = Flippy (Tall a) deriving (Show, Read)
data Flip = Flip deriving Typeable
instance Message Flip
instance LayoutClass Flippy a where
runLayout (Workspace id (Flippy tall) ms) r =
fmap (second (fmap Flippy)) $ runLayout (Workspace id tall ms) r
handleMessage (Flippy tall) m =
case flip of
Just _ -> return $ doFlip (Flippy tall)
Nothing -> fmap (fmap Flippy) $ handleMessage tall m
where flip = fromMessage m :: Maybe Flip
doFlip (Flippy (Tall 1 delta frac)) = Just $ Flippy $ Tall 2
delta frac
doFlip (Flippy (Tall _ delta frac)) = Just $ Flippy $ Tall 1
delta frac
description _ = "Flippy"
No guarantee this works, but it compiles.
On Wed, Oct 1, 2014 at 6:10 PM, Brandon Allbery
On Wed, Oct 1, 2014 at 7:03 PM, Devin Mullins
wrote: I think another option is to make a new instance of LayoutClass that is just like Tall except for also supporting this message. In fact, you should be able to delegate to Tall for most definitions. Just writing off the cuff - could be wrong.
Delegating to Tall won't work; you'd have to copy the definition and modify it, like I suggested for (|||).
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net