Some natural transformations

Main.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeOperators #-}

module Main where

-- | 'f ~> g' means natural transformation from a functor 'f' to a functor 'g'
type (~>) f g = forall a. f a -> g a

-- | const functor, which works as if it's just a constant
data Const a b = Const a deriving Show

instance Functor (Const a) where
  fmap _ (Const a) = (Const a)

-- | natural transformation from list functor to const functor
natLen :: [] ~> Const Int
natLen = Const . length

-- | natural transformation from list functor to maybe functor
natHead :: [] ~> Maybe
natHead [] = Nothing
natHead (a:_) = Just a

main :: IO ()
main = do
  print $ natLen [1 .. 100] -- Const 100
  print $ natHead [1 .. 100] -- Just 1
  print $ natHead ([] :: [Integer]) -- Nothing