module XMonad.Prompt.Shell
(
Shell (..)
, shellPrompt
, prompt
, safePrompt
, unsafePrompt
, getCommands
, getBrowser
, getEditor
, getShellCompl
, split
) where
import Codec.Binary.UTF8.String (encodeString)
import Control.Exception as E
import Control.Monad (forM)
import Data.Char (toLower)
import Data.List (isPrefixOf, sortBy)
import System.Directory (getDirectoryContents)
import System.Environment (getEnv)
import System.Posix.Files (getFileStatus, isDirectory)
import XMonad hiding (config)
import XMonad.Prompt
import XMonad.Util.Run
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 Shell = Shell
type Predicate = String -> String -> Bool
instance XPrompt Shell where
showXPrompt :: Shell -> String
showXPrompt Shell = "Run: "
completionToCommand :: Shell -> String -> String
completionToCommand _ = String -> String
escape
shellPrompt :: XPConfig -> X ()
shellPrompt :: XPConfig -> X ()
shellPrompt c :: XPConfig
c = do
[String]
cmds <- IO [String] -> X [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO [String]
getCommands
Shell -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt Shell
Shell 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 ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn
prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X ()
prompt :: String -> XPConfig -> X ()
prompt = String -> XPConfig -> X ()
unsafePrompt
safePrompt :: String -> XPConfig -> X ()
safePrompt c :: String
c config :: XPConfig
config = Shell -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt Shell
Shell XPConfig
config ([String] -> Predicate -> ComplFunction
getShellCompl [String
c] (Predicate -> ComplFunction) -> Predicate -> ComplFunction
forall a b. (a -> b) -> a -> b
$ XPConfig -> Predicate
searchPredicate XPConfig
config) String -> X ()
run
where run :: String -> X ()
run = String -> [String] -> X ()
forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
c ([String] -> X ()) -> (String -> [String]) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return
unsafePrompt :: String -> XPConfig -> X ()
unsafePrompt c :: String
c config :: XPConfig
config = Shell -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt Shell
Shell XPConfig
config ([String] -> Predicate -> ComplFunction
getShellCompl [String
c] (Predicate -> ComplFunction) -> Predicate -> ComplFunction
forall a b. (a -> b) -> a -> b
$ XPConfig -> Predicate
searchPredicate XPConfig
config) String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
run
where run :: String -> m ()
run a :: String
a = String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
getShellCompl :: [String] -> Predicate -> String -> IO [String]
getShellCompl :: [String] -> Predicate -> ComplFunction
getShellCompl cmds :: [String]
cmds p :: Predicate
p s :: String
s | String
s Predicate
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = do
[String]
f <- (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> [String]
lines (IO String -> IO [String]) -> IO String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO String
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> m String
runProcessWithInput "bash" [] ("compgen -A file -- "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n")
[String]
files <- case [String]
f of
[x :: String
x] -> do FileStatus
fs <- String -> IO FileStatus
getFileStatus (String -> String
encodeString String
x)
if FileStatus -> Bool
isDirectory FileStatus
fs then [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/"]
else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
x]
_ -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
f
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Ordering) -> [String] -> [String]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy String -> String -> Ordering
typedFirst ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
uniqSort ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
files [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> Predicate -> String -> [String]
commandCompletionFunction [String]
cmds Predicate
p String
s
where
typedFirst :: String -> String -> Ordering
typedFirst x :: String
x y :: String
y
| String
x Predicate
`startsWith` String
s Bool -> Bool -> Bool
&& Bool -> Bool
not (String
y Predicate
`startsWith` String
s) = Ordering
LT
| String
y Predicate
`startsWith` String
s Bool -> Bool -> Bool
&& Bool -> Bool
not (String
x Predicate
`startsWith` String
s) = Ordering
GT
| Bool
otherwise = String
x String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String
y
startsWith :: Predicate
startsWith str :: String
str ps :: String
ps = Predicate
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
ps) ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
str)
commandCompletionFunction :: [String] -> Predicate -> String -> [String]
commandCompletionFunction :: [String] -> Predicate -> String -> [String]
commandCompletionFunction cmds :: [String]
cmds p :: Predicate
p str :: String
str | '/' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
str = []
| Bool
otherwise = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Predicate
p String
str) [String]
cmds
getCommands :: IO [String]
getCommands :: IO [String]
getCommands = do
String
p <- String -> IO String
getEnv "PATH" 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 []
let ds :: [String]
ds = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Predicate
forall a. Eq a => a -> a -> Bool
/= "") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
split ':' String
p
[[String]]
es <- [String] -> ComplFunction -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
ds (ComplFunction -> IO [[String]]) -> ComplFunction -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ \d :: String
d -> ComplFunction
getDirectoryContents String
d 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 []
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([[String]] -> [String]) -> [[String]] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
uniqSort ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.') (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head) ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> IO [String]) -> [[String]] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [[String]]
es
split :: Eq a => a -> [a] -> [[a]]
split :: a -> [a] -> [[a]]
split _ [] = []
split e :: a
e l :: [a]
l =
[a]
f [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
split a
e ([a] -> [a]
forall a. Eq a => [a] -> [a]
rest [a]
ls)
where
(f :: [a]
f,ls :: [a]
ls) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
e) [a]
l
rest :: [a] -> [a]
rest s :: [a]
s | [a]
s [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [] = []
| Bool
otherwise = [a] -> [a]
forall a. [a] -> [a]
tail [a]
s
escape :: String -> String
escape :: String -> String
escape [] = ""
escape (x :: Char
x:xs :: String
xs)
| Char -> Bool
isSpecialChar Char
x = '\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape String
xs
| Bool
otherwise = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape String
xs
isSpecialChar :: Char -> Bool
isSpecialChar :: Char -> Bool
isSpecialChar = (Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem " &\\@\"'#?$*()[]{};"
env :: String -> String -> IO String
env :: String -> String -> IO String
env variable :: String
variable fallthrough :: String
fallthrough = String -> IO String
getEnv String
variable 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 String
fallthrough
getBrowser :: IO String
getBrowser :: IO String
getBrowser = String -> String -> IO String
env "BROWSER" "x-www-browser"
getEditor :: IO String
getEditor :: IO String
getEditor = String -> String -> IO String
env "EDITOR" "emacs"