{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- 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 Data.Tainted 
    (Tainted(..), isClean, isDirty, cleans, dirtys, partitionTaints)
where

import Control.Monad
import Control.Applicative
import Data.Typeable


-- | The 'Tainted' type encapsulates a value.  A value of type
-- @'Tainted' a@ either contains a "clean" value of type @a@ (represented as @'Clean' a@), 
-- or it contains a "dirty" value of type @a@ (represented as @'Dirty' a@).  
--
-- The 'Tainted' type is also a monad. Once the "dirty" state has been
-- reached, and clean operations performed themselves create a "dirty"
-- value. 
data Tainted a = Dirty a | Clean a
    deriving (Tainted a -> Tainted a -> Bool
(Tainted a -> Tainted a -> Bool)
-> (Tainted a -> Tainted a -> Bool) -> Eq (Tainted a)
forall a. Eq a => Tainted a -> Tainted a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Tainted a -> Tainted a -> Bool
== :: Tainted a -> Tainted a -> Bool
$c/= :: forall a. Eq a => Tainted a -> Tainted a -> Bool
/= :: Tainted a -> Tainted a -> Bool
Eq, Eq (Tainted a)
Eq (Tainted a) =>
(Tainted a -> Tainted a -> Ordering)
-> (Tainted a -> Tainted a -> Bool)
-> (Tainted a -> Tainted a -> Bool)
-> (Tainted a -> Tainted a -> Bool)
-> (Tainted a -> Tainted a -> Bool)
-> (Tainted a -> Tainted a -> Tainted a)
-> (Tainted a -> Tainted a -> Tainted a)
-> Ord (Tainted a)
Tainted a -> Tainted a -> Bool
Tainted a -> Tainted a -> Ordering
Tainted a -> Tainted a -> Tainted a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Tainted a)
forall a. Ord a => Tainted a -> Tainted a -> Bool
forall a. Ord a => Tainted a -> Tainted a -> Ordering
forall a. Ord a => Tainted a -> Tainted a -> Tainted a
$ccompare :: forall a. Ord a => Tainted a -> Tainted a -> Ordering
compare :: Tainted a -> Tainted a -> Ordering
$c< :: forall a. Ord a => Tainted a -> Tainted a -> Bool
< :: Tainted a -> Tainted a -> Bool
$c<= :: forall a. Ord a => Tainted a -> Tainted a -> Bool
<= :: Tainted a -> Tainted a -> Bool
$c> :: forall a. Ord a => Tainted a -> Tainted a -> Bool
> :: Tainted a -> Tainted a -> Bool
$c>= :: forall a. Ord a => Tainted a -> Tainted a -> Bool
>= :: Tainted a -> Tainted a -> Bool
$cmax :: forall a. Ord a => Tainted a -> Tainted a -> Tainted a
max :: Tainted a -> Tainted a -> Tainted a
$cmin :: forall a. Ord a => Tainted a -> Tainted a -> Tainted a
min :: Tainted a -> Tainted a -> Tainted a
Ord, ReadPrec [Tainted a]
ReadPrec (Tainted a)
Int -> ReadS (Tainted a)
ReadS [Tainted a]
(Int -> ReadS (Tainted a))
-> ReadS [Tainted a]
-> ReadPrec (Tainted a)
-> ReadPrec [Tainted a]
-> Read (Tainted a)
forall a. Read a => ReadPrec [Tainted a]
forall a. Read a => ReadPrec (Tainted a)
forall a. Read a => Int -> ReadS (Tainted a)
forall a. Read a => ReadS [Tainted a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Tainted a)
readsPrec :: Int -> ReadS (Tainted a)
$creadList :: forall a. Read a => ReadS [Tainted a]
readList :: ReadS [Tainted a]
$creadPrec :: forall a. Read a => ReadPrec (Tainted a)
readPrec :: ReadPrec (Tainted a)
$creadListPrec :: forall a. Read a => ReadPrec [Tainted a]
readListPrec :: ReadPrec [Tainted a]
Read, Int -> Tainted a -> ShowS
[Tainted a] -> ShowS
Tainted a -> String
(Int -> Tainted a -> ShowS)
-> (Tainted a -> String)
-> ([Tainted a] -> ShowS)
-> Show (Tainted a)
forall a. Show a => Int -> Tainted a -> ShowS
forall a. Show a => [Tainted a] -> ShowS
forall a. Show a => Tainted a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Tainted a -> ShowS
showsPrec :: Int -> Tainted a -> ShowS
$cshow :: forall a. Show a => Tainted a -> String
show :: Tainted a -> String
$cshowList :: forall a. Show a => [Tainted a] -> ShowS
showList :: [Tainted a] -> ShowS
Show, Typeable)

-- Identity law:
--
-- fmap id (Dirty a) = Dirty (id a) = Dirty a => fmap id = id 
-- 
-- Same proof can be generalized for Clean
--
-- Composition law:
--
-- ((fmap p) . (fmap q)) (Dirty a) = fmap p (Dirty (q a) = (Dirty ((p . q) a)) 
-- = fmap (p . q)
--
-- Same proof can be generalized for Clean
instance Functor Tainted where
    fmap :: forall a b. (a -> b) -> Tainted a -> Tainted b
fmap a -> b
f (Dirty a
a) = b -> Tainted b
forall a. a -> Tainted a
Dirty (a -> b
f a
a)
    fmap a -> b
f (Clean a
a) = b -> Tainted b
forall a. a -> Tainted a
Clean (a -> b
f a
a)


-- Proof of correctness comes from Monad correctness
instance Applicative Tainted where
    pure :: forall a. a -> Tainted a
pure = a -> Tainted a
forall a. a -> Tainted a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall a b. Tainted (a -> b) -> Tainted a -> Tainted b
(<*>) = Tainted (a -> b) -> Tainted a -> Tainted b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
 
-- Left Identity Law:
--
-- (return x) >>= f = Clean f x  ≡ f x
--
-- Right Identity Law:
--
-- m >>= return ≡ m 
--
-- proof is in definition of the Clean case below for (>>=)
--
-- Associativity Law:
--
-- Case of m being Clean :
-- 
-- LHS: (Clean a >>= f) >>= g = f a >>= g 
-- RHS: Clean a >>= (\x -> f x >>= g) =  f a >>= g
-- LHS = RHS
--
-- Case of m being Dirty:
--
-- LHS: (Dirty a >>= f) >>= g = 
--      g =<< case f a of 
--          (Clean y) -> Dirty y
--          y         -> y
--
-- RHS: Dirty a >>= (\x -> f x >>= g) = 
--      g =<< case f a of
--          (Clean y) -> Dirty y
--          y         -> y    
-- LHS = RHS
instance Monad Tainted where
    return :: forall a. a -> Tainted a
return = a -> Tainted a
forall a. a -> Tainted a
Clean
    Dirty a
x  >>= :: forall a b. Tainted a -> (a -> Tainted b) -> Tainted b
>>= a -> Tainted b
f = case a -> Tainted b
f a
x of
                        (Clean b
y) -> b -> Tainted b
forall a. a -> Tainted a
Dirty b
y
                        Tainted b
y -> Tainted b
y 
    Clean a
x  >>= a -> Tainted b
f = a -> Tainted b
f a
x


-- ---------------------------------------------------------------------------
-- The Tainted type, and instances


-- | Returns 'True' iff its argument is of the form 'Clean _.
isClean :: Tainted a -> Bool
isClean :: forall a. Tainted a -> Bool
isClean (Clean a
_) = Bool
True
isClean Tainted a
_ = Bool
False


-- | Returns 'True' iff its argument is of the form Dirty _.  
isDirty :: Tainted a -> Bool 
isDirty :: forall a. Tainted a -> Bool
isDirty = Bool -> Bool
not (Bool -> Bool) -> (Tainted a -> Bool) -> Tainted a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tainted a -> Bool
forall a. Tainted a -> Bool
isClean 


-- | Extracts from a list of 'Tainted' all the 'Clean' elements. 
--   All the 'Clean' elements are extracted in order.
cleans :: [Tainted a] -> [a]
cleans :: forall a. [Tainted a] -> [a]
cleans = (Tainted a -> a) -> [Tainted a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Tainted a -> a
forall a. Tainted a -> a
extractTaint ([Tainted a] -> [a])
-> ([Tainted a] -> [Tainted a]) -> [Tainted a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tainted a -> Bool) -> [Tainted a] -> [Tainted a]
forall a. (a -> Bool) -> [a] -> [a]
filter Tainted a -> Bool
forall a. Tainted a -> Bool
isClean 


-- | Extracts from a list of 'Tainted' all the 'Dirty' elements.
--   All the 'Dirty' elements are extracted in order.
dirtys :: [Tainted a] -> [a]
dirtys :: forall a. [Tainted a] -> [a]
dirtys = (Tainted a -> a) -> [Tainted a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Tainted a -> a
forall a. Tainted a -> a
extractTaint ([Tainted a] -> [a])
-> ([Tainted a] -> [Tainted a]) -> [Tainted a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tainted a -> Bool) -> [Tainted a] -> [Tainted a]
forall a. (a -> Bool) -> [a] -> [a]
filter Tainted a -> Bool
forall a. Tainted a -> Bool
isDirty


-- | Partitions a list of 'Tainted' into two lists. 
--   All the 'Dirty' elements are extracted, in order, to the first component of the output. 
--   Similarly the 'Clean' elements are extracted to the second component of the output.
partitionTaints :: [Tainted a] -> ([a], [a])
partitionTaints :: forall a. [Tainted a] -> ([a], [a])
partitionTaints [Tainted a]
ts = ([a]
c, [a]
d)
    where c :: [a]
c = [Tainted a] -> [a]
forall a. [Tainted a] -> [a]
cleans  [Tainted a]
ts
          d :: [a]
d = [Tainted a] -> [a]
forall a. [Tainted a] -> [a]
dirtys  [Tainted a]
ts


-- | Extract the value contained in a 'Tainted' type
extractTaint :: Tainted a -> a
extractTaint :: forall a. Tainted a -> a
extractTaint (Clean a
a) = a
a
extractTaint (Dirty a
a) = a
a