{-# LANGUAGE NoImplicitPrelude #-}
module Bifunctor where

import Prelude (($), id, (.))

class Bifunctor p where
    {-# MINIMAL bimap | first, second #-}

    bimap :: (a -> b)
          -> (c -> d)
          -> p a c
          -> p b d
    bimap f g = first f . second g

    first :: (a -> b) -> p a c -> p b c
    first f = bimap f id

    second :: (b -> c) -> p a b -> p a c
    second = bimap id

-- 1
data Deux a b = Deux a b

instance Bifunctor Deux where
    first f (Deux a c) = Deux (f a) c
    second f (Deux a b) = Deux a (f b)

-- 2
data Const a b = Const a

instance Bifunctor Const where
    first f (Const a) = Const (f a)
    second f (Const a) = Const a

-- 3
data Drei a b c = Drei a b c

instance Bifunctor (Drei a) where
    first f (Drei a b c) = Drei a (f b) c
    second f (Drei a b c) = Drei a b (f c)

-- 4
data SuperDrei a b c = SuperDrei a b

instance Bifunctor (SuperDrei a) where
    first f (SuperDrei a b) = SuperDrei a (f b)
    second f (SuperDrei a b) = SuperDrei a b

-- 5
data SemiDrei a b c = SemiDrei a

instance Bifunctor (SemiDrei a) where
    first f (SemiDrei a) = SemiDrei a
    second f (SemiDrei a) = SemiDrei a

-- 6
data Quadriceps a b c d = Quadzzz a b c d

instance Bifunctor (Quadriceps a b) where
    first f (Quadzzz a b c d) = Quadzzz a b (f c) d
    second f (Quadzzz a b c d) = Quadzzz a b c (f d)

-- 7
data Either a b = Left a | Right b

instance Bifunctor Either where
    first f (Left a) = Left $ f a
    second f (Right b) = Right $ f b