added mtl workaround and instances for Generics and HasHttpManager

This commit is contained in:
Christian Klinger 2016-09-06 13:11:01 +02:00
parent 0b861b7fe3
commit 7b57b98368

View file

@ -1,4 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -12,7 +13,15 @@ import Control.Applicative
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.Catch (MonadThrow) import Control.Monad.Catch (MonadThrow)
import Control.Monad.Except
#if MIN_VERSION_mtl(2,2,0)
import Control.Monad.Except (MonadError(..))
#else
import Control.Monad.Error.Class (MonadError(..))
#endif
import Control.Monad.Trans.Except
import GHC.Generics
import Control.Monad.IO.Class () import Control.Monad.IO.Class ()
import Control.Monad.Reader import Control.Monad.Reader
import Data.ByteString.Lazy hiding (pack, filter, map, null, elem) import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
@ -152,17 +161,20 @@ parseRequest url = liftM disableStatusCheck (parseUrl url)
displayHttpRequest :: Method -> String displayHttpRequest :: Method -> String
displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request" displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
-- previously:
--type ClientM = ExceptT ServantError IO
data ClientEnv data ClientEnv
= ClientEnv = ClientEnv
{ manager :: Manager { manager :: Manager
, baseUrl :: BaseUrl , baseUrl :: BaseUrl
} }
instance HasHttpManager ClientEnv where
getHttpManager = manager
-- | @ClientM@ is the monad in which client functions run. Contains the
-- 'Manager' and 'BaseUrl' used for requests in the reader environment.
newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a } newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }
deriving ( Functor, Applicative, Monad, MonadIO deriving ( Functor, Applicative, Monad, MonadIO, Generic
, MonadReader ClientEnv , MonadReader ClientEnv
, MonadError ServantError , MonadError ServantError
) )