Covariant, contravariant, and invariant functor explosion

module Main
  ( main
  ) where

import Data.Foldable (traverse_)
import Data.List (intercalate)

data Variance =
  Co | Contra | In
  deriving (Bounded, Enum)

showVariance :: Variance -> String
showVariance Co     = "O"
showVariance Contra = "I"
showVariance In     = "X"

showParameter :: Int -> Variance -> String
showParameter n Co     = "(a" ++ show n ++ " -> b" ++ show n ++ ")"
showParameter n Contra = "(b" ++ show n ++ " -> a" ++ show n ++ ")"
showParameter n In     = "(a" ++ show n ++ " -> b" ++ show n ++ ") -> " ++
                         "(b" ++ show n ++ " -> a" ++ show n ++ ")"

showType :: [Variance] -> String
showType variances =
  let
    parameters :: String
    parameters = intercalate " -> " . fmap (uncurry showParameter) $
                   [1 ..] `zip` variances

    arguments :: String -> String
    arguments t = intercalate " " . fmap ((t ++) . show) $
                    [1 .. length variances]
  in
    parameters ++ " -> f " ++ arguments "a"
               ++ " -> f " ++ arguments "b"

functors :: [String]
functors =
  [ "class Functor" ++ foldMap showVariance variances ++ " f where\n" ++
    "  map" ++ foldMap showVariance variances ++ " :: " ++ showType variances
  | count <- [1 .. 4]
  , variances <- traverse (const [minBound .. maxBound])
                          [1 .. count] ]

main :: IO ()
main = traverse_ putStrLn functors