LGTM
On Fri, Aug 22, 2014 at 2:16 PM, Niklas Hambuechen <[email protected]> wrote: > So that exceptions can be caught in the `RpcClientMonad`. > > Signed-off-by: Niklas Hambuechen <[email protected]> > --- > src/Ganeti/THH/HsRPC.hs | 11 ++++++++++- > 1 file changed, 10 insertions(+), 1 deletion(-) > > diff --git a/src/Ganeti/THH/HsRPC.hs b/src/Ganeti/THH/HsRPC.hs > index 1198e37..751ebfb 100644 > --- a/src/Ganeti/THH/HsRPC.hs > +++ b/src/Ganeti/THH/HsRPC.hs > @@ -1,4 +1,5 @@ > -{-# LANGUAGE TemplateHaskell, FunctionalDependencies, FlexibleContexts #-} > +{-# LANGUAGE TemplateHaskell, FunctionalDependencies, FlexibleContexts, > + TypeFamilies #-} > -- {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} > > {-| Creates a client out of list of RPC server components. > @@ -38,6 +39,7 @@ import Control.Monad > import Control.Monad.Base > import Control.Monad.Error > import Control.Monad.Reader > +import Control.Monad.Trans.Control > import Language.Haskell.TH > import qualified Text.JSON as J > > @@ -70,6 +72,13 @@ instance Monad RpcClientMonad where > instance MonadBase IO RpcClientMonad where > liftBase = RpcClientMonad . liftBase > > +instance MonadBaseControl IO RpcClientMonad where > + newtype StM RpcClientMonad b = StMRpcClientMonad > + { runStMRpcClientMonad :: StM (ReaderT Client ResultG) b } > + liftBaseWith f = RpcClientMonad . liftBaseWith > + $ \r -> f (liftM StMRpcClientMonad . r . > runRpcClientMonad) > + restoreM = RpcClientMonad . restoreM . runStMRpcClientMonad > + > instance MonadIO RpcClientMonad where > liftIO = RpcClientMonad . liftIO > > -- > 2.1.0.rc2.206.gedb03e5 > >
