libjenkins 0.4.0.0 → 0.4.1.0
raw patch · 6 files changed
+102/−21 lines, 6 filesdep +hspec-expectations-lens
Dependencies added: hspec-expectations-lens
Files
- CHANGELOG.md +7/−0
- README.md +2/−2
- libjenkins.cabal +4/−2
- src/Jenkins/Rest.hs +37/−10
- src/Jenkins/Rest/Internal.hs +20/−7
- test/Jenkins/Rest/InternalSpec.hs +32/−0
CHANGELOG.md view
@@ -1,3 +1,10 @@+0.4.1.0+=======++ * Generalize `io`++ * Add `runJenkinsThrowing`+ 0.4.0.0 =======
README.md view
@@ -1,5 +1,5 @@ libjenkins ==========-[](http://hackage.haskell.org/package/libjenkins)+[](https://hackage.haskell.org/package/libjenkins) [](https://drone.io/github.com/supki/libjenkins/latest)-[](http://travis-ci.org/supki/libjenkins)+[](https://travis-ci.org/supki/libjenkins)
libjenkins.cabal view
@@ -1,5 +1,5 @@ name: libjenkins-version: 0.4.0.0+version: 0.4.1.0 synopsis: Jenkins API interface description: Jenkins API interface. It supports REST and Discovery APIs license: BSD3@@ -26,7 +26,7 @@ source-repository this type: git location: https://github.com/supki/libjenkins- tag: 0.4.0.0+ tag: 0.4.1.0 library default-language: Haskell2010@@ -74,6 +74,7 @@ , conduit , free , hspec+ , hspec-expectations-lens , http-client , http-conduit , http-types@@ -89,5 +90,6 @@ main-is: Spec.hs other-modules: Jenkins.RestSpec+ Jenkins.Rest.InternalSpec cpp-options: -DTEST
src/Jenkins/Rest.hs view
@@ -4,18 +4,41 @@ -- | Jenkins REST API interface module Jenkins.Rest ( -- * Query Jenkins- runJenkins, ConnectInfo(..), defaultConnectInfo, Jenkins, Result(..)+ Jenkins+ , ConnectInfo(..)+ , defaultConnectInfo+ , Result(..)+ , runJenkins+ , runJenkinsThrowing -- ** Combinators- , get, post, post_, concurrently, io, disconnect, with+ , get+ , post+ , post_+ , concurrently+ , io+ , disconnect+ , with -- ** Method , module Jenkins.Rest.Method -- ** Convenience- , postXML, concurrentlys, concurrentlys_, reload, restart, forceRestart- -- * Lensy things- , jenkinsUrl, jenkinsPort, jenkinsUser, jenkinsApiToken, jenkinsPassword- , _Error, _Disconnect, _Result- -- * Type reexports- , Request, HttpException+ , postXML+ , concurrentlys+ , concurrentlys_+ , reload+ , restart+ , forceRestart+ -- * Optics+ , jenkinsUrl+ , jenkinsPort+ , jenkinsUser+ , jenkinsApiToken+ , jenkinsPassword+ , _Error+ , _Disconnect+ , _Result+ -- * Reexports+ , Request+ , HttpException ) where import Control.Applicative ((<$))@@ -55,8 +78,12 @@ concurrently ja jb = liftJ $ Conc ja jb (,) {-# INLINE concurrently #-} --- | Lift arbitrary 'IO' action-io :: IO a -> Jenkins a+-- | Lift an arbitrary 'IO' action to the 'Jenkins' monad+--+-- @+-- io :: 'IO' a -> 'Jenkins' a+-- @+io :: MonadIO m => IO a -> m a io = liftIO {-# INLINE io #-}
src/Jenkins/Rest/Internal.hs view
@@ -89,19 +89,32 @@ -- If 'HttpException' was thrown by @http-conduit@, 'runJenkins' catches it -- and wraps in 'Error'. Other exceptions are /not/ catched runJenkins :: ConnectInfo -> Jenkins a -> IO (Result HttpException a)-runJenkins (ConnectInfo h p user token) jenk =- fmap result . try . withManager $ \manager -> do+runJenkins conn jenk = either Error (maybe Disconnect Result) <$> try (runJenkinsInternal conn jenk)++-- | Query Jenkins API using 'Jenkins' description+--+-- Successful result is either 'Disconnect' or @ 'Result' v @+--+-- No exceptions are catched, i.e.+--+-- @+-- runJenkinsThrowing :: 'ConnectInfo' -> 'Jenkins' a -> 'IO' ('Result' 'Void' a)+-- @+--+-- is perfectly fine—'Result' won't ever be an 'Error'+runJenkinsThrowing :: ConnectInfo -> Jenkins a -> IO (Result e a)+runJenkinsThrowing conn jenk = maybe Disconnect Result <$> runJenkinsInternal conn jenk++runJenkinsInternal :: ConnectInfo -> Jenkins a -> IO (Maybe a)+runJenkinsInternal (ConnectInfo h p user token) jenk =+ withManager $ \manager -> do req <- liftIO $ parseUrl h let req' = req & Lens.port .~ p & Lens.responseTimeout .~ Just (20 * 1000000) & applyBasicAuth (Text.encodeUtf8 user) (Text.encodeUtf8 token) runReaderT (runMaybeT (iterJenkinsIO manager jenk)) req'- where- result :: Either e (Maybe v) -> Result e v- result (Left e) = Error e- result (Right Nothing) = Disconnect- result (Right (Just val)) = Result val+ -- | A prism into Jenkins error _Error :: Prism (Result e a) (Result e' a) e e'
+ test/Jenkins/Rest/InternalSpec.hs view
@@ -0,0 +1,32 @@+module Jenkins.Rest.InternalSpec (spec) where++import Control.Exception (throwIO)+import Control.Exception.Lens (throwingM, _IOException)+import Control.Monad.IO.Class (liftIO)+import Test.Hspec.Lens+import System.IO.Error+import System.IO.Error.Lens (errorType, _NoSuchThing)++import Jenkins.Rest.Internal+import Network.HTTP.Conduit.Lens (_TooManyRetries)+++spec :: Spec+spec = do+ let raiseHttp, raiseIO :: Jenkins a+ raiseHttp = liftIO (throwingM _TooManyRetries ())+ raiseIO = liftIO (throwIO (mkIOError doesNotExistErrorType "foo" Nothing Nothing))++ describe "runJenkins" $ do+ it "catches 'HttpException' exceptions" $+ runJenkins defaultConnectInfo raiseHttp `shouldPerform` () `through` _Error._TooManyRetries++ it "does not catch 'IOException' exceptions" $+ runJenkins defaultConnectInfo raiseIO `shouldThrow` _IOException.errorType._NoSuchThing++ describe "runJenkinsThrowing" $ do+ it "does not catch 'HttpException' exceptions" $+ runJenkinsThrowing defaultConnectInfo raiseHttp `shouldThrow` _TooManyRetries++ it "does not catch 'IOException' exceptions" $+ runJenkinsThrowing defaultConnectInfo raiseIO `shouldThrow` _IOException.errorType._NoSuchThing