Create ResulT for monad transformations

This patch creates ResultT, a monad transformation used later in
RPC <-> query integration.

Signed-off-by: Agata Murawska <agatamurawska@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>

diff --git a/htools/Ganeti/BasicTypes.hs b/htools/Ganeti/BasicTypes.hs
index 61a7e56..f4bb9a6 100644 (file)
--- a/htools/Ganeti/BasicTypes.hs
+++ b/htools/Ganeti/BasicTypes.hs
@@ -21,6 +21,8 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Ganeti.BasicTypes
   ( Result(..)
+  , ResultT(..)
+  , resultT
   , isOk
   , isBad
   , eitherToResult
@@ -38,6 +40,7 @@ module Ganeti.BasicTypes
 
 import Control.Applicative
 import Control.Monad
+import Control.Monad.Trans
 import Data.Function
 import Data.List
 
@@ -75,6 +78,29 @@ instance Applicative Result where
   _       <*> (Bad x) = Bad x
   (Ok f)  <*> (Ok x)  = Ok $ f x
 
+-- | This is a monad transformation for Result. It's implementation is
+-- based on the implementations of MaybeT and ErrorT.
+newtype ResultT m a = ResultT {runResultT :: m (Result a)}
+
+instance (Monad m) => Monad (ResultT m) where
+  fail err = ResultT (return $ Bad err)
+  return = lift . return
+  x >>= f = ResultT $ do
+              a <- runResultT x
+              case a of
+                Ok val -> runResultT $ f val
+                Bad err -> return $ Bad err
+
+instance MonadTrans ResultT where
+  lift x = ResultT (liftM Ok x)
+
+instance (MonadIO m) => MonadIO (ResultT m) where
+  liftIO = lift . liftIO
+
+-- | Lift a `Result` value to a `ResultT`.
+resultT :: Monad m => Result a -> ResultT m a
+resultT = ResultT . return
+
 -- | Simple checker for whether a 'Result' is OK.
 isOk :: Result a -> Bool
 isOk (Ok _) = True