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