Compose.hs

import Data.Functor
import Control.Applicative

newtype O f g a = O { unO :: f (g a) }

instance (Functor f, Functor g) => Functor (O f g) where
  -- fmap :: (a -> b) -> O f g a -> O f g b
  fmap f' o = O $ fmap (\g' -> fmap f' g') $ unO o

instance (Applicative f, Applicative g) => Applicative (O f g) where
  -- pure :: a -> O f g a
  pure a = O $ pure $ pure a
  -- <*> :: O f g (a -> b) -> O f g a -> O f g b
  f <*> g = let op = unO f
                val = unO g
                func = (fmap (\x -> (x <*> )) op) 
                in O $ func <*> val

using

let f = O $ Just $ Just $ \x -> x + 1
let g = O $ Just $ Just $ 1
show $ unO $ f <*> g

let f = O $ Just $ Just $ (+)
let a1 = O $ Just $ Just $ 2
let a2 = O $ Just $ Just $ 2
show $ unO $ f <*> a1 <*> a2