{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns      #-}
{- |
Module      :  XMonad.Prompt.Shell
Description :  A shell prompt.
Copyright   :  (C) 2007 Andrea Rossato
License     :  BSD3

Maintainer  :  andrea.rossato@unibz.it
Stability   :  unstable
Portability :  unportable

A shell prompt for XMonad
-}

module XMonad.Prompt.Shell
    ( -- * Usage
      -- $usage
      Shell (..)
    , shellPrompt
    -- ** Variations on shellPrompt
    -- $spawns
    , safePrompt
    , safeDirPrompt
    , unsafePrompt
    , prompt

    -- * Utility functions
    , compgenDirectories
    , compgenFiles
    , getCommands
    , getBrowser
    , getEditor
    , getShellCompl
    , getShellCompl'
    , split
    ) where

import           Codec.Binary.UTF8.String (encodeString)
import           Control.Exception        as E
import           Data.Bifunctor           (bimap)
import           System.Directory         (getDirectoryContents)
import           System.Environment       (getEnv)
import           System.Posix.Files       (getFileStatus, isDirectory)

import           XMonad                   hiding (config)
import           XMonad.Prelude
import           XMonad.Prompt
import           XMonad.Util.Run

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
> import XMonad.Prompt.Shell

2. In your keybindings add something like:

>   , ((modm .|. controlMask, xK_x), shellPrompt def)

For detailed instruction on editing the key binding see
"XMonad.Doc.Extending#Editing_key_bindings". -}

data Shell = Shell
type Predicate = String -> String -> Bool

instance XPrompt Shell where
    showXPrompt :: Shell -> String
showXPrompt Shell
Shell     = String
"Run: "
    completionToCommand :: Shell -> String -> String
completionToCommand Shell
_ = String -> String
escape

shellPrompt :: XPConfig -> X ()
shellPrompt :: XPConfig -> X ()
shellPrompt 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

{- $spawns
    See safe and unsafeSpawn in "XMonad.Util.Run".
    prompt is an alias for unsafePrompt;
    safePrompt and unsafePrompt work on the same principles, but will use
    XPrompt to interactively query the user for input; the appearance is
    set by passing an XPConfig as the second argument. The first argument
    is the program to be run with the interactive input.
    You would use these like this:

    >     , ((modm,               xK_b), safePrompt "firefox" greenXPConfig)
    >     , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig)

    Note that you want to use safePrompt for Firefox input, as Firefox
    wants URLs, and unsafePrompt for the XTerm example because this allows
    you to easily start a terminal executing an arbitrary command, like
    'top'. -}

prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X ()
prompt :: String -> XPConfig -> X ()
prompt = String -> XPConfig -> X ()
unsafePrompt
safePrompt :: String -> XPConfig -> X ()
safePrompt String
c 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 String
c 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 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 -> String
forall a. [a] -> [a] -> [a]
++ String
a

{- | Like 'safePrompt', but optimized for the use-case of a program that
needs a file as an argument.

For example, a prompt for <https://github.com/mwh/dragon dragon> that
always starts searching in your home directory would look like

> safeDirPrompt "dragon" def "~/"

This is especially useful when using something like
'XMonad.Prompt.FuzzyMatch.fuzzyMatch' from "XMonad.Prompt.FuzzyMatch" as
your prompt's @searchPredicate@.
-}
safeDirPrompt
    :: FilePath  -- ^ The command to execute
    -> XPConfig  -- ^ The prompt configuration
    -> String    -- ^ Which string to start @compgen@ with
    -> X ()
safeDirPrompt :: String -> XPConfig -> String -> X ()
safeDirPrompt String
cmd cfg :: XPConfig
cfg@XPC{ Predicate
searchPredicate :: Predicate
searchPredicate :: XPConfig -> Predicate
searchPredicate } String
compgenStr =
    Shell -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt Shell
Shell XPConfig
cfg ComplFunction
mkCompl (String -> [String] -> X ()
forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
cmd ([String] -> X ()) -> (String -> [String]) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  where
    mkCompl :: String -> IO [String]
    mkCompl :: ComplFunction
mkCompl String
input =
        ComplCaseSensitivity
-> ([String] -> [String]) -> [String] -> String -> ComplFunction
shellComplImpl
            ComplCaseSensitivity
CaseSensitive
            ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Predicate
searchPredicate String
ext))
            ([String] -> Predicate -> String -> [String]
commandCompletionFunction [String
cmd] Predicate
searchPredicate String
input)
            (if String
"/" Predicate
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
input then String
dir else String
compgenStr)
            String
input
      where
        -- "/path/to/some/file" ⇒ ("file", "/path/to/some/")
        (String
ext, String
dir) :: (String, String)
            = (String -> String)
-> (String -> String) -> (String, String) -> (String, String)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> String
forall a. [a] -> [a]
reverse String -> String
forall a. [a] -> [a]
reverse ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
input

getShellCompl :: [String] -> Predicate -> String -> IO [String]
getShellCompl :: [String] -> Predicate -> ComplFunction
getShellCompl = ComplCaseSensitivity -> [String] -> Predicate -> ComplFunction
getShellCompl' ComplCaseSensitivity
CaseSensitive

getShellCompl' :: ComplCaseSensitivity -> [String] -> Predicate -> String -> IO [String]
getShellCompl' :: ComplCaseSensitivity -> [String] -> Predicate -> ComplFunction
getShellCompl' ComplCaseSensitivity
csn [String]
cmds Predicate
p String
input =
    ComplCaseSensitivity
-> ([String] -> [String]) -> [String] -> String -> ComplFunction
shellComplImpl ComplCaseSensitivity
csn [String] -> [String]
forall a. a -> a
id ([String] -> Predicate -> String -> [String]
commandCompletionFunction [String]
cmds Predicate
p String
input) String
input String
input

-- | Based in the user input and the given filtering function, create
-- the completion string to show in the prompt.
shellComplImpl
    :: ComplCaseSensitivity    -- ^ Whether the @compgen@ query should be case sensitive
    -> ([String] -> [String])  -- ^ How to filter the files we get back
    -> [String]                -- ^ The available commands to suggest
    -> String                  -- ^ Which string to give to @compgen@
    -> String                  -- ^ The input string
    -> IO [String]
shellComplImpl :: ComplCaseSensitivity
-> ([String] -> [String]) -> [String] -> String -> ComplFunction
shellComplImpl ComplCaseSensitivity
csn [String] -> [String]
filterFiles [String]
cmds String
cmpgenStr String
input
    | String
input Predicate
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
last String
input Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    | Bool
otherwise = do
        [String]
choices <- [String] -> [String]
filterFiles ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComplCaseSensitivity -> String -> IO String
compgenFiles ComplCaseSensitivity
csn String
cmpgenStr
        [String]
files   <- case [String]
choices of
            [String
x] -> do FileStatus
fs <- String -> IO FileStatus
getFileStatus (String -> String
encodeString String
x)
                      [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ if FileStatus -> Bool
isDirectory FileStatus
fs then [String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"] else [String
x]
            [String]
_   -> [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
choices
        [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([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]
cmds
  where
    typedFirst :: String -> String -> Ordering
    typedFirst :: String -> String -> Ordering
typedFirst String
x String
y
        | String
x Predicate
`startsWith` String
input Bool -> Bool -> Bool
&& Bool -> Bool
not (String
y Predicate
`startsWith` String
input) = Ordering
LT
        | String
y Predicate
`startsWith` String
input Bool -> Bool -> Bool
&& Bool -> Bool
not (String
x Predicate
`startsWith` String
input) = Ordering
GT
        | Bool
otherwise = String
x String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String
y

    startsWith :: String -> String -> Bool
    startsWith :: Predicate
startsWith String
str String
ps = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower 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
str

compgenFiles :: ComplCaseSensitivity -> String -> IO String
compgenFiles :: ComplCaseSensitivity -> String -> IO String
compgenFiles ComplCaseSensitivity
csn = ComplCaseSensitivity -> String -> String -> IO String
compgen ComplCaseSensitivity
csn String
"file"

compgenDirectories :: ComplCaseSensitivity -> String -> IO String
compgenDirectories :: ComplCaseSensitivity -> String -> IO String
compgenDirectories ComplCaseSensitivity
csn = ComplCaseSensitivity -> String -> String -> IO String
compgen ComplCaseSensitivity
csn String
"directory"

compgen :: ComplCaseSensitivity -> String -> String -> IO String
compgen :: ComplCaseSensitivity -> String -> String -> IO String
compgen ComplCaseSensitivity
csn String
actionOpt String
s = String -> [String] -> String -> IO String
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> m String
runProcessWithInput String
"bash" [] (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$
    ComplCaseSensitivity -> String
complCaseSensitivityCmd ComplCaseSensitivity
csn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
compgenCmd String
actionOpt String
s

complCaseSensitivityCmd :: ComplCaseSensitivity -> String
complCaseSensitivityCmd :: ComplCaseSensitivity -> String
complCaseSensitivityCmd ComplCaseSensitivity
CaseSensitive =
    String
"bind 'set completion-ignore-case off'"
complCaseSensitivityCmd ComplCaseSensitivity
CaseInSensitive =
    String
"bind 'set completion-ignore-case on'"

compgenCmd :: String -> String -> String
compgenCmd :: String -> String -> String
compgenCmd String
actionOpt String
s = String
"compgen -A " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
actionOpt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

commandCompletionFunction :: [String] -> Predicate -> String -> [String]
commandCompletionFunction :: [String] -> Predicate -> String -> [String]
commandCompletionFunction [String]
cmds Predicate
p String
str | Char
'/' 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 String
"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] -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
split Char
':' 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
$ \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
'.') (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 :: forall a. Eq a => a -> [a] -> [[a]]
split a
_ [] = []
split a
e [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 (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
ls)
        where
          ([a]
f,[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

escape :: String -> String
escape :: String -> String
escape []       = String
""
escape (Char
x:String
xs)
    | Char -> Bool
isSpecialChar Char
x = Char
'\\' 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 String
" &\\@\"'#?$*()[]{};"

-- | Ask the shell environment for the value of a variable in XMonad's environment, with a default value.
--   In order to /set/ an environment variable (eg. combine with a prompt so you can modify @$HTTP_PROXY@ dynamically),
--   you need to use 'System.Posix.putEnv'.
env :: String -> String -> IO String
env :: String -> String -> IO String
env String
variable 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

{- | Ask the shell what browser the user likes. If the user hasn't defined any
   $BROWSER, defaults to returning \"firefox\", since that seems to be the most
   common X web browser.
   Note that if you don't specify a GUI browser but a textual one, that'll be a problem
   as 'getBrowser' will be called by functions expecting to be able to just execute the string
   or pass it to a shell; so in that case, define $BROWSER as something like \"xterm -e elinks\"
   or as the name of a shell script doing much the same thing. -}
getBrowser :: IO String
getBrowser :: IO String
getBrowser = String -> String -> IO String
env String
"BROWSER" String
"firefox"

-- | Like 'getBrowser', but should be of a text editor. This gets the $EDITOR variable, defaulting to \"emacs\".
getEditor :: IO String
getEditor :: IO String
getEditor = String -> String -> IO String
env String
"EDITOR" String
"emacs"