    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.MessageControl
    -- Description :  Message escaping and filtering facilities.
    -- Copyright   :  (c) 2008 Quentin Moser
    -- License     :  BSD3
    --
    -- Maintainer  :  orphaned
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Provides message \"escaping\" and filtering facilities which
    -- help control complex nested layouts.
    -----------------------------------------------------------------------------

    module XMonad.Layout.MessageControl (
                                   -- * Usage
                                   -- $usage
                                Ignore()
                              , ignore
                              , UnEscape()
                              , unEscape
                              , EscapedMessage(Escape)
                              , escape
                              ) where

    import XMonad.Core (Message, SomeMessage(..)
                       , fromMessage, LayoutClass(..))
    import XMonad.StackSet (Workspace(..))

    import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))

    import Control.Arrow (second)

    -- $usage
    -- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
    --
    -- > import XMonad.Layout.MessageEscape
    --
    -- Then, if you use a modified layout where the modifier would intercept
    -- a message, but you'd want to be able to send it to the inner layout
    -- only, add the 'unEscape' modifier to the inner layout like so:
    --
    -- > import XMonad.Layout.Master (mastered)
    -- > import XMonad.Layout.Tabbed (simpleTabbed)
    -- >
    -- > myLayout = Tall ||| unEscape (mastered 0.01 0.5 $ Full ||| simpleTabbed)
    --
    -- you can now send a message to the inner layout with
    --  @sendMessage $ escape message@, e.g.
    --
    -- > -- Change the inner layout
    -- > ((modm .|. controlMask, xK_space), sendMessage $ escape NextLayout)
    --
    -- If you want unescaped messages to be handled /only/ by the enclosing
    -- layout, use the 'ignore' modifier:
    --
    -- > myLayout = Tall ||| (ignore NextLayout $ ignore (JumpToLayout "") $
    -- >                       unEscape $ mastered 0.01 0.5
    -- >                         $ Full ||| simpleTabbed)
    --

    -- | the Ignore layout modifier. Prevents its inner layout from receiving
    -- messages of a certain type.

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

    instance (Message m, LayoutClass l w) => LayoutClass (Ignore m l) w where
        runLayout :: Workspace String (Ignore m l w) w
    -> Rectangle -> X ([(w, Rectangle)], Maybe (Ignore m l w))
    runLayout Workspace String (Ignore m l w) w
    ws Rectangle
    r = (Maybe (l w) -> Maybe (Ignore m l w))
    -> ([(w, Rectangle)], Maybe (l w))
    -> ([(w, Rectangle)], Maybe (Ignore m l w))
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (l w -> Ignore m l w
    forall m (l :: * -> *) w. l w -> Ignore m l w
    I (l w -> Ignore m l w) -> Maybe (l w) -> Maybe (Ignore m l w)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([(w, Rectangle)], Maybe (l w))
     -> ([(w, Rectangle)], Maybe (Ignore m l w)))
    -> X ([(w, Rectangle)], Maybe (l w))
    -> X ([(w, Rectangle)], Maybe (Ignore m l w))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Workspace String (l w) w
    -> Rectangle -> X ([(w, Rectangle)], Maybe (l w))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace String (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout (Workspace String (Ignore m l w) w -> Workspace String (l w) w
    forall i m (l :: * -> *) w.
    Workspace i (Ignore m l w) w -> Workspace i (l w) w
    unILayout Workspace String (Ignore m l w) w
    ws) Rectangle
    r
            where  unILayout :: Workspace i (Ignore m l w) w -> Workspace i (l w) w
                   unILayout :: forall i m (l :: * -> *) w.
    Workspace i (Ignore m l w) w -> Workspace i (l w) w
    unILayout w :: Workspace i (Ignore m l w) w
    w@Workspace{ layout :: forall i l a. Workspace i l a -> l
    layout = (I l w
    l) } = Workspace i (Ignore m l w) w
    w { layout :: l w
    layout = l w
    l }
        handleMessage :: Ignore m l w -> SomeMessage -> X (Maybe (Ignore m l w))
    handleMessage l :: Ignore m l w
    l@(I l w
    l') SomeMessage
    sm
            = case SomeMessage -> Ignore m l w -> Maybe m
    forall m' (l :: * -> *) w.
    Message m' =>
    SomeMessage -> Ignore m' l w -> Maybe m'
    fromMessageAs SomeMessage
    sm Ignore m l w
    l of
                Just m
    _ -> Maybe (Ignore m l w) -> X (Maybe (Ignore m l w))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Ignore m l w)
    forall a. Maybe a
    Nothing
                Maybe m
    Nothing -> (l w -> Ignore m l w
    forall m (l :: * -> *) w. l w -> Ignore m l w
    I (l w -> Ignore m l w) -> Maybe (l w) -> Maybe (Ignore m l w)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Maybe (l w) -> Maybe (Ignore m l w))
    -> X (Maybe (l w)) -> X (Maybe (Ignore m l w))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> l w -> SomeMessage -> X (Maybe (l w))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    layout a -> SomeMessage -> X (Maybe (layout a))
    handleMessage l w
    l' SomeMessage
    sm
            where fromMessageAs :: Message m' => SomeMessage -> Ignore m' l w -> Maybe m'
                  fromMessageAs :: forall m' (l :: * -> *) w.
    Message m' =>
    SomeMessage -> Ignore m' l w -> Maybe m'
    fromMessageAs SomeMessage
    a Ignore m' l w
    _ = SomeMessage -> Maybe m'
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    a
        description :: Ignore m l w -> String
    description (I l w
    l) = String
    "Ignore "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++l w -> String
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    layout a -> String
    description l w
    l

    -- | the UnEscape layout modifier. Listens to 'EscapedMessage's and sends
    -- their nested message to the inner layout.

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

    instance LayoutModifier UnEscape a where
        handleMessOrMaybeModifyIt :: UnEscape a
    -> SomeMessage -> X (Maybe (Either (UnEscape a) SomeMessage))
    handleMessOrMaybeModifyIt UnEscape a
    _ SomeMessage
    mess
            = Maybe (Either (UnEscape a) SomeMessage)
    -> X (Maybe (Either (UnEscape a) SomeMessage))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Either (UnEscape a) SomeMessage)
     -> X (Maybe (Either (UnEscape a) SomeMessage)))
    -> Maybe (Either (UnEscape a) SomeMessage)
    -> X (Maybe (Either (UnEscape a) SomeMessage))
    forall a b. (a -> b) -> a -> b
    $ case SomeMessage -> Maybe EscapedMessage
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    mess of
                         Just (Escape SomeMessage
    mess') -> Either (UnEscape a) SomeMessage
    -> Maybe (Either (UnEscape a) SomeMessage)
    forall a. a -> Maybe a
    Just (Either (UnEscape a) SomeMessage
     -> Maybe (Either (UnEscape a) SomeMessage))
    -> Either (UnEscape a) SomeMessage
    -> Maybe (Either (UnEscape a) SomeMessage)
    forall a b. (a -> b) -> a -> b
    $ SomeMessage -> Either (UnEscape a) SomeMessage
    forall a b. b -> Either a b
    Right SomeMessage
    mess'
                         Maybe EscapedMessage
    Nothing -> Maybe (Either (UnEscape a) SomeMessage)
    forall a. Maybe a
    Nothing

    -- | Data type for an escaped message. Send with 'escape'.

    newtype EscapedMessage = Escape SomeMessage
    instance Message EscapedMessage

    -- | Creates an 'EscapedMessage'.

    escape :: Message m => m -> EscapedMessage
    escape :: forall m. Message m => m -> EscapedMessage
    escape = SomeMessage -> EscapedMessage
    Escape (SomeMessage -> EscapedMessage)
    -> (m -> SomeMessage) -> m -> EscapedMessage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m -> SomeMessage
    forall a. Message a => a -> SomeMessage
    SomeMessage

    -- | Applies the UnEscape layout modifier to a layout.

    unEscape :: LayoutClass l w => l w -> ModifiedLayout UnEscape l w
    unEscape :: forall (l :: * -> *) w.
    LayoutClass l w =>
    l w -> ModifiedLayout UnEscape l w
    unEscape = UnEscape w -> l w -> ModifiedLayout UnEscape l w
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout UnEscape w
    forall w. UnEscape w
    UE

    -- | Applies the Ignore layout modifier to a layout, blocking
    -- all messages of the same type as the one passed as its first argument.

    ignore :: (Message m, LayoutClass l w)
              => m -> l w -> Ignore m l w
    ignore :: forall m (l :: * -> *) w.
    (Message m, LayoutClass l w) =>
    m -> l w -> Ignore m l w
    ignore m
    _ = l w -> Ignore m l w
    forall m (l :: * -> *) w. l w -> Ignore m l w
    I