@@ -1,9 +1,11 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE CPP #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE ScopedTypeVariables #-}
79
810module Servant.Common.Req where
911
@@ -24,8 +26,10 @@ import Control.Monad.Trans.Except
2426
2527
2628import GHC.Generics
29+import Control.Monad.Base (MonadBase (..))
2730import Control.Monad.IO.Class ()
2831import Control.Monad.Reader
32+import Control.Monad.Trans.Control (MonadBaseControl (..))
2933import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
3034import Data.String
3135import Data.String.Conversions
@@ -203,6 +207,18 @@ newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantE
203207 , MonadThrow, MonadCatch
204208 )
205209
210+instance MonadBase IO ClientM where
211+ liftBase = ClientM . liftBase
212+
213+instance MonadBaseControl IO ClientM where
214+ type StM ClientM a = Either ServantError a
215+
216+ -- liftBaseWith :: (RunInBase ClientM IO -> IO a) -> ClientM a
217+ liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))
218+
219+ -- restoreM :: StM ClientM a -> ClientM a
220+ restoreM st = ClientM (restoreM st)
221+
206222runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
207223runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
208224