1module System.Console.Haskeline.Completion( 2 CompletionFunc, 3 Completion(..), 4 noCompletion, 5 simpleCompletion, 6 fallbackCompletion, 7 -- * Word completion 8 completeWord, 9 completeWord', 10 completeWordWithPrev, 11 completeWordWithPrev', 12 completeQuotedWord, 13 -- * Filename completion 14 completeFilename, 15 listFiles, 16 filenameWordBreakChars 17 ) where 18 19 20import System.FilePath 21import Data.List(isPrefixOf) 22import Control.Monad(forM) 23 24import System.Console.Haskeline.Directory 25import System.Console.Haskeline.Monads 26 27-- | Performs completions from the given line state. 28-- 29-- The first 'String' argument is the contents of the line to the left of the cursor, 30-- reversed. 31-- The second 'String' argument is the contents of the line to the right of the cursor. 32-- 33-- The output 'String' is the unused portion of the left half of the line, reversed. 34type CompletionFunc m = (String,String) -> m (String, [Completion]) 35 36 37data Completion = Completion {replacement :: String, -- ^ Text to insert in line. 38 display :: String, 39 -- ^ Text to display when listing 40 -- alternatives. 41 isFinished :: Bool 42 -- ^ Whether this word should be followed by a 43 -- space, end quote, etc. 44 } 45 deriving (Eq, Ord, Show) 46 47-- | Disable completion altogether. 48noCompletion :: Monad m => CompletionFunc m 49noCompletion (s,_) = return (s,[]) 50 51-------------- 52-- Word break functions 53 54-- | A custom 'CompletionFunc' which completes the word immediately to the left of the cursor. 55-- 56-- A word begins either at the start of the line or after an unescaped whitespace character. 57completeWord :: Monad m => Maybe Char 58 -- ^ An optional escape character 59 -> [Char]-- ^ Characters which count as whitespace 60 -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions 61 -> CompletionFunc m 62completeWord esc ws = completeWordWithPrev esc ws . const 63 64-- | The same as 'completeWord' but takes a predicate for the whitespace characters 65completeWord' :: Monad m => Maybe Char 66 -- ^ An optional escape character 67 -> (Char -> Bool) -- ^ Characters which count as whitespace 68 -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions 69 -> CompletionFunc m 70completeWord' esc ws = completeWordWithPrev' esc ws . const 71 72-- | A custom 'CompletionFunc' which completes the word immediately to the left of the cursor, 73-- and takes into account the line contents to the left of the word. 74-- 75-- A word begins either at the start of the line or after an unescaped whitespace character. 76completeWordWithPrev :: Monad m => Maybe Char 77 -- ^ An optional escape character 78 -> [Char]-- ^ Characters which count as whitespace 79 -> (String -> String -> m [Completion]) 80 -- ^ Function to produce a list of possible completions. The first argument is the 81 -- line contents to the left of the word, reversed. The second argument is the word 82 -- to be completed. 83 -> CompletionFunc m 84completeWordWithPrev esc ws = completeWordWithPrev' esc (`elem` ws) 85 86-- | The same as 'completeWordWithPrev' but takes a predicate for the whitespace characters 87completeWordWithPrev' :: Monad m => Maybe Char 88 -- ^ An optional escape character 89 -> (Char -> Bool) -- ^ Characters which count as whitespace 90 -> (String -> String -> m [Completion]) 91 -- ^ Function to produce a list of possible completions. The first argument is the 92 -- line contents to the left of the word, reversed. The second argument is the word 93 -- to be completed. 94 -> CompletionFunc m 95completeWordWithPrev' esc wpred f (line, _) = do 96 let (word,rest) = case esc of 97 Nothing -> break wpred line 98 Just e -> escapedBreak e line 99 completions <- f rest (reverse word) 100 return (rest,map (escapeReplacement esc wpred) completions) 101 where 102 escapedBreak e (c:d:cs) | d == e && (c == e || wpred c) 103 = let (xs,ys) = escapedBreak e cs in (c:xs,ys) 104 escapedBreak e (c:cs) | not $ wpred c 105 = let (xs,ys) = escapedBreak e cs in (c:xs,ys) 106 escapedBreak _ cs = ("",cs) 107 108-- | Create a finished completion out of the given word. 109simpleCompletion :: String -> Completion 110simpleCompletion = completion 111 112-- NOTE: this is the same as for readline, except that I took out the '\\' 113-- so they can be used as a path separator. 114filenameWordBreakChars :: String 115filenameWordBreakChars = " \t\n`@$><=;|&{(" 116 117-- A completion command for file and folder names. 118completeFilename :: MonadIO m => CompletionFunc m 119completeFilename = completeQuotedWord (Just '\\') "\"'" listFiles 120 $ completeWord (Just '\\') ("\"\'" ++ filenameWordBreakChars) 121 listFiles 122 123completion :: String -> Completion 124completion str = Completion str str True 125 126setReplacement :: (String -> String) -> Completion -> Completion 127setReplacement f c = c {replacement = f $ replacement c} 128 129escapeReplacement :: Maybe Char -> (Char -> Bool) -> Completion -> Completion 130escapeReplacement esc wpred f = case esc of 131 Nothing -> f 132 Just e -> f {replacement = escape e (replacement f)} 133 where 134 escape e (c:cs) | c == e || wpred c = e : c : escape e cs 135 | otherwise = c : escape e cs 136 escape _ "" = "" 137 138 139--------- 140-- Quoted completion 141completeQuotedWord :: Monad m => Maybe Char -- ^ An optional escape character 142 -> [Char] -- ^ Characters which set off quotes 143 -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions 144 -> CompletionFunc m -- ^ Alternate completion to perform if the 145 -- cursor is not at a quoted word 146 -> CompletionFunc m 147completeQuotedWord esc qs completer alterative line@(left,_) 148 = case splitAtQuote esc qs left of 149 Just (w,rest) | isUnquoted esc qs rest -> do 150 cs <- completer (reverse w) 151 return (rest, map (addQuotes . escapeReplacement esc (`elem` qs)) cs) 152 _ -> alterative line 153 154addQuotes :: Completion -> Completion 155addQuotes c = if isFinished c 156 then c {replacement = "\"" ++ replacement c ++ "\""} 157 else c {replacement = "\"" ++ replacement c} 158 159splitAtQuote :: Maybe Char -> String -> String -> Maybe (String,String) 160splitAtQuote esc qs line = case line of 161 c:e:cs | isEscape e && isEscapable c 162 -> do 163 (w,rest) <- splitAtQuote esc qs cs 164 return (c:w,rest) 165 q:cs | isQuote q -> Just ("",cs) 166 c:cs -> do 167 (w,rest) <- splitAtQuote esc qs cs 168 return (c:w,rest) 169 "" -> Nothing 170 where 171 isQuote = (`elem` qs) 172 isEscape c = Just c == esc 173 isEscapable c = isEscape c || isQuote c 174 175isUnquoted :: Maybe Char -> String -> String -> Bool 176isUnquoted esc qs s = case splitAtQuote esc qs s of 177 Just (_,s') -> not (isUnquoted esc qs s') 178 _ -> True 179 180 181-- | List all of the files or folders beginning with this path. 182listFiles :: MonadIO m => FilePath -> m [Completion] 183listFiles path = liftIO $ do 184 fixedDir <- fixPath dir 185 dirExists <- doesDirectoryExist fixedDir 186 -- get all of the files in that directory, as basenames 187 allFiles <- if not dirExists 188 then return [] 189 else fmap (map completion . filterPrefix) 190 $ getDirectoryContents fixedDir 191 -- The replacement text should include the directory part, and also 192 -- have a trailing slash if it's itself a directory. 193 forM allFiles $ \c -> do 194 isDir <- doesDirectoryExist (fixedDir </> replacement c) 195 return $ setReplacement fullName $ alterIfDir isDir c 196 where 197 (dir, file) = splitFileName path 198 filterPrefix = filter (\f -> notElem f [".",".."] 199 && file `isPrefixOf` f) 200 alterIfDir False c = c 201 alterIfDir True c = c {replacement = addTrailingPathSeparator (replacement c), 202 isFinished = False} 203 fullName = replaceFileName path 204 205-- turn a user-visible path into an internal version useable by System.FilePath. 206fixPath :: String -> IO String 207-- For versions of filepath < 1.2 208fixPath "" = return "." 209fixPath ('~':c:path) | isPathSeparator c = do 210 home <- getHomeDirectory 211 return (home </> path) 212fixPath path = return path 213 214-- | If the first completer produces no suggestions, fallback to the second 215-- completer's output. 216fallbackCompletion :: Monad m => CompletionFunc m -> CompletionFunc m -> CompletionFunc m 217fallbackCompletion a b input = do 218 aCompletions <- a input 219 if null (snd aCompletions) 220 then b input 221 else return aCompletions 222