b548f8d · typeable/servant

git.iko.soy/typeable/servant

Add MonadBaseControl IO ClientM instance

commitb548f8df86396f0e33f57b3e60ff7edaf267740a authorOleg Grenrus <oleg.grenrus@iki.fi> dateMon 16 Jan 2017, 09:51 (10 years ago) parent875f592

2 files changed+24−6

compare with master

unifiedsplit

servant-client/servant-client.cabal+2 servant-client/src/Servant/Common/Req.hs+22−6

servant-client/servant-client.cabal+2

@@ -47,12 +47,14 @@ library

4747 , http-client-tls >= 0.2.2 && < 0.4

4848 , http-media >= 0.6.2 && < 0.7

4949 , http-types >= 0.8.6 && < 0.10

50+ , monad-control >= 1.0.0.4 && < 1.1

5051 , network-uri >= 2.6 && < 2.7

5152 , safe >= 0.3.9 && < 0.4

5253 , servant == 0.9.*

5354 , string-conversions >= 0.3 && < 0.5

5455 , text >= 1.2 && < 1.3

5556 , transformers >= 0.3 && < 0.6

57+ , transformers-base >= 0.4.4 && < 0.5

5658 , transformers-compat >= 0.4 && < 0.6

5759 , mtl

5860 hs-source-dirs: src

servant-client/src/Servant/Common/Req.hs+22−6

@@ -1,9 +1,11 @@

1−{-# LANGUAGE DeriveDataTypeable #-}

2−{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE CPP #-}

4−{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE ScopedTypeVariables #-}

6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DeriveDataTypeable #-}

3+{-# LANGUAGE DeriveGeneric #-}

4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

6+{-# LANGUAGE TypeFamilies #-}

7+{-# LANGUAGE OverloadedStrings #-}

8+{-# LANGUAGE ScopedTypeVariables #-}

810module Servant.Common.Req where

911

@@ -24,8 +26,10 @@ import Control.Monad.Trans.Except

2426

2527

2628import GHC.Generics

29+import Control.Monad.Base (MonadBase (..))

2730import Control.Monad.IO.Class ()

2831import Control.Monad.Reader

32+import Control.Monad.Trans.Control (MonadBaseControl (..))

2933import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)

3034import Data.String

3135import Data.String.Conversions

@@ -180,6 +184,18 @@ newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantE

180184 , MonadThrow, MonadCatch

181185 )

182186

187+instance MonadBase IO ClientM where

188+ liftBase = ClientM . liftBase

189+

190+instance MonadBaseControl IO ClientM where

191+ type StM ClientM a = Either ServantError a

192+

193+ -- liftBaseWith :: (RunInBase ClientM IO -> IO a) -> ClientM a

194+ liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))

195+

196+ -- restoreM :: StM ClientM a -> ClientM a

197+ restoreM st = ClientM (restoreM st)

198+

183199runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)

184200runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

185201