Merge pull request #665 from phadej/client-monad-control

Add MonadBaseControl IO ClientM instance
This commit is contained in:
Oleg Grenrus 2017-01-16 10:25:35 +02:00 committed by GitHub
commit cfaa7a06be
5 changed files with 40 additions and 6 deletions

View file

@ -1,3 +1,12 @@
0.10
----
* Add MonadBase and MonadBaseControl instances for ClientM
([#663](https://github.com/haskell-servant/servant/issues/663))
* client asks for any content-type in Accept contentTypes non-empty list
([#615](https://github.com/haskell-servant/servant/pull/615))
0.9.1.1
-------

View file

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

View file

@ -1,9 +1,11 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Servant.Common.Req where
@ -24,8 +26,10 @@ import Control.Monad.Trans.Except
import GHC.Generics
import Control.Monad.Base (MonadBase (..))
import Control.Monad.IO.Class ()
import Control.Monad.Reader
import Control.Monad.Trans.Control (MonadBaseControl (..))
import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
import Data.String
import Data.String.Conversions
@ -203,6 +207,18 @@ newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantE
, 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 cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

View file

@ -1,3 +1,9 @@
0.10
----
* Add `err422` Unprocessable Entity
([#646](https://github.com/haskell-servant/servant/pull/646))
0.7.1
------

View file

@ -2,6 +2,7 @@
------
* Use `NT` from `natural-transformation` for `Enter`
([#616](https://github.com/haskell-servant/servant/issues/616))
0.9.1
------