Commit d5868411 authored by Petr Pudlak's avatar Petr Pudlak

Add instances of MonadBase and MonadControl for ResultT

This allows to use lifted operations like 'fork' or 'bracket' inside
ResultT.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent b172b0ab
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{- {-
...@@ -58,8 +61,10 @@ module Ganeti.BasicTypes ...@@ -58,8 +61,10 @@ module Ganeti.BasicTypes
import Control.Applicative import Control.Applicative
import Control.Exception (try) import Control.Exception (try)
import Control.Monad import Control.Monad
import Control.Monad.Base
import Control.Monad.Error.Class import Control.Monad.Error.Class
import Control.Monad.Trans import Control.Monad.Trans
import Control.Monad.Trans.Control
import Data.Function import Data.Function
import Data.List import Data.List
import Data.Maybe import Data.Maybe
...@@ -171,6 +176,27 @@ instance (MonadIO m, Error a) => MonadIO (ResultT a m) where ...@@ -171,6 +176,27 @@ instance (MonadIO m, Error a) => MonadIO (ResultT a m) where
. liftM (either (failError . show) return) . liftM (either (failError . show) return)
. (try :: IO a -> IO (Either IOError a)) . (try :: IO a -> IO (Either IOError a))
instance (MonadBase IO m, Error a) => MonadBase IO (ResultT a m) where
liftBase = ResultT . liftBase
. liftM (either (failError . show) return)
. (try :: IO a -> IO (Either IOError a))
instance (Error a) => MonadTransControl (ResultT a) where
newtype StT (ResultT a) b = StResultT { runStResultT :: GenericResult a b }
liftWith f = ResultT . liftM return $ f (liftM StResultT . runResultT)
restoreT = ResultT . liftM runStResultT
{-# INLINE liftWith #-}
{-# INLINE restoreT #-}
instance (Error a, MonadBaseControl IO m)
=> MonadBaseControl IO (ResultT a m) where
newtype StM (ResultT a m) b
= StMResultT { runStMResultT :: ComposeSt (ResultT a) m b }
liftBaseWith = defaultLiftBaseWith StMResultT
restoreM = defaultRestoreM runStMResultT
{-# INLINE liftBaseWith #-}
{-# INLINE restoreM #-}
instance (Monad m, Error a, Monoid a) => MonadPlus (ResultT a m) where instance (Monad m, Error a, Monoid a) => MonadPlus (ResultT a m) where
mzero = ResultT $ return mzero mzero = ResultT $ return mzero
-- Ensure that 'y' isn't run if 'x' contains a value. This makes it a bit -- Ensure that 'y' isn't run if 'x' contains a value. This makes it a bit
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment