{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.MessageControl (
Ignore()
, ignore
, UnEscape()
, unEscape
, EscapedMessage(Escape)
, escape
) where
import XMonad.Core (Message, SomeMessage(..)
, fromMessage, LayoutClass(..))
import XMonad.StackSet (Workspace(..))
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
import Control.Arrow (second)
newtype Ignore m l w = I (l w)
deriving (Int -> Ignore m l w -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall m (l :: * -> *) w.
Show (l w) =>
Int -> Ignore m l w -> ShowS
forall m (l :: * -> *) w. Show (l w) => [Ignore m l w] -> ShowS
forall m (l :: * -> *) w. Show (l w) => Ignore m l w -> String
showList :: [Ignore m l w] -> ShowS
$cshowList :: forall m (l :: * -> *) w. Show (l w) => [Ignore m l w] -> ShowS
show :: Ignore m l w -> String
$cshow :: forall m (l :: * -> *) w. Show (l w) => Ignore m l w -> String
showsPrec :: Int -> Ignore m l w -> ShowS
$cshowsPrec :: forall m (l :: * -> *) w.
Show (l w) =>
Int -> Ignore m l w -> ShowS
Show, ReadPrec [Ignore m l w]
ReadPrec (Ignore m l w)
ReadS [Ignore m l w]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall m (l :: * -> *) w. Read (l w) => ReadPrec [Ignore m l w]
forall m (l :: * -> *) w. Read (l w) => ReadPrec (Ignore m l w)
forall m (l :: * -> *) w. Read (l w) => Int -> ReadS (Ignore m l w)
forall m (l :: * -> *) w. Read (l w) => ReadS [Ignore m l w]
readListPrec :: ReadPrec [Ignore m l w]
$creadListPrec :: forall m (l :: * -> *) w. Read (l w) => ReadPrec [Ignore m l w]
readPrec :: ReadPrec (Ignore m l w)
$creadPrec :: forall m (l :: * -> *) w. Read (l w) => ReadPrec (Ignore m l w)
readList :: ReadS [Ignore m l w]
$creadList :: forall m (l :: * -> *) w. Read (l w) => ReadS [Ignore m l w]
readsPrec :: Int -> ReadS (Ignore m l w)
$creadsPrec :: forall m (l :: * -> *) w. Read (l w) => Int -> ReadS (Ignore m l w)
Read)
instance (Message m, LayoutClass l w) => LayoutClass (Ignore m l) w where
runLayout :: Workspace String (Ignore m l w) w
-> Rectangle -> X ([(w, Rectangle)], Maybe (Ignore m l w))
runLayout Workspace String (Ignore m l w) w
ws Rectangle
r = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall m (l :: * -> *) w. l w -> Ignore m l w
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i m (l :: * -> *) w.
Workspace i (Ignore m l w) w -> Workspace i (l w) w
unILayout Workspace String (Ignore m l w) w
ws) Rectangle
r
where unILayout :: Workspace i (Ignore m l w) w -> Workspace i (l w) w
unILayout :: forall i m (l :: * -> *) w.
Workspace i (Ignore m l w) w -> Workspace i (l w) w
unILayout w :: Workspace i (Ignore m l w) w
w@Workspace{ layout :: forall i l a. Workspace i l a -> l
layout = (I l w
l) } = Workspace i (Ignore m l w) w
w { layout :: l w
layout = l w
l }
handleMessage :: Ignore m l w -> SomeMessage -> X (Maybe (Ignore m l w))
handleMessage l :: Ignore m l w
l@(I l w
l') SomeMessage
sm
= case forall m' (l :: * -> *) w.
Message m' =>
SomeMessage -> Ignore m' l w -> Maybe m'
fromMessageAs SomeMessage
sm Ignore m l w
l of
Just m
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe m
Nothing -> (forall m (l :: * -> *) w. l w -> Ignore m l w
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l w
l' SomeMessage
sm
where fromMessageAs :: Message m' => SomeMessage -> Ignore m' l w -> Maybe m'
fromMessageAs :: forall m' (l :: * -> *) w.
Message m' =>
SomeMessage -> Ignore m' l w -> Maybe m'
fromMessageAs SomeMessage
a Ignore m' l w
_ = forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
a
description :: Ignore m l w -> String
description (I l w
l) = String
"Ignore "forall a. [a] -> [a] -> [a]
++forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l w
l
data UnEscape w = UE
deriving (Int -> UnEscape w -> ShowS
forall w. Int -> UnEscape w -> ShowS
forall w. [UnEscape w] -> ShowS
forall w. UnEscape w -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnEscape w] -> ShowS
$cshowList :: forall w. [UnEscape w] -> ShowS
show :: UnEscape w -> String
$cshow :: forall w. UnEscape w -> String
showsPrec :: Int -> UnEscape w -> ShowS
$cshowsPrec :: forall w. Int -> UnEscape w -> ShowS
Show, ReadPrec [UnEscape w]
ReadPrec (UnEscape w)
ReadS [UnEscape w]
forall w. ReadPrec [UnEscape w]
forall w. ReadPrec (UnEscape w)
forall w. Int -> ReadS (UnEscape w)
forall w. ReadS [UnEscape w]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnEscape w]
$creadListPrec :: forall w. ReadPrec [UnEscape w]
readPrec :: ReadPrec (UnEscape w)
$creadPrec :: forall w. ReadPrec (UnEscape w)
readList :: ReadS [UnEscape w]
$creadList :: forall w. ReadS [UnEscape w]
readsPrec :: Int -> ReadS (UnEscape w)
$creadsPrec :: forall w. Int -> ReadS (UnEscape w)
Read)
instance LayoutModifier UnEscape a where
handleMessOrMaybeModifyIt :: UnEscape a
-> SomeMessage -> X (Maybe (Either (UnEscape a) SomeMessage))
handleMessOrMaybeModifyIt UnEscape a
_ SomeMessage
mess
= forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess of
Just (Escape SomeMessage
mess') -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right SomeMessage
mess'
Maybe EscapedMessage
Nothing -> forall a. Maybe a
Nothing
newtype EscapedMessage = Escape SomeMessage
instance Message EscapedMessage
escape :: Message m => m -> EscapedMessage
escape :: forall m. Message m => m -> EscapedMessage
escape = SomeMessage -> EscapedMessage
Escape forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Message a => a -> SomeMessage
SomeMessage
unEscape :: LayoutClass l w => l w -> ModifiedLayout UnEscape l w
unEscape :: forall (l :: * -> *) w.
LayoutClass l w =>
l w -> ModifiedLayout UnEscape l w
unEscape = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall w. UnEscape w
UE
ignore :: (Message m, LayoutClass l w)
=> m -> l w -> Ignore m l w
ignore :: forall m (l :: * -> *) w.
(Message m, LayoutClass l w) =>
m -> l w -> Ignore m l w
ignore m
_ = forall m (l :: * -> *) w. l w -> Ignore m l w
I