Mini lens

MiniLens.hs

{-# LANGUAGE RankNTypes #-}

import Control.Applicative
import Data.Functor.Identity
import Data.Monoid

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

_1 :: Lens (a,b) (a',b) a a'
_1 f (a,b) = (\a' -> (a',b)) <$> f a

_2 :: Lens (a,b) (a,b') b b'
_2 f (a,b) = (\b' -> (a,b')) <$> f b

both :: Traversal (a,a) (b,b) a b
both f (a,b) = (,) <$> f a <*> f b

traverse' :: Traversal [a] [b] a b
traverse' f (x:xs) = (:) <$> f x <*> traverse' f xs
traverse' _ [] = pure []

type Setting s t a b = (a -> Identity b) -> s -> Identity t
type Getting r s a   = (a -> Const r a)  -> s -> Const r s

over :: Setting s t a b -> (a -> b) -> s -> t
over l f s = runIdentity (l (Identity . f) s)

view :: Getting a s a -> s -> a
view l s = getConst (l Const s)

toListOf :: Getting [a] s a -> s -> [a]
toListOf l s = getConst (l (Const . (\x -> [x])) s)

sumOf :: Getting (Sum a) s a -> s -> a
sumOf l s = getSum (getConst (l (Const . Sum) s))