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