module Data.Functor.Contravariant.Representable
(
Value
, Valued(..)
, Coindexed(..)
, Representable(..)
, 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) => Representable f where
contrarep :: (a -> Value f) -> f a
contramapDefault :: Representable f => (a -> b) -> f b -> f a
contramapDefault f = contrarep . (. f) . coindex
contramapWithValueDefault :: Representable f => (b -> Either a (Value f)) -> f a -> f b
contramapWithValueDefault f p = contrarep $ 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 Representable (Op r) where
contrarep = Op
type instance Value Predicate = Bool
instance Valued Predicate where
contramapWithValue = contramapWithValueDefault
instance Coindexed Predicate where
coindex = getPredicate
instance Representable Predicate where
contrarep = 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 (Representable f, Representable g) => Representable (Product f g) where
contrarep f = Pair (contrarep (fst . f)) (contrarep (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