Control.Lensの再発明

gistfile1.hs

module Main where
import Data.Functor.Identity

infixr 4 .~
infixl 1 &

instance Show a => Show (Identity a) where
  show x = "Identity " ++ (show $ runIdentity x)

type Setter s t a b = (a -> Identity b) -> s -> Identity t

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

_1 :: Setter (a, v) (b, v) a b
_1 f (x, y) = Identity (runIdentity . f $ x, y)

_2 :: Setter (v, a) (v, b) a b
_2 f (x, y) = Identity (x, runIdentity . f $ y)

(&) = flip ($)
a .~ v = (over a) (const v)

main = let
  v = (("Hello", ()), "World")&_1._2.~"Lens"
  in print v -- => (("Hello","Lens"),"World")

あと、Getterも再実装しなくては。
fmapDefaultからこの実装にたどり着くのがｽｹﾞｰよekmett