module XMonad.Prompt.DirExec
(
dirExecPrompt
, dirExecPromptNamed
, DirExec
) where
import Control.Exception as E
import System.Directory
import Control.Monad
import Data.List
import XMonad
import XMonad.Prompt
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
data DirExec = DirExec String
instance XPrompt DirExec where
showXPrompt :: DirExec -> String
showXPrompt (DirExec name :: String
name) = String
name
dirExecPrompt :: XPConfig -> (String -> X ()) -> FilePath -> X ()
dirExecPrompt :: XPConfig -> (String -> X ()) -> String -> X ()
dirExecPrompt cfg :: XPConfig
cfg runner :: String -> X ()
runner path :: String
path = do
let name :: String
name = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": ") (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
. (["Root"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
([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 (\x :: Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/' then ' ' 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
dirExecPromptNamed :: XPConfig -> (String -> X ()) -> FilePath -> String -> X ()
dirExecPromptNamed :: XPConfig -> (String -> X ()) -> String -> String -> X ()
dirExecPromptNamed cfg :: XPConfig
cfg runner :: String -> X ()
runner path :: String
path name :: String
name = do
let path' :: String
path' = String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/"
[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 cmds :: [[a]]
cmds s :: [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 path :: 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 (\x :: 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 (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&)
(String -> IO Bool
doesFileExist String
x')
((Permissions -> Bool) -> IO Permissions -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM 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 []