{-# 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)
ReadS [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
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]
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
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 :: forall (lt :: * -> *) a (lf :: * -> *).
(LayoutClass lt a, LayoutClass lf a) =>
lt a -> lf a -> ToggleLayouts lt lf a
toggleLayouts = 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') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (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
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
ws,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\lt a
lt' -> 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') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (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
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
ws,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
_) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lt a
lt
description (ToggleLayouts Bool
False lt a
_ lf a
lf) = 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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
do Maybe (lf a)
mlf' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lf a
lf SomeMessage
m
Maybe (lt a)
mlt' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lt a
lt SomeMessage
m
forall (m :: * -> *) a. Monad m => a -> m a
return 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 ) -> forall a. Maybe a
Nothing
(Just lt a
lt',Maybe (lf a)
Nothing ) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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') -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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') -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do Maybe (lt a)
mlt' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lt a
lt (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
let lt' :: lt a
lt' = forall a. a -> Maybe a -> a
fromMaybe lt a
lt Maybe (lt a)
mlt'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
String
d forall a. Eq a => a -> a -> Bool
== forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lt a
lt Bool -> Bool -> Bool
|| String
d forall a. Eq a => a -> a -> Bool
== forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lf a
lf =
do Maybe (lt a)
mlt' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lt a
lt (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
let lt' :: lt a
lt' = forall a. a -> Maybe a -> a
fromMaybe lt a
lt Maybe (lt a)
mlt'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lt a
lt SomeMessage
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\lt a
lt' -> 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 <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do Maybe (lf a)
mlf' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lf a
lf (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
let lf' :: lf a
lf' = forall a. a -> Maybe a -> a
fromMaybe lf a
lf Maybe (lf a)
mlf'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
String
d forall a. Eq a => a -> a -> Bool
== forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lt a
lt Bool -> Bool -> Bool
|| String
d forall a. Eq a => a -> a -> Bool
== forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description lf a
lf =
do Maybe (lf a)
mlf' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lf a
lf (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
let lf' :: lf a
lf' = forall a. a -> Maybe a -> a
fromMaybe lf a
lf Maybe (lf a)
mlf'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage lf a
lf SomeMessage
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (lt :: * -> *) (lf :: * -> *) a.
Bool -> lt a -> lf a -> ToggleLayouts lt lf a
ToggleLayouts Bool
False lt a
lt) Maybe (lf a)
mlf'