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