Applicative version of Seer monad. See this for context:http://unknownparallel.wordpress.com/2013/05/07/two-implementations-of-seers/

SeerA.hs

{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}

module SeerA (SeerA, runSeerA, see, send, contact) where

import Control.Applicative
import Data.Functor.Constant
import Data.Functor.Product
import Data.Monoid (Monoid, mempty, (<>), Sum(..))
import Data.Traversable
import Data.Maybe

-- | The 'Applicative' version of Seer.  @Product (Constant w)
-- Identity@ is the applicative version of @Writer@, so this type just
-- combines that with a reader.  
-- 
-- A 'SeerA' is a Seer whose universe can be discovered by static
-- analysis (without running it).  A 'send' in 'SeerA' can never access
-- the universe.
newtype SeerA w a = SeerA { unSeerA :: Product (Constant w) ((->) w) a }
    deriving (Functor, Applicative)

runSeerA :: Monoid w => SeerA w a -> a
runSeerA (SeerA (Pair c r)) = r (getConstant c)

-- We can weaken drb226's class constraint from 'Monad' to 'Applicative';
-- the class operations aren't intrinsically monadic.  Note that the only
-- 'Monad' operations the original 'MonadSeer' class used were '>>'
-- and 'return'.
class (Applicative f, Monoid w) => ApplicativeSeer w f | f -> w where
    see :: f w
    send :: w -> f ()
    contact :: w -> f w

    see = contact mempty
    send w = contact w *> pure ()
    contact w = send w *> see

instance Monoid w => ApplicativeSeer w (SeerA w) where
    see = SeerA (Pair (pure mempty) id)
    send w = SeerA (Pair (Constant w) (pure ()))
    contact w = SeerA (Pair (Constant w) id)


--
-- Example: divide each element of the traversable by their sum.
--
normalize :: (Traversable t, Fractional a) => t a -> t a
normalize = runSeerA . traverse step 
    where step x = send (Sum x) *> ((x/) <$> fmap getSum see)

--
-- Original motivating example: eliminate identifiers defined later
-- than their use.  It turns out that this doesn't need the full
-- monadic power.
--
type Program a = [Statement a]
data Statement a = Definition Identifier a | Use Identifier
type Identifier = String
 
program1 = [ Use "y"
           , Use "x"
           , Definition "x" 5
           , Use "x"
           , Definition "y" 7 
           ]
 
elimDefinition :: Program a -> [a]
elimDefinition = catMaybes . runSeerA . traverse elimStep
 
elimStep :: Statement a -> SeerA [(Identifier,a)] (Maybe a)
elimStep (Definition v x) = send [(v,x)] *> pure Nothing
elimStep (Use v) = fmap (lookup v) see 
 
example2 :: [Integer]
example2 = elimDefinition program1