Toy example of applicative validation

gistfile1.hs

{-# LANGUAGE DeriveFunctor #-}
import Data.Monoid
import Control.Monad
import Control.Applicative
import Data.Either

-- newtype to avoid conflict with Applicative (Either e) defined in Control.Applicative
newtype E l r = E (Either l r)
	deriving (Functor, Show)

instance Monoid m => Applicative (E m) where
    pure = E . Right
    E (Left e1) <*> E (Left e2) = E $ Left (e1 `mappend` e2)
    E (Right f) <*> E r = E $ fmap f r

instance Monoid m => Monad (E m) where
	return = pure
	E (Left a) >>= f = E $ Left a
	E (Right a) >>= f = f a

validValue = E $ Right 2
invalidValue1 = E $ Left ["An error"]
invalidValue2 = E $ Left ["Another error"]

monadic = do
	a <- validValue
	b <- invalidValue1
	c <- invalidValue2
	return a

applicative = id <$> validValue <* invalidValue1 <* invalidValue2

main = do
	print monadic -- Left ["An error"]
	print applicative -- Left ["An error", "Another error"]