-----------------------------------------------------------------------------
-- |
-- 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
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 = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

{- $usage
1. In your @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
<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-}

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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO [String]
getCommands
                        forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt RunOrRaisePrompt
RRP XPConfig
c ([String] -> Predicate -> ComplFunction
getShellCompl [String]
cmds forall a b. (a -> b) -> a -> b
$ XPConfig -> Predicate
searchPredicate XPConfig
c) String -> X ()
open
open :: String -> X ()
open :: String -> X ()
open String
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> IO Bool
isNormalFile String
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b ->
            if Bool
b
            then forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall a b. (a -> b) -> a -> b
$ String
"xdg-open \"" forall a. [a] -> [a] -> [a]
++ String
path forall a. [a] -> [a] -> [a]
++ String
"\""
            else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Query Bool -> X ()
runOrRaise forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, Query Bool)
getTarget forall a b. (a -> b) -> a -> b
$ String
path
    where
      isNormalFile :: String -> IO Bool
isNormalFile String
f = do
          Bool
notCommand <- forall a. Maybe a -> Bool
isNothing 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 <- forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
_            -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      notExecutable :: String -> IO Bool
notExecutable = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Bool
executable) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Permissions
getPermissions
      doesDirExist :: String -> IO Bool
doesDirExist String
f = (String
"/" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
f Bool -> Bool -> 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 forall a. Eq a => Query a -> a -> Query Bool
=? String
"Firefox-bin"     forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
"Firefox"
isApp String
"thunderbird" = Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
"Thunderbird-bin" forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
"Thunderbird"
isApp String
x = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Eq a => a -> a -> Bool
(==) Query Int
pid forall a b. (a -> b) -> a -> b
$ String -> Query Int
pidof String
x

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

pid :: Query Int
pid :: Query Int
pid = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Window
w -> forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> 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" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
a -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$
                       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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]
_)) = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
          getPID' (Just [])    = -b
1
          getPID' Maybe [a]
Nothing      = -b
1