module System.Console.Haskeline.Completion(
                            CompletionFunc,
                            Completion(..),
                            noCompletion,
                            simpleCompletion,
                            fallbackCompletion,
                            -- * Word completion
                            completeWord,
                            completeWordWithPrev,
                            completeQuotedWord,
                            -- * Filename completion
                            completeFilename,
                            listFiles,
                            filenameWordBreakChars
                        ) where


import System.FilePath
import Data.List(isPrefixOf)
import Control.Monad(forM)

import System.Console.Haskeline.Directory
import System.Console.Haskeline.Monads

-- | Performs completions from the given line state.
--
-- The first 'String' argument is the contents of the line to the left of the cursor,
-- reversed.
-- The second 'String' argument is the contents of the line to the right of the cursor.
--
-- The output 'String' is the unused portion of the left half of the line, reversed.
type CompletionFunc m = (String,String) -> m (String, [Completion])


data Completion = Completion {Completion -> String
replacement  :: String, -- ^ Text to insert in line.
                        Completion -> String
display  :: String,
                                -- ^ Text to display when listing
                                -- alternatives.
                        Completion -> Bool
isFinished :: Bool
                            -- ^ Whether this word should be followed by a
                            -- space, end quote, etc.
                            }
                    deriving (Completion -> Completion -> Bool
(Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool) -> Eq Completion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Completion -> Completion -> Bool
$c/= :: Completion -> Completion -> Bool
== :: Completion -> Completion -> Bool
$c== :: Completion -> Completion -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
Eq, Eq Completion
Eq Completion
-> (Completion -> Completion -> Ordering)
-> (Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool)
-> (Completion -> Completion -> Completion)
-> (Completion -> Completion -> Completion)
-> Ord Completion
Completion -> Completion -> Bool
Completion -> Completion -> Ordering
Completion -> Completion -> Completion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Completion -> Completion -> Completion
$cmin :: Completion -> Completion -> Completion
max :: Completion -> Completion -> Completion
$cmax :: Completion -> Completion -> Completion
>= :: Completion -> Completion -> Bool
$c>= :: Completion -> Completion -> Bool
> :: Completion -> Completion -> Bool
$c> :: Completion -> Completion -> Bool
<= :: Completion -> Completion -> Bool
$c<= :: Completion -> Completion -> Bool
< :: Completion -> Completion -> Bool
$c< :: Completion -> Completion -> Bool
compare :: Completion -> Completion -> Ordering
$ccompare :: Completion -> Completion -> Ordering
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type Ord Bool
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Instance of class: Eq of the constraint type Eq Completion
Instance of class: Ord of the constraint type Ord Completion
Instance of class: Eq of the constraint type Eq Completion
Ord, Int -> Completion -> ShowS
[Completion] -> ShowS
Completion -> String
(Int -> Completion -> ShowS)
-> (Completion -> String)
-> ([Completion] -> ShowS)
-> Show Completion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Completion] -> ShowS
$cshowList :: [Completion] -> ShowS
show :: Completion -> String
$cshow :: Completion -> String
showsPrec :: Int -> Completion -> ShowS
$cshowsPrec :: Int -> Completion -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Bool
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Ord Int
Show)

-- | Disable completion altogether.
noCompletion :: Monad m => CompletionFunc m
noCompletion :: CompletionFunc m
noCompletion (String
s,String
_) = (String, [Completion]) -> m (String, [Completion])
forall (m :: * -> *) a. Monad m => a -> m a
Evidence bound by a type signature of the constraint type Monad m
return (String
s,[])

--------------
-- Word break functions

-- | A custom 'CompletionFunc' which completes the word immediately to the left of the cursor.
--
-- A word begins either at the start of the line or after an unescaped whitespace character.
completeWord :: Monad m => Maybe Char
        -- ^ An optional escape character
        -> [Char]-- ^ Characters which count as whitespace
        -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions
        -> CompletionFunc m
completeWord :: Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
esc String
ws = Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
Evidence bound by a type signature of the constraint type Monad m
completeWordWithPrev Maybe Char
esc String
ws ((String -> String -> m [Completion]) -> CompletionFunc m)
-> ((String -> m [Completion])
    -> String -> String -> m [Completion])
-> (String -> m [Completion])
-> CompletionFunc m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> m [Completion]) -> String -> String -> m [Completion]
forall a b. a -> b -> a
const

