eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add MonadBaseControl IO ClientM instance

Browse source
This commit is contained in:
Oleg Grenrus 2017-01-16 09:51:27 +02:00
parent 875f5921fc
commit b548f8df86
2 changed files with 24 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant-client/servant-client.cabal
View file

@ -47,12 +47,14 @@ library
, http-client-tls >= 0.2.2 && < 0.4 , http-client-tls >= 0.2.2 && < 0.4
, http-media >= 0.6.2 && < 0.7 , http-media >= 0.6.2 && < 0.7
, http-types >= 0.8.6 && < 0.10 , http-types >= 0.8.6 && < 0.10
, monad-control >= 1.0.0.4 && < 1.1
, network-uri >= 2.6 && < 2.7 , network-uri >= 2.6 && < 2.7
, safe >= 0.3.9 && < 0.4 , safe >= 0.3.9 && < 0.4
, servant == 0.9.* , servant == 0.9.*
, string-conversions >= 0.3 && < 0.5 , string-conversions >= 0.3 && < 0.5
, text >= 1.2 && < 1.3 , text >= 1.2 && < 1.3
, transformers >= 0.3 && < 0.6 , transformers >= 0.3 && < 0.6
, transformers-base >= 0.4.4 && < 0.5
, transformers-compat >= 0.4 && < 0.6 , transformers-compat >= 0.4 && < 0.6
, mtl , mtl
hs-source-dirs: src hs-source-dirs: src

28
servant-client/src/Servant/Common/Req.hs
View file

@ -1,9 +1,11 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Servant.Common.Req where module Servant.Common.Req where
@ -24,8 +26,10 @@ import Control.Monad.Trans.Except
import GHC.Generics import GHC.Generics
import Control.Monad.Base (MonadBase (..))
import Control.Monad.IO.Class () import Control.Monad.IO.Class ()
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Control (MonadBaseControl (..))
import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any) import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
import Data.String import Data.String
import Data.String.Conversions import Data.String.Conversions
@ -180,6 +184,18 @@ newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantE
, MonadThrow, MonadCatch , MonadThrow, MonadCatch
) )
instance MonadBase IO ClientM where
liftBase = ClientM . liftBase
instance MonadBaseControl IO ClientM where
type StM ClientM a = Either ServantError a
-- liftBaseWith :: (RunInBase ClientM IO -> IO a) -> ClientM a
liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))
-- restoreM :: StM ClientM a -> ClientM a
restoreM st = ClientM (restoreM st)
runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a) runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm