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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Completion -> Completion -> Bool
$c/= :: Completion -> Completion -> Bool
== :: Completion -> Completion -> Bool
$c== :: Completion -> Completion -> Bool
Eq, Eq 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
Ord, Int -> Completion -> ShowS
[Completion] -> ShowS
Completion -> String
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
Show)
noCompletion :: Monad m => CompletionFunc m
noCompletion :: forall (m :: * -> *). Monad m => CompletionFunc m
noCompletion (String
s,String
_) = 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 = forall (m :: * -> *).
Monad m =>
Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev Maybe Char
esc String
ws forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool)
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev' Maybe Char
esc Char -> Bool
ws forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool)
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev' Maybe Char
esc (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 -> 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
[Completion]
completions <- String -> String -> m [Completion]
f String
rest (forall a. [a] -> [a]
reverse String
word)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
rest,forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char -> (Char -> Bool) -> Completion -> Completion
escapeReplacement Maybe Char
esc Char -> Bool
wpred) [Completion]
completions)
where
escapedBreak :: Char -> String -> (String, String)
escapedBreak Char
e (Char
c:Char
d:String
cs) | Char
d forall a. Eq a => a -> a -> Bool
== Char
e Bool -> Bool -> Bool
&& (Char
c 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
cforall a. a -> [a] -> [a]
:String
xs,String
ys)
escapedBreak Char
e (Char
c:String
cs) | Bool -> Bool
not 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
cforall 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 = forall (m :: * -> *).
Monad m =>
Maybe Char
-> String
-> (String -> m [Completion])
-> CompletionFunc m
-> CompletionFunc m
completeQuotedWord (forall a. a -> Maybe a
Just Char
'\\') String
"\"'" forall (m :: * -> *). MonadIO m => String -> m [Completion]
listFiles
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord (forall a. a -> Maybe a
Just Char
'\\') (String
"\"\'" forall a. [a] -> [a] -> [a]
++ String
filenameWordBreakChars)
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 :: String
replacement = ShowS
f forall a b. (a -> b) -> a -> b
$ Completion -> String
replacement Completion
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 :: 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 forall a. Eq a => a -> a -> Bool
== Char
e Bool -> Bool -> Bool
|| Char -> Bool
wpred Char
c = Char
e forall a. a -> [a] -> [a]
: Char
c forall a. a -> [a] -> [a]
: Char -> ShowS
escape Char
e String
cs
| Bool
otherwise = Char
c 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
[Completion]
cs <- String -> m [Completion]
completer (forall a. [a] -> [a]
reverse String
w)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
rest, forall a b. (a -> b) -> [a] -> [b]
map (Completion -> Completion
addQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> (Char -> Bool) -> Completion -> Completion
escapeReplacement Maybe Char
esc (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` 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
"\"" forall a. [a] -> [a] -> [a]
++ Completion -> String
replacement Completion
c forall a. [a] -> [a] -> [a]
++ String
"\""}
else Completion
c {replacement :: String
replacement = String
"\"" 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
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cforall a. a -> [a] -> [a]
:String
w,String
rest)
Char
q:String
cs | Char -> Bool
isQuote Char
q -> 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
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cforall a. a -> [a] -> [a]
:String
w,String
rest)
String
"" -> forall a. Maybe a
Nothing
where
isQuote :: Char -> Bool
isQuote = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
qs)
isEscape :: Char -> Bool
isEscape Char
c = forall a. a -> Maybe a
Just Char
c 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
String
fixedDir <- String -> IO String
fixPath String
dir
Bool
dirExists <- String -> IO Bool
doesDirectoryExist String
fixedDir
[Completion]
allFiles <- if Bool -> Bool
not Bool
dirExists
then forall (m :: * -> *) a. Monad m => a -> m a
return []
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map String -> Completion
completion forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
filterPrefix)
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
fixedDir
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Completion]
allFiles 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)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ShowS -> Completion -> Completion
setReplacement ShowS
fullName 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (\String
f -> forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
f [String
".",String
".."]
Bool -> Bool -> Bool
&& String
file 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 :: String
replacement = ShowS
addTrailingPathSeparator (Completion -> String
replacement Completion
c),
isFinished :: Bool
isFinished = Bool
False}
fullName :: ShowS
fullName = String -> ShowS
replaceFileName String
path
fixPath :: String -> IO String
fixPath :: String -> IO String
fixPath String
"" = forall (m :: * -> *) a. Monad m => a -> m a
return String
"."
fixPath (Char
'~':Char
c:String
path) | Char -> Bool
isPathSeparator Char
c = do
String
home <- IO String
getHomeDirectory
forall (m :: * -> *) a. Monad m => a -> m a
return (String
home String -> ShowS
</> String
path)
fixPath String
path = 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
(String, [Completion])
aCompletions <- CompletionFunc m
a (String, String)
input
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a b. (a, b) -> b
snd (String, [Completion])
aCompletions)
then CompletionFunc m
b (String, String)
input
else forall (m :: * -> *) a. Monad m => a -> m a
return (String, [Completion])
aCompletions