Free applicative functors in terms of liftA2.

Applicatives.hs

{-# LANGUAGE ExistentialQuantification #-}

import Control.Applicative
import Data.Functor.Identity

data Ap f a = Pure a
            | forall x y. LiftA2 (x -> y -> a) (f x) (Ap f y)

instance Functor f => Functor (Ap f) where
    fmap f (Pure a) = Pure (f a)
    fmap f (LiftA2 g x y) = LiftA2 ((f .) . g) x y

instance Functor f => Applicative (Ap f) where
    pure = Pure
    (Pure f) <*> x = fmap f x
    (LiftA2 f x y) <*> z = LiftA2 (\x (y, z) -> f x y z) x ((,) <$> y <*> z)

interp :: Applicative f => Ap f a -> f a
interp (Pure a) = pure a
interp (LiftA2 f x y) = liftA2 f x (interp y)

example :: Ap Identity Int
example = LiftA2 (+) (Identity 123) (Pure 456)

example2 :: Ap Identity Int
example2 = (+) <$> example <*> example