-----------------------------------------------------------------------------
-- |
-- 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 :: 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 (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 (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)
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 (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      notExecutable :: String -> IO Bool
notExecutable = (Permissions -> Bool) -> IO Permissions -> IO Bool
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 (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 (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 (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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe [CLong] -> b
forall a p. (Integral a, Num p) => Maybe [a] -> p
getPID' (Display -> Window -> Window -> IO (Maybe [CLong])
getWindowProperty32 Display
d Window
a Window
w)
          getPID' :: Maybe [a] -> p
getPID' (Just (a
x:[a]
_)) = a -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
          getPID' (Just [])    = -p
1
          getPID' Maybe [a]
Nothing      = -p
1