    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Prompt.RunOrRaise
    -- Description :  A prompt to run a program, open a file, or raise a running program.
    -- Copyright   :  (C) 2008 Justin Bogner
    -- License     :  BSD3
    --
    -- Maintainer  :  mail@justinbogner.com
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- A prompt for XMonad which will run a program, open a file,
    -- or raise an already running program, depending on context.
    --
    -----------------------------------------------------------------------------

    module XMonad.Prompt.RunOrRaise
        ( -- * Usage
          -- $usage
          runOrRaisePrompt,
          RunOrRaisePrompt,
        ) where

    import XMonad hiding (config)
    import XMonad.Prelude (isNothing, isSuffixOf, liftA2)
    import XMonad.Prompt
    import XMonad.Prompt.Shell
    import XMonad.Actions.WindowGo (runOrRaise)
    import XMonad.Util.Run (runProcessWithInput)

    import Control.Exception as E
    import System.Directory (doesDirectoryExist, doesFileExist, executable, findExecutable, getPermissions)

    econst :: Monad m => a -> IOException -> m a
    econst :: forall (m :: * -> *) a. Monad m => a -> IOException -> m a
    econst = m a -> IOException -> m a
    forall a b. a -> b -> a
    const (m a -> IOException -> m a)
    -> (a -> m a) -> a -> IOException -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    {- $usage
    1. In your @~\/.xmonad\/xmonad.hs@:

    > import XMonad.Prompt
    > import XMonad.Prompt.RunOrRaise

    2. In your keybindings add something like:

    >   , ((modm .|. controlMask, xK_x), runOrRaisePrompt def)

    For detailed instruction on editing the key binding see
    "XMonad.Doc.Extending#Editing_key_bindings". -}

    data RunOrRaisePrompt = RRP
    instance XPrompt RunOrRaisePrompt where
        showXPrompt :: RunOrRaisePrompt -> String
    showXPrompt RunOrRaisePrompt
    RRP = String
    "Run or Raise: "

    runOrRaisePrompt :: XPConfig -> X ()
    runOrRaisePrompt :: XPConfig -> X ()
    runOrRaisePrompt XPConfig
    c = do [String]
    cmds <- IO [String] -> X [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io IO [String]
    getCommands
                            RunOrRaisePrompt
    -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    forall p.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    mkXPrompt RunOrRaisePrompt
    RRP 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 ()
    open
    open :: String -> X ()
    open :: String -> X ()
    open String
    path = IO Bool -> X Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (String -> IO Bool
    isNormalFile String
    path) X Bool -> (Bool -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Bool
    b ->
                if Bool
    b
                then String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ String
    "xdg-open \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    path String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""
                else (String -> Query Bool -> X ()) -> (String, Query Bool) -> X ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry String -> Query Bool -> X ()
    runOrRaise ((String, Query Bool) -> X ())
    -> (String -> (String, Query Bool)) -> String -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> (String, Query Bool)
    getTarget (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ String
    path
        where
          isNormalFile :: String -> IO Bool
    isNormalFile String
    f = do
              Bool
    notCommand <- Maybe String -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Maybe String)
    findExecutable String
    f -- not a command (executable in $PATH)
              Bool
    exists <- [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ([Bool] -> Bool) -> IO [Bool] -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [IO Bool] -> IO [Bool]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [String -> IO Bool
    doesDirExist String
    f, String -> IO Bool
    doesFileExist String
    f]
              case (Bool
    notCommand, Bool
    exists) of
                  (Bool
    True, Bool
    True) -> String -> IO Bool
    notExecutable String
    f -- not executable as a file in current dir
                  (Bool, Bool)
    _            -> Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
          notExecutable :: String -> IO Bool
    notExecutable = (Permissions -> Bool) -> IO Permissions -> IO Bool
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool -> Bool
    not (Bool -> Bool) -> (Permissions -> Bool) -> Permissions -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permissions -> Bool
    executable) (IO Permissions -> IO Bool)
    -> (String -> IO Permissions) -> String -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO Permissions
    getPermissions
          doesDirExist :: String -> IO Bool
    doesDirExist String
    f = (String
    "/" Predicate
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    f Bool -> Bool -> Bool
    &&) (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Bool
    doesDirectoryExist String
    f
          getTarget :: String -> (String, Query Bool)
    getTarget String
    x = (String
    x,String -> Query Bool
    isApp String
    x)

    isApp :: String -> Query Bool
    isApp :: String -> Query Bool
    isApp String
    "firefox"     = Query String
    className Query String -> String -> Query Bool
    forall a. Eq a => Query a -> a -> Query Bool
    =? String
    "Firefox-bin"     Query Bool -> Query Bool -> Query Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <||> Query String
    className Query String -> String -> Query Bool
    forall a. Eq a => Query a -> a -> Query Bool
    =? String
    "Firefox"
    isApp String
    "thunderbird" = Query String
    className Query String -> String -> Query Bool
    forall a. Eq a => Query a -> a -> Query Bool
    =? String
    "Thunderbird-bin" Query Bool -> Query Bool -> Query Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <||> Query String
    className Query String -> String -> Query Bool
    forall a. Eq a => Query a -> a -> Query Bool
    =? String
    "Thunderbird"
    isApp String
    x = (Int -> Int -> Bool) -> Query Int -> Query Int -> Query Bool
    forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Query Int
    pid (Query Int -> Query Bool) -> Query Int -> Query Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Query Int
    pidof String
    x

    pidof :: String -> Query Int
    pidof :: String -> Query Int
    pidof String
    x = IO Int -> Query Int
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Int -> Query Int) -> IO Int -> Query Int
    forall a b. (a -> b) -> a -> b
    $ (String -> [String] -> String -> IO String
    forall (m :: * -> *).
    MonadIO m =>
    String -> [String] -> String -> m String
    runProcessWithInput String
    "pidof" [String
    x] [] IO String -> (String -> IO Int) -> IO Int
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> IO Int
    forall a. Read a => String -> IO a
    readIO) IO Int -> (IOException -> IO Int) -> IO Int
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` Int -> IOException -> IO Int
    forall (m :: * -> *) a. Monad m => a -> IOException -> m a
    econst Int
    0

    pid :: Query Int
    pid :: Query Int
    pid = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query Int) -> Query Int
    forall a b. Query a -> (a -> Query b) -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\Window
    w -> X Int -> Query Int
    forall a. X a -> Query a
    liftX (X Int -> Query Int) -> X Int -> Query Int
    forall a b. (a -> b) -> a -> b
    $ (Display -> X Int) -> X Int
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X Int) -> X Int) -> (Display -> X Int) -> X Int
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> Display -> Window -> X Int
    forall {b}. Num b => Display -> Window -> X b
    getPID Display
    d Window
    w)
        where getPID :: Display -> Window -> X b
    getPID Display
    d Window
    w = String -> X Window
    getAtom String
    "_NET_WM_PID" X Window -> (Window -> X b) -> X b
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Window
    a -> IO b -> X b
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO b -> X b) -> IO b -> X b
    forall a b. (a -> b) -> a -> b
    $
                           (Maybe [CLong] -> b) -> IO (Maybe [CLong]) -> IO b
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe [CLong] -> b
    forall {a} {b}. (Integral a, Num b) => Maybe [a] -> b
    getPID' (Display -> Window -> Window -> IO (Maybe [CLong])
    getWindowProperty32 Display
    d Window
    a Window
    w)
              getPID' :: Maybe [a] -> b
    getPID' (Just (a
    x:[a]
    _)) = a -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x
              getPID' (Just [])    = -b
    1
              getPID' Maybe [a]
    Nothing      = -b
    1