repl-toolkit 0.1.0.0 → 0.2.0.0

raw patch · 2 files changed

+204/−99 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• System/REPL.hs +199/−98
• repl-toolkit.cabal +5/−1

@@ -9,37 +9,68 @@    module Data.ListLike.IO,
    putErr,
    putErrLn,
+   prompt,
+   -- * Prompts
+   prompt',
+   promptAbort,
    -- *Feture-rich reading of user-input
    -- |These functions automate parsing and validating command-line
    --  input via the 'Asker' type.
+   PromptMsg,
+   TypeErrorMsg,
+   PredicateErrorMsg,
+   Predicate,
+   Parser,
+   Asker(..),
+   AskFailure(..),
+   askerP,
+   typeAskerP,
+   maybeAskerP,
+   -- **Asking based on 'Read'
+   -- |These askers use 'Text.Read.readMaybe' as their parser.
    --
    --  It is possible to ask for Strings, but then quotes will be required
-   --  around them (per their Read-instance). If you want to get the user's
+   --  around them (per their Read-instance). To get the user's
    --  input as-is, use the 'Verbatim' type.
-   Asker(..),
-   Success(..),
-   AskFailure(..),
+   readParser,
    asker,
    typeAsker,
    predAsker,
    maybeAsker,
-   prompt,
-   prompt',
    Verbatim(..),
-   -- **Asking for input
+   -- **Running askers
+   -- |Since the parsing depends on the Read-instance, the expected result type
+   --  must be explicitly given. E.g.:
+   --
+   -- @
+   --   intAsker :: Asker IO Int
+   --   intAsker = typeAsker "> " "Expected Int!"
+   -- @
+   --
+   -- or, for polymorphic askers,
+   --
+   -- @
+   --   genericAsk :: Read a => Asker IO a
+   --   genericAsk = typeAsker "> " "Couldn't parse value!"
+   --   ...
+   --   do (x :: Int) <- genericAsk
+   --      (y :: Int) <- genericAsk
+   --      putStrLn $ "The sum is: " ++ show (x+y)
+   -- @
    ask,
    ask',
+   askEither,
    untilValid,
    ) where
 
-import Prelude hiding (putStrLn, putStr, getLine)
+import Prelude hiding (putStrLn, putStr, getLine, reverse)
 
 import Control.Arrow (right, (|||))
 import Control.Exception
 import Control.Monad.Except
 import Data.Char (isSpace)
 import Data.Functor.Monadic
-import Data.ListLike()
+import Data.ListLike(ListLike(empty, cons, reverse))
 import Data.ListLike.IO (ListLikeIO(..))
 import Data.Text.Lazy (Text)
 import qualified Data.Text.Lazy as T
@@ -59,50 +90,82 @@ putErrLn = hPutStrLn IO.stderr
 
 -- |Prints @> @ and asks the user to input a line.
-prompt :: (MonadIO m, Functor m, ListLikeIO full item) => m full
+prompt :: (MonadIO m, ListLikeIO full item) => m full
 prompt = prompt' ("> " :: String)
 
 -- |Prints its first argument and, in the same line, asks the user
 --  to input a line.
-prompt' :: (MonadIO m, Functor m, ListLikeIO full item, ListLikeIO full' item')
+prompt' :: (MonadIO m, ListLikeIO full item, ListLikeIO full' item')
         => full -> m full'
 prompt' s = liftIO (putStr s >> IO.hFlush IO.stdout >> getLine)
 
