packages feed

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 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