-- | A custom 'CompletionFunc' which completes the word immediately to the left of the cursor,
-- and takes into account the line contents to the left of the word.
--
-- A word begins either at the start of the line or after an unescaped whitespace character.
completeWordWithPrev :: Monad m => Maybe Char
        -- ^ An optional escape character
        -> [Char]-- ^ Characters which count as whitespace
        -> (String ->  String -> m [Completion])
            -- ^ Function to produce a list of possible completions.  The first argument is the
            -- line contents to the left of the word, reversed.  The second argument is the word
            -- to be completed.
        -> CompletionFunc m
completeWordWithPrev :: Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev Maybe Char
esc String
ws String -> String -> m [Completion]
f (String
line, String
_) = do
    let (String
word,String
rest) = case Maybe Char
esc of
                        Maybe Char
Nothing -> (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` String
ws) String
line
                        Just Char
e -> Char -> String -> (String, String)
escapedBreak Char
e String
line
    [Completion]
completions <- String -> String -> m [Completion]
f String
rest (ShowS
forall a. [a] -> [a]
reverse String
word)
    (String, [Completion]) -> m (String, [Completion])
forall (m :: * -> *) a. Monad m => a -> m a
Evidence bound by a type signature of the constraint type Monad m
return (String
rest,(Completion -> Completion) -> [Completion] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char -> String -> Completion -> Completion
escapeReplacement Maybe Char
esc String
ws) [Completion]
completions)
  where
    escapedBreak :: Char -> String -> (String, String)
escapedBreak Char
e (Char
c:Char
d:String
cs) | Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
e Bool -> Bool -> Bool
&& Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` (Char
eChar -> ShowS
forall a. a -> [a] -> [a]
:String
ws)
            = let (String
xs,String
ys) = Char -> String -> (String, String)
escapedBreak Char
e String
cs in (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs,String
ys)
    escapedBreak Char
e (Char
c:String
cs) | Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
notElem Char
c String
ws
            = let (String
xs,String
ys) = Char -> String -> (String, String)
escapedBreak Char
e String
cs in (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs,String
ys)
    escapedBreak Char
_ String
cs = (String
"",String
cs)

-- | Create a finished completion out of the given word.
simpleCompletion :: String -> Completion
simpleCompletion :: String -> Completion
simpleCompletion = String -> Completion
completion

-- NOTE: this is the same as for readline, except that I took out the '\\'
-- so they can be used as a path separator.
filenameWordBreakChars :: String
filenameWordBreakChars :: String
filenameWordBreakChars = String
" \t\n`@$><=;|&{("

-- A completion command for file and folder names.
completeFilename :: MonadIO m => CompletionFunc m
completeFilename :: CompletionFunc m
completeFilename  = Maybe Char
-> String
-> (String -> m [Completion])
-> CompletionFunc m
-> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String
-> (String -> m [Completion])
-> CompletionFunc m
-> CompletionFunc m
External instance of the constraint type forall (m :: * -> *). MonadIO m => Monad m
Evidence bound by a type signature of the constraint type MonadIO m
completeQuotedWord (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') String
"\"'" String -> m [Completion]
forall (m :: * -> *). MonadIO m => String -> m [Completion]
Evidence bound by a type signature of the constraint type MonadIO m
listFiles
                        (CompletionFunc m -> CompletionFunc m)
-> CompletionFunc m -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
External instance of the constraint type forall (m :: * -> *). MonadIO m => Monad m
Evidence bound by a type signature of the constraint type MonadIO m
completeWord (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') (String
"\"\'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filenameWordBreakChars)
                                String -> m [Completion]
forall (m :: * -> *). MonadIO m => String -> m [Completion]
Evidence bound by a type signature of the constraint type MonadIO m
listFiles

completion :: String -> Completion
completion :: String -> Completion
completion String
str = String -> String -> Bool -> Completion
Completion String
str String
str Bool
True

setReplacement :: (String -> String) -> Completion -> Completion
setReplacement :: ShowS -> Completion -> Completion
setReplacement ShowS
f Completion
c = Completion
c {replacement :: String
replacement = ShowS
f ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Completion -> String
replacement Completion
c}

escapeReplacement :: Maybe Char -> String -> Completion -> Completion
escapeReplacement :: Maybe Char -> String -> Completion -> Completion
escapeReplacement Maybe Char
esc String
ws Completion
f = case Maybe Char
esc of
    Maybe Char
Nothing -> Completion
f
    Just Char
e -> Completion
f {replacement :: String
replacement = Char -> ShowS
escape Char
e (Completion -> String
replacement Completion
f)}
  where
    escape :: Char -> ShowS
escape Char
e (Char
c:String
cs) | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` (Char
eChar -> ShowS
forall a. a -> [a] -> [a]
:String
ws)     = Char
e Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> ShowS
escape Char
e String
cs
                    | Bool
otherwise = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> ShowS
escape Char
e String
cs
    escape Char
_ String
"" = String
""


---------
-- Quoted completion
completeQuotedWord :: Monad m => Maybe Char -- ^ An optional escape character
                            -> [Char] -- ^ Characters which set off quotes
                            -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions
                            -> CompletionFunc m -- ^ Alternate completion to perform if the
                                            -- cursor is not at a quoted word
                            -> CompletionFunc m
completeQuotedWord :: Maybe Char
-> String
-> (String -> m [Completion])
-> CompletionFunc m
-> CompletionFunc m
completeQuotedWord Maybe Char
esc String
qs String -> m [Completion]
completer CompletionFunc m
alterative line :: (String, String)
line@(String
left,String
_)
  = case Maybe Char -> String -> String -> Maybe (String, String)
splitAtQuote Maybe Char
esc String
qs String
left of
    Just (String
w,String
rest) | Maybe Char -> String -> String -> Bool
isUnquoted Maybe Char
esc String
qs String
rest -> do
        [Completion]
cs <- String -> m [Completion]
completer (ShowS
forall a. [a] -> [a]
reverse String
w)
        (String, [Completion]) -> m (String, [Completion])
forall (m :: * -> *) a. Monad m => a -> m a
Evidence bound by a type signature of the constraint type Monad m
return (String
rest, (Completion -> Completion) -> [Completion] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (Completion -> Completion
addQuotes (Completion -> Completion)
-> (Completion -> Completion) -> Completion -> Completion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> String -> Completion -> Completion
escapeReplacement Maybe Char
esc String
qs) [Completion]
cs)
    Maybe (String, String)
_ -> CompletionFunc m
alterative (String, String)
line

addQuotes :: Completion -> Completion
addQuotes :: Completion -> Completion
addQuotes Completion
c = if Completion -> Bool
isFinished Completion
c
    then Completion
c {replacement :: String
replacement = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Completion -> String
replacement Completion
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""}
    else Completion
c {replacement :: String
replacement = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Completion -> String
replacement Completion
c}

splitAtQuote :: Maybe Char -> String -> String -> Maybe (String,String)
splitAtQuote :: Maybe Char -> String -> String -> Maybe (String, String)
splitAtQuote Maybe Char
esc String
qs String
line = case String
line of
    Char
c:Char
e:String
cs | Char -> Bool
isEscape Char
e Bool -> Bool -> Bool
&& Char -> Bool
isEscapable Char
c
                        -> do
                            (String
w,String
rest) <- Maybe Char -> String -> String -> Maybe (String, String)
splitAtQuote Maybe Char
esc String
qs String
cs
                            (String, String) -> Maybe (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
w,String
rest)
    Char
q:String
cs   | Char -> Bool
isQuote Char
q  -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
"",String
cs)
    Char
c:String
cs                -> do
                            (String
w,String
rest) <- Maybe Char -> String -> String -> Maybe (String, String)
splitAtQuote Maybe Char
esc String
qs String
cs
                            (String, String) -> Maybe (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
w,String
rest)
    String
""                  -> Maybe (String, String)
forall a. Maybe a
Nothing
  where
    isQuote :: Char -> Bool
isQuote = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` String
qs)
    isEscape :: Char -> Bool
isEscape Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type Eq Char
== Maybe Char
esc
    isEscapable :: Char -> Bool
isEscapable Char
c = Char -> Bool
isEscape Char
c Bool -> Bool -> Bool
|| Char -> Bool
isQuote Char
c

isUnquoted :: Maybe Char -> String -> String -> Bool
isUnquoted :: Maybe Char -> String -> String -> Bool
isUnquoted Maybe Char
esc String
qs String
s = case Maybe Char -> String -> String -> Maybe (String, String)
splitAtQuote Maybe Char
esc String
qs String
s of
    Just (String
_,String
s') -> Bool -> Bool
not (Maybe Char -> String -> String -> Bool
isUnquoted Maybe Char
esc String
qs String
s')
    Maybe (String, String)
_ -> Bool
True


-- | List all of the files or folders beginning with this path.
listFiles :: MonadIO m => FilePath -> m [Completion]
listFiles :: String -> m [Completion]
listFiles String
path = IO [Completion] -> m [Completion]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Evidence bound by a type signature of the constraint type MonadIO m
liftIO (IO [Completion] -> m [Completion])
-> IO [Completion] -> m [Completion]
forall a b. (a -> b) -> a -> b
$ do
    String
fixedDir <- String -> IO String
fixPath String
dir
    Bool
dirExists <- String -> IO Bool
doesDirectoryExist String
fixedDir
    -- get all of the files in that directory, as basenames
    [Completion]
allFiles <- if Bool -> Bool
not Bool
dirExists
                    then [Completion] -> IO [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return []
                    else ([String] -> [Completion]) -> IO [String] -> IO [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap ((String -> Completion) -> [String] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map String -> Completion
completion ([String] -> [Completion])
-> ([String] -> [String]) -> [String] -> [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
filterPrefix)
                            (IO [String] -> IO [Completion]) -> IO [String] -> IO [Completion]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
fixedDir
    -- The replacement text should include the directory part, and also
    -- have a trailing slash if it's itself a directory.
    [Completion] -> (Completion -> IO Completion) -> IO [Completion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
External instance of the constraint type Monad IO
External instance of the constraint type Traversable []
forM [Completion]
allFiles ((Completion -> IO Completion) -> IO [Completion])
-> (Completion -> IO Completion) -> IO [Completion]
forall a b. (a -> b) -> a -> b
$ \Completion
c -> do
            Bool
isDir <- String -> IO Bool
doesDirectoryExist (String
fixedDir String -> ShowS
</> Completion -> String
replacement Completion
c)
            Completion -> IO Completion
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Completion -> IO Completion) -> Completion -> IO Completion
forall a b. (a -> b) -> a -> b
$ ShowS -> Completion -> Completion
setReplacement ShowS
fullName (Completion -> Completion) -> Completion -> Completion
forall a b. (a -> b) -> a -> b
$ Bool -> Completion -> Completion
alterIfDir Bool
isDir Completion
c
  where
    (String
dir, String
file) = String -> (String, String)
splitFileName String
path
    filterPrefix :: [String] -> [String]
filterPrefix = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
f -> String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
notElem String
f [String
".",String
".."]
                                        Bool -> Bool -> Bool
&& String
file String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
External instance of the constraint type Eq Char
`isPrefixOf` String
f)
    alterIfDir :: Bool -> Completion -> Completion
alterIfDir Bool
False Completion
c = Completion
c
    alterIfDir Bool
True Completion
c = Completion
c {replacement :: String
replacement = ShowS
addTrailingPathSeparator (Completion -> String
replacement Completion
c),
                            isFinished :: Bool
isFinished = Bool
False}
    fullName :: ShowS
fullName = String -> ShowS
replaceFileName String
path

-- turn a user-visible path into an internal version useable by System.FilePath.
fixPath :: String -> IO String
-- For versions of filepath < 1.2
fixPath :: String -> IO String
fixPath String
"" = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return String
"."
fixPath (Char
'~':Char
c:String
path) | Char -> Bool
isPathSeparator Char
c = do
    String
home <- IO String
getHomeDirectory
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (String
home String -> ShowS
</> String
path)
fixPath String
path = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return String
path

-- | If the first completer produces no suggestions, fallback to the second
-- completer's output.
fallbackCompletion :: Monad m => CompletionFunc m -> CompletionFunc m -> CompletionFunc m
fallbackCompletion :: CompletionFunc m -> CompletionFunc m -> CompletionFunc m
fallbackCompletion CompletionFunc m
a CompletionFunc m
b (String, String)
input = do
    (String, [Completion])
aCompletions <- CompletionFunc m
a (String, String)
input
    if [Completion] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null ((String, [Completion]) -> [Completion]
forall a b. (a, b) -> b
snd (String, [Completion])
aCompletions)
        then CompletionFunc m
b (String, String)
input
        else (String, [Completion]) -> m (String, [Completion])
forall (m :: * -> *) a. Monad m => a -> m a
Evidence bound by a type signature of the constraint type Monad m
return (String, [Completion])
aCompletions