{- |
Module      :  ./Common/ResultT.hs
Description :  ResultT type and a monadic transformer instance
Copyright   :  (c) T. Mossakowski, C. Maeder, Uni Bremen 2006
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

'ResultT' type and a monadic transformer instance
-}

module Common.ResultT where

import Common.Result
import Control.Applicative ()
import Control.Monad
import qualified Control.Monad.Fail as MFail
import Control.Monad.Trans

newtype ResultT m a = ResultT { ResultT m a -> m (Result a)
runResultT :: m (Result a) }

instance Monad m => Functor (ResultT m) where
    fmap :: (a -> b) -> ResultT m a -> ResultT m b
fmap f :: a -> b
f m :: ResultT m a
m = m (Result b) -> ResultT m b
forall (m :: * -> *) a. m (Result a) -> ResultT m a
ResultT (m (Result b) -> ResultT m b) -> m (Result b) -> ResultT m b
forall a b. (a -> b) -> a -> b
$ do
        Result a
r <- ResultT m a -> m (Result a)
forall (m :: * -> *) a. ResultT m a -> m (Result a)
runResultT ResultT m a
m
        Result b -> m (Result b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result b -> m (Result b)) -> Result b -> m (Result b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Result a
r

instance Monad m => Applicative (ResultT m) where
    pure :: a -> ResultT m a
pure = a -> ResultT m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: ResultT m (a -> b) -> ResultT m a -> ResultT m b
(<*>) = ResultT m (a -> b) -> ResultT m a -> ResultT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (ResultT m) where
    return :: a -> ResultT m a
return = m (Result a) -> ResultT m a
forall (m :: * -> *) a. m (Result a) -> ResultT m a
ResultT (m (Result a) -> ResultT m a)
-> (a -> m (Result a)) -> a -> ResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a -> m (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> m (Result a)) -> (a -> Result a) -> a -> m (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return
    m :: ResultT m a
m >>= :: ResultT m a -> (a -> ResultT m b) -> ResultT m b
>>= k :: a -> ResultT m b
k = m (Result b) -> ResultT m b
forall (m :: * -> *) a. m (Result a) -> ResultT m a
ResultT (m (Result b) -> ResultT m b) -> m (Result b) -> ResultT m b
forall a b. (a -> b) -> a -> b
$ do
        r :: Result a
r@(Result e :: [Diagnosis]
e v :: Maybe a
v) <- ResultT m a -> m (Result a)
forall (m :: * -> *) a. ResultT m a -> m (Result a)
runResultT ResultT m a
m
        case Maybe a
v of
          Nothing -> Result b -> m (Result b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result b -> m (Result b)) -> Result b -> m (Result b)
forall a b. (a -> b) -> a -> b
$ [Diagnosis] -> Maybe b -> Result b
forall a. [Diagnosis] -> Maybe a -> Result a
Result [Diagnosis]
e Maybe b
forall a. Maybe a
Nothing
          Just a :: a
a -> do
                Result b
s <- ResultT m b -> m (Result b)
forall (m :: * -> *) a. ResultT m a -> m (Result a)
runResultT (ResultT m b -> m (Result b)) -> ResultT m b -> m (Result b)
forall a b. (a -> b) -> a -> b
$ a -> ResultT m b
k a
a
                Result b -> m (Result b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result b -> m (Result b)) -> Result b -> m (Result b)
forall a b. (a -> b) -> a -> b
$ Result a -> Result b -> Result b
forall a b. Result a -> Result b -> Result b
joinResult Result a
r Result b
s

instance Monad m => MFail.MonadFail (ResultT m) where
  fail :: String -> ResultT m a
fail = m (Result a) -> ResultT m a
forall (m :: * -> *) a. m (Result a) -> ResultT m a
ResultT (m (Result a) -> ResultT m a)
-> (String -> m (Result a)) -> String -> ResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a -> m (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> m (Result a))
-> (String -> Result a) -> String -> m (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

instance MonadTrans ResultT where
    lift :: m a -> ResultT m a
lift m :: m a
m = m (Result a) -> ResultT m a
forall (m :: * -> *) a. m (Result a) -> ResultT m a
ResultT (m (Result a) -> ResultT m a) -> m (Result a) -> ResultT m a
forall a b. (a -> b) -> a -> b
$ do
        a
a <- m a
m
        Result a -> m (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> m (Result a)) -> Result a -> m (Result a)
forall a b. (a -> b) -> a -> b
$ a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Inspired by the MonadIO-class
class Monad m => MonadResult m where
    liftR :: Result a -> m a

instance Monad m => MonadResult (ResultT m) where
    liftR :: Result a -> ResultT m a
liftR = m (Result a) -> ResultT m a
forall (m :: * -> *) a. m (Result a) -> ResultT m a
ResultT (m (Result a) -> ResultT m a)
-> (Result a -> m (Result a)) -> Result a -> ResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a -> m (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return

instance MonadIO m => MonadIO (ResultT m) where
    liftIO :: IO a -> ResultT m a
liftIO = m (Result a) -> ResultT m a
forall (m :: * -> *) a. m (Result a) -> ResultT m a
ResultT (m (Result a) -> ResultT m a)
-> (IO a -> m (Result a)) -> IO a -> ResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result a) -> m a -> m (Result a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return (m a -> m (Result a)) -> (IO a -> m a) -> IO a -> m (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO