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