Lens example code from talk by SPJ

lens.hs

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}

-- Lens example code from talk by SPJ
-- "Lenses: compositional data access and manipulation."
-- https://skillsmatter.com/skillscasts/4251-lenses-compositional-data-access-and-manipulation

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

data LensR s a = L { viewR :: s -> a
                   , setR  :: a -> s -> s }

-- Useful functors

newtype Identity a = Identity a

runIdentity :: Identity a -> a
runIdentity (Identity x) = x

instance Functor Identity where
  fmap f (Identity x) = Identity (f x)

newtype Const v a = Const v

runConst :: Const v a -> v
runConst (Const x) = x

instance Functor (Const v) where
  fmap f (Const x) = Const x

-- Isomorphism

lensToLensR :: Lens' s a -> LensR s a
lensToLensR ln = L { viewR = view ln , setR = set ln}
  where
    set :: Lens' s a -> (a -> s -> s) 
    set ln x = runIdentity . ln (Identity . const x)

    view :: Lens' s a -> (s -> a)
    -- view :: ((a -> f a) -> s -> f s) -> s -> a
    -- view :: ((a -> Const a a) -> s -> Const a s) -> s -> a
    view ln = runConst . ln Const

lensRToLens :: LensR s a -> Lens' s a
-- lensRToLens :: Functor f => LensR s a -> ((a -> f a) -> s -> f s)
lensRToLens (L view set) f s = fmap (\x -> set x s) (f (view s))

-- Composition

composeL :: Lens' s1 s2 -> Lens' s2 a -> Lens' s1 a
-- composeL :: ((s2 -> f s2) -> (s1 -> f s1)) -> ((a -> f a) -> (s2 -> f s2)) -> (a -> f a) -> (s1 -> f s1)
composeL = (.)