Functional references (also knows as lenses)

FRef.hs

module Optic where

import Prelude hiding (fst, (.))
import qualified Prelude

-- https://twanvl.nl/blog/haskell/overloading-functional-references

data FRef s a = FRef
  { get :: s -> a
  , set :: a -> s -> s
  }

fst :: FRef (a, b) a
fst = FRef
  { get = \(a, b) -> a
  , set = \a (a', b) -> (a, b)
  }

update :: FRef s a -> (a -> a) -> s -> s
update r f s = set r (f (get r s)) s

compose :: FRef b c -> FRef a b -> FRef a c
compose r1 r2 = FRef
  { get = \a -> get r1 (get r2 a)
  , set = \a -> update r2 (set r1 a)
  }

data Employee = Employee
  { name_ :: String
  , salary_ :: Int
  }

class Ref r where
  ref :: (s -> a) -> (a -> s -> s) -> r s a
  (.) :: r b c -> r a b -> r a c

instance Ref FRef where
  ref = FRef
  (.) = compose

instance Ref (->) where
  ref = const
  (.) = (Prelude..)

name :: Ref r => r Employee String
name = ref name_ (\n e -> e { name_ = n })

salary :: Ref r => r Employee Int
salary = ref salary_ (\s e -> e { salary_ = s })

-- λ> get fst (1, 2)
-- λ> set fst 3 (1, 2)
-- λ> update fst (+ 1) (1, 2)
-- λ> update (fst `compose` fst) (* 2) ((3, 4), 5)
-- λ> update (fst `compose` fst) (* 2) ((3, 4), 5)
-- λ> john = Employee "John" 100000
-- λ> get salary john
-- λ> salary john
-- λ> :t update (salary . fst) (+ 100)