+-- |The same as prompt, but aborts as soon as the user presses a given key
+--  (commonly @'\ESC'@). This function temporarily tries to set the buffering mode
+--  to NoBuffering via 'System.IO.hSetBuffering', which may not be supported.
+--  See the documentation of 'System.IO.hSetBuffering' for details.
+promptAbort :: (MonadIO m, ListLikeIO full item, ListLikeIO full' Char)
+            => Char -> full -> m (Maybe full')
+promptAbort abortChar s = liftIO (do putStr s
+                                     IO.hFlush IO.stdout
+                                     bufMode <- IO.hGetBuffering IO.stdin
+                                     IO.hSetBuffering IO.stdin IO.NoBuffering
+                                     input <- getUntil empty
+                                     IO.hSetBuffering IO.stdin bufMode
+                                     return $ input >$> reverse)
+   where
+      getUntil acc = do c <- getChar
+                        if c == abortChar then return Nothing
+                        else if c == '\n' then return $ Just acc
+                        else                   getUntil (cons c acc)
+
 -- Askers
 -------------------------------------------------------------------------------
 
+-- |An error message indicating that a value wasn't able to be parsed.
+type TypeErrorMsg = Text
+-- |An error message indicating that a value failied a predicate.
+type PredicateErrorMsg = Text
+-- |A prompt.
+type PromptMsg = Text
+
+-- |A predicate which a value has to fulfil.
+type Predicate m a = a -> m Bool
+
+-- |A parser which either returns a parsed value or an error message.
+type Parser a = Text -> Either Text a
+
 -- |The description of an \'ask for user input\'-action.
---  The type parameters are the used monad (typically @IO@),
+--  The type parameters are the used monad (typically 'IO' or 'ExceptT'),
 --  the type of the read value and the type of the error that is thrown
 --  in case of failures.
+--
+--  The components are a prompt, a parser, and a predicate that
+--  the parsed value must fulfil. The predicate, being monadic, can
+--  perform arbitrarily complex tests, such as checking whether a given
+--  date is in the future, whether an item is in a database, whether
+--  a file with a given name exists, etc.
 data Asker m a = Asker{ -- |The prompt to be displayed to the user.
                         askerPrompt::Text,
-                        -- |The parser for the input value, which
-                        --  either delivers a value of type @a@ or
-                        --  an error message.
-                        askerParser::Text -> Either Text a,
+                        -- |The parser for the input value.
+                        askerParser::Parser a,
                         -- |The predicate which the input, once read,
-                        --  must fulfill. It either delivers 'Success'
-                        --  or an error message.
-                        askerPredicate::a -> m (Either Text Success)}
+                        --  must fulfill. The Left side is an error message.
+                        askerPredicate::a -> m (Either Text ())}
 
--- |Singleton type representing success.
-data Success = Success deriving (Eq, Show, Read)
 
--- |Represents a failure of an ask function.
---  It can either be a type failure (failure to interpret the
---  user input as a value of the required type) or a predicate
---  failure (the user input could be interpreter as a value
---  of the required type, but it failed some user-supplied test).
-data AskFailure = TypeFailure Text -- ^Indicates that the parsing as the
-                                   --  required type failed.
-                  | PredicateFailure Text -- ^Indiciates that the parsed
-                                          -- value failed a predicate.
+-- |Represents a failure during the running of an asking function.
+--  Either the input was incorrect in some way, or the process was aborted
+--  by the user.
+data AskFailure = -- |The input wasn't able to be parsed.
+                  TypeFailure TypeErrorMsg
+                  -- |The parsed value failed a predicate.
+                  | PredicateFailure PredicateErrorMsg
+                  -- |An incorrect number of parameters was passed.
                   | ParamFailure Text
-                    -- ^Indicates that an incorrect number of
-                    --  parameters was passed.
-                  | NothingFoundFailure -- ^Indicates that no action was
-                                        --  appropriate to the given input.
+                  -- |No action was appropriate for the given input.
+                  | NothingFoundFailure
+                  -- |The input was aborted by the user.
+                  | AbortFailure
    deriving (Typeable, Eq)
 
 instance Exception AskFailure
@@ -112,108 +175,146 @@    show NothingFoundFailure = "No appropriate action found!"
    show (PredicateFailure t) = T.unpack t
    show (TypeFailure t) = T.unpack t
+   show AbortFailure = "Input aborted."
 
 -- |A verbatim Text whose Read instance simply returns the read
 --  string, as-is.
 --  This is useful for askers which ask for strings without quotes.
-newtype Verbatim = Verbatim{fromVerbatim::Text -- ^Extracts a 'Verbatim''s 'Text'.
-                            }
+newtype Verbatim = Verbatim{fromVerbatim::Text}
 
 -- |Read-instance for 'Verbatim'. Wraps the given value into quotes and
 --  reads it a a 'Text'.
 instance Read Verbatim where
    readsPrec _ s = [(Verbatim $ T.pack s,"")]
 
--- |Creates a general 'Asker' with 'Data.Read.readMaybe' as its parser.
---  This suffices for most simple values.
---  The main drawback of using 'Data.Read.readMaybe' is that the input
---  'Text' is unpacked into a String, which incurs a performance hit.
---  For short (one-line) input. this isn't important, but if large ones
---  are expected, it's better to pass a custom, 'Text'-compatible parsing
---  function, such as a parsec-parser.
-asker :: (Monad m, Functor m, Read a)
-      => Text -- ^The prompt.
-      -> Text -- ^Type error message.
-      -> Text -- ^Predicate error message.
-      -> (a -> m Bool) -- ^Predicate.
-      -> Asker m a
-asker pr errT errP pred = Asker pr parse check
+-- |Creates a general 'Asker' with a custom parsing function and a predicate
+--  that the parsed value has to pass. If either the parsing or the predicate
+--  fail, one of the given error messages is displayed.
+askerP :: (Monad m, Functor m)
+       => PromptMsg
+       -> PredicateErrorMsg
+       -> Parser a
+       -> Predicate m a
+       -> Asker m a
+askerP pr errP parse pred = Asker pr parse check
    where
-      parse = maybe (Left errT) Right . readMaybe . T.unpack
-      check = pred >=$> (\case True  -> Right Success
+      check = pred >=$> (\case True  -> Right ()
                                False -> Left errP)
 
--- |Creates an 'Asker' which just cares about the type of the input.
+-- |Creates an 'Asker' which only cares about the type of the input.
+typeAskerP :: (Monad m, Functor m)
+            => PromptMsg
+            -> Parser a
+            -> Asker m a
+typeAskerP pr parse = askerP pr undefined parse (const $ return True)
+
+-- |An asker which asks for an optional value. If only whitespace
+--  is entered (according to 'Data.Char.isSpace'), it returns 'Nothing'
+--  without further parsing or checking; otherwise, it behaves identically
+--  to 'asker'.
+maybeAskerP :: (Monad m, Functor m)
+           => PromptMsg
+           -> PredicateErrorMsg
+           -> Parser a
+           -> Predicate m a
+           -> Asker m (Maybe a)
+maybeAskerP pr errP parse pred = Asker pr parse' check
+   where
+      parse' t = if T.all isSpace t then Right Nothing
+                                    else right Just $ parse t
+
+      check Nothing = return $ Right ()
+      check (Just t) = pred t >$> (\case True  -> Right ()
+                                         False -> Left errP)
+
+-- Parsers based on Read
+-------------------------------------------------------------------------------
+
+-- |A parser based on 'Text.Read.readMaybe'. This suffices for the parsing of
+--  most data types.
+readParser :: Read a
+           => TypeErrorMsg
+           -> Text
+           -> (Either Text a)
+readParser errT = maybe (Left errT) Right . readMaybe . T.unpack
+
+-- |Creates a general 'Asker' with 'Text.Read.readMaybe' as its parser.
+--  Using 'Data.Read.readMaybe' is perfectly fine for most values, but it has
+--  two drawbacks:
+--
+--  1. The user input is unpacked into a String and then parsed. This can
+--     incur a performance hit for large inputs.
+--  2. A Read-instance must be available for the expected type.
+asker :: (Monad m, Functor m, Read a)
+      => PromptMsg
+      -> TypeErrorMsg
+      -> PredicateErrorMsg
+      -> Predicate m a
+      -> Asker m a
+asker pr errT errP pred = askerP pr errP (readParser errT) pred
+
+-- |Creates an 'Asker' based on Read which just cares about the type of the input.
 typeAsker :: (Monad m, Functor m, Read a)
-          => Text -- ^The prompt.
-          -> Text -- ^Type error message.
+          => PromptMsg
+          -> TypeErrorMsg
           -> Asker m a
 typeAsker p errT = asker p errT undefined (const $ return True)
 
--- |Creates an 'Asker' which takes its input verbatim as 'Text'.
+-- |Creates an 'Asker' which takes its input verbatim as 'Text'. The input
+--  thus only has to pass a predicate, not any parsing.
 predAsker :: (Monad m, Functor m)
-          => Text -- ^The prompt.
+          => PromptMsg
           -> Text -- ^Predicate error message.
           -> (Text -> m Bool) -- ^The predicate.
           -> Asker m Verbatim
 predAsker p errP f = asker p (error "Type error in predAsker. This is a bug.")
                            errP (f . fromVerbatim)
 
--- |An asker which asks for an optional value. If only whitespace
---  is entered (according to 'Data.Char.isSpace'), it returns 'Nothing'
---  without further parsing or checking; otherwise, it behaves identically
---  to 'asker'.
+-- |An asker based on Read which asks for an optional value.
 maybeAsker :: (Monad m, Functor m, Read a)
-           => Text -- ^The prompt.
-           -> Text -- ^Type error message.
-           -> Text -- ^Predicate error message.
-           -> (a -> m Bool) -- ^Predicate.
+           => PromptMsg
+           -> TypeErrorMsg
+           -> PredicateErrorMsg
+           -> Predicate m a
            -> Asker m (Maybe a)
-maybeAsker pr errT errP pred = Asker pr parse check
-   where
-      parse t = if T.all isSpace t then Right Nothing
-                                   else right Just
-                                        $ maybe (Left errT) Right
-                                        $ readMaybe
-                                        $ T.unpack t
-
-      check Nothing = return $ Right Success
-      check (Just t) = pred t >$> (\case True  -> Right Success
-                                         False -> Left errP)
+maybeAsker pr errT errP pred = maybeAskerP pr errP (readParser errT) pred
 
 -- Running askers
 --------------------------------------------------------------------------------
 
--- |Executes an 'Asker'. If the Text argument is Nothing, the user is asked
---  to enter a line on stdin. If it is @Just x@, @x@ is taken to be input.
---  If the input is of the wrong type, an error-message is printed
---  and the user is asked again.
---  In addition to the condition that the input must be of the correct
---  type, it must also fulfill a predicate.
---
---  Since the predicate is of monadic, arbitrarily complex
---  tests can be performed: checking whether an item is in a database,
---  whether a date was less than x years ago, etc.
-ask :: (MonadIO m, MonadError SomeException m, Functor m, Read a)
+-- |Executes an Asker. If the process fails, an exception is thrown
+--  The canonical instance of @MonadError SomeException@ is the 'ExceptT' monad.
+ask :: (MonadIO m, MonadError SomeException m, Functor m)
     => Asker m a
     -> Maybe Text
     -> m a
-ask a v = maybe ((liftIO . prompt' . askerPrompt $ a) >>= check)
-                check
-                v
-   where
-      check inp =
-         case askerParser a inp of
-            Left err -> throwError $ SomeException $ TypeFailure err
-            Right t -> askerPredicate a t
-                       >>= (throwError . SomeException . PredicateFailure ||| return . const t)
+ask a v = askEither a v >>= either (throwError . SomeException) return
 
 -- |See 'ask'. Always reads the input from stdin.
---  @ask' a = ask a Nothing@.
-ask' :: (MonadIO m, MonadError SomeException m, Functor m, Read a)
+--
+-- @
+-- ask' a = ask a Nothing
+-- @
+ask' :: (MonadIO m, MonadError SomeException m, Functor m)
      => Asker m a
      -> m a
 ask' a = ask a Nothing
+
+-- |Executes an 'Asker'. If the Text argument is Nothing, the user is asked
+--  to enter a line on stdin. If it is @Just x@, @x@ is taken to be input.
+askEither :: (MonadIO m, Functor m)
+          => Asker m a
+          -> Maybe Text
+          -> m (Either AskFailure a)
+askEither a = maybe getInput check
+   where
+      getInput = promptAbort '\ESC' (askerPrompt a)
+                 >>= maybe (return $ Left AbortFailure) check
+
+      check inp = case askerParser a inp of
+         Left err -> return $ Left $ TypeFailure err
+         Right t -> askerPredicate a t
+                    >>= return . (Left . PredicateFailure ||| Right . const t)
 
 -- |Repeatedly executes an ask action until the user enters a valid value.
 --  Error messages are printed each time.

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                repl-toolkit
-version:             0.1.0.0
+version:             0.2.0.0
 synopsis:            Toolkit for quickly whipping up command-line interfaces.
 description:         A simple toolkit for quickly whipping up REPLs, input validation and sets of commands included.
 homepage:            https://github.com/ombocomp/repl-toolkit
@@ -13,6 +13,10 @@ category:            System, REPL
 build-type:          Simple
 cabal-version:       >=1.10
+
+source-repository head
+  type: git
+  location: git://github.com/ombocomp/repl-toolkit.git
 
 library
   exposed-modules:     System.REPL, System.REPL.State, System.REPL.Command