module Pandora.Pattern.Functor.Representable where

import Pandora.Core.Functor (type (<:=))
import Pandora.Pattern.Functor.Pointable (Pointable)

{- |
> When providing a new instance, you should ensure it satisfies:
> * Isomorphism (to): tabulate . index ≡ identity
> * Isomorphism (from): index . tabulate ≡ identity
> * Right adjoint: tabulate . point ≡ point
> * Interchange tabulation: comap f . tabulate ≡ tabulate . comap f
-}

class Pointable t => Representable t where
	{-# MINIMAL (<#>), tabulate #-}
	type Representation t :: *
	-- | Infix and flipped version of 'index'
	(<#>) :: Representation t -> a <:= t
	-- Build with a function which describes value
	tabulate :: (Representation t -> a) -> t a
	-- | Prefix and flipped version of '<#>'
	index :: t a -> Representation t -> a
	index t a
x Representation t
r = Representation t
r Representation t -> a <:= t
forall (t :: * -> *) a.
Representable t =>
Representation t -> a <:= t
<#> t a
x