I can into lenses! (pt. 2)

gistfile1.hs

{-# LANGUAGE RankNTypes #-}
import Data.Functor.Identity
import Control.Applicative

data Point = Point { _x :: Int, _y :: Int } deriving (Show)
data Rect = Rect { _a :: Point, _b :: Point, _c :: Point, _d :: Point} deriving (Show)



type Lens s a = forall f. Functor f => (a -> f a) -> s -> f s


set :: Lens s a -> a -> s -> s
set ln x = runIdentity . ln (Identity . const x)

-- view x (Point x y) =
-- getConst $ x Const x =
-- getConst $ fmap (\x' -> Point x' y) (Const $ x =
-- getConst $ Const x =
-- x


view :: Lens s a -> s -> a
view ln = getConst . ln Const

-- set x z (Point x y) =
-- runIdentity $ x (Identity . const z) (Point x y) =
-- runIdentity $ fmap (\x' -> Point x' y) (Identity $ const z x) =
-- runIdentity $ fmap (\x' -> Point x' y) (Identity z) =
-- runIdentity $ Identity (Point z y) =
-- Point z y


-- I don't know how to do that better... yet
over :: Lens s a -> (a -> a) -> s -> s
over ln f s = set ln (f $ view ln s) s


x :: Lens Point Int
x elt_fn (Point x y) = fmap (\x' -> Point x' y) (elt_fn x)

a :: Lens Rect Point
a elt_fn (Rect a b c d) = fmap (\a' -> Rect a' b c d) (elt_fn a)


p1 = Point 0 0
p2 = Point 1 0
p3 = Point 0 1
p4 = Point 1 1

r1 = Rect p1 p2 p3 p4
r2 = set (a.x) 123 r1
r3 = over (a.x) (+ 543) r2