HCL 1.4 → 1.5

raw patch · 2 files changed

+56/−27 lines, 2 filesdep +HCLdep ~QuickCheckdep ~basenew-uploader

Dependencies added: HCL

Dependency ranges changed: QuickCheck, base

Files

• HCL.cabal +12/−9
• src/System/Console/HCL.hs +44/−18

@@ -1,13 +1,11 @@ Name:           HCL-Version:        1.4+Version:        1.5 License:        BSD3 Author:         Justin Bailey Homepage:       http://github.com/m4dc4p/hcl/tree/master-Maintainer:     jgbailey _ gmail _ com+Maintainer:     Jonathan Lamothe <jlamothe1980@gmail.com> Category:       User Interfaces License-File:   LICENSE-License:        BSD3-Build-Depends:  base, QuickCheck < 2, mtl, random, containers Build-type: Simple Synopsis:       High-level library for building command line interfaces. Description:@@ -16,10 +14,15 @@   Dates, or other structured values), build lists of values, and use simple   menus. It is not intended to build complex interfaces with full cursor   control. It is oriented towards line-based interfaces.-Exposed-modules: System.Console.HCL-Hs-Source-Dirs: src+cabal-version: >= 1.6 Data-files: hangman/2of12.txt -Executable:     hangman-Main-Is:        Hangman.hs-Hs-Source-Dirs: hangman, src+Library+  Build-Depends:  base >= 4.7 && < 5, QuickCheck == 2.*, mtl, random, containers+  Exposed-modules: System.Console.HCL+  Hs-Source-Dirs: src++Executable hangman+  Build-Depends:  HCL+  Main-Is:        Hangman.hs+  Hs-Source-Dirs: hangman, src

@@ -12,6 +12,10 @@ 
  * 'reqInteger' - Requests "Integer" values.
 
+ * 'reqChar' - Requests a single character (without waiting for the user to press enter)
+
+ * 'reqPassword' - Like "reqResp", but doesn't echo the user's input to the console.
+
  * 'reqRead' - Requests "Read"-able values.
 
  * 'reqList' - Asks a request repeatedly and builds a list of the responses, which are returned when the user
@@ -281,7 +285,7 @@   Request,
   runRequest, execReq, reqIO, makeReq,
 -- * Request building blocks
-  reqResp, reqInteger, reqInt, reqRead,
+  reqResp, reqInteger, reqInt, reqRead, reqChar, reqPassword,
 -- * Functions lifted into Requests
   andReq, orReq, notReq, reqIf, reqConst, reqLift, reqLift2,
   reqMaybe,
@@ -296,11 +300,12 @@ ) where
  
 import Data.Char (isSpace, toLower, isPrint)
-import System.IO (hFlush, stdout)
+import System.IO
 import Test.QuickCheck 
 import System.IO.Unsafe (unsafePerformIO)
 import System.Random
 import Data.Maybe (isNothing, isJust)
+import Control.Monad (when)
 import Control.Monad.Trans 
 
 {- |
@@ -326,15 +331,28 @@               -> IO (Maybe a) -- ^ Result of the request.
 runRequest (Request r) = r
 
+{- |
+Because we have defined @Request@ as @Applicative@,
+we must also define it as @Functor@. -}
+instance Functor Request where
+  fmap = reqLift
 
 {- |
+Because we have defined @Request@ as @Monad@,
+we must also define it as @Applicative@. -}
+instance Applicative Request where
+  pure = makeReq
+  f <*> x = f `andMaybe` \f' ->
+    fmap f' x
+
+{- |
 Request behavior as a @Monad@ covers failure - when
 a request results in @Nothing@, all bind
 operations fail afterwards. Thus, when one request fails,
 all subsequent requests automatically fail. -}
 instance Monad Request where
-  return x = makeReq x
   f >>= g = f `andMaybe` g
+  fail _ = reqFail
 
 {- |
 Takes a value and makes it into a request. Should
@@ -417,8 +435,31 @@         ((v, _):[]) -> return $ Just v
         _           -> return Nothing
 
+{- |
+@reqChar@ requests a single character. Unlike other @Request@s, it
+does not wait for the user to hit enter; it simply returns the first
+keystroke. -}
+reqChar :: Request Char
+reqChar = Request $ do
+  mode <- hGetBuffering stdin
+  hSetBuffering stdin NoBuffering
+  val <- getChar
+  when (val /= '\n') $ putStrLn ""
+  hSetBuffering stdin mode
+  return $ Just val
 
 {- |
+@reqPassword@ works like 'reqResp' except that it does not echo the user's input to standard output. -}
+reqPassword :: Request String
+reqPassword = Request $ do
+  echo <- hGetEcho stdin
+  hSetEcho stdin False
+  val <- runRequest reqResp
+  putStrLn ""
+  hSetEcho stdin echo
+  return val
+
+{- |
 @&&@ operator for requests (with failure). Behaves similarly, including
 "short-circuit" behavior. If either condition fails, the entire @Request@
 fails. -}
@@ -803,7 +844,6 @@       do
         val <- arbitrary
         return (RandomRequest $ random val)
-  coarbitrary = undefined
   
 {- |
 Creates a request which will return a random value or Nothing. The
@@ -816,20 +856,6 @@       if rnd
         then return $ Request (return (Just val))
         else return $ Request (return Nothing)
-  coarbitrary = undefined
-
--- | QuickCheck does not define arbitrary for Chars for some reason ...
-instance Arbitrary Char where
-  arbitrary =
-      choose'
-    where
-      choose' = 
-        do
-          val <- choose (minBound, maxBound)
-          if isPrint val
-            then return val
-            else choose'
-  coarbitrary = undefined
 
 -- | Show for random requests.  
 instance (Show a) => Show (RandomRequest a) where