SimpleLens.hs

{-# LANGUAGE RankNTypes #-}

import Data.Functor.Const
import Data.Functor.Identity

type SimpleLens s a = forall f. Functor f => (a -> f a) -> s -> f s

view :: SimpleLens s a -> s -> a
view l = getConst . l Const

set :: SimpleLens s a -> a -> s -> s
set l b = runIdentity . l (\_ -> Identity b)

over :: SimpleLens s a -> (a -> a) -> s -> s
over l f = runIdentity . l (Identity . f)



data Person =
  Person
    { name :: String
    , age  :: Int
    } deriving (Eq,Read,Show)

_name :: SimpleLens Person String
_name a_to_f_a (Person pName pAge) = (\ppName -> Person ppName pAge) <$> a_to_f_a pName

_age :: SimpleLens Person Int
_age a_to_f_a (Person pName pAge) = (\ppAge -> Person pName ppAge) <$> a_to_f_a pAge


data Phone = 
  Phone 
    { phoneNumber :: String 
    } deriving (Show)

data Employee = 
  Employee 
    { employeeName :: String
    , employeePhone :: Phone 
    } deriving (Show)
    
_phoneNumber :: SimpleLens Phone String
_phoneNumber a_to_f_a (Phone phoneNum) = (\pPhoneNum -> Phone pPhoneNum) <$> a_to_f_a phoneNum

_employeePhone :: SimpleLens Employee Phone
_employeePhone a_to_f_a (Employee eName ePhone) = (\eEPhone -> Employee eName eEPhone) <$> a_to_f_a ePhone

_employeeName :: SimpleLens Employee String
_employeeName a_to_f_a (Employee eName ePhone) = (\eEName -> Employee eEName ePhone) <$> a_to_f_a eName