module Data.Record.Label.Core where
import Prelude hiding ((.), id)
import Control.Applicative
import Control.Category
import Control.Monad.State
import Control.Monad.Reader
data Point f i o = Point
{ _get :: f -> o
, _set :: i -> f -> f
}
_mod :: Point f i o -> (o -> i) -> f -> f
_mod l f a = _set l (f (_get l a)) a
newtype (f :-> a) = Lens { unLens :: Point f a a }
lens :: (f -> a) -> (a -> f -> f) -> f :-> a
lens g s = Lens (Point g s)
getL :: (f :-> a) -> f -> a
getL = _get . unLens
setL :: (f :-> a) -> a -> f -> f
setL = _set . unLens
modL :: (f :-> a) -> (a -> a) -> f -> f
modL = _mod . unLens
instance Category (:->) where
id = lens id const
Lens a . Lens b = lens (_get a . _get b) (_mod b . _set a)
instance Functor (Point f i) where
fmap f x = Point (f . _get x) (_set x)
instance Applicative (Point f i) where
pure a = Point (const a) (const id)
a <*> b = Point (_get a <*> _get b) (\r -> _set b r . _set a r)
fmapL :: Applicative f => (a :-> b) -> f a :-> f b
fmapL l = lens (fmap (getL l)) (\x f -> setL l <$> x <*> f)
class Iso f where
(%) :: a :<->: b -> f a -> f b
infixr 7 :<->:
data a :<->: b = (:<->:) { fw :: a -> b, bw :: b -> a }
instance Category (:<->:) where
id = id :<->: id
(a :<->: b) . (c :<->: d) = a . c :<->: d . b
infixr 8 %
instance Iso ((:->) i) where
l % Lens a = lens (fw l . _get a) (_set a . bw l)
instance Iso ((:<->:) i) where
(%) = (.)
lmap :: Functor f => (a :<->: b) -> f a :<->: f b
lmap l = let a :<->: b = l in fmap a :<->: fmap b
dimap :: (o' -> o) -> (i -> i') -> Point f i' o' -> Point f i o
dimap f g l = Point (f . _get l) (_set l . g)
for :: (i -> o) -> (f :-> o) -> Point f i o
for a b = dimap id a (unLens b)