From b5fe333cefd952ac5de5530ad293c588640ce9aa Mon Sep 17 00:00:00 2001 From: Lyndon Maydwell Date: Thu, 19 Jan 2017 16:38:45 +1100 Subject: [PATCH] Alternative instance for ClientM --- servant-client/src/Servant/Common/Req.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index 3fb8c5aa..a57e28e8 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -21,6 +21,8 @@ import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Trans.Except import GHC.Generics +import Data.Monoid +import Control.Applicative import Control.Monad.Base (MonadBase (..)) import Control.Monad.IO.Class () import Control.Monad.Reader @@ -83,6 +85,10 @@ instance Eq ServantError where instance Exception ServantError +instance Monoid ServantError where -- Outlaw Implementation + mempty = ConnectionError (SomeException (AssertionFailed "Empty")) + mappend a b = b + data Req = Req { reqPath :: String , qs :: QueryText @@ -214,6 +220,11 @@ instance MonadBaseControl IO ClientM where -- restoreM :: StM ClientM a -> ClientM a 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 cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm