Synnefo » snf-ganeti

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE MultiParamTypeClasses #-}

{-# LANGUAGE TypeFamilies #-}

import Control.Monad.Base

import Control.Monad.Trans.Control

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 #-}