Simple experiment creating Lenses

Lenses_Experiments.hs

module Main where

import Prelude (String, Show, print, flip, IO)
import Control.Category

data Lens a b = L ( a -> b,        -- getter
                    b -> a -> a )  -- setter

mkLens :: (a -> b) -> (b -> a -> a) -> Lens a b
mkLens g s = L (g, s)

set :: Lens a b -> b -> a -> a
set (L (_, s)) = s

get :: Lens a b -> a -> b
get (L (g, _)) = g

instance Category Lens where
        id = id
        (.) = flip compose 

compose :: Lens a b -> Lens b c -> Lens a c
compose (L (g1, s1)) (L (g2, s2)) = L (g2 . g1, \v o-> s1 (s2 v (g1 o)) o)

data Person = P { firstName:: String, lastName:: String } deriving Show

data Family = F { husband:: Person, wife:: Person } deriving Show

lens1 :: Lens Family Person
lens1 = mkLens wife (\w p -> p { wife = w })

lens2 :: Lens Person String
lens2 = mkLens firstName (\s p -> p { firstName = s })


lens3 :: Lens Family String
lens3 = lens2 . lens1

sample :: Family
sample = F { husband = P { firstName = "Homer", lastName = "Simpson" },
             wife = P { firstName = "Marjorie", lastName = "Simpson" } }

main :: IO () 
main = print (set lens3 "Marge" sample)