CPS based lenses

Optic.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}

module Optic where

-- https://twanvl.nl/blog/haskell/cps-functional-references
-- https://mail.haskell.org/pipermail/haskell-cafe/2007-November/035263.html

import Control.Applicative
import qualified Control.Category as Cat
import Control.Monad.Identity

type RefF a b = forall f. Functor f => (b -> f b) -> a -> f a

getF :: RefF a b -> a -> b
getF r a = getConst $ r Const a

modifyF :: RefF a b -> (b -> b) -> a -> a
modifyF r f a = runIdentity $ r (return . f) a

setF :: RefF a b -> b -> a -> a
setF r b a = modifyF r (const b) a

fstF :: RefF (a, b) a
fstF f (a, b) = (, b) <$> f a

sndF :: RefF (a, b) b
sndF f (a, b) = (a,) <$> f b

newtype Lens a b = Lens { focus :: a -> (b, b -> a) }

get :: Lens a b -> a -> b
get r a = fst $ focus r a

set :: Lens a b -> b -> a -> a
set r b a = snd (focus r a) b

modify :: Lens a b -> (b -> b) -> a -> a
modify r f a = set r (f (get r a)) a

instance Cat.Category Lens where
  id = Lens $ \a -> (a, id)
  l1 . l2 = Lens $ \a -> let
    (b, f) = focus l2 a
    (c, g) = focus l1 b
    in (c, f . g)