-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad
-- Copyright   :  Ross Meikleham
-- License     :  BSD-style 
-- 
-- Maintainer  :  RossMeikleham@hotmail.co.uk
-- Stability   :  provisional
-- Portability :  portable
--
-- The Tainted type, and associated operations.
-----------------------------------------------------------------------------

module Control.Monad.Trans.Tainted(TaintedT(..), hoistTainted)

where

import Control.Monad
import Control.Monad.Trans
import Control.Applicative
import Data.Tainted

-- | 'TaintedT' is a monad transformed of 'Tainted'
newtype TaintedT m a = TaintedT {forall (m :: * -> *) a. TaintedT m a -> m (Tainted a)
runTainted :: m (Tainted a)}


instance (Monad m, Functor m) => Functor (TaintedT m) where
    fmap :: forall a b. (a -> b) -> TaintedT m a -> TaintedT m b
fmap a -> b
f = m (Tainted b) -> TaintedT m b
forall (m :: * -> *) a. m (Tainted a) -> TaintedT m a
TaintedT (m (Tainted b) -> TaintedT m b)
-> (TaintedT m a -> m (Tainted b)) -> TaintedT m a -> TaintedT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tainted a -> Tainted b) -> m (Tainted a) -> m (Tainted b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Tainted a -> Tainted b
forall a b. (a -> b) -> Tainted a -> Tainted b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Tainted a) -> m (Tainted b))
-> (TaintedT m a -> m (Tainted a)) -> TaintedT m a -> m (Tainted b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaintedT m a -> m (Tainted a)
forall (m :: * -> *) a. TaintedT m a -> m (Tainted a)
runTainted

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


instance Monad m => Monad (TaintedT m) where
    return :: forall a. a -> TaintedT m a
return = m (Tainted a) -> TaintedT m a
forall (m :: * -> *) a. m (Tainted a) -> TaintedT m a
TaintedT (m (Tainted a) -> TaintedT m a)
-> (a -> m (Tainted a)) -> a -> TaintedT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tainted a -> m (Tainted a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tainted a -> m (Tainted a))
-> (a -> Tainted a) -> a -> m (Tainted a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Tainted a
forall a. a -> Tainted a
forall (m :: * -> *) a. Monad m => a -> m a
return
    TaintedT m (Tainted a)
x >>= :: forall a b. TaintedT m a -> (a -> TaintedT m b) -> TaintedT m b
>>= a -> TaintedT m b
f = m (Tainted b) -> TaintedT m b
forall (m :: * -> *) a. m (Tainted a) -> TaintedT m a
TaintedT (m (Tainted b) -> TaintedT m b) -> m (Tainted b) -> TaintedT m b
forall a b. (a -> b) -> a -> b
$ do
        Tainted a
res <- m (Tainted a)
x
        case Tainted a
res of
            Clean a
v -> TaintedT m b -> m (Tainted b)
forall (m :: * -> *) a. TaintedT m a -> m (Tainted a)
runTainted (TaintedT m b -> m (Tainted b)) -> TaintedT m b -> m (Tainted b)
forall a b. (a -> b) -> a -> b
$ a -> TaintedT m b
f a
v
            Dirty a
t -> do
                    -- Ensure Dirty stays Dirty
                    Tainted b
res <- TaintedT m b -> m (Tainted b)
forall (m :: * -> *) a. TaintedT m a -> m (Tainted a)
runTainted (TaintedT m b -> m (Tainted b)) -> TaintedT m b -> m (Tainted b)
forall a b. (a -> b) -> a -> b
$ a -> TaintedT m b
f a
t
                    Tainted b -> m (Tainted b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tainted b -> m (Tainted b)) -> Tainted b -> m (Tainted b)
forall a b. (a -> b) -> a -> b
$ case Tainted b
res of
                        Clean b
u -> b -> Tainted b
forall a. a -> Tainted a
Dirty b
u 
                        Tainted b
d       -> Tainted b
d
                                

instance MonadTrans TaintedT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> TaintedT m a
lift = m (Tainted a) -> TaintedT m a
forall (m :: * -> *) a. m (Tainted a) -> TaintedT m a
TaintedT (m (Tainted a) -> TaintedT m a)
-> (m a -> m (Tainted a)) -> m a -> TaintedT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Tainted a) -> m a -> m (Tainted a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Tainted a
forall a. a -> Tainted a
forall (m :: * -> *) a. Monad m => a -> m a
return


-- | Lift a 'Tainted' into an 'TaintedT'
hoistTainted :: Monad m => Tainted a -> TaintedT m a
hoistTainted :: forall (m :: * -> *) a. Monad m => Tainted a -> TaintedT m a
hoistTainted = m (Tainted a) -> TaintedT m a
forall (m :: * -> *) a. m (Tainted a) -> TaintedT m a
TaintedT (m (Tainted a) -> TaintedT m a)
-> (Tainted a -> m (Tainted a)) -> Tainted a -> TaintedT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tainted a -> m (Tainted a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return