    {-# 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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    {- $usage
    1. In your @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
    <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
    -}

    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
        cmds <- IO [String] -> X [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io IO [String]
    getCommands
        mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) 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 a. a -> [a]
    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 :: XPConfig -> Predicate
    searchPredicate :: 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 a. a -> [a]
    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 a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    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. HasCallStack => [a] -> a
    last String
    input Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' = [String] -> IO [String]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
        | Bool
    otherwise = do
            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
            files   <- case choices of
                [String
    x] -> do fs <- String -> IO FileStatus
    getFileStatus (String -> String
    encodeString String
    x)
                          pure $ if isDirectory fs then [x ++ "/"] else [x]
                [String]
    _   -> [String] -> IO [String]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [String]
    choices
            pure . sortBy typedFirst . uniqSort $ files ++ 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 a. Eq a => a -> [a] -> 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
        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 -> 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
        es <- forM ds $ \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 []
        return . uniqSort . filter (not . ("." `isPrefixOf`)) . concat $ 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 a. Eq a => a -> [a] -> 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
    "x-www-browser"

    -- | 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"