    {-# LANGUAGE DeriveDataTypeable #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module       : XMonad.Actions.SpawnOn
    -- Copyright    : (c) Spencer Janssen
    -- License      : BSD
    --
    -- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
    -- Stability    : unstable
    -- Portability  : unportable
    --
    -- Provides a way to modify a window spawned by a command(e.g shift it to the workspace
    -- it was launched on) by using the _NET_WM_PID property that most windows set on creation.
    -- Hence this module won't work on applications that don't set this property.
    --
    -----------------------------------------------------------------------------

    module XMonad.Actions.SpawnOn (
        -- * Usage
        -- $usage
        Spawner,
        manageSpawn,
        manageSpawnWithGC,
        spawnHere,
        spawnOn,
        spawnAndDo,
        shellPromptHere,
        shellPromptOn
    ) where

    import Control.Exception (tryJust)
    import Control.Monad (guard)
    import Data.List (isInfixOf)
    import Data.Maybe (isJust)
    import System.IO.Error (isDoesNotExistError)
    import System.IO.Unsafe (unsafePerformIO)
    import System.Posix.Types (ProcessID)
    import Text.Printf (printf)

    import XMonad
    import qualified XMonad.StackSet as W

    import XMonad.Hooks.ManageHelpers
    import XMonad.Prompt
    import XMonad.Prompt.Shell
    import qualified XMonad.Util.ExtensibleState as XS

    -- $usage
    -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
    --
    -- >    import XMonad.Actions.SpawnOn
    --
    -- >    main = do
    -- >      xmonad def {
    -- >         ...
    -- >         manageHook = manageSpawn <+> manageHook def
    -- >         ...
    -- >      }
    --
    -- To ensure that application appears on a workspace it was launched at, add keybindings like:
    --
    -- >  , ((mod1Mask,xK_o), spawnHere "urxvt")
    -- >  , ((mod1Mask,xK_s), shellPromptHere def)
    --
    -- The module can also be used to apply other manage hooks to the window of
    -- the spawned application(e.g. float or resize it).
    --
    -- For detailed instructions on editing your key bindings, see
    -- "XMonad.Doc.Extending#Editing_key_bindings".

    newtype Spawner = Spawner {Spawner -> [(ProcessID, ManageHook)]
    pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable

    instance ExtensionClass Spawner where
        initialValue :: Spawner
    initialValue = [(ProcessID, ManageHook)] -> Spawner
    Spawner []

    getPPIDOf :: ProcessID -> Maybe ProcessID
    getPPIDOf :: ProcessID -> Maybe ProcessID
    getPPIDOf pid :: ProcessID
    pid =
        case IO (Either () String) -> Either () String
    forall a. IO a -> a
    unsafePerformIO (IO (Either () String) -> Either () String)
    -> (Integer -> IO (Either () String))
    -> Integer
    -> Either () String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IOError -> Maybe ()) -> IO String -> IO (Either () String)
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> IO a -> IO (Either b a)
    tryJust (Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IOError -> Bool
    isDoesNotExistError) (IO String -> IO (Either () String))
    -> (Integer -> IO String) -> Integer -> IO (Either () String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO String
    readFile (String -> IO String)
    -> (Integer -> String) -> Integer -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Integer -> String
    forall r. PrintfType r => String -> r
    printf "/proc/%d/stat" (Integer -> Either () String) -> Integer -> Either () String
    forall a b. (a -> b) -> a -> b
    $ ProcessID -> Integer
    forall a. Integral a => a -> Integer
    toInteger ProcessID
    pid of
          Left _         -> Maybe ProcessID
    forall a. Maybe a
    Nothing
          Right contents :: String
    contents -> case String -> [String]
    lines String
    contents of
                              []        -> Maybe ProcessID
    forall a. Maybe a
    Nothing
                              first :: String
    first : _ -> case String -> [String]
    words String
    first of
                                             _ : _ : _ : ppid :: String
    ppid : _ -> ProcessID -> Maybe ProcessID
    forall a. a -> Maybe a
    Just (ProcessID -> Maybe ProcessID) -> ProcessID -> Maybe ProcessID
    forall a b. (a -> b) -> a -> b
    $ Int -> ProcessID
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (String -> Int
    forall a. Read a => String -> a
    read String
    ppid :: Int)
                                             _                    -> Maybe ProcessID
    forall a. Maybe a
    Nothing

    getPPIDChain :: ProcessID -> [ProcessID]
    getPPIDChain :: ProcessID -> [ProcessID]
    getPPIDChain pid' :: ProcessID
    pid' = ProcessID -> [ProcessID] -> [ProcessID]
    ppid_chain ProcessID
    pid' []
        where ppid_chain :: ProcessID -> [ProcessID] -> [ProcessID]
    ppid_chain pid :: ProcessID
    pid acc :: [ProcessID]
    acc =
                  if ProcessID
    pid ProcessID -> ProcessID -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0
                  then [ProcessID]
    acc
                  else case ProcessID -> Maybe ProcessID
    getPPIDOf ProcessID
    pid of
                         Nothing   -> [ProcessID]
    acc
                         Just ppid :: ProcessID
    ppid -> ProcessID -> [ProcessID] -> [ProcessID]
    ppid_chain ProcessID
    ppid (ProcessID
    ppid ProcessID -> [ProcessID] -> [ProcessID]
    forall a. a -> [a] -> [a]
    : [ProcessID]
    acc)

    -- | Get the current Spawner or create one if it doesn't exist.
    modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
    modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
    modifySpawner f :: [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]
    f = (Spawner -> Spawner) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify ([(ProcessID, ManageHook)] -> Spawner
    Spawner ([(ProcessID, ManageHook)] -> Spawner)
    -> (Spawner -> [(ProcessID, ManageHook)]) -> Spawner -> Spawner
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]
    f ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)])
    -> (Spawner -> [(ProcessID, ManageHook)])
    -> Spawner
    -> [(ProcessID, ManageHook)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Spawner -> [(ProcessID, ManageHook)]
    pidsRef)

    -- | Provides a manage hook to react on process spawned with
    -- 'spawnOn', 'spawnHere' etc.
    manageSpawn :: ManageHook
    manageSpawn :: ManageHook
    manageSpawn = ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
    -> ManageHook
    manageSpawnWithGC ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
    -> ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)])
    -> [(ProcessID, ManageHook)]
    -> X [(ProcessID, ManageHook)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]
    forall a. Int -> [a] -> [a]
    take 20)

    manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
            -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@
           -> ManageHook
    manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
    -> ManageHook
    manageSpawnWithGC garbageCollect :: [(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]
    garbageCollect = do
        Spawner pids :: [(ProcessID, ManageHook)]
    pids <- X Spawner -> Query Spawner
    forall a. X a -> Query a
    liftX X Spawner
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
        Maybe ProcessID
    mp <- Query (Maybe ProcessID)
    pid
        let ppid_chain :: [ProcessID]
    ppid_chain = case Maybe ProcessID
    mp of
                           Just winpid :: ProcessID
    winpid -> ProcessID
    winpid ProcessID -> [ProcessID] -> [ProcessID]
    forall a. a -> [a] -> [a]
    : ProcessID -> [ProcessID]
    getPPIDChain ProcessID
    winpid
                           Nothing     -> []
            known_window_handlers :: [ManageHook]
    known_window_handlers = [ ManageHook
    mh
                                    | ProcessID
    ppid <- [ProcessID]
    ppid_chain
                                    , let mpid :: Maybe ManageHook
    mpid = ProcessID -> [(ProcessID, ManageHook)] -> Maybe ManageHook
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ProcessID
    ppid [(ProcessID, ManageHook)]
    pids
                                    , Maybe ManageHook -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe ManageHook
    mpid
                                    , let (Just mh :: ManageHook
    mh) = Maybe ManageHook
    mpid ]
        case [ManageHook]
    known_window_handlers of
            [] -> ManageHook
    forall m. Monoid m => m
    idHook
            (mh :: ManageHook
    mh:_)  -> do
                Maybe ProcessID -> (ProcessID -> Query ()) -> Query ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe ProcessID
    mp ((ProcessID -> Query ()) -> Query ())
    -> (ProcessID -> Query ()) -> Query ()
    forall a b. (a -> b) -> a -> b
    $ \p :: ProcessID
    p -> X () -> Query ()
    forall a. X a -> Query a
    liftX (X () -> Query ()) -> X () -> Query ()
    forall a b. (a -> b) -> a -> b
    $ do
                    [(ProcessID, ManageHook)]
    ps <- (Spawner -> [(ProcessID, ManageHook)])
    -> X [(ProcessID, ManageHook)]
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets Spawner -> [(ProcessID, ManageHook)]
    pidsRef
                    Spawner -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (Spawner -> X ())
    -> ([(ProcessID, ManageHook)] -> Spawner)
    -> [(ProcessID, ManageHook)]
    -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(ProcessID, ManageHook)] -> Spawner
    Spawner ([(ProcessID, ManageHook)] -> X ())
    -> X [(ProcessID, ManageHook)] -> X ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]
    garbageCollect (((ProcessID, ManageHook) -> Bool)
    -> [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((ProcessID -> ProcessID -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ProcessID
    p) (ProcessID -> Bool)
    -> ((ProcessID, ManageHook) -> ProcessID)
    -> (ProcessID, ManageHook)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProcessID, ManageHook) -> ProcessID
    forall a b. (a, b) -> a
    fst) [(ProcessID, ManageHook)]
    ps)
                ManageHook
    mh

    mkPrompt :: (String -> X ()) -> XPConfig -> X ()
    mkPrompt :: (String -> X ()) -> XPConfig -> X ()
    mkPrompt cb :: String -> X ()
    cb c :: XPConfig
    c = do
        [String]
    cmds <- IO [String] -> X [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [String] -> X [String]) -> IO [String] -> X [String]
    forall a b. (a -> b) -> a -> b
    $ IO [String]
    getCommands
        Shell -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    forall p.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    mkXPrompt Shell
    Shell XPConfig
    c ([String] -> Predicate -> ComplFunction
    getShellCompl [String]
    cmds (Predicate -> ComplFunction) -> Predicate -> ComplFunction
    forall a b. (a -> b) -> a -> b
    $ XPConfig -> Predicate
    searchPredicate XPConfig
    c) String -> X ()
    cb

    -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
    -- application on current workspace.
    shellPromptHere :: XPConfig -> X ()
    shellPromptHere :: XPConfig -> X ()
    shellPromptHere = (String -> X ()) -> XPConfig -> X ()
    mkPrompt String -> X ()
    spawnHere

    -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
    -- application on given workspace.
    shellPromptOn :: WorkspaceId -> XPConfig -> X ()
    shellPromptOn :: String -> XPConfig -> X ()
    shellPromptOn ws :: String
    ws = (String -> X ()) -> XPConfig -> X ()
    mkPrompt (String -> String -> X ()
    spawnOn String
    ws)

    -- | Replacement for 'spawn' which launches
    -- application on current workspace.
    spawnHere :: String -> X ()
    spawnHere :: String -> X ()
    spawnHere cmd :: String
    cmd = (WindowSet -> X ()) -> X ()
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \ws :: WindowSet
    ws -> String -> String -> X ()
    spawnOn (WindowSet -> String
    forall i l a s sd. StackSet i l a s sd -> i
    W.currentTag WindowSet
    ws) String
    cmd

    -- | Replacement for 'spawn' which launches
    -- application on given workspace.
    spawnOn :: WorkspaceId -> String -> X ()
    spawnOn :: String -> String -> X ()
    spawnOn ws :: String
    ws cmd :: String
    cmd = ManageHook -> String -> X ()
    spawnAndDo (String -> ManageHook
    doShift String
    ws) String
    cmd

    -- | Spawn an application and apply the manage hook when it opens.
    spawnAndDo :: ManageHook -> String -> X ()
    spawnAndDo :: ManageHook -> String -> X ()
    spawnAndDo mh :: ManageHook
    mh cmd :: String
    cmd = do
        ProcessID
    p <- String -> X ProcessID
    forall (m :: * -> *). MonadIO m => String -> m ProcessID
    spawnPID (String -> X ProcessID) -> String -> X ProcessID
    forall a b. (a -> b) -> a -> b
    $ String -> String
    mangle String
    cmd
        ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
    modifySpawner (([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ())
    -> ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
    forall a b. (a -> b) -> a -> b
    $ ((ProcessID
    p,ManageHook
    mh) (ProcessID, ManageHook)
    -> [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]
    forall a. a -> [a] -> [a]
    :)
     where
        -- TODO this is silly, search for a better solution
        mangle :: String -> String
    mangle xs :: String
    xs | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    metaChars) String
    xs Bool -> Bool -> Bool
    || "exec" Predicate
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    xs = String
    xs
                  | Bool
    otherwise = "exec " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    xs
        metaChars :: String
    metaChars = "&|;"