Bifunctor.hs

{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}

module Data.Bifunctor.Linear.Internal.Bifunctor
  ( Bifunctor (..),
  )
where

import Prelude.Linear

-- | The Bifunctor class
--
-- == Laws
--
-- If 'bimap' is supplied, then
-- @'bimap' 'id' 'id' = 'id'@
--
-- * If 'first' and 'second' are supplied, then
-- @
-- 'first' 'id' ≡ 'id'
-- 'second' 'id' ≡ 'id'
-- @
--
-- * If all are supplied, then
-- @'bimap' f g = 'first' f '.' 'second' g
class Bifunctor p where
  {-# MINIMAL bimap | (first, second) #-}
  bimap :: (a %1 -> b) -> (c %1 -> d) -> a `p` c %1 -> b `p` d
  bimap f g x = first f (second g x)
  {-# INLINE bimap #-}

  first :: (a %1 -> b) -> a `p` c %1 -> b `p` c
  first f = bimap f id
  {-# INLINE first #-}

  second :: (b %1 -> c) -> a `p` b %1 -> a `p` c
  second = bimap id
  {-# INLINE second #-}

-- # Instances
-------------------------------------------------------------------------------

instance Bifunctor (,) where
  bimap f g (x, y) = (f x, g y)
  first f (x, y) = (f x, y)
  second g (x, y) = (x, g y)

instance Bifunctor Either where
  bimap f g = either (Left . f) (Right . g)