simple-prompt 0.1.0 → 0.2.0
raw patch · 5 files changed
+192/−38 lines, 5 filesdep +exceptionsdep +haskelinedep +time
Dependencies added: exceptions, haskeline, time
Files
- ChangeLog.md +9/−0
- README.md +10/−6
- simple-prompt.cabal +7/−3
- src/SimplePrompt.hs +72/−29
- src/SimplePrompt/Internal.hs +94/−0
ChangeLog.md view
@@ -1,4 +1,13 @@ # Revision history for simple-prompt +## 0.2.0 (2023-05-28)+- new API using haskeline and MonadIO+- prompt ignores buffered stdin lines if it returns in milliseconds+- promptEnter replaces Prompt_+- new functions: promptEnter, promptInitial, promptNonEmpty, promptPassword+- yesNo and yesNoDefault replace yesno+- internal haskeline functions in SimplePrompt.Internal: including+ getPrompt*, runPrompt, untilInput, mapInput, nonEmptyInput, timedInput+ ## 0.1.0 (2023-04-02) - initial release with prompt, prompt_, yesno functions
README.md view
@@ -1,10 +1,14 @@ # simple-prompt -A little library for commandline text prompts for user input.+A simple commandline text prompt library for user input. -- `prompt`: return a String-- `prompt_` ignore input-- `yesno` expects y/n answer+- `prompt`: returns a string+- `promptNonEmpty` prompts for non-empty string+- `promptInitial` with pre-filled initial input+- `promptPassword` prompts for password+- `promptChar` prompt for a character+- `promptEnter` waits for Enter key+- `yesNo` expects y/n answer+- `yesNoDefault` [y/N] or [Y/n] -Currently assumes unix since it reads from /dev/tty for fresh stdin,-but it could probably easily be extended to work on Windows.+It uses haskeline to read the input.
simple-prompt.cabal view
@@ -1,5 +1,5 @@ name: simple-prompt-version: 0.1.0+version: 0.2.0 synopsis: Simple commandline text prompt functions description: The library provides prompt functions for reading user input:@@ -22,7 +22,7 @@ || == 8.10.7 || == 9.0.2 || == 9.2.7- || == 9.4.4+ || == 9.4.5 source-repository head type: git@@ -30,10 +30,14 @@ library build-depends: base < 5,- extra+ exceptions,+ extra,+ haskeline,+ time default-language: Haskell2010 exposed-modules: SimplePrompt+ SimplePrompt.Internal hs-source-dirs: src ghc-options: -Wall
src/SimplePrompt.hs view
@@ -1,39 +1,82 @@+{-# LANGUAGE CPP #-}+ module SimplePrompt ( prompt,- prompt_,- yesno+ promptInitial,+ promptBuffered,+ promptNonEmpty,+ promptChar,+ promptEnter,+ promptPassword,+ yesNo,+ yesNoDefault ) where import Control.Monad (void)-import Data.Bool (bool)-import Data.Char (isPrint) import Data.List.Extra (lower, trim) -import System.IO+import SimplePrompt.Internal -prompt :: String -> IO String-prompt s = do- putStr $ s ++ ": "- tty <- openFile "/dev/tty" ReadMode- inp <- hGetLine tty- if all isPrint inp- then return inp- else do- putStrLn $- "input rejected because of unprintable character(s): '" ++- show inp ++ "'"- prompt s+#include "monadconstraint.h" -prompt_ :: String -> IO ()-prompt_ = void <$> prompt+-- FIXME use haveTerminalUI ?+-- | prompt which drops buffered input (using timedInput)+--+-- Ignores buffered input lines (ie if input line gotten in under 5ms)+prompt :: MONADCONSTRAINT => String -> m String+prompt = runPrompt . timedInput . getPromptLine -yesno :: Maybe Bool -> String -> IO Bool-yesno mdefault desc = do- inp <- prompt $ desc ++ "? " ++ maybe "[y/n]" (bool "[y/N]" "[Y/n]") mdefault- case trim (lower inp) of- "y" -> return True- "yes" -> return True- "n" -> return False- "no" -> return False- "" -> maybe (yesno Nothing desc) return mdefault- _ -> yesno mdefault desc+-- FIXME non-empty?+-- | reads string with initial input (using timedInput)+promptInitial :: MONADCONSTRAINT => String -> String -> m String+promptInitial s = runPrompt . timedInput . getPromptInitial s++-- | reads string with buffering+promptBuffered :: MONADCONSTRAINT => String -> m String+promptBuffered = runPrompt . getPromptLine++-- | reads non-empty string (using nonEmptyInput)+promptNonEmpty :: MONADCONSTRAINT => String -> m String+promptNonEmpty = runPrompt . nonEmptyInput . getPromptLine++-- | prompt for a password+promptPassword :: MONADCONSTRAINT => String -> m String+promptPassword = runPrompt . nonEmptyInput . getPromptPassword++-- | prompt for character key+promptChar :: MONADCONSTRAINT => String -> m Char+promptChar =+ runPrompt . timedInput . getPromptChar++-- | prompt for Enter key+promptEnter :: MONADCONSTRAINT => String -> m ()+promptEnter =+ void . runPrompt . untilInput (== "") . timedInput . getPromptLine++-- | Yes-No prompt (accepts only {y,n,yes,no} case-insensitive)+yesNo :: MONADCONSTRAINT => String -> m Bool+yesNo desc =+ runPrompt . mapInput maybeYN . getPromptLine $ desc ++ "? [y/n]"+ where+ maybeYN inp =+ case trim (lower inp) of+ "y" -> Just True+ "yes" -> Just True+ "n" -> Just False+ "no" -> Just False+ _ -> Nothing++-- | Yes-No prompt with default (uses timedInput)+yesNoDefault :: MONADCONSTRAINT => Bool -> String -> m Bool+yesNoDefault yes desc =+ runPrompt . mapInput maybeYN' . timedInput . getPromptLine $+ desc ++ "? " ++ if yes then "[Y/n]" else "[y/N]"+ where+ maybeYN' inp =+ case trim (lower inp) of+ "" -> Just yes+ "y" -> Just True+ "yes" -> Just True+ "n" -> Just False+ "no" -> Just False+ _ -> Nothing
+ src/SimplePrompt/Internal.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE CPP #-}++module SimplePrompt.Internal (+ getPromptLine,+ getPromptInitial,+ getPromptChar,+ getPromptPassword,+ getGenericPrompt,+ runPrompt,+ untilInput,+ mapInput,+ nonEmptyInput,+ timedInput,+ MonadIO,+#if MIN_VERSION_haskeline(0,8,0)+ MonadMask+#else+ MonadException+#endif+ ) where++#if MIN_VERSION_haskeline(0,8,0)+import Control.Monad.Catch (MonadMask)+#endif+import Control.Monad.IO.Class (liftIO, MonadIO)+import Data.Time.Clock (diffUTCTime, getCurrentTime)++import System.Console.Haskeline++#include "../monadconstraint.h"++-- | generic prompt wrapper+getGenericPrompt :: MonadIO m => (String -> InputT m (Maybe a))+ -> String -> InputT m a+getGenericPrompt prompter s =+ prompter (s ++ ": ") >>=+ maybe (error "could not read input!") return++-- | like getInputLine, but error if fails+getPromptLine :: MONADCONSTRAINT => String -> InputT m String+getPromptLine =+ getGenericPrompt getInputLine++-- | like getPromptLine, but with initial input+getPromptInitial :: MONADCONSTRAINT => String -> String -> InputT m String+getPromptInitial s i =+ getGenericPrompt (`getInputLineWithInitial` (i,"")) s++-- | like getInputChar, but error if fails+getPromptChar :: MONADCONSTRAINT => String -> InputT m Char+getPromptChar =+ getGenericPrompt getInputChar++-- | get password+getPromptPassword :: MONADCONSTRAINT => String -> InputT m String+getPromptPassword =+ getGenericPrompt (getPassword Nothing)++-- | run a prompt+runPrompt :: MONADCONSTRAINT => InputT m a -> m a+runPrompt = runInputT defaultSettings++-- | loop prompt until check+untilInput :: MONADCONSTRAINT => (a -> Bool) -> InputT m a -> InputT m a+untilInput p prompting = do+ input <- prompting+ if p input+ then return input+ else untilInput p prompting++-- | maybe map input or loop prompt+mapInput :: MONADCONSTRAINT => (a -> Maybe b) -> InputT m a -> InputT m b+mapInput f prompting = do+ input <- prompting+ case f input of+ Just x -> return x+ Nothing -> mapInput f prompting++-- | repeat prompt until non-empty+nonEmptyInput :: MONADCONSTRAINT => InputT m String -> InputT m String+nonEmptyInput = untilInput (not . null)++-- | repeat prompt if input returned within milliseconds+timedInput :: MonadIO m => InputT m a -> InputT m a+timedInput prompter = do+ start <- liftIO getCurrentTime+ input <- prompter+ end <- liftIO getCurrentTime+ let diff = diffUTCTime end start+ if diff < 0.005+ then do+ outputStrLn $ "ignoring buffered input: " ++ show diff ++ " too quick"+ timedInput prompter+ else return input