{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
module XMonad.Layout.ToggleLayouts (
toggleLayouts, ToggleLayout(..), ToggleLayouts
) where
import XMonad
import XMonad.Prelude (fromMaybe)
import XMonad.StackSet (Workspace (..))
data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (ReadPrec [ToggleLayouts lt lf a]
ReadPrec (ToggleLayouts lt lf a)
Int -> ReadS (ToggleLayouts lt lf a)
ReadS [ToggleLayouts lt lf a]
(Int -> ReadS (ToggleLayouts lt lf a))
-> ReadS [ToggleLayouts lt lf a]
-> ReadPrec (ToggleLayouts lt lf a)
-> ReadPrec [ToggleLayouts lt lf a]
-> Read (ToggleLayouts lt lf a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (lt :: * -> *) (lf :: * -> *) a.
(Read (lt a), Read (lf a)) =>
ReadPrec [ToggleLayouts lt lf a]
forall (lt :: * -> *) (lf :: * -> *) a.
(Read (lt a), Read (lf a)) =>
ReadPrec (ToggleLayouts lt lf a)
forall (lt :: * -> *) (lf :: * -> *) a.
(Read (lt a), Read (lf a)) =>
Int -> ReadS (ToggleLayouts lt lf a)
forall (lt :: * -> *) (lf :: * -> *) a.
(Read (lt a), Read (lf a)) =>
ReadS [ToggleLayouts lt lf a]
readListPrec :: ReadPrec [ToggleLayouts lt lf a]
$creadListPrec :: forall (lt :: * -> *) (lf :: * -> *) a.
(Read (lt a), Read (lf a)) =>
ReadPrec [ToggleLayouts lt lf a]
readPrec :: ReadPrec (ToggleLayouts lt lf a)
$creadPrec :: forall (lt :: * -> *) (lf :: * -> *) a.
(Read (lt a), Read (lf a)) =>
ReadPrec (ToggleLayouts lt lf a)
readList :: ReadS [ToggleLayouts lt lf a]
$creadList :: forall (lt :: * -> *) (lf :: * -> *) a.
(Read (lt a), Read (lf a)) =>
ReadS [ToggleLayouts lt lf a]
readsPrec :: Int -> ReadS (ToggleLayouts lt lf a)
$creadsPrec :: forall (lt :: * -> *) (lf :: * -> *) a.
(Read (lt a), Read (lf a)) =>
Int -> ReadS (ToggleLayouts lt lf a)
Read,Int -> ToggleLayouts lt lf a -> ShowS
[ToggleLayouts lt lf a] -> ShowS
ToggleLayouts lt lf a -> String
(Int -> ToggleLayouts lt lf a -> ShowS)
-> (ToggleLayouts lt lf a -> String)
-> ([ToggleLayouts lt lf a] -> ShowS)
-> Show (ToggleLayouts lt lf a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (lt :: * -> *) (lf :: * -> *) a.
(Show (lt a), Show (lf a)) =>
Int -> ToggleLayouts lt lf a -> ShowS
forall (lt :: * -> *) (lf :: * -> *) a.
(Show (lt a), Show (lf a)) =>
[ToggleLayouts lt lf a] -> ShowS
forall (lt :: * -> *) (lf :: * -> *) a.
(Show (lt a), Show (lf a)) =>
ToggleLayouts lt lf a -> String
showList :: [ToggleLayouts lt lf a] -> ShowS
$cshowList :: forall (lt :: * -> *) (lf :: * -> *) a.
(Show (lt a), Show (lf a)) =>
[ToggleLayouts lt lf a] -> ShowS
show :: ToggleLayouts lt lf a -> String
$cshow :: forall (lt :: * -> *) (lf :: * -> *) a.
(Show (lt a), Show (lf a)) =>
ToggleLayouts lt lf a -> String
showsPrec :: Int -> ToggleLayouts lt lf a -> ShowS
$cshowsPrec :: forall (lt :: * -> *) (lf :: * -> *) a.
(Show (lt a), Show (lf a)) =>
Int -> ToggleLayouts lt lf a -> ShowS
Show)
data ToggleLayout = ToggleLayout | Toggle String deriving (ReadPrec [ToggleLayout]
ReadPrec ToggleLayout
Int -> ReadS ToggleLayout
ReadS [ToggleLayout]
(Int -> ReadS ToggleLayout)
-> ReadS [ToggleLayout]
-> ReadPrec ToggleLayout
-> ReadPrec [ToggleLayout]
-> Read ToggleLayout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ToggleLayout]
$creadListPrec :: ReadPrec [ToggleLayout]
readPrec :: ReadPrec ToggleLayout
$creadPrec :: ReadPrec ToggleLayout
readList :: ReadS [ToggleLayout]
$creadList :: ReadS [ToggleLayout]
readsPrec :: Int -> ReadS ToggleLayout
$creadsPrec :: Int -> ReadS ToggleLayout
Read,Int -> ToggleLayout -> ShowS
[ToggleLayout] -> ShowS
ToggleLayout -> String
(Int -> ToggleLayout -> ShowS)
-> (ToggleLayout -> String)
-> ([ToggleLayout] -> ShowS)
-> Show ToggleLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToggleLayout] -> ShowS
$cshowList :: [ToggleLayout] -> ShowS
show :: ToggleLayout -> String
$cshow :: ToggleLayout -> String
showsPrec :: Int -> ToggleLayout -> ShowS
$cshowsPrec :: Int -> ToggleLayout -> ShowS
Show)
instance Message ToggleLayout
toggleLayouts :: (LayoutClass lt a, LayoutClass lf a) => lt a -> lf a -> ToggleLayouts lt lf a
toggleLayouts :: lt a -> lf a -> ToggleLayouts lt lf a
toggleLayouts = Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
False
instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt lf) a where
runLayout :: Workspace String (ToggleLayouts lt lf a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (ToggleLayouts lt lf a))
runLayout (Workspace String
i (ToggleLayouts Bool
True lt a
lt lf a
lf) Maybe (Stack a)
ms) Rectangle
r = do ([(a, Rectangle)]
ws,Maybe (lt a)
mlt') <- Workspace String (lt a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (lt a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> lt a -> Maybe (Stack a) -> Workspace String (lt a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
i lt a
lt Maybe (Stack a)
ms) Rectangle
r
([(a, Rectangle)], Maybe (ToggleLayouts lt lf a))
-> X ([(a, Rectangle)], Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
ws,(lt a -> ToggleLayouts lt lf a)
-> Maybe (lt a) -> Maybe (ToggleLayouts lt lf a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\lt a
lt' -> Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
True lt a
lt' lf a
lf) Maybe (lt a)
mlt')
runLayout (Workspace String
i (ToggleLayouts Bool
False lt a
lt lf a
lf) Maybe (Stack a)
ms) Rectangle
r = do ([(a, Rectangle)]
ws,Maybe (lf a)
mlf') <- Workspace String (lf a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (lf a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> lf a -> Maybe (Stack a) -> Workspace String (lf a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
i lf a
lf Maybe (Stack a)
ms) Rectangle
r
([(a, Rectangle)], Maybe (ToggleLayouts lt lf a))
-> X ([(a, Rectangle)], Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
ws,(lf a -> ToggleLayouts lt lf a)
-> Maybe (lf a) -> Maybe (ToggleLayouts lt lf a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
False lt a
lt) Maybe (lf a)
mlf')
description :: ToggleLayouts lt lf a -> String
description (ToggleLayouts Bool
True lt a
lt lf a
_) = lt a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lt a
lt
description (ToggleLayouts Bool
False lt a
_ lf a
lf) = lf a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lf a
lf
handleMessage :: ToggleLayouts lt lf a
-> SomeMessage -> X (Maybe (ToggleLayouts lt lf a))
handleMessage (ToggleLayouts Bool
bool lt a
lt lf a
lf) SomeMessage
m
| Just LayoutMessages
ReleaseResources <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
do Maybe (lf a)
mlf' <- lf a -> SomeMessage -> X (Maybe (lf a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lf a
lf SomeMessage
m
Maybe (lt a)
mlt' <- lt a -> SomeMessage -> X (Maybe (lt a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lt a
lt SomeMessage
m
Maybe (ToggleLayouts lt lf a) -> X (Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a)))
-> Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a))
forall a b. (a -> b) -> a -> b
$ case (Maybe (lt a)
mlt',Maybe (lf a)
mlf') of
(Maybe (lt a)
Nothing ,Maybe (lf a)
Nothing ) -> Maybe (ToggleLayouts lt lf a)
forall a. Maybe a
Nothing
(Just lt a
lt',Maybe (lf a)
Nothing ) -> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a. a -> Maybe a
Just (ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a))
-> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a b. (a -> b) -> a -> b
$ Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
bool lt a
lt' lf a
lf
(Maybe (lt a)
Nothing ,Just lf a
lf') -> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a. a -> Maybe a
Just (ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a))
-> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a b. (a -> b) -> a -> b
$ Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
bool lt a
lt lf a
lf'
(Just lt a
lt',Just lf a
lf') -> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a. a -> Maybe a
Just (ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a))
-> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a b. (a -> b) -> a -> b
$ Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
bool lt a
lt' lf a
lf'
handleMessage (ToggleLayouts Bool
True lt a
lt lf a
lf) SomeMessage
m
| Just ToggleLayout
ToggleLayout <- SomeMessage -> Maybe ToggleLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do Maybe (lt a)
mlt' <- lt a -> SomeMessage -> X (Maybe (lt a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lt a
lt (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
let lt' :: lt a
lt' = lt a -> Maybe (lt a) -> lt a
forall a. a -> Maybe a -> a
fromMaybe lt a
lt Maybe (lt a)
mlt'
Maybe (ToggleLayouts lt lf a) -> X (Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a)))
-> Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a))
forall a b. (a -> b) -> a -> b
$ ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a. a -> Maybe a
Just (ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a))
-> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a b. (a -> b) -> a -> b
$ Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
False lt a
lt' lf a
lf
| Just (Toggle String
d) <- SomeMessage -> Maybe ToggleLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
String
d String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== lt a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lt a
lt Bool -> Bool -> Bool
|| String
d String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== lf a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lf a
lf =
do Maybe (lt a)
mlt' <- lt a -> SomeMessage -> X (Maybe (lt a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lt a
lt (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
let lt' :: lt a
lt' = lt a -> Maybe (lt a) -> lt a
forall a. a -> Maybe a -> a
fromMaybe lt a
lt Maybe (lt a)
mlt'
Maybe (ToggleLayouts lt lf a) -> X (Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a)))
-> Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a))
forall a b. (a -> b) -> a -> b
$ ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a. a -> Maybe a
Just (ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a))
-> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a b. (a -> b) -> a -> b
$ Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
False lt a
lt' lf a
lf
| Bool
otherwise = do Maybe (lt a)
mlt' <- lt a -> SomeMessage -> X (Maybe (lt a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lt a
lt SomeMessage
m
Maybe (ToggleLayouts lt lf a) -> X (Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a)))
-> Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a))
forall a b. (a -> b) -> a -> b
$ (lt a -> ToggleLayouts lt lf a)
-> Maybe (lt a) -> Maybe (ToggleLayouts lt lf a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\lt a
lt' -> Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
True lt a
lt' lf a
lf) Maybe (lt a)
mlt'
handleMessage (ToggleLayouts Bool
False lt a
lt lf a
lf) SomeMessage
m
| Just ToggleLayout
ToggleLayout <- SomeMessage -> Maybe ToggleLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do Maybe (lf a)
mlf' <- lf a -> SomeMessage -> X (Maybe (lf a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lf a
lf (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
let lf' :: lf a
lf' = lf a -> Maybe (lf a) -> lf a
forall a. a -> Maybe a -> a
fromMaybe lf a
lf Maybe (lf a)
mlf'
Maybe (ToggleLayouts lt lf a) -> X (Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a)))
-> Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a))
forall a b. (a -> b) -> a -> b
$ ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a. a -> Maybe a
Just (ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a))
-> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a b. (a -> b) -> a -> b
$ Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
True lt a
lt lf a
lf'
| Just (Toggle String
d) <- SomeMessage -> Maybe ToggleLayout
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
String
d String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== lt a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lt a
lt Bool -> Bool -> Bool
|| String
d String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== lf a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lf a
lf =
do Maybe (lf a)
mlf' <- lf a -> SomeMessage -> X (Maybe (lf a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lf a
lf (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
let lf' :: lf a
lf' = lf a -> Maybe (lf a) -> lf a
forall a. a -> Maybe a -> a
fromMaybe lf a
lf Maybe (lf a)
mlf'
Maybe (ToggleLayouts lt lf a) -> X (Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a)))
-> Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a))
forall a b. (a -> b) -> a -> b
$ ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a. a -> Maybe a
Just (ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a))
-> ToggleLayouts lt lf a -> Maybe (ToggleLayouts lt lf a)
forall a b. (a -> b) -> a -> b
$ Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
True lt a
lt lf a
lf'
| Bool
otherwise = do Maybe (lf a)
mlf' <- lf a -> SomeMessage -> X (Maybe (lf a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lf a
lf SomeMessage
m
Maybe (ToggleLayouts lt lf a) -> X (Maybe (ToggleLayouts lt lf a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a)))
-> Maybe (ToggleLayouts lt lf a)
-> X (Maybe (ToggleLayouts lt lf a))
forall a b. (a -> b) -> a -> b
$ (lf a -> ToggleLayouts lt lf a)
-> Maybe (lf a) -> Maybe (ToggleLayouts lt lf a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> lt a -> lf a -> ToggleLayouts lt lf a
forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
False lt a
lt) Maybe (lf a)
mlf'