{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Layout.ToggleLayouts
-- Description :  A module to toggle between two layouts.
-- Copyright    : (c) David Roundy <droundy@darcs.net>
-- License      : BSD
--
-- Maintainer   : none
-- Stability    : unstable
-- Portability  : portable
--
-- A module to toggle between two layouts.
-----------------------------------------------------------------------------

module XMonad.Layout.ToggleLayouts (
    -- * Usage
    -- $usage
    toggleLayouts, ToggleLayout(..), ToggleLayouts
    ) where

import XMonad
import XMonad.Prelude (fromMaybe)
import XMonad.StackSet (Workspace (..))

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.ToggleLayouts
--
-- Then edit your @layoutHook@ by adding the ToggleLayouts layout:
--
-- > myLayout = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- To toggle between layouts add a key binding like
--
-- >    , ((modm .|. controlMask, xK_space), sendMessage ToggleLayout)
--
-- or a key binding like
--
-- >    , ((modm .|. controlMask, xK_space), sendMessage (Toggle "Full"))
--
-- For detailed instruction on editing the key binding see:
--
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

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'