FunctorDerivation.hs

import Data.Bifunctor
import Data.Char
import Data.Functor.Const
import Data.Functor.Identity
import Prelude hiding (Maybe(..))

newtype BiComp bf fu gu a b =
  BiComp (bf (fu a) (gu b))

instance (Bifunctor bf, Functor fu, Functor gu) =>
         Bifunctor (BiComp bf fu gu) where
  bimap f g (BiComp x) = BiComp (bimap (fmap f) (fmap g) x)

---
newtype Pair a b =
  Pair (a, b)
  deriving (Show)

type Pair' a b = BiComp (,) Identity Identity a b

isoPair' :: Pair a b -> Pair' a b
isoPair' (Pair (a, b)) = BiComp (Identity a, Identity b)

isoPair :: Pair' a b -> Pair a b
isoPair (BiComp (Identity a, Identity b)) = Pair (a, b)

instance Functor (Pair a) where
  fmap f = isoPair . second f . isoPair'

---
type Maybe' a = BiComp Either (Const ()) Identity () a

data Maybe a
  = Nothing
  | Just a
  deriving (Show)

isoMaybe' :: Maybe a -> Maybe' a
isoMaybe' Nothing = BiComp (Left $ Const ())
isoMaybe' (Just x) = BiComp (Right (Identity x))

isoMaybe :: Maybe' a -> Maybe a
isoMaybe (BiComp (Left _)) = Nothing
isoMaybe (BiComp (Right (Identity x))) = Just x

instance Functor Maybe where
  fmap f = isoMaybe . second f . isoMaybe'

main :: IO ()
main = do
  print $ (+ 1) <$> Just 1
  print $ (+ 1) <$> Nothing
  print $ map toUpper <$> Pair (42, "hello")