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

Alternative instance for ClientM

Browse source
This commit is contained in:
Lyndon Maydwell 2017-01-19 16:38:45 +11:00
parent 484bc9cb64
commit b5fe333cef
1 changed files with 11 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -21,6 +21,8 @@ import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
import GHC.Generics import GHC.Generics
import Data.Monoid
import Control.Applicative
import Control.Monad.Base (MonadBase (..)) import Control.Monad.Base (MonadBase (..))
import Control.Monad.IO.Class () import Control.Monad.IO.Class ()
import Control.Monad.Reader import Control.Monad.Reader
@ -83,6 +85,10 @@ instance Eq ServantError where
instance Exception ServantError instance Exception ServantError
instance Monoid ServantError where -- Outlaw Implementation
mempty = ConnectionError (SomeException (AssertionFailed "Empty"))
mappend a b = b
data Req = Req data Req = Req
{ reqPath :: String { reqPath :: String
, qs :: QueryText , qs :: QueryText
@ -214,6 +220,11 @@ instance MonadBaseControl IO ClientM where
-- restoreM :: StM ClientM a -> ClientM a -- restoreM :: StM ClientM a -> ClientM a
restoreM st = ClientM (restoreM st) restoreM st = ClientM (restoreM st)
-- Should we really have this exception as the empty case? Who knows!
instance Alternative ClientM where
empty = throwError (ConnectionError (SomeException (AssertionFailed "Empty")))
(ClientM x) <|> (ClientM y) = ClientM (x <|> y)
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