-----------------------------------------------------------------------------
-- |
-- 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 = 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.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
-- "XMonad.Doc.Extending#Editing_key_bindings".

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 = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
last
                         ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String
"Root"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++) -- handling of "/" path parameter
                         ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
                         (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' then Char
' ' else Char
x)
                         (String -> String) -> String -> String
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
    [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
$ ComplFunction
getDirectoryExecutables String
path'
    DirExec -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> DirExec
DirExec String
name) XPConfig
cfg ([String] -> ComplFunction
forall {m :: * -> *} {a}.
(Monad m, Eq a) =>
[[a]] -> [a] -> m [[a]]
compList [String]
cmds) (String -> X ()
runner (String -> X ()) -> (String -> String) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
path' String -> String -> String
forall a. [a] -> [a] -> [a]
++))
    where
        compList :: [[a]] -> [a] -> m [[a]]
compList [[a]]
cmds [a]
s = [[a]] -> m [[a]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[a]] -> m [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> m [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
s) ([[a]] -> m [[a]]) -> [[a]] -> m [[a]]
forall a b. (a -> b) -> a -> b
$ [[a]]
cmds

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