Skip to content

Instantly share code, notes, and snippets.

@funrep
Last active August 29, 2015 14:01
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save funrep/0acd0e10082b2e7c8b6a to your computer and use it in GitHub Desktop.
Save funrep/0acd0e10082b2e7c8b6a to your computer and use it in GitHub Desktop.
Mini van Laarhoven lens tutorial

Basic functional references with pairs.

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

fstF :: FRef (x, y) x
fstF = FRef
  { get = \(x, _) -> x
  , set = \x (_, y) -> (x, y)
  }

> get fstF (1, 2)
1
> set fstF 5 (1, 2)
(5, 2)

modify :: FRef a b -> (b -> b) -> a -> a
modify ref f s = set ref (f (get ref s)) s

> modify fstF (+2) (1, 2)
(3,2)

o :: FRef b c -> FRef a b -> FRef a c
o bc ab = FRef
  { get = get bc . get ab
  , set = modify ab . set bc
  }

> update (fstF `o` fstF) (*3) ((3, 1), 2)
((9,1), 2)

Pretty cool, ha? Lets generalize FRef.

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

data FRef a b = FRef (a -> b) (b -> a -> a)

type FRef a b = (a -> b) -> (b -> a -> a) -> ?

-- ? ==

type FRef a b = forall f. Functor f => (b -> f b) -> (a -> f a) -- requires Rank2Types

Huh? Don't run away, it will make sense. Lets re-write the pairs-code using this type.

get :: RefF a b -> a -> b
get r = getConst . r Const

modify :: RefF a b -> (b -> b) -> a -> a
modify r m = runIdentity . r (Identity . m)

set :: RefF a b -> b -> a -> a
set r b = modify r (const b)

fstF :: RefF (a,b) a
fstF a_to_fa (a, b) = fmap (\a' -> (a', b)) (a_to_fa a)

Okey, now lets evaluate these applications step by step.

get :: ((b -> f b) -> ((a, b) -> f (a, b))) -> (a, b) -> b
get fstF (1, 2)
getConst . fstF Const $ (1, 2)
getConst . (\(a, b) -> fmap (\a' -> (a', b)) (Const a)) $ (1, 2)
getConst . fmap (\a' -> (a', 2)) (Const 1)
getConst . Const 1
1

modify :: ((b -> f b) -> ((a, b) -> f (a, b))) -> (b -> b) -> (a, b) -> (a, b)
modify fstF (+2) (1, 2)
runIdentity . fstF (Identity . (+2)) $ (1, 2)
runIdentity . (\(a, b) -> fmap (\a' -> (a', b)) (Identity . (+2) $ a)) $ (1, 2)
runIdentity . fmap (\a' -> (a', 2)) (Identity (2 + 1))
runIdentity . Identity (3, 2)
(3, 2)

Now do the same for set fsfF 5 (1, 2) as an exercise, answer is here.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment