module Data.Functor.Contravariant.Representable
(
Value
, Valued(..)
, Coindexed(..)
, Representable(..)
, contramapDefault
, contramapWithValueDefault
) where
import Control.Monad.Reader
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Day
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
instance (Valued f, Valued g) => Valued (Day f g) where
contramapWithValue d2eafg (Day fb gc abc) = Day (contramapWithValue id fb) (contramapWithValue id gc) $ \d -> case d2eafg d of
Left a -> case abc a of
(b, c) -> (Left b, Left c)
Right (vf, vg) -> (Right vf, Right vg)
class Coindexed f where
coindex :: f a -> a -> Value f
type instance Value (Day f g) = (Value f, Value g)
instance (Coindexed f, Coindexed g) => Coindexed (Day f g) where
coindex (Day fb gc abc) a = case abc a of
(b, c) -> (coindex fb b, coindex gc c)
class (Coindexed f, Valued f) => Representable f where
contrarep :: (a -> Value f) -> f a
instance (Representable f, Representable g) => Representable (Day f g) where
contrarep a2fg = Day (contrarep fst) (contrarep snd) $ \a -> let b = a2fg a in (b,b)
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