1{- |
2
3A rich user interface for line input in command-line programs.  Haskeline is
4Unicode-aware and runs both on POSIX-compatible systems and on Windows.
5
6Users may customize the interface with a @~/.haskeline@ file; see
7<https://github.com/judah/haskeline/wiki/UserPreferences> for more information.
8
9An example use of this library for a simple read-eval-print loop (REPL) is the
10following:
11
12> import System.Console.Haskeline
13>
14> main :: IO ()
15> main = runInputT defaultSettings loop
16>    where
17>        loop :: InputT IO ()
18>        loop = do
19>            minput <- getInputLine "% "
20>            case minput of
21>                Nothing -> return ()
22>                Just "quit" -> return ()
23>                Just input -> do outputStrLn $ "Input was: " ++ input
24>                                 loop
25
26-}
27
28
29module System.Console.Haskeline(
30                    -- * Interactive sessions
31                    -- ** The InputT monad transformer
32                    InputT,
33                    runInputT,
34                    haveTerminalUI,
35                    mapInputT,
36                    -- ** Behaviors
37                    Behavior,
38                    runInputTBehavior,
39                    defaultBehavior,
40                    useFileHandle,
41                    useFile,
42                    preferTerm,
43                    -- * User interaction functions
44                    -- ** Reading user input
45                    -- $inputfncs
46                    getInputLine,
47                    getInputLineWithInitial,
48                    getInputChar,
49                    getPassword,
50                    waitForAnyKey,
51                    -- ** Outputting text
52                    -- $outputfncs
53                    outputStr,
54                    outputStrLn,
55                    getExternalPrint,
56                    -- * Customization
57                    -- ** Settings
58                    Settings(..),
59                    defaultSettings,
60                    setComplete,
61                    -- ** User preferences
62                    Prefs(),
63                    readPrefs,
64                    defaultPrefs,
65                    runInputTWithPrefs,
66                    runInputTBehaviorWithPrefs,
67                    withRunInBase,
68                    -- ** History
69                    -- $history
70                    getHistory,
71                    putHistory,
72                    modifyHistory,
73                    -- * Ctrl-C handling
74                    withInterrupt,
75                    Interrupt(..),
76                    handleInterrupt,
77                    -- * Additional submodules
78                    module System.Console.Haskeline.Completion)
79                     where
80
81import System.Console.Haskeline.LineState
82import System.Console.Haskeline.Command
83import System.Console.Haskeline.Vi
84import System.Console.Haskeline.Emacs
85import System.Console.Haskeline.Prefs
86import System.Console.Haskeline.History
87import System.Console.Haskeline.Monads
88import System.Console.Haskeline.InputT
89import System.Console.Haskeline.Completion
90import System.Console.Haskeline.Term
91import System.Console.Haskeline.Key
92import System.Console.Haskeline.RunCommand
93
94import Control.Monad.Catch (MonadMask, handle)
95import Data.Char (isSpace, isPrint)
96import Data.Maybe (isJust)
97import System.IO
98
99
100-- | A useful default.  In particular:
101--
102-- @
103-- defaultSettings = Settings {
104--           complete = completeFilename,
105--           historyFile = Nothing,
106--           autoAddHistory = True
107--           }
108-- @
109defaultSettings :: MonadIO m => Settings m
110defaultSettings = Settings {complete = completeFilename,
111                        historyFile = Nothing,
112                        autoAddHistory = True}
113
114{- $outputfncs
115The following functions enable cross-platform output of text that may contain
116Unicode characters.
117-}
118
119-- | Write a Unicode string to the user's standard output.
120outputStr :: MonadIO m => String -> InputT m ()
121outputStr xs = do
122    putter <- InputT $ asks putStrOut
123    liftIO $ putter xs
124
125-- | Write a string to the user's standard output, followed by a newline.
126outputStrLn :: MonadIO m => String -> InputT m ()
127outputStrLn = outputStr . (++ "\n")
128
129
130{- $inputfncs
131The following functions read one line or character of input from the user.
132
133They return `Nothing` if they encounter the end of input.  More specifically:
134
135- When using terminal-style interaction, they return `Nothing` if the user
136  pressed @Ctrl-D@ when the input text was empty.
137
138- When using file-style interaction, they return `Nothing` if an @EOF@ was
139  encountered before any characters were read.
140-}
141
142
143{- | Reads one line of input.  The final newline (if any) is removed.  When using terminal-style interaction, this function provides a rich line-editing user interface.
144
145If @'autoAddHistory' == 'True'@ and the line input is nonblank (i.e., is not all
146spaces), it will be automatically added to the history.
147-}
148getInputLine :: (MonadIO m, MonadMask m)
149            => String -- ^ The input prompt
150                            -> InputT m (Maybe String)
151getInputLine = promptedInput (getInputCmdLine emptyIM) $ runMaybeT . getLocaleLine
152
153{- | Reads one line of input and fills the insertion space with initial text. When using
154terminal-style interaction, this function provides a rich line-editing user interface with the
155added ability to give the user default values.
156
157This function behaves in the exact same manner as 'getInputLine', except that
158it pre-populates the input area. The text that resides in the input area is given as a 2-tuple
159with two 'String's.   The string on the left of the tuple (obtained by calling 'fst') is
160what will appear to the left of the cursor and the string on the right (obtained by
161calling 'snd') is what will appear to the right of the cursor.
162
163Some examples of calling of this function are:
164
165> getInputLineWithInitial "prompt> " ("left", "") -- The cursor starts at the end of the line.
166> getInputLineWithInitial "prompt> " ("left ", "right") -- The cursor starts before the second word.
167 -}
168getInputLineWithInitial :: (MonadIO m, MonadMask m)
169                            => String           -- ^ The input prompt
170                            -> (String, String) -- ^ The initial value left and right of the cursor
171                            -> InputT m (Maybe String)
172getInputLineWithInitial prompt (left,right) = promptedInput (getInputCmdLine initialIM)
173                                                (runMaybeT . getLocaleLine) prompt
174  where
175    initialIM = insertString left $ moveToStart $ insertString right $ emptyIM
176
177getInputCmdLine :: (MonadIO m, MonadMask m) => InsertMode -> TermOps -> Prefix -> InputT m (Maybe String)
178getInputCmdLine initialIM tops prefix = do
179    emode <- InputT $ asks editMode
180    result <- runInputCmdT tops $ case emode of
181                Emacs -> runCommandLoop tops prefix emacsCommands initialIM
182                Vi -> evalStateT' emptyViState $
183                        runCommandLoop tops prefix viKeyCommands initialIM
184    maybeAddHistory result
185    return result
186
187maybeAddHistory :: forall m . MonadIO m => Maybe String -> InputT m ()
188maybeAddHistory result = do
189    settings :: Settings m <- InputT ask
190    histDupes <- InputT $ asks historyDuplicates
191    case result of
192        Just line | autoAddHistory settings && not (all isSpace line)
193            -> let adder = case histDupes of
194                        AlwaysAdd -> addHistory
195                        IgnoreConsecutive -> addHistoryUnlessConsecutiveDupe
196                        IgnoreAll -> addHistoryRemovingAllDupes
197               in modifyHistory (adder line)
198        _ -> return ()
199
200----------
201
202{- | Reads one character of input.  Ignores non-printable characters.
203
204When using terminal-style interaction, the character will be read without waiting
205for a newline.
206
207When using file-style interaction, a newline will be read if it is immediately
208available after the input character.
209-}
210getInputChar :: (MonadIO m, MonadMask m) => String -- ^ The input prompt
211                    -> InputT m (Maybe Char)
212getInputChar = promptedInput getInputCmdChar $ \fops -> do
213                        c <- getPrintableChar fops
214                        maybeReadNewline fops
215                        return c
216
217getPrintableChar :: FileOps -> IO (Maybe Char)
218getPrintableChar fops = do
219    c <- runMaybeT $ getLocaleChar fops
220    case fmap isPrint c of
221        Just False -> getPrintableChar fops
222        _ -> return c
223
224getInputCmdChar :: (MonadIO m, MonadMask m) => TermOps -> Prefix -> InputT m (Maybe Char)
225getInputCmdChar tops prefix = runInputCmdT tops
226        $ runCommandLoop tops prefix acceptOneChar emptyIM
227
228acceptOneChar :: Monad m => KeyCommand m InsertMode (Maybe Char)
229acceptOneChar = choiceCmd [useChar $ \c s -> change (insertChar c) s
230                                                >> return (Just c)
231                          , ctrlChar 'l' +> clearScreenCmd >|>
232                                        keyCommand acceptOneChar
233                          , ctrlChar 'd' +> failCmd]
234
235----------
236{- | Waits for one key to be pressed, then returns.  Ignores the value
237of the specific key.
238
239Returns 'True' if it successfully accepted one key.  Returns 'False'
240if it encountered the end of input; i.e., an @EOF@ in file-style interaction,
241or a @Ctrl-D@ in terminal-style interaction.
242
243When using file-style interaction, consumes a single character from the input which may
244be non-printable.
245-}
246waitForAnyKey :: (MonadIO m, MonadMask m)
247    => String -- ^ The input prompt
248    -> InputT m Bool
249waitForAnyKey = promptedInput getAnyKeyCmd
250            $ \fops -> fmap isJust . runMaybeT $ getLocaleChar fops
251
252getAnyKeyCmd :: (MonadIO m, MonadMask m) => TermOps -> Prefix -> InputT m Bool
253getAnyKeyCmd tops prefix = runInputCmdT tops
254    $ runCommandLoop tops prefix acceptAnyChar emptyIM
255  where
256    acceptAnyChar = choiceCmd
257                [ ctrlChar 'd' +> const (return False)
258                , KeyMap $ const $ Just (Consumed $ const $ return True)
259                ]
260
261----------
262-- Passwords
263
264{- | Reads one line of input, without displaying the input while it is being typed.
265When using terminal-style interaction, the masking character (if given) will replace each typed character.
266
267When using file-style interaction, this function turns off echoing while reading
268the line of input.
269
270Note that if Haskeline is built against a version of the @Win32@ library
271earlier than 2.5, 'getPassword' will incorrectly echo back input on MinTTY
272consoles (such as Cygwin or MSYS).
273-}
274
275getPassword :: (MonadIO m, MonadMask m) => Maybe Char -- ^ A masking character; e.g., @Just \'*\'@
276                            -> String -> InputT m (Maybe String)
277getPassword x = promptedInput
278                    (\tops prefix -> runInputCmdT tops
279                                        $ runCommandLoop tops prefix loop
280                                        $ Password [] x)
281                    (\fops -> withoutInputEcho fops $ runMaybeT $ getLocaleLine fops)
282 where
283    loop = choiceCmd [ simpleChar '\n' +> finish
284                     , simpleKey Backspace +> change deletePasswordChar
285                                                >|> loop'
286                     , useChar $ \c -> change (addPasswordChar c) >|> loop'
287                     , ctrlChar 'd' +> \p -> if null (passwordState p)
288                                                then failCmd p
289                                                else finish p
290                     , ctrlChar 'l' +> clearScreenCmd >|> loop'
291                     ]
292    loop' = keyCommand loop
293
294{- $history
295The 'InputT' monad transformer provides direct, low-level access to the user's line history state.
296
297However, for most applications, it should suffice to just use the 'autoAddHistory'
298and 'historyFile' flags.
299
300-}
301
302
303-------
304-- | Wrapper for input functions.
305-- This is the function that calls "wrapFileInput" around file backend input
306-- functions (see Term.hs).
307promptedInput :: MonadIO m => (TermOps -> Prefix -> InputT m a)
308                        -> (FileOps -> IO a)
309                        -> String -> InputT m a
310promptedInput doTerm doFile prompt = do
311    -- If other parts of the program have written text, make sure that it
312    -- appears before we interact with the user on the terminal.
313    liftIO $ hFlush stdout
314    rterm <- InputT ask
315    case termOps rterm of
316        Right fops -> liftIO $ do
317                        putStrOut rterm prompt
318                        wrapFileInput fops $ doFile fops
319        Left tops -> do
320            -- Convert the full prompt to graphemes (not just the last line)
321            -- to account for the `\ESC...STX` appearing anywhere in it.
322            let prompt' = stringToGraphemes prompt
323            -- If the prompt contains newlines, print all but the last line.
324            let (lastLine,rest) = break (`elem` stringToGraphemes "\r\n")
325                                    $ reverse prompt'
326            outputStr $ graphemesToString $ reverse rest
327            doTerm tops $ reverse lastLine
328
329{- | If Ctrl-C is pressed during the given action, throw an exception
330of type 'Interrupt'.  For example:
331
332> tryAction :: InputT IO ()
333> tryAction = handle (\Interrupt -> outputStrLn "Cancelled.")
334>                $ withInterrupt $ someLongAction
335
336The action can handle the interrupt itself; a new 'Interrupt' exception will be thrown
337every time Ctrl-C is pressed.
338
339> tryAction :: InputT IO ()
340> tryAction = withInterrupt loop
341>     where loop = handle (\Interrupt -> outputStrLn "Cancelled; try again." >> loop)
342>                    someLongAction
343
344This behavior differs from GHC's built-in Ctrl-C handling, which
345may immediately terminate the program after the second time that the user presses
346Ctrl-C.
347
348-}
349withInterrupt :: (MonadIO m, MonadMask m) => InputT m a -> InputT m a
350withInterrupt act = do
351    rterm <- InputT ask
352    wrapInterrupt rterm act
353
354-- | Catch and handle an exception of type 'Interrupt'.
355--
356-- > handleInterrupt f = handle $ \Interrupt -> f
357handleInterrupt :: MonadMask m => m a -> m a -> m a
358handleInterrupt f = handle $ \Interrupt -> f
359
360{- | Return a printing function, which in terminal-style interactions is
361thread-safe and may be run concurrently with user input without affecting the
362prompt. -}
363getExternalPrint :: MonadIO m => InputT m (String -> IO ())
364getExternalPrint = do
365    rterm <- InputT ask
366    return $ case termOps rterm of
367        Right _ -> putStrOut rterm
368        Left tops -> externalPrint tops
369