Lens From Scratch.hs

{-# LANGUAGE RankNTypes #-}
module Example where

import Data.Functor.Const

data Atom = Atom {_point :: !Point}
data Point = Point {_x :: !Int, _y :: !Int}

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

lens :: (a -> b) -> (a -> b -> a) -> Lens' a b
lens sa sbt afb s = sbt s <$> afb (sa s)

point :: Lens' Atom Point
point = lens _point (\atom newPoint -> atom { _point = newPoint })

x :: Lens' Point Int
x = lens _x (\point newX -> point { _x = newX })

main = do
   let point' = Point { _x = 1, _y = 2 }
   let atom'  = Atom { _point = point' }
   putStrLn (show (view (point . x) atom'))

view :: ((b -> Const b b) -> (a -> Const b a)) -> a -> b
view getter x = getConst (getter Const x)