added mtl workaround and instances for Generics and HasHttpManager
This commit is contained in:
parent
0b861b7fe3
commit
7b57b98368
1 changed files with 17 additions and 5 deletions
|
@ -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
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in a new issue