    {-# LANGUAGE PatternGuards #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.NamedScratchpad
    -- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com>
    -- License     :  BSD-style (see LICENSE)
    --
    -- Maintainer  :  Konstantin Sobolev <konstantin.sobolev@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Named scratchpads that support several arbitrary applications at the same time.
    --
    -----------------------------------------------------------------------------

    module XMonad.Util.NamedScratchpad (
      -- * Usage
      -- $usage
      NamedScratchpad(..),
      nonFloating,
      defaultFloating,
      customFloating,
      NamedScratchpads,
      namedScratchpadAction,
      allNamedScratchpadAction,
      namedScratchpadManageHook,
      namedScratchpadFilterOutWorkspace,
      namedScratchpadFilterOutWorkspacePP
      ) where

    import XMonad
    import XMonad.Hooks.ManageHelpers (doRectFloat)
    import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)
    import XMonad.Hooks.DynamicLog (PP, ppSort)

    import Control.Monad (filterM)
    import Data.Maybe (listToMaybe)

    import qualified XMonad.StackSet as W

    -- $usage
    -- Allows to have several floating scratchpads running different applications.
    -- Bind a key to 'namedScratchpadSpawnAction'.
    -- Pressing it will spawn configured application, or bring it to the current
    -- workspace if it already exists.
    -- Pressing the key with the application on the current workspace will
    -- send it to a hidden workspace called @NSP@.
    --
    -- If you already have a workspace called @NSP@, it will use that.
    -- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your
    -- @dynamicLog@ settings to filter it out if you like.
    --
    -- Create named scratchpads configuration in your xmonad.hs like this:
    --
    -- > import XMonad.StackSet as W
    -- > import XMonad.ManageHook
    -- > import XMonad.Util.NamedScratchpad
    -- >
    -- > scratchpads = [
    -- > -- run htop in xterm, find it by title, use default floating window placement
    -- >     NS "htop" "xterm -e htop" (title =? "htop") defaultFloating ,
    -- >
    -- > -- run stardict, find it by class name, place it in the floating window
    -- > -- 1/6 of screen width from the left, 1/6 of screen height
    -- > -- from the top, 2/3 of screen width by 2/3 of screen height
    -- >     NS "stardict" "stardict" (className =? "Stardict")
    -- >         (customFloating $ W.RationalRect (1/6) (1/6) (2/3) (2/3)) ,
    -- >
    -- > -- run gvim, find by role, don't float
    -- >     NS "notes" "gvim --role notes ~/notes.txt" (role =? "notes") nonFloating
    -- > ] where role = stringProperty "WM_WINDOW_ROLE"
    --
    -- Add keybindings:
    --
    -- >  , ((modm .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop")
    -- >  , ((modm .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict")
    -- >  , ((modm .|. controlMask .|. shiftMask, xK_n), namedScratchpadAction scratchpads "notes")
    --
    -- ... and a manage hook:
    --
    -- >  , manageHook = namedScratchpadManageHook scratchpads
    --
    -- For detailed instruction on editing the key binding see
    -- "XMonad.Doc.Extending#Editing_key_bindings"
    --

    -- | Single named scratchpad configuration
    data NamedScratchpad = NS { NamedScratchpad -> String
    name   :: String      -- ^ Scratchpad name
                              , NamedScratchpad -> String
    cmd    :: String      -- ^ Command used to run application
                              , NamedScratchpad -> Query Bool
    query  :: Query Bool  -- ^ Query to find already running application
                              , NamedScratchpad -> ManageHook
    hook   :: ManageHook  -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@
                              }

    -- | Manage hook that makes the window non-floating
    nonFloating :: ManageHook
    nonFloating :: ManageHook
    nonFloating = ManageHook
    forall m. Monoid m => m
    idHook

    -- | Manage hook that makes the window floating with the default placement
    defaultFloating :: ManageHook
    defaultFloating :: ManageHook
    defaultFloating = ManageHook
    doFloat

    -- | Manage hook that makes the window floating with custom placement
    customFloating :: W.RationalRect -> ManageHook
    customFloating :: RationalRect -> ManageHook
    customFloating = RationalRect -> ManageHook
    doRectFloat

    -- | Named scratchpads configuration
    type NamedScratchpads = [NamedScratchpad]

    -- | Finds named scratchpad configuration by name
    findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad
    findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad
    findByName c :: NamedScratchpads
    c s :: String
    s = NamedScratchpads -> Maybe NamedScratchpad
    forall a. [a] -> Maybe a
    listToMaybe (NamedScratchpads -> Maybe NamedScratchpad)
    -> NamedScratchpads -> Maybe NamedScratchpad
    forall a b. (a -> b) -> a -> b
    $ (NamedScratchpad -> Bool) -> NamedScratchpads -> NamedScratchpads
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((String
    sString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (String -> Bool)
    -> (NamedScratchpad -> String) -> NamedScratchpad -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedScratchpad -> String
    name) NamedScratchpads
    c

    -- | Runs application which should appear in specified scratchpad
    runApplication :: NamedScratchpad -> X ()
    runApplication :: NamedScratchpad -> X ()
    runApplication = String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn (String -> X ())
    -> (NamedScratchpad -> String) -> NamedScratchpad -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedScratchpad -> String
    cmd

    -- | Action to pop up specified named scratchpad
    namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration
                          -> String           -- ^ Scratchpad name
                          -> X ()
    namedScratchpadAction :: NamedScratchpads -> String -> X ()
    namedScratchpadAction = ((Window -> X ()) -> [Window] -> X ())
    -> NamedScratchpads -> String -> X ()
    someNamedScratchpadAction (\f :: Window -> X ()
    f ws :: [Window]
    ws -> Window -> X ()
    f (Window -> X ()) -> Window -> X ()
    forall a b. (a -> b) -> a -> b
    $ [Window] -> Window
    forall a. [a] -> a
    head [Window]
    ws)

    allNamedScratchpadAction :: NamedScratchpads
                             -> String
                             -> X ()
    allNamedScratchpadAction :: NamedScratchpads -> String -> X ()
    allNamedScratchpadAction = ((Window -> X ()) -> [Window] -> X ())
    -> NamedScratchpads -> String -> X ()
    someNamedScratchpadAction (Window -> X ()) -> [Window] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_

    someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ())
                              -> NamedScratchpads
                              -> String
                              -> X ()
    someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ())
    -> NamedScratchpads -> String -> X ()
    someNamedScratchpadAction f :: (Window -> X ()) -> [Window] -> X ()
    f confs :: NamedScratchpads
    confs n :: String
    n
        | Just conf :: NamedScratchpad
    conf <- NamedScratchpads -> String -> Maybe NamedScratchpad
    findByName NamedScratchpads
    confs String
    n = (WindowSet -> X ()) -> X ()
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WindowSet
    s -> do
                         [Window]
    filterCurrent <- (Window -> X Bool) -> [Window] -> X [Window]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM (Query Bool -> Window -> X Bool
    forall a. Query a -> Window -> X a
    runQuery (NamedScratchpad -> Query Bool
    query NamedScratchpad
    conf))
                                            (([Window]
    -> (Stack Window -> [Window]) -> Maybe (Stack Window) -> [Window]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] Stack Window -> [Window]
    forall a. Stack a -> [a]
    W.integrate (Maybe (Stack Window) -> [Window])
    -> (WindowSet -> Maybe (Stack Window)) -> WindowSet -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace String (Layout Window) Window -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
    -> (WindowSet -> Workspace String (Layout Window) Window)
    -> WindowSet
    -> Maybe (Stack Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
     -> Workspace String (Layout Window) Window)
    -> (WindowSet
        -> Screen String (Layout Window) Window ScreenId ScreenDetail)
    -> WindowSet
    -> Workspace String (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current) WindowSet
    s)
                         [Window]
    filterAll <- (Window -> X Bool) -> [Window] -> X [Window]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM (Query Bool -> Window -> X Bool
    forall a. Query a -> Window -> X a
    runQuery (NamedScratchpad -> Query Bool
    query NamedScratchpad
    conf)) (WindowSet -> [Window]
    forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
    W.allWindows WindowSet
    s)
                         case [Window]
    filterCurrent of
                           [] -> do
                             case [Window]
    filterAll of
                               [] -> NamedScratchpad -> X ()
    runApplication NamedScratchpad
    conf
                               _  -> (Window -> X ()) -> [Window] -> X ()
    f ((WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (Window -> WindowSet -> WindowSet) -> Window -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Window -> WindowSet -> WindowSet
    forall a s i l sd.
    (Ord a, Eq s, Eq i) =>
    i -> a -> StackSet i l a s sd -> StackSet i l a s sd
    W.shiftWin (WindowSet -> String
    forall i l a s sd. StackSet i l a s sd -> i
    W.currentTag WindowSet
    s)) [Window]
    filterAll
                           _ -> do
                             if [Workspace String (Layout Window) Window] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ((Workspace String (Layout Window) Window -> Bool)
    -> [Workspace String (Layout Window) Window]
    -> [Workspace String (Layout Window) Window]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    scratchpadWorkspaceTag) (String -> Bool)
    -> (Workspace String (Layout Window) Window -> String)
    -> Workspace String (Layout Window) Window
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace String (Layout Window) Window -> String
    forall i l a. Workspace i l a -> i
    W.tag) (WindowSet -> [Workspace String (Layout Window) Window]
    forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
    W.workspaces WindowSet
    s))
                                 then String -> X ()
    addHiddenWorkspace String
    scratchpadWorkspaceTag
                                 else () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                             (Window -> X ()) -> [Window] -> X ()
    f ((WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (Window -> WindowSet -> WindowSet) -> Window -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Window -> WindowSet -> WindowSet
    forall a s i l sd.
    (Ord a, Eq s, Eq i) =>
    i -> a -> StackSet i l a s sd -> StackSet i l a s sd
    W.shiftWin String
    scratchpadWorkspaceTag) [Window]
    filterAll
        | Bool
    otherwise = () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- tag of the scratchpad workspace
    scratchpadWorkspaceTag :: String
    scratchpadWorkspaceTag :: String
    scratchpadWorkspaceTag = "NSP"

    -- | Manage hook to use with named scratchpads
    namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration
                              -> ManageHook
    namedScratchpadManageHook :: NamedScratchpads -> ManageHook
    namedScratchpadManageHook = [ManageHook] -> ManageHook
    forall m. Monoid m => [m] -> m
    composeAll ([ManageHook] -> ManageHook)
    -> (NamedScratchpads -> [ManageHook])
    -> NamedScratchpads
    -> ManageHook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NamedScratchpad -> ManageHook) -> NamedScratchpads -> [ManageHook]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\c :: NamedScratchpad
    c -> NamedScratchpad -> Query Bool
    query NamedScratchpad
    c Query Bool -> ManageHook -> ManageHook
    forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
    --> NamedScratchpad -> ManageHook
    hook NamedScratchpad
    c)

    -- | Transforms a workspace list containing the NSP workspace into one that
    -- doesn't contain it. Intended for use with logHooks.
    namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]
    namedScratchpadFilterOutWorkspace :: [Workspace String (Layout Window) Window]
    -> [Workspace String (Layout Window) Window]
    namedScratchpadFilterOutWorkspace = (Workspace String (Layout Window) Window -> Bool)
    -> [Workspace String (Layout Window) Window]
    -> [Workspace String (Layout Window) Window]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(W.Workspace tag :: String
    tag _ _) -> String
    tag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    scratchpadWorkspaceTag)

    -- | Transforms a pretty-printer into one not displaying the NSP workspace.
    --
    -- A simple use could be:
    --
    -- > logHook = dynamicLogWithPP . namedScratchpadFilterOutWorkspace $ def
    --
    -- Here is another example, when using "XMonad.Layout.IndependentScreens".
    -- If you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write
    --
    -- > logHook = let log screen handle = dynamicLogWithPP . namedScratchpadFilterOutWorkspacePP . marshallPP screen . pp $ handle
    -- >           in log 0 hLeft >> log 1 hRight
    namedScratchpadFilterOutWorkspacePP :: PP -> PP
    namedScratchpadFilterOutWorkspacePP :: PP -> PP
    namedScratchpadFilterOutWorkspacePP pp :: PP
    pp = PP
    pp {
      ppSort :: X ([Workspace String (Layout Window) Window]
       -> [Workspace String (Layout Window) Window])
    ppSort = (([Workspace String (Layout Window) Window]
      -> [Workspace String (Layout Window) Window])
     -> [Workspace String (Layout Window) Window]
     -> [Workspace String (Layout Window) Window])
    -> X ([Workspace String (Layout Window) Window]
          -> [Workspace String (Layout Window) Window])
    -> X ([Workspace String (Layout Window) Window]
          -> [Workspace String (Layout Window) Window])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([Workspace String (Layout Window) Window]
     -> [Workspace String (Layout Window) Window])
    -> ([Workspace String (Layout Window) Window]
        -> [Workspace String (Layout Window) Window])
    -> [Workspace String (Layout Window) Window]
    -> [Workspace String (Layout Window) Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Workspace String (Layout Window) Window]
    -> [Workspace String (Layout Window) Window]
    namedScratchpadFilterOutWorkspace) (PP
    -> X ([Workspace String (Layout Window) Window]
          -> [Workspace String (Layout Window) Window])
    ppSort PP
    pp)
      }

    -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: