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
[Completion]
completions <- String -> String -> m [Completion]
f String
rest (ShowS
forall a. [a] -> [a]
reverse String
word)
(String, [Completion]) -> m (String, [Completion])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
rest,(Completion -> Completion) -> [Completion] -> [Completion]
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 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 :: String
replacement = ShowS
f ShowS -> ShowS
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 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
[Completion]
cs <- String -> m [Completion]
completer (ShowS
forall a. [a] -> [a]
reverse String
w)
(String, [Completion]) -> m (String, [Completion])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 -> (Char -> Bool) -> Completion -> Completion
escapeReplacement 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
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 a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
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 a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
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 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
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 [Completion] -> IO [Completion]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else ([String] -> [Completion]) -> IO [String] -> IO [Completion]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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
[Completion] -> (Completion -> IO Completion) -> IO [Completion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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
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 :: 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
"" = 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
String
home <- IO String
getHomeDirectory
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
home String -> ShowS
</> String
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
(String, [Completion])
aCompletions <- CompletionFunc m
a (String, String)
input
if [Completion] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String, [Completion])
aCompletions