module System.Console.Haskeline.Completion(
CompletionFunc,
Completion(..),
noCompletion,
simpleCompletion,
fallbackCompletion,
completeWord,
completeWord',
completeWordWithPrev,
completeWordWithPrev',
completeQuotedWord,
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
type CompletionFunc m = (String,String) -> m (String, [Completion])
data Completion = Completion {Completion -> String
replacement :: String,
Completion -> String
display :: String,
Completion -> Bool
isFinished :: Bool
}
deriving (Completion -> Completion -> Bool
(Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool) -> Eq Completion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Completion -> Completion -> Bool
== :: Completion -> Completion -> Bool
$c/= :: Completion -> Completion -> Bool
/= :: Completion -> Completion -> Bool
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
$ccompare :: Completion -> Completion -> Ordering
compare :: Completion -> Completion -> Ordering
$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
>= :: Completion -> Completion -> Bool
$cmax :: Completion -> Completion -> Completion
max :: Completion -> Completion -> Completion
$cmin :: Completion -> Completion -> Completion
min :: Completion -> Completion -> 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
$cshowsPrec :: Int -> Completion -> ShowS
showsPrec :: Int -> Completion -> ShowS
$cshow :: Completion -> String
show :: Completion -> String
$cshowList :: [Completion] -> ShowS
showList :: [Completion] -> ShowS
Show)
noCompletion :: Monad m => CompletionFunc m
noCompletion :: forall (m :: * -> *). Monad m => CompletionFunc m
noCompletion (String
s,String
_) = (String, [Completion]) -> m (String, [Completion])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
s,[])
completeWord :: Monad m => Maybe Char
-> [Char]
-> (String -> m [Completion])
-> CompletionFunc m
completeWord :: forall (m :: * -> *).
Monad m =>
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
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
completeWord' :: Monad m => Maybe Char
-> (Char -> Bool)
-> (String -> m [Completion])
-> CompletionFunc m
completeWord' :: forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool) -> (String -> m [Completion]) -> CompletionFunc m
completeWord' Maybe Char
esc Char -> Bool
ws = Maybe Char
-> (Char -> Bool)
-> (String -> String -> m [Completion])
-> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool)
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev' Maybe Char
esc Char -> Bool
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
completeWordWithPrev :: Monad m => Maybe Char
-> [Char]
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev :: forall (m :: * -> *).
Monad m =>
Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev Maybe Char
esc String
ws = Maybe Char
-> (Char -> Bool)
-> (String -> String -> m [Completion])
-> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool)
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev' Maybe Char
esc (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
ws)
completeWordWithPrev' :: Monad m => Maybe Char
-> (Char -> Bool)
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev' :: forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool)
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev' Maybe Char
esc Char -> Bool
wpred 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 -> Bool
wpred String
line
Just Char
e -> Char -> String -> (String, String)
escapedBreak Char
e String
line
completions <- String -> String -> m [Completion]
f String
rest (ShowS
forall a. [a] -> [a]
reverse String
word)
return (rest,map (escapeReplacement esc wpred) 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
== Char
e Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
e Bool -> Bool -> Bool
|| Char -> Bool
wpred Char
c)
= 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) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
wpred Char
c
= 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)
simpleCompletion :: String -> Completion
simpleCompletion :: String -> Completion
simpleCompletion = String -> Completion
completion
filenameWordBreakChars :: String
filenameWordBreakChars :: String
filenameWordBreakChars = String
" \t\n`@$><=;|&{("
completeFilename :: MonadIO m => CompletionFunc m
completeFilename :: forall (m :: * -> *). MonadIO m => 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
completeQuotedWord (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') String
"\"'" String -> m [Completion]
forall (m :: * -> *). MonadIO m => String -> m [Completion]
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
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]
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 = f $ replacement c}
escapeReplacement :: Maybe Char -> (Char -> Bool) -> Completion -> Completion
escapeReplacement :: Maybe Char -> (Char -> Bool) -> Completion -> Completion
escapeReplacement Maybe Char
esc Char -> Bool
wpred Completion
f = case Maybe Char
esc of
Maybe Char
Nothing -> Completion
f
Just Char
e -> Completion
f {replacement = escape e (replacement f)}
where
escape :: Char -> ShowS
escape Char
e (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
e Bool -> Bool -> Bool
|| Char -> Bool
wpred Char
c = 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
""
completeQuotedWord :: Monad m => Maybe Char
-> [Char]
-> (String -> m [Completion])
-> CompletionFunc m
-> CompletionFunc m
completeQuotedWord :: forall (m :: * -> *).
Monad m =>
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
cs <- String -> m [Completion]
completer (ShowS
forall a. [a] -> [a]
reverse String
w)
return (rest, map (addQuotes . escapeReplacement esc (`elem` qs)) 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 = "\"" ++ replacement c ++ "\""}
else Completion
c {replacement = "\"" ++ replacement 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
(w,rest) <- Maybe Char -> String -> String -> Maybe (String, String)
splitAtQuote Maybe Char
esc String
qs String
cs
return (c:w,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
(w,rest) <- Maybe Char -> String -> String -> Maybe (String, String)
splitAtQuote Maybe Char
esc String
qs String
cs
return (c:w,rest)
String
"" -> Maybe (String, String)
forall a. Maybe a
Nothing
where
isQuote :: Char -> Bool
isQuote = (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`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
== 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
listFiles :: MonadIO m => FilePath -> m [Completion]
listFiles :: forall (m :: * -> *). MonadIO m => String -> m [Completion]
listFiles String
path = IO [Completion] -> m [Completion]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Completion] -> m [Completion])
-> IO [Completion] -> m [Completion]
forall a b. (a -> b) -> a -> b
$ do
fixedDir <- String -> IO String
fixPath String
dir
dirExists <- doesDirectoryExist fixedDir
allFiles <- if not dirExists
then return []
else fmap (map completion . filterPrefix)
$ getDirectoryContents fixedDir
forM allFiles $ \Completion
c -> do
isDir <- String -> IO Bool
doesDirectoryExist (String
fixedDir String -> ShowS
</> Completion -> String
replacement Completion
c)
return $ setReplacement fullName $ alterIfDir isDir 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
notElem String
f [String
".",String
".."]
Bool -> Bool -> Bool
&& String
file String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
f)
alterIfDir :: Bool -> Completion -> Completion
alterIfDir Bool
False Completion
c = Completion
c
alterIfDir Bool
True Completion
c = Completion
c {replacement = addTrailingPathSeparator (replacement c),
isFinished = False}
fullName :: ShowS
fullName = String -> ShowS
replaceFileName String
path
fixPath :: String -> IO String
fixPath :: String -> IO String
fixPath String
"" = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"."
fixPath (Char
'~':Char
c:String
path) | Char -> Bool
isPathSeparator Char
c = do
home <- IO String
getHomeDirectory
return (home </> path)
fixPath String
path = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
fallbackCompletion :: Monad m => CompletionFunc m -> CompletionFunc m -> CompletionFunc m
fallbackCompletion :: forall (m :: * -> *).
Monad m =>
CompletionFunc m -> CompletionFunc m -> CompletionFunc m
fallbackCompletion CompletionFunc m
a CompletionFunc m
b (String, String)
input = do
aCompletions <- CompletionFunc m
a (String, String)
input
if null (snd aCompletions)
then b input
else return aCompletions