module Control.Lens.Projection
( Projection
, Projective(..)
, project
, by
, Project(..)
, projection
, stereo
, mirror
, SimpleProjection
) where
import Control.Applicative
import Control.Lens.Type
import Control.Lens.Getter
import Data.Functor.Identity
import Control.Lens.Iso
type Projection a b c d = forall k f. (Projective k a d, Applicative f) => k (c -> f d) (a -> f a)
class Projective k a d where
projective :: (d -> a) -> (x -> y) -> k x y
instance Projective (->) a d where
projective _ x = x
data Project a d x y = Project (d -> a) (x -> y)
stereo :: Projective k a c => Project b c y z -> Project a b x y -> k x z
stereo (Project g f) (Project i h) = projective (i.g) (f.h)
instance (a ~ a', d ~ d') => Projective (Project a d) a' d' where
projective = Project
project :: Projective k a d => Overloaded (Project a d) f a a c d -> Overloaded k f a a c d
project (Project f g) = projective f g
by :: Project a d (d -> Identity d) (a -> Identity a) -> Getter d a
by (Project g _) = to g
projection :: (d -> a) -> (a -> Maybe c) -> Projection a b c d
projection da amc = projective da (\cfd a -> maybe (pure a) (fmap da . cfd) (amc a))
mirror :: Projective k a c => Simple Iso a c -> Simple Projection a c
mirror l = projection (^.from l) (\a -> Just (a^.l))
type SimpleProjection a b = Projection a a b b