HCL 1.6 → 1.7

raw patch · 10 files changed

+44/−40 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HCL.cabal +1/−2
• src/System/Console/HCL.hs +13/−8
• test/Spec/AndReq.hs +1/−3
• test/Spec/Common.hs +0/−9
• test/Spec/Constructors.hs +24/−3
• test/Spec/NotReq.hs +1/−3
• test/Spec/OrReq.hs +1/−3
• test/Spec/ReqIf.hs +1/−3
• test/Spec/ReqLift.hs +1/−3
• test/Spec/ReqLift2.hs +1/−3

@@ -1,5 +1,5 @@ Name:           HCL-Version:        1.6+Version:        1.7 License:        BSD3 Author:         Justin Bailey Homepage:       http://github.com/m4dc4p/hcl/tree/master@@ -37,7 +37,6 @@   other-modules:     Spec.AndReq     Spec.Constructors-    Spec.Common     Spec.NotReq     Spec.OrReq     Spec.ReqIf

@@ -279,11 +279,13 @@   
 -}
 
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module System.Console.HCL 
 (
 -- * Request type and related functions
-  Request,
-  runRequest, execReq, reqIO, makeReq,
+  Request (..),
+  runRequest, execReq, reqIO, reqLiftMaybe, makeReq,
 -- * Request building blocks
   reqResp, reqInteger, reqInt, reqRead, reqChar, reqPassword,
 -- * Functions lifted into Requests
@@ -306,6 +308,7 @@ import System.Random
 import Data.Maybe (isNothing, isJust)
 import Control.Applicative (Alternative (..))
+import Control.Exception (catch, IOException)
 import Control.Monad (when, MonadPlus)
 import Control.Monad.Trans 
 
@@ -406,12 +409,14 @@ type. Same as @liftIO@ in "MonadIO" class (in @Control.Monad.Trans@ module) -}
 reqIO :: IO a -- ^ IO action to perform
          -> Request a -- ^ Result of the IO action, as a Request.
-reqIO io = Request ioVal
-  where
-    ioVal =
-      do
-        val <- io
-        return $ Just val
+reqIO io = Request $ catch (fmap Just io) $
+  \(_ :: IOException) -> return Nothing
+
+{- |
+Lifts a @"Maybe" a@ into a @'Request' a@. -}
+reqLiftMaybe :: Maybe a -- ^ the value to lift
+                -> Request a -- ^ the resulting 'Request'
+reqLiftMaybe = Request . return
 
 {- |
 The basic request - get a string from the user. If a newline or all whitespace

@@ -4,8 +4,6 @@ 
 import System.Console.HCL
 
-import Spec.Common
-
 tests = TestLabel "andReq" $ TestList $ map test'
   [ ( Nothing,    Nothing,    Nothing    )
   , ( Just False, Nothing,    Just False )
@@ -19,5 +17,5 @@ 
 test' (x, y, expect) = let label = show x ++ " andReq " ++ show y
   in TestLabel label $ TestCase $ do
-    val <- runRequest $ req x `andReq` req y
+    val <- runRequest $ reqLiftMaybe x `andReq` reqLiftMaybe y
     assertEqual "" val expect

@@ -1,9 +0,0 @@-module Spec.Common where--import Test.HUnit--import System.Console.HCL--req x = case x of-  Just x  -> makeReq x-  Nothing -> reqFail

@@ -4,14 +4,35 @@  import System.Console.HCL -tests = TestLabel "constructors" $ TestList [makeReqTests, reqFailTest]+tests = TestLabel "constructors" $ TestList+  [ makeReqTests+  , reqFailTest+  , reqLiftMaybeTests+  , reqIOTests+  ] -makeReqTests = TestLabel "makeReq" $ TestList $ map test' [ True, False ]+makeReqTests = TestLabel "makeReq" $ TestList $ map makeReqTest [ True, False ] -test' x = TestLabel (show x) $ TestCase $ do+makeReqTest x = TestLabel (show x) $ TestCase $ do   val <- runRequest $ makeReq x   assertEqual "" (Just x) val  reqFailTest = TestLabel "reqFail" $ TestCase $ do   val <- runRequest (reqFail :: Request ())   assertEqual "" Nothing val++reqLiftMaybeTests = TestLabel "reqMaybe" $ TestList $ map reqLiftMaybeTest+  [Nothing, Just ()]++reqLiftMaybeTest x = TestLabel (show x) $ TestCase $ do+  val <- runRequest $ reqLiftMaybe x+  assertEqual "" x val++reqIOTests = TestLabel "reqIO" $ TestList $ map reqIOTest+  [ ( "success", return (), Just () )+  , ( "failure", fail "",   Nothing )+  ]++reqIOTest (label, x, expect) = TestLabel label $ TestCase $ do+  val <- runRequest $ reqIO x+  assertEqual "" expect val

@@ -4,8 +4,6 @@ 
 import System.Console.HCL
 
-import Spec.Common
-
 tests = TestLabel "notReq" $ TestList $ map test'
   [ ( Nothing,    Nothing    )
   , ( Just False, Just True  )
@@ -14,5 +12,5 @@ 
 test' (x, expect) = let label = "notReq " ++ show x in
   TestLabel label $ TestCase $ do
-    val <- runRequest $ notReq $ req x
+    val <- runRequest $ notReq $ reqLiftMaybe x
     assertEqual "" expect val

@@ -4,8 +4,6 @@ 
 import System.Console.HCL
 
-import Spec.Common
-
 tests = TestLabel "orReq" $ TestList $ map test'
   [ ( Nothing,    Nothing,    Nothing    )
   , ( Just True,  Nothing,    Just True  )
@@ -19,5 +17,5 @@ 
 test' (x, y, expect) = let label = show x ++ " orReq " ++ show y
   in TestLabel label $ TestCase $ do
-    val <- runRequest $ req x `orReq` req y
+    val <- runRequest $ reqLiftMaybe x `orReq` reqLiftMaybe y
     assertEqual "" val expect

@@ -4,8 +4,6 @@ 
 import System.Console.HCL
 
-import Spec.Common
-
 tests = TestLabel "reqIf" $ TestList $ map test'
   [ ( Nothing,    Nothing  )
   , ( Just True,  Just 'a' )
@@ -14,5 +12,5 @@ 
 test' (x, expect) = let label = "reqIf " ++ show x in
   TestLabel label $ TestCase $ do
-    val <- runRequest $ reqIf (req x) (return 'a') (return 'b')
+    val <- runRequest $ reqIf (reqLiftMaybe x) (return 'a') (return 'b')
     assertEqual "" expect val

@@ -4,13 +4,11 @@ 
 import System.Console.HCL
 
-import Spec.Common
-
 tests = TestLabel "reqLift" $ TestList $ map test'
   [ ( Nothing, Nothing )
   , ( Just 1,  Just 2  )
   ]
 
 test' (x, expect) = TestLabel (show x) $ TestCase $ do
-  val <- runRequest $ reqLift succ $ req x
+  val <- runRequest $ reqLift succ $ reqLiftMaybe x
   assertEqual "" expect val

@@ -4,8 +4,6 @@ 
 import System.Console.HCL
 
-import Spec.Common
-
 tests = TestLabel "reqLift2" $ TestList $ map test'
   [ ( Nothing, Nothing, Nothing )
   , ( Just 1,  Nothing, Nothing )
@@ -15,5 +13,5 @@ 
 test' (x, y, expect) = let label = show x ++ " + " ++ show y in
   TestLabel label $ TestCase $ do
-    val <- runRequest $ reqLift2 (+) (req x) (req y)
+    val <- runRequest $ reqLift2 (+) (reqLiftMaybe x) (reqLiftMaybe y)
     assertEqual "" expect val