5d75bd0 · typeable/req

git.iko.soy/typeable/req

on master help sign in

Add a way to avoid orphans (#26)

5d75bd0Mark Karpov9 years ago

CHANGELOG.md+5

compare with master

unifiedsplit

@@ -1,3 +1,8 @@

1+## Req 0.4.0

3+* Added the `Req` monad and `runReq` function to run it. This allows to use

4+ `req` without defining new (orphan) instances.

1## Req 0.3.1

6## Req 0.3.1

3* Added `basicAuthUnsafe`.

8* Added `basicAuthUnsafe`.

Network/HTTP/Req.hs+42

@@ -95,6 +95,7 @@

95{-# LANGUAGE FlexibleInstances #-}

96{-# LANGUAGE GeneralizedNewtypeDeriving #-}

97{-# LANGUAGE KindSignatures #-}

98+{-# LANGUAGE MultiParamTypeClasses #-}

98{-# LANGUAGE OverloadedStrings #-}

99{-# LANGUAGE OverloadedStrings #-}

99{-# LANGUAGE RankNTypes #-}

100{-# LANGUAGE RankNTypes #-}

100{-# LANGUAGE RecordWildCards #-}

101{-# LANGUAGE RecordWildCards #-}

@@ -123,6 +124,8 @@ module Network.HTTP.Req

123 -- $embedding-requests

124 -- $embedding-requests

124 , MonadHttp (..)

125 , MonadHttp (..)

125 , HttpConfig (..)

126 , HttpConfig (..)

127+ , Req

128+ , runReq

126 -- * Request

129 -- * Request

127 -- ** Method

130 -- ** Method

128 -- $method

131 -- $method

@@ -213,7 +216,10 @@ import Control.Applicative

213import Control.Arrow (first, second)

216import Control.Arrow (first, second)

214import Control.Exception (Exception, try, handle, throwIO)

217import Control.Exception (Exception, try, handle, throwIO)

215import Control.Monad

218import Control.Monad

219+import Control.Monad.Base

216import Control.Monad.IO.Class

220import Control.Monad.IO.Class

221+import Control.Monad.Reader

222+import Control.Monad.Trans.Control

217import Control.Retry

223import Control.Retry

218import Data.Aeson (ToJSON (..), FromJSON (..))

224import Data.Aeson (ToJSON (..), FromJSON (..))

219import Data.ByteString (ByteString)

225import Data.ByteString (ByteString)

@@ -582,6 +588,42 @@ instance RequestComponent HttpConfig where

582 , L.redirectCount = httpConfigRedirectCount

588 , L.redirectCount = httpConfigRedirectCount

583 , LI.requestManagerOverride = httpConfigAltManager }

589 , LI.requestManagerOverride = httpConfigAltManager }

584

590

591+-- | A monad that allows to run 'req' in any 'IO'-enabled monad without

592+-- having to define new instances.

593+--

594+-- @since 0.4.0

595+

596+newtype Req a = Req (ReaderT HttpConfig IO a)

597+ deriving ( Functor

598+ , Applicative

599+ , Monad

600+ , MonadIO )

601+

602+instance MonadBase IO Req where

603+ liftBase = liftIO

604+

605+instance MonadBaseControl IO Req where

606+ type StM Req a = a

607+ liftBaseWith f = Req . ReaderT $ \r -> f (runReq r)

608+ {-# INLINEABLE liftBaseWith #-}

609+ restoreM = Req . ReaderT . const . return

610+ {-# INLINEABLE restoreM #-}

611+

612+instance MonadHttp Req where

613+ handleHttpException = Req . lift . throwIO

614+ getHttpConfig = Req ask

615+

616+-- | Run a computation in the 'Req' monad with the given 'HttpConfig'. In

617+-- case of exceptional situation an 'HttpException' will be thrown.

618+--

619+-- @since 0.4.0

620+

621+runReq :: MonadIO m

622+ => HttpConfig -- ^ 'HttpConfig' to use

623+ -> Req a -- ^ Computation to run

624+ -> m a

625+runReq config (Req m) = liftIO (runReaderT m config)

626+

585----------------------------------------------------------------------------

627----------------------------------------------------------------------------

586-- Request—Method

628-- Request—Method

587

629

httpbin-tests/Network/HTTP/ReqSpec.hs+27−10

@@ -9,8 +9,9 @@ module Network.HTTP.ReqSpec

9 ( spec )

10where

12−import Control.Exception (throwIO)

12+import Control.Exception

13import Control.Monad.Reader

14+import Control.Monad.Trans.Control

14import Data.Aeson (Value (..), ToJSON (..), object, (.=))

15import Data.Aeson (Value (..), ToJSON (..), object, (.=))

15import Data.Default.Class

16import Data.Default.Class

16import Data.IORef

17import Data.IORef

@@ -41,16 +42,17 @@ import Data.Word (Word)

41spec :: Spec

42spec :: Spec

42spec = do

43spec = do

44− describe "exception throwing on non 2xx-status codes" $

45+ describe "exception throwing on non-2xx status codes" $

45− it "throws indeed for non-2xx" $ do

46+ it "throws indeed for non-2xx" $

46− let selector :: HttpException -> Bool

47− selector (VanillaHttpException

48− (L.HttpExceptionRequest _

49− (L.StatusCodeException response chunk))) =

50− L.responseStatus response == Y.status404 && not (B.null chunk)

51− selector _ = False

52 req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty

47 req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty

53− `shouldThrow` selector

48+ `shouldThrow` selector404

49+

50+ describe "exception throwing on non-2xx status codes (Req monad)" $

51+ it "throws indeed for non-2xx" $

52+ asIO . runReq def $

53+ liftBaseWith $ \run ->

54+ run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)

55+ `shouldThrow` selector404

55 describe "response check via httpConfigCheckResponse" $

57 describe "response check via httpConfigCheckResponse" $

56 context "if it's set to always throw" $

58 context "if it's set to always throw" $

@@ -401,6 +403,15 @@ checkStatusCode code =

401 NoReqBody ignoreResponse mempty

403 NoReqBody ignoreResponse mempty

402 responseStatusCode r `shouldBe` code

404 responseStatusCode r `shouldBe` code

403

405

406+-- | Exception selector that selects only 404 “Not found” exceptions.

407+

408+selector404 :: HttpException -> Bool

409+selector404 (VanillaHttpException

410+ (L.HttpExceptionRequest _

411+ (L.StatusCodeException response chunk))) =

412+ L.responseStatus response == Y.status404 && not (B.null chunk)

413+selector404 _ = False

414+

404-- | Empty JSON 'Object'.

415-- | Empty JSON 'Object'.

405

416

406emptyObject :: Value

417emptyObject :: Value

@@ -410,3 +421,9 @@ emptyObject = Object HM.empty

410

421

411reflectJSON :: ToJSON a => a -> Text

422reflectJSON :: ToJSON a => a -> Text

412reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode

423reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode

424+

425+-- | Clarify to the type checker that the inner computation is in the 'IO'

426+-- monad.

427+

428+asIO :: IO a -> IO a

429+asIO = id

req.cabal+3

@@ -39,11 +39,13 @@ library

39 , http-client >= 0.5 && < 0.6

40 , http-client-tls >= 0.3.2 && < 0.4

41 , http-types >= 0.8 && < 10.0

42+ , monad-control >= 1.0 && < 1.1

42 , mtl >= 2.0 && < 3.0

43 , mtl >= 2.0 && < 3.0

43 , retry >= 0.7 && < 0.8

44 , retry >= 0.7 && < 0.8

44 , text >= 0.2 && < 1.3

45 , text >= 0.2 && < 1.3

45 , time >= 1.2 && < 1.9

46 , time >= 1.2 && < 1.9

46 , transformers >= 0.4 && < 0.6

47 , transformers >= 0.4 && < 0.6

48+ , transformers-base

47 if !impl(ghc >= 8.0)

49 if !impl(ghc >= 8.0)

48 build-depends: semigroups == 0.18.*

50 build-depends: semigroups == 0.18.*

49 exposed-modules: Network.HTTP.Req

51 exposed-modules: Network.HTTP.Req

@@ -92,6 +94,7 @@ test-suite httpbin-tests

92 , hspec >= 2.0 && < 3.0

94 , hspec >= 2.0 && < 3.0

93 , http-client >= 0.5 && < 0.6

95 , http-client >= 0.5 && < 0.6

94 , http-types >= 0.8 && < 10.0

96 , http-types >= 0.8 && < 10.0

97+ , monad-control >= 1.0 && < 1.1

95 , mtl >= 2.0 && < 3.0

98 , mtl >= 2.0 && < 3.0

96 , req

99 , req

97 , retry >= 0.7 && < 0.8

100 , retry >= 0.7 && < 0.8