module System.Console.Haskeline.Completion(
CompletionFunc,
Completion(..),
completeWord,
simpleCompletion,
noCompletion,
completeFilename,
filenameWordBreakChars
) where
import System.Directory
import System.FilePath
import Data.List(isPrefixOf)
import Control.Monad(forM)
import System.Console.Haskeline.Monads
type CompletionFunc m = String -> m (String, [Completion])
data Completion = Completion {replacement :: String,
display :: String
}
deriving Show
noCompletion :: Monad m => CompletionFunc m
noCompletion s = return (s,[])
completeWord :: Monad m => Maybe Char
-> String
-> (String -> m [Completion])
-> CompletionFunc m
completeWord esc ws f line = do
let (word,rest) = case esc of
Nothing -> break (`elem` ws) line
Just e -> escapedBreak e line
completions <- f (reverse word)
return (rest,completions)
where
escapedBreak e (c:d:cs) | d == e
= let (xs,ys) = escapedBreak e cs in (c:d:xs,ys)
escapedBreak e (c:cs) | not (elem c ws)
= let (xs,ys) = escapedBreak e cs in (c:xs,ys)
escapedBreak _ cs = ("",cs)
simpleCompletion :: String -> Completion
simpleCompletion = setReplacement (++ " ") . completion
filenameWordBreakChars :: String
filenameWordBreakChars = " \t\n`@$><=;|&{("
completeFilename :: MonadIO m => CompletionFunc m
completeFilename = completeWord (Just '\\') filenameWordBreakChars $
(liftIO . quotedFilenames (`elem` "\"\'"))
completion :: String -> Completion
completion str = Completion str str
setReplacement :: (String -> String) -> Completion -> Completion
setReplacement f c = c {replacement = f $ replacement c}
quotedFilenames :: (Char -> Bool) -> String -> IO [Completion]
quotedFilenames isQuote (q:file) | isQuote q = do
files <- findFiles file
return $ map (setReplacement ((q:) . appendIfNotDir [q,' '])) files
quotedFilenames _ file = do
files <- findFiles file
return $ map (setReplacement (appendIfNotDir " ")) files
appendIfNotDir :: String -> FilePath -> FilePath
appendIfNotDir str file | null (takeFileName file) = file
| otherwise = file ++ str
findFiles :: FilePath -> IO [Completion]
findFiles path = handle (\_ -> return []) $ do
fixedDir <- fixPath dir
dirExists <- doesDirectoryExist fixedDir
allFiles <- if not dirExists
then return []
else fmap (map completion . filterPrefix)
$ getDirectoryContents fixedDir
forM allFiles $ \c -> do
isDir <- doesDirectoryExist (fixedDir </> replacement c)
return $ setReplacement (fullName . maybeAddSlash isDir) c
where
(dir, file) = splitFileName path
filterPrefix = filter (\f -> not (f `elem` [".",".."])
&& file `isPrefixOf` f)
maybeAddSlash False = id
maybeAddSlash True = addTrailingPathSeparator
fullName f = dir ++ f
fixPath :: String -> IO String
fixPath "" = return "."
fixPath ('~':c:path) | isPathSeparator c = do
home <- getHomeDirectory
return (home </> path)
fixPath path = return path