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

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.MultiToggle
    -- 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,

        HList,
        HCons,
        MultiToggle,
    ) where

    import XMonad

    import XMonad.StackSet (Workspace(..))

    import Control.Arrow
    import Data.Typeable
    import Data.Maybe

    -- $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, Typeable)
    -- > instance Transformer MIRROR Window where
    -- >     transform _ x k = k (Mirror x) (\(Mirror x') -> x')
    --
    -- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ 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 (EL x _) k = k x

    deEL :: (LayoutClass l a) => EL l a -> l a
    deEL (EL x det) = det x

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

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

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

    data MultiToggleS ts l a = MultiToggleS (l a) (Maybe Int) ts
        deriving (Read, Show)

    data MultiToggle ts l a = MultiToggle{
        currLayout :: EL l a,
        currIndex :: Maybe Int,
        transformers :: ts
    }

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

    collapse :: (LayoutClass l a) => MultiToggle ts l a -> MultiToggleS ts l a
    collapse mt = MultiToggleS (deEL (currLayout mt)) (currIndex mt) (transformers mt)

    instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where
        readsPrec p s = map (first expand) $ readsPrec p s

    instance (Show ts, Show (l a), LayoutClass l a) => Show (MultiToggle ts l a) where
        showsPrec p = showsPrec p . 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 ts l = MultiToggle (EL l id) Nothing 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 t = mkToggle (single t)

    -- | Marks the end of a transformer list.
    data EOT = EOT deriving (Read, Show)
    data HCons a b = HCons a b deriving (Read, Show)

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

    -- | Construct a singleton transformer table.
    single :: a -> HCons a EOT
    single = (?? 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 EOT _ = Nothing
        resolve EOT _ d _ = d

    instance (Transformer a w, HList b w) => HList (HCons a b) w where
        find (HCons x xs) t
            | t `geq` x = Just 0
            | otherwise = fmap succ (find xs t)
        resolve (HCons x xs) n d k =
            case n `compare` 0 of
                LT -> d
                EQ -> k x
                GT -> resolve xs (pred n) d k

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

    instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where
        description mt = currLayout mt `unEL` \l -> description l

        runLayout (Workspace i mt s) r = case currLayout mt of
            EL l det -> fmap (fmap . fmap $ (\x -> mt { currLayout = EL x det })) $
                runLayout (Workspace i l s) r

        handleMessage mt m
            | Just (Toggle t) <- fromMessage m
            , i@(Just _) <- find (transformers mt) t
                = case currLayout mt of
                    EL l det -> do
                        l' <- fromMaybe l `fmap` handleMessage l (SomeMessage ReleaseResources)
                        return . Just $
                            mt {
                                currLayout = (if cur then id else transform' t) (EL (det l') id),
                                currIndex = if cur then Nothing else i
                            }
                        where cur = (i == currIndex mt)
            | otherwise
                = case currLayout mt of
                    EL l det -> fmap (fmap (\x -> mt { currLayout = EL x det })) $
                        handleMessage l m