Implementation of Functor and Applicative Functor for a Compose type.

ComposeFunc.hs

{-# LANGUAGE InstanceSigs #-}

newtype Compose f g a = Compose { getCompose :: f (g a) }

instance (Functor f, Functor g) => Functor (Compose f g) where
  fmap :: (a -> b) -> Compose f g a -> Compose f g b
  fmap f (Compose fga) = Compose $ fmap (fmap f) fga

instance (Applicative f, Applicative g) => Applicative (Compose f g) where
  pure :: a -> Compose f g a
  pure x = Compose (pure (pure x))

  (<*>) :: Compose f g (a -> b) -> Compose f g a -> Compose f g b
  (<*>) (Compose fgh) (Compose fga) = Compose $ (<*>) <$> fgh <*> fga

main :: IO ()
main = do
  putStrLn $ show $ getCompose $ fmap (+1) (Compose [Just 10])             -- [Just 11]
  putStrLn $ show $ getCompose $ Compose [Just (*2)] <*> Compose [Just 10] -- [Just 20]