module Data.Functor.Corepresentable
(
Value
, Valued(..)
, Coindexed(..)
, Corepresentable(..)
, contramapDefault
, contramapWithValueDefault
) where
import Control.Monad.Reader
import Data.Functor.Contravariant
import Data.Functor.Product
import Data.Functor.Coproduct
import Prelude hiding (lookup)
type family Value (f :: * -> *)
class Contravariant f => Valued f where
contramapWithValue :: (b -> Either a (Value f)) -> f a -> f b
class Coindexed f where
coindex :: f a -> a -> Value f
class (Coindexed f, Valued f) => Corepresentable f where
corep :: (a -> Value f) -> f a
contramapDefault :: Corepresentable f => (a -> b) -> f b -> f a
contramapDefault f = corep . (. f) . coindex
contramapWithValueDefault :: Corepresentable f => (b -> Either a (Value f)) -> f a -> f b
contramapWithValueDefault f p = corep $ either (coindex p) id . f
type instance Value (Op r) = r
instance Valued (Op r) where
contramapWithValue = contramapWithValueDefault
instance Coindexed (Op r) where
coindex = getOp
instance Corepresentable (Op r) where
corep = Op
type instance Value Predicate = Bool
instance Valued Predicate where
contramapWithValue = contramapWithValueDefault
instance Coindexed Predicate where
coindex = getPredicate
instance Corepresentable Predicate where
corep = Predicate
type instance Value (Product f g) = (Value f, Value g)
instance (Valued f, Valued g) => Valued (Product f g) where
contramapWithValue h (Pair f g) = Pair
(contramapWithValue (fmap fst . h) f)
(contramapWithValue (fmap snd . h) g)
instance (Coindexed f, Coindexed g) => Coindexed (Product f g) where
coindex (Pair f g) a = (coindex f a, coindex g a)
instance (Corepresentable f, Corepresentable g) => Corepresentable (Product f g) where
corep f = Pair (corep (fst . f)) (corep (snd . f))
type instance Value (Coproduct f g) = Either (Value f) (Value g)
instance (Coindexed f, Coindexed g) => Coindexed (Coproduct f g) where
coindex (Coproduct (Left f)) a = Left $ coindex f a
coindex (Coproduct (Right g)) a = Right $ coindex g a