pandora-0.2.9: Pandora/Pattern/Functor/Contravariant.hs

module Pandora.Pattern.Functor.Contravariant where

import Pandora.Core.Functor (type (:.), type (:=))
import Pandora.Core.Morphism ((!), (%))
import Pandora.Pattern.Category ((.))

infixl 4 >$<, $<, >$

{- |
> When providing a new instance, you should ensure it satisfies the two laws:
> * Identity morphism: contramap identity ≡ identity
> * Interpreted of morphisms: contramap f . contramap g ≡ contramap (g . f)
-}

class Contravariant (t :: * -> *) where
	{-# MINIMAL (>$<) #-}
	-- | Infix version of 'contramap'
	(>$<) :: (a -> b) -> t b -> t a

	-- | Prefix version of '>$<'
	contramap :: (a -> b) -> t b -> t a
	contramap f x = f >$< x
	-- | Replace all locations in the output with the same value
	(>$) :: b -> t b -> t a
	(>$) = contramap . (!)
	-- | Flipped version of '>$'
	($<) :: t b -> b -> t a
	($<) = (%) (>$)
	-- | Fill the input of evaluation
	full :: t () -> t a
	full x = () >$ x
	-- | Flipped infix version of 'contramap'
	(>&<) :: t b -> (a -> b) -> t a
	x >&< f = f >$< x

	-- | Infix versions of `contramap` with various nesting levels
	(>$$<) :: Contravariant u => (a -> b) -> t :. u := a -> t :. u := b
	(>$$<) = (>$<) . (>$<)
	(>$$$<) :: (Contravariant u, Contravariant v)
		=> (a -> b) -> t :. u :. v := b -> t :. u :. v := a
	(>$$$<) = (>$<) . (>$<) . (>$<)
	(>$$$$<) :: (Contravariant u, Contravariant v, Contravariant w)
		=> (a -> b) -> t :. u :. v :. w := a -> t :. u :. v :. w := b
	(>$$$$<) = (>$<) . (>$<) . (>$<) . (>$<)

	-- | Infix flipped versions of `contramap` with various nesting levels
	(>&&<) :: Contravariant u => t :. u := a -> (a -> b) -> t :. u := b
	x >&&< f = f >$$< x
	(>&&&<) :: (Contravariant u, Contravariant v)
		=> t :. u :. v := b -> (a -> b) -> t :. u :. v := a
	x >&&&< f = f >$$$< x
	(>&&&&<) :: (Contravariant u, Contravariant v, Contravariant w)
		=> t :. u :. v :. w := a -> (a -> b) -> t :. u :. v :. w := b
	x >&&&&< f = f >$$$$< x