From d71fbcc57d3553efbd49d8ca5d42bc041fa438a1 Mon Sep 17 00:00:00 2001
From: Agata Murawska <agatamurawska@google.com>
Date: Fri, 21 Sep 2012 10:44:07 +0200
Subject: [PATCH] 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>
---
htools/Ganeti/BasicTypes.hs | 26 ++++++++++++++++++++++++++
1 file changed, 26 insertions(+)
diff --git a/htools/Ganeti/BasicTypes.hs b/htools/Ganeti/BasicTypes.hs
index 61a7e566f..f4bb9a6fc 100644
--- 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
--
GitLab