{-# LANGUAGE ExistentialQuantification, Rank2Types, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards, ScopedTypeVariables #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.MultiToggle
-- Description :  Dynamically apply and unapply transformers to your window layout.
-- Copyright   :  (c) Lukas Mai
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <l.mai@web.de>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Dynamically apply and unapply transformers to your window layout. This can
-- be used to rotate your window layout by 90 degrees, or to make the
-- currently focused window occupy the whole screen (\"zoom in\") then undo
-- the transformation (\"zoom out\").

module XMonad.Layout.MultiToggle (
    -- * Usage
    -- $usage
    Transformer(..),
    Toggle(..),
    (??),
    EOT(..),
    single,
    mkToggle,
    mkToggle1,
    isToggleActive,

    HList,
    HCons,
    MultiToggle,
) where

import XMonad
import XMonad.Prelude hiding (find)

import XMonad.StackSet (Workspace(..))

import Control.Arrow
import Data.IORef
import Data.Typeable

-- $usage
-- The basic idea is to have a base layout and a set of layout transformers,
-- of which at most one is active at any time. Enabling another transformer
-- first disables any currently active transformer; i.e. it works like a
-- group of radio buttons.
--
-- To use this module, you need some data types which represent
-- transformers; for some commonly used transformers (including
-- MIRROR, NOBORDERS, and FULL used in the examples below) you can
-- simply import "XMonad.Layout.MultiToggle.Instances".
--
-- Somewhere else in your file you probably have a definition of @layout@;
-- the default looks like this:
--
-- > layout = tiled ||| Mirror tiled ||| Full
--
-- After changing this to
--
-- > layout = mkToggle (single MIRROR) (tiled ||| Full)
--
-- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation:
--
-- > ...
-- >   , ((modm,               xK_x     ), sendMessage $ Toggle MIRROR)
-- > ...
--
-- (That should be part of your key bindings.) When you press @mod-x@, the
-- active layout is mirrored. Another @mod-x@ and it's back to normal.
--
-- It's also possible to stack @MultiToggle@s.  For example:
--
-- @
-- layout = id
--     . 'XMonad.Layout.NoBorders.smartBorders'
--     . mkToggle (NOBORDERS ?? FULL ?? EOT)
--     . mkToggle (single MIRROR)
--     $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle'
-- @
--
-- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily
-- maximize windows, in addition to being able to rotate layouts and remove
-- window borders.
--
-- You can also define your own transformers by creating a data type
-- which is an instance of the 'Transformer' class.  For example, here
-- is the definition of @MIRROR@:
--
-- > data MIRROR = MIRROR deriving (Read, Show, Eq)
-- > instance Transformer MIRROR Window where
-- >     transform _ x k = k (Mirror x) (\(Mirror x') -> x')
--
-- Note, you need to put @{-\# LANGUAGE
-- TypeSynonymInstances, MultiParamTypeClasses \#-}@ at the
-- beginning of your file.

-- | A class to identify custom transformers (and look up transforming
-- functions by type).
class (Eq t, Typeable t) => Transformer t a | t -> a where
    transform :: (LayoutClass l a) => t -> l a ->
        (forall l'. (LayoutClass l' a) => l' a -> (l' a -> l a) -> b) -> b

data  EL l a = forall l'. (LayoutClass l' a) => EL (l' a) (l' a -> l a)

unEL :: (LayoutClass l a) => EL l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b
unEL :: forall (l :: * -> *) a b.
LayoutClass l a =>
EL l a
-> (forall (l' :: * -> *). LayoutClass l' a => l' a -> b) -> b
unEL (EL l' a
x l' a -> l a
_) forall (l' :: * -> *). LayoutClass l' a => l' a -> b
k = l' a -> b
forall (l' :: * -> *). LayoutClass l' a => l' a -> b
k l' a
x

deEL :: (LayoutClass l a) => EL l a -> l a
deEL :: forall (l :: * -> *) a. LayoutClass l a => EL l a -> l a
deEL (EL l' a
x l' a -> l a
det) = l' a -> l a
det l' a
x

transform' :: (Transformer t a, LayoutClass l a) => t -> EL l a -> EL l a
transform' :: forall t a (l :: * -> *).
(Transformer t a, LayoutClass l a) =>
t -> EL l a -> EL l a
transform' t
t (EL l' a
l l' a -> l a
det) = t
-> l' a
-> (forall (l' :: * -> *).
    LayoutClass l' a =>
    l' a -> (l' a -> l' a) -> EL l a)
-> EL l a
forall t a (l :: * -> *) b.
(Transformer t a, LayoutClass l a) =>
t
-> l a
-> (forall (l' :: * -> *).
    LayoutClass l' a =>
    l' a -> (l' a -> l a) -> b)
-> b
transform t
t l' a
l (\l' a
l' l' a -> l' a
det' -> l' a -> (l' a -> l a) -> EL l a
forall (l :: * -> *) a (l' :: * -> *).
LayoutClass l' a =>
l' a -> (l' a -> l a) -> EL l a
EL l' a
l' (l' a -> l a
det (l' a -> l a) -> (l' a -> l' a) -> l' a -> l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l' a -> l' a
det'))

-- | Toggle the specified layout transformer.
data Toggle a = forall t. (Transformer t a) => Toggle t

instance (Typeable a) => Message (Toggle a)

data MultiToggleS ts l a = MultiToggleS (l a) (Maybe Int) ts
    deriving (ReadPrec [MultiToggleS ts l a]
ReadPrec (MultiToggleS ts l a)
Int -> ReadS (MultiToggleS ts l a)
ReadS [MultiToggleS ts l a]
(Int -> ReadS (MultiToggleS ts l a))
-> ReadS [MultiToggleS ts l a]
-> ReadPrec (MultiToggleS ts l a)
-> ReadPrec [MultiToggleS ts l a]
-> Read (MultiToggleS ts l a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall ts (l :: * -> *) a.
(Read ts, Read (l a)) =>
ReadPrec [MultiToggleS ts l a]
forall ts (l :: * -> *) a.
(Read ts, Read (l a)) =>
ReadPrec (MultiToggleS ts l a)
forall ts (l :: * -> *) a.
(Read ts, Read (l a)) =>
Int -> ReadS (MultiToggleS ts l a)
forall ts (l :: * -> *) a.
(Read ts, Read (l a)) =>
ReadS [MultiToggleS ts l a]
readListPrec :: ReadPrec [MultiToggleS ts l a]
$creadListPrec :: forall ts (l :: * -> *) a.
(Read ts, Read (l a)) =>
ReadPrec [MultiToggleS ts l a]
readPrec :: ReadPrec (MultiToggleS ts l a)
$creadPrec :: forall ts (l :: * -> *) a.
(Read ts, Read (l a)) =>
ReadPrec (MultiToggleS ts l a)
readList :: ReadS [MultiToggleS ts l a]
$creadList :: forall ts (l :: * -> *) a.
(Read ts, Read (l a)) =>
ReadS [MultiToggleS ts l a]
readsPrec :: Int -> ReadS (MultiToggleS ts l a)
$creadsPrec :: forall ts (l :: * -> *) a.
(Read ts, Read (l a)) =>
Int -> ReadS (MultiToggleS ts l a)
Read, Int -> MultiToggleS ts l a -> ShowS
[MultiToggleS ts l a] -> ShowS
MultiToggleS ts l a -> String
(Int -> MultiToggleS ts l a -> ShowS)
-> (MultiToggleS ts l a -> String)
-> ([MultiToggleS ts l a] -> ShowS)
-> Show (MultiToggleS ts l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ts (l :: * -> *) a.
(Show ts, Show (l a)) =>
Int -> MultiToggleS ts l a -> ShowS
forall ts (l :: * -> *) a.
(Show ts, Show (l a)) =>
[MultiToggleS ts l a] -> ShowS
forall ts (l :: * -> *) a.
(Show ts, Show (l a)) =>
MultiToggleS ts l a -> String
showList :: [MultiToggleS ts l a] -> ShowS
$cshowList :: forall ts (l :: * -> *) a.
(Show ts, Show (l a)) =>
[MultiToggleS ts l a] -> ShowS
show :: MultiToggleS ts l a -> String
$cshow :: forall ts (l :: * -> *) a.
(Show ts, Show (l a)) =>
MultiToggleS ts l a -> String
showsPrec :: Int -> MultiToggleS ts l a -> ShowS
$cshowsPrec :: forall ts (l :: * -> *) a.
(Show ts, Show (l a)) =>
Int -> MultiToggleS ts l a -> ShowS
Show)

data MultiToggle ts l a = MultiToggle{
    forall ts (l :: * -> *) a. MultiToggle ts l a -> EL l a
currLayout :: EL l a,
    forall ts (l :: * -> *) a. MultiToggle ts l a -> Maybe Int
currIndex :: Maybe Int,
    forall ts (l :: * -> *) a. MultiToggle ts l a -> ts
transformers :: ts
}

expand :: (LayoutClass l a, HList ts a) => MultiToggleS ts l a -> MultiToggle ts l a
expand :: forall (l :: * -> *) a ts.
(LayoutClass l a, HList ts a) =>
MultiToggleS ts l a -> MultiToggle ts l a
expand (MultiToggleS l a
b Maybe Int
i ts
ts) =
    ts
-> Int
-> (MultiToggle ts l a -> MultiToggle ts l a)
-> (forall t.
    Transformer t a =>
    t -> MultiToggle ts l a -> MultiToggle ts l a)
-> MultiToggle ts l a
-> MultiToggle ts l a
forall c a b.
HList c a =>
c -> Int -> b -> (forall t. Transformer t a => t -> b) -> b
resolve ts
ts (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) Maybe Int
i) MultiToggle ts l a -> MultiToggle ts l a
forall a. a -> a
id
        (\t
x MultiToggle ts l a
mt ->
            let g :: EL l a -> EL l a
g = t -> EL l a -> EL l a
forall t a (l :: * -> *).
(Transformer t a, LayoutClass l a) =>
t -> EL l a -> EL l a
transform' t
x in MultiToggle ts l a
mt{ currLayout :: EL l a
currLayout = EL l a -> EL l a
g (EL l a -> EL l a) -> EL l a -> EL l a
forall a b. (a -> b) -> a -> b
$ MultiToggle ts l a -> EL l a
forall ts (l :: * -> *) a. MultiToggle ts l a -> EL l a
currLayout MultiToggle ts l a
mt }
        )
        (EL l a -> Maybe Int -> ts -> MultiToggle ts l a
forall ts (l :: * -> *) a.
EL l a -> Maybe Int -> ts -> MultiToggle ts l a
MultiToggle (l a -> (l a -> l a) -> EL l a
forall (l :: * -> *) a (l' :: * -> *).
LayoutClass l' a =>
l' a -> (l' a -> l a) -> EL l a
EL l a
b l a -> l a
forall a. a -> a
id) Maybe Int
i ts
ts)

collapse :: (LayoutClass l a) => MultiToggle ts l a -> MultiToggleS ts l a
collapse :: forall (l :: * -> *) a ts.
LayoutClass l a =>
MultiToggle ts l a -> MultiToggleS ts l a
collapse MultiToggle ts l a
mt = l a -> Maybe Int -> ts -> MultiToggleS ts l a
forall ts (l :: * -> *) a.
l a -> Maybe Int -> ts -> MultiToggleS ts l a
MultiToggleS (EL l a -> l a
forall (l :: * -> *) a. LayoutClass l a => EL l a -> l a
deEL (MultiToggle ts l a -> EL l a
forall ts (l :: * -> *) a. MultiToggle ts l a -> EL l a
currLayout MultiToggle ts l a
mt)) (MultiToggle ts l a -> Maybe Int
forall ts (l :: * -> *) a. MultiToggle ts l a -> Maybe Int
currIndex MultiToggle ts l a
mt) (MultiToggle ts l a -> ts
forall ts (l :: * -> *) a. MultiToggle ts l a -> ts
transformers MultiToggle ts l a
mt)

instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where
    readsPrec :: Int -> ReadS (MultiToggle ts l a)
readsPrec Int
p String
s = ((MultiToggleS ts l a, String) -> (MultiToggle ts l a, String))
-> [(MultiToggleS ts l a, String)]
-> [(MultiToggle ts l a, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((MultiToggleS ts l a -> MultiToggle ts l a)
-> (MultiToggleS ts l a, String) -> (MultiToggle ts l a, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first MultiToggleS ts l a -> MultiToggle ts l a
forall (l :: * -> *) a ts.
(LayoutClass l a, HList ts a) =>
MultiToggleS ts l a -> MultiToggle ts l a
expand) ([(MultiToggleS ts l a, String)] -> [(MultiToggle ts l a, String)])
-> [(MultiToggleS ts l a, String)]
-> [(MultiToggle ts l a, String)]
forall a b. (a -> b) -> a -> b
$ Int -> ReadS (MultiToggleS ts l a)
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s

instance (Show ts, Show (l a), LayoutClass l a) => Show (MultiToggle ts l a) where
    showsPrec :: Int -> MultiToggle ts l a -> ShowS
showsPrec Int
p = Int -> MultiToggleS ts l a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (MultiToggleS ts l a -> ShowS)
-> (MultiToggle ts l a -> MultiToggleS ts l a)
-> MultiToggle ts l a
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiToggle ts l a -> MultiToggleS ts l a
forall (l :: * -> *) a ts.
LayoutClass l a =>
MultiToggle ts l a -> MultiToggleS ts l a
collapse

-- | Construct a @MultiToggle@ layout from a transformer table and a base
-- layout.
mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a
mkToggle :: forall (l :: * -> *) a ts.
LayoutClass l a =>
ts -> l a -> MultiToggle ts l a
mkToggle ts
ts l a
l = EL l a -> Maybe Int -> ts -> MultiToggle ts l a
forall ts (l :: * -> *) a.
EL l a -> Maybe Int -> ts -> MultiToggle ts l a
MultiToggle (l a -> (l a -> l a) -> EL l a
forall (l :: * -> *) a (l' :: * -> *).
LayoutClass l' a =>
l' a -> (l' a -> l a) -> EL l a
EL l a
l l a -> l a
forall a. a -> a
id) Maybe Int
forall a. Maybe a
Nothing ts
ts

-- | Construct a @MultiToggle@ layout from a single transformer and a base
-- layout.
mkToggle1 :: (LayoutClass l a) => t -> l a -> MultiToggle (HCons t EOT) l a
mkToggle1 :: forall (l :: * -> *) a t.
LayoutClass l a =>
t -> l a -> MultiToggle (HCons t EOT) l a
mkToggle1 t
t = HCons t EOT -> l a -> MultiToggle (HCons t EOT) l a
forall (l :: * -> *) a ts.
LayoutClass l a =>
ts -> l a -> MultiToggle ts l a
mkToggle (t -> HCons t EOT
forall a. a -> HCons a EOT
single t
t)

-- | Marks the end of a transformer list.
data EOT = EOT deriving (ReadPrec [EOT]
ReadPrec EOT
Int -> ReadS EOT
ReadS [EOT]
(Int -> ReadS EOT)
-> ReadS [EOT] -> ReadPrec EOT -> ReadPrec [EOT] -> Read EOT
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EOT]
$creadListPrec :: ReadPrec [EOT]
readPrec :: ReadPrec EOT
$creadPrec :: ReadPrec EOT
readList :: ReadS [EOT]
$creadList :: ReadS [EOT]
readsPrec :: Int -> ReadS EOT
$creadsPrec :: Int -> ReadS EOT
Read, Int -> EOT -> ShowS
[EOT] -> ShowS
EOT -> String
(Int -> EOT -> ShowS)
-> (EOT -> String) -> ([EOT] -> ShowS) -> Show EOT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EOT] -> ShowS
$cshowList :: [EOT] -> ShowS
show :: EOT -> String
$cshow :: EOT -> String
showsPrec :: Int -> EOT -> ShowS
$cshowsPrec :: Int -> EOT -> ShowS
Show)
data HCons a b = HCons a b deriving (ReadPrec [HCons a b]
ReadPrec (HCons a b)
Int -> ReadS (HCons a b)
ReadS [HCons a b]
(Int -> ReadS (HCons a b))
-> ReadS [HCons a b]
-> ReadPrec (HCons a b)
-> ReadPrec [HCons a b]
-> Read (HCons a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [HCons a b]
forall a b. (Read a, Read b) => ReadPrec (HCons a b)
forall a b. (Read a, Read b) => Int -> ReadS (HCons a b)
forall a b. (Read a, Read b) => ReadS [HCons a b]
readListPrec :: ReadPrec [HCons a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [HCons a b]
readPrec :: ReadPrec (HCons a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (HCons a b)
readList :: ReadS [HCons a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [HCons a b]
readsPrec :: Int -> ReadS (HCons a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (HCons a b)
Read, Int -> HCons a b -> ShowS
[HCons a b] -> ShowS
HCons a b -> String
(Int -> HCons a b -> ShowS)
-> (HCons a b -> String)
-> ([HCons a b] -> ShowS)
-> Show (HCons a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> HCons a b -> ShowS
forall a b. (Show a, Show b) => [HCons a b] -> ShowS
forall a b. (Show a, Show b) => HCons a b -> String
showList :: [HCons a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [HCons a b] -> ShowS
show :: HCons a b -> String
$cshow :: forall a b. (Show a, Show b) => HCons a b -> String
showsPrec :: Int -> HCons a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> HCons a b -> ShowS
Show)

infixr 0 ??
-- | Prepend an element to a heterogeneous list. Used to build transformer
-- tables for 'mkToggle'.
(??) ::  a -> b -> HCons a b
?? :: forall a b. a -> b -> HCons a b
(??) = a -> b -> HCons a b
forall a b. a -> b -> HCons a b
HCons

-- | Construct a singleton transformer table.
single :: a -> HCons a EOT
single :: forall a. a -> HCons a EOT
single = (a -> EOT -> HCons a EOT
forall a b. a -> b -> HCons a b
?? EOT
EOT)

class HList c a where
    find :: (Transformer t a) => c -> t -> Maybe Int
    resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b

instance HList EOT w where
    find :: forall t. Transformer t w => EOT -> t -> Maybe Int
find EOT
EOT t
_ = Maybe Int
forall a. Maybe a
Nothing
    resolve :: forall b.
EOT -> Int -> b -> (forall t. Transformer t w => t -> b) -> b
resolve EOT
EOT Int
_ b
d forall t. Transformer t w => t -> b
_ = b
d

instance (Transformer a w, HList b w) => HList (HCons a b) w where
    find :: forall t. Transformer t w => HCons a b -> t -> Maybe Int
find (HCons a
x b
xs) t
t
        | t
t t -> a -> Bool
forall a b. (Typeable a, Eq a, Typeable b) => a -> b -> Bool
`geq` a
x = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
        | Bool
otherwise = (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Enum a => a -> a
succ (b -> t -> Maybe Int
forall c a t. (HList c a, Transformer t a) => c -> t -> Maybe Int
find b
xs t
t)
    resolve :: forall b.
HCons a b -> Int -> b -> (forall t. Transformer t w => t -> b) -> b
resolve (HCons a
x b
xs) Int
n b
d forall t. Transformer t w => t -> b
k =
        case Int
n Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
0 of
            Ordering
LT -> b
d
            Ordering
EQ -> a -> b
forall t. Transformer t w => t -> b
k a
x
            Ordering
GT -> b -> Int -> b -> (forall t. Transformer t w => t -> b) -> b
forall c a b.
HList c a =>
c -> Int -> b -> (forall t. Transformer t a => t -> b) -> b
resolve b
xs (Int -> Int
forall a. Enum a => a -> a
pred Int
n) b
d forall t. Transformer t w => t -> b
k

geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool
geq :: forall a b. (Typeable a, Eq a, Typeable b) => a -> b -> Bool
geq a
a b
b = a -> Maybe a
forall a. a -> Maybe a
Just a
a Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== b -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast b
b

instance (Typeable a, Show ts, Typeable ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where
    description :: MultiToggle ts l a -> String
description MultiToggle ts l a
mt = MultiToggle ts l a -> EL l a
forall ts (l :: * -> *) a. MultiToggle ts l a -> EL l a
currLayout MultiToggle ts l a
mt EL l a
-> (forall (l' :: * -> *). LayoutClass l' a => l' a -> String)
-> String
forall (l :: * -> *) a b.
LayoutClass l a =>
EL l a
-> (forall (l' :: * -> *). LayoutClass l' a => l' a -> b) -> b
`unEL` \l' a
l -> l' a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l' a
l

    runLayout :: Workspace String (MultiToggle ts l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (MultiToggle ts l a))
runLayout (Workspace String
i MultiToggle ts l a
mt Maybe (Stack a)
s) Rectangle
r = case MultiToggle ts l a -> EL l a
forall ts (l :: * -> *) a. MultiToggle ts l a -> EL l a
currLayout MultiToggle ts l a
mt of
        EL l' a
l l' a -> l a
det -> ((Maybe (l' a) -> Maybe (MultiToggle ts l a))
-> ([(a, Rectangle)], Maybe (l' a))
-> ([(a, Rectangle)], Maybe (MultiToggle ts l a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (l' a) -> Maybe (MultiToggle ts l a))
 -> ([(a, Rectangle)], Maybe (l' a))
 -> ([(a, Rectangle)], Maybe (MultiToggle ts l a)))
-> ((l' a -> MultiToggle ts l a)
    -> Maybe (l' a) -> Maybe (MultiToggle ts l a))
-> (l' a -> MultiToggle ts l a)
-> ([(a, Rectangle)], Maybe (l' a))
-> ([(a, Rectangle)], Maybe (MultiToggle ts l a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l' a -> MultiToggle ts l a)
-> Maybe (l' a) -> Maybe (MultiToggle ts l a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((l' a -> MultiToggle ts l a)
 -> ([(a, Rectangle)], Maybe (l' a))
 -> ([(a, Rectangle)], Maybe (MultiToggle ts l a)))
-> (l' a -> MultiToggle ts l a)
-> ([(a, Rectangle)], Maybe (l' a))
-> ([(a, Rectangle)], Maybe (MultiToggle ts l a))
forall a b. (a -> b) -> a -> b
$ (\l' a
x -> MultiToggle ts l a
mt { currLayout :: EL l a
currLayout = l' a -> (l' a -> l a) -> EL l a
forall (l :: * -> *) a (l' :: * -> *).
LayoutClass l' a =>
l' a -> (l' a -> l a) -> EL l a
EL l' a
x l' a -> l a
det })) (([(a, Rectangle)], Maybe (l' a))
 -> ([(a, Rectangle)], Maybe (MultiToggle ts l a)))
-> X ([(a, Rectangle)], Maybe (l' a))
-> X ([(a, Rectangle)], Maybe (MultiToggle ts l a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Workspace String (l' a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l' a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l' a -> Maybe (Stack a) -> Workspace String (l' a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
i l' a
l Maybe (Stack a)
s) Rectangle
r

    handleMessage :: MultiToggle ts l a -> SomeMessage -> X (Maybe (MultiToggle ts l a))
handleMessage MultiToggle ts l a
mt SomeMessage
m
        | Just (Toggle t
t) <- SomeMessage -> Maybe (Toggle a)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
        , i :: Maybe Int
i@(Just Int
_) <- ts -> t -> Maybe Int
forall c a t. (HList c a, Transformer t a) => c -> t -> Maybe Int
find (MultiToggle ts l a -> ts
forall ts (l :: * -> *) a. MultiToggle ts l a -> ts
transformers MultiToggle ts l a
mt) t
t
            = case MultiToggle ts l a -> EL l a
forall ts (l :: * -> *) a. MultiToggle ts l a -> EL l a
currLayout MultiToggle ts l a
mt of
                EL l' a
l l' a -> l a
det -> do
                    l' a
l' <- l' a -> Maybe (l' a) -> l' a
forall a. a -> Maybe a -> a
fromMaybe l' a
l (Maybe (l' a) -> l' a) -> X (Maybe (l' a)) -> X (l' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l' a -> SomeMessage -> X (Maybe (l' a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l' a
l (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
                    Maybe (MultiToggle ts l a) -> X (Maybe (MultiToggle ts l a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MultiToggle ts l a) -> X (Maybe (MultiToggle ts l a)))
-> (MultiToggle ts l a -> Maybe (MultiToggle ts l a))
-> MultiToggle ts l a
-> X (Maybe (MultiToggle ts l a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiToggle ts l a -> Maybe (MultiToggle ts l a)
forall a. a -> Maybe a
Just (MultiToggle ts l a -> X (Maybe (MultiToggle ts l a)))
-> MultiToggle ts l a -> X (Maybe (MultiToggle ts l a))
forall a b. (a -> b) -> a -> b
$
                        MultiToggle ts l a
mt {
                            currLayout :: EL l a
currLayout = (if Bool
cur then EL l a -> EL l a
forall a. a -> a
id else t -> EL l a -> EL l a
forall t a (l :: * -> *).
(Transformer t a, LayoutClass l a) =>
t -> EL l a -> EL l a
transform' t
t) (l a -> (l a -> l a) -> EL l a
forall (l :: * -> *) a (l' :: * -> *).
LayoutClass l' a =>
l' a -> (l' a -> l a) -> EL l a
EL (l' a -> l a
det l' a
l') l a -> l a
forall a. a -> a
id),
                            currIndex :: Maybe Int
currIndex = if Bool
cur then Maybe Int
forall a. Maybe a
Nothing else Maybe Int
i
                        }
                    where cur :: Bool
cur = Maybe Int
i Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== MultiToggle ts l a -> Maybe Int
forall ts (l :: * -> *) a. MultiToggle ts l a -> Maybe Int
currIndex MultiToggle ts l a
mt
        | Just (MultiToggleActiveQueryMessage t
t IORef (Maybe Bool)
ref :: MultiToggleActiveQueryMessage a) <- SomeMessage -> Maybe (MultiToggleActiveQueryMessage a)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
        , i :: Maybe Int
i@(Just Int
_) <- ts -> t -> Maybe Int
forall c a t. (HList c a, Transformer t a) => c -> t -> Maybe Int
find (MultiToggle ts l a -> ts
forall ts (l :: * -> *) a. MultiToggle ts l a -> ts
transformers MultiToggle ts l a
mt) t
t
            = Maybe (MultiToggle ts l a)
forall a. Maybe a
Nothing Maybe (MultiToggle ts l a)
-> X () -> X (Maybe (MultiToggle ts l a))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IORef (Maybe Bool) -> Maybe Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Bool)
ref (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Maybe Int
i Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== MultiToggle ts l a -> Maybe Int
forall ts (l :: * -> *) a. MultiToggle ts l a -> Maybe Int
currIndex MultiToggle ts l a
mt)))
        | Bool
otherwise
            = case MultiToggle ts l a -> EL l a
forall ts (l :: * -> *) a. MultiToggle ts l a -> EL l a
currLayout MultiToggle ts l a
mt of
                EL l' a
l l' a -> l a
det -> (l' a -> MultiToggle ts l a)
-> Maybe (l' a) -> Maybe (MultiToggle ts l a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\l' a
x -> MultiToggle ts l a
mt { currLayout :: EL l a
currLayout = l' a -> (l' a -> l a) -> EL l a
forall (l :: * -> *) a (l' :: * -> *).
LayoutClass l' a =>
l' a -> (l' a -> l a) -> EL l a
EL l' a
x l' a -> l a
det }) (Maybe (l' a) -> Maybe (MultiToggle ts l a))
-> X (Maybe (l' a)) -> X (Maybe (MultiToggle ts l a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    l' a -> SomeMessage -> X (Maybe (l' a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l' a
l SomeMessage
m

data MultiToggleActiveQueryMessage a = forall t. (Transformer t a) =>
    MultiToggleActiveQueryMessage t (IORef (Maybe Bool))

instance (Typeable a) => Message (MultiToggleActiveQueryMessage a)

-- | Query the state of a 'Transformer' on a given workspace.
--
-- To query the current workspace, use something like this:
--
-- > withWindowSet (isToggleActive t . W.workspace . W.current)
isToggleActive :: Transformer t Window => t -> WindowSpace -> X (Maybe Bool)
isToggleActive :: forall t.
Transformer t Window =>
t -> WindowSpace -> X (Maybe Bool)
isToggleActive t
t WindowSpace
w = do
    IORef (Maybe Bool)
ref <- IO (IORef (Maybe Bool)) -> X (IORef (Maybe Bool))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (IORef (Maybe Bool)) -> X (IORef (Maybe Bool)))
-> IO (IORef (Maybe Bool)) -> X (IORef (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> IO (IORef (Maybe Bool))
forall a. a -> IO (IORef a)
newIORef Maybe Bool
forall a. Maybe a
Nothing
    MultiToggleActiveQueryMessage Window -> WindowSpace -> X ()
forall a. Message a => a -> WindowSpace -> X ()
sendMessageWithNoRefresh (t -> IORef (Maybe Bool) -> MultiToggleActiveQueryMessage Window
forall a t.
Transformer t a =>
t -> IORef (Maybe Bool) -> MultiToggleActiveQueryMessage a
MultiToggleActiveQueryMessage t
t IORef (Maybe Bool)
ref) WindowSpace
w
    IO (Maybe Bool) -> X (Maybe Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe Bool) -> X (Maybe Bool))
-> IO (Maybe Bool) -> X (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Bool) -> IO (Maybe Bool)
forall a. IORef a -> IO a
readIORef IORef (Maybe Bool)
ref