-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Prompt.DirExec
-- Description :  A directory file executables prompt for XMonad.
-- Copyright   :  (C) 2008 Juraj Hercek
-- License     :  BSD3
--
-- Maintainer  :  juhe_xmonad@hck.sk
-- Stability   :  unstable
-- Portability :  unportable
--
-- A directory file executables prompt for XMonad. This might be useful if you
-- don't want to have scripts in your PATH environment variable (same
-- executable names, different behavior) - otherwise you might want to use
-- "XMonad.Prompt.Shell" instead - but you want to have easy access to these
-- executables through the xmonad's prompt.
--
-----------------------------------------------------------------------------

module XMonad.Prompt.DirExec
    ( -- * Usage
      -- $usage
      dirExecPrompt
    , dirExecPromptNamed
    , DirExec
    ) where

import Control.Exception as E
import System.Directory
import XMonad
import XMonad.Prelude
import XMonad.Prompt

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.DirExec
--
-- 2. In your keybindings add something like:
--
-- >   , ("M-C-x", dirExecPrompt def spawn "/home/joe/.scipts")
--
-- or
--
-- >   , ("M-C-x", dirExecPromptNamed def spawn
-- >                                  "/home/joe/.scripts" "My Scripts: ")
--
-- or add this after your default bindings:
--
-- >   ++
-- >   [ ("M-x " ++ key, dirExecPrompt def fn "/home/joe/.scripts")
-- >     | (key, fn) <- [ ("x", spawn), ("M-x", runInTerm "-hold") ]
-- >   ]
-- >   ++
--
-- The first alternative uses the last element of the directory path for
-- a name of prompt. The second alternative uses the provided string
-- for the name of the prompt. The third alternative defines 2 key bindings,
-- first one spawns the program by shell, second one runs the program in
-- terminal
--
-- For detailed instruction on editing the key binding see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

newtype DirExec = DirExec String

instance XPrompt DirExec where
    showXPrompt :: DirExec -> String
showXPrompt (DirExec String
name) = String
name

-- | Function 'dirExecPrompt' starts the prompt with list of all executable
-- files in directory specified by 'FilePath'. The name of the prompt is taken
-- from the last element of the path. If you specify root directory - @\/@ - as
-- the path, name @Root:@ will be used as the name of the prompt instead. The
-- 'XPConfig' parameter can be used to customize visuals of the prompt.
-- The runner parameter specifies the function used to run the program - see
-- usage for more information
dirExecPrompt :: XPConfig -> (String -> X ()) -> FilePath -> X ()
dirExecPrompt :: XPConfig -> (String -> X ()) -> String -> X ()
dirExecPrompt XPConfig
cfg String -> X ()
runner String
path = do
    let name :: String
name = (forall a. [a] -> [a] -> [a]
++ String
": ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String
"Root"] forall a. [a] -> [a] -> [a]
++) -- handling of "/" path parameter
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
== Char
'/' then Char
' ' else Char
x)
                         forall a b. (a -> b) -> a -> b
$ String
path
    XPConfig -> (String -> X ()) -> String -> String -> X ()
dirExecPromptNamed XPConfig
cfg String -> X ()
runner String
path String
name

-- | Function 'dirExecPromptNamed' does the same as 'dirExecPrompt' except
-- the name of the prompt is specified by 'String' parameter.
dirExecPromptNamed :: XPConfig -> (String -> X ()) -> FilePath -> String -> X ()
dirExecPromptNamed :: XPConfig -> (String -> X ()) -> String -> String -> X ()
dirExecPromptNamed XPConfig
cfg String -> X ()
runner String
path String
name = do
    let path' :: String
path' = String
path forall a. [a] -> [a] -> [a]
++ String
"/"
    [String]
cmds <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ ComplFunction
getDirectoryExecutables String
path'
    forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> DirExec
DirExec String
name) XPConfig
cfg (forall {m :: * -> *} {a}.
(Monad m, Eq a) =>
[[a]] -> [a] -> m [[a]]
compList [String]
cmds) (String -> X ()
runner forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
path' forall a. [a] -> [a] -> [a]
++))
    where
        compList :: [[a]] -> [a] -> m [[a]]
compList [[a]]
cmds [a]
s = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
s) forall a b. (a -> b) -> a -> b
$ [[a]]
cmds

getDirectoryExecutables :: FilePath -> IO [String]
getDirectoryExecutables :: ComplFunction
getDirectoryExecutables String
path =
    (ComplFunction
getDirectoryContents String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\String
x -> let x' :: String
x' = String
path forall a. [a] -> [a] -> [a]
++ String
x in
            forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&)
                (String -> IO Bool
doesFileExist String
x')
                (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Permissions -> Bool
executable (String -> IO Permissions
getPermissions String
x'))))
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst []