[Haskell-cafe] Applicative and Monad transformers

[Jeremy Shaw]

Attached is as slight better test example which does not rely on the
'fail' method. Doesn't really change anything significant though.

-------------- next part --------------
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
module Main where

import Control.Applicative (Applicative((<*>), pure), (<$>))
import Control.Monad (Monad((>>=), return), ap)
import Control.Monad.Reader (MonadReader(ask, local), ReaderT(ReaderT, runReaderT), mapReaderT)
import Data.Monoid(Monoid(mappend))

{-
instance (Monad f, Applicative f) => Applicative (ReaderT r f) where
    pure = return
    (<*>) = ap

-}
instance (Monad f, Applicative f) => Applicative (ReaderT r f) where
    pure a = ReaderT $ const (pure a)
    f <*> a = ReaderT $ \r -> 
              ((runReaderT f r) <*> (runReaderT a r))

instance (Monoid e) => Applicative (Either e) where
    pure = Right
    (Left errF) <*> (Left errA) = Left (errF `mappend` errA)
    (Left err)  <*> _           = Left err
    _           <*> (Left err)  = Left err
    (Right f)   <*> (Right a)   = Right (f a)

instance Monad (Either e) where
    return = Right 
    (Right a) >>= f = f a
    (Left e) >>= f = (Left e)
--    fail str = Left [str]

lookupE :: (Eq a) => a -> [(a,b)] -> (Either a b)
lookupE a env =
    case lookup a env of
      Just b -> Right b
      Nothing -> Left a

look :: (Eq a) => a -> ReaderT [(a,b)] (Either [a]) b
look a =
    do env <- ask
       case lookup a env of
         (Just b) -> return b
         Nothing -> asLeft a

asLeft :: a -> ReaderT r (Either [a]) b
asLeft a =
    mapReaderT (\m -> case m of
                        (Left as) -> Left (a:as)
                        (Right _) -> Left [a])
               (return ())

looker :: ReaderT [(String, Int)] (Either [String]) (Int, Int, Int)
looker = ((,,) <$> look "foo" <*> look "bar" <*> look "baz")

test :: Either [String] (Int, Int, Int)
test =
    runReaderT looker [("bar", 1)]