SimpleLens http://www.mchaver.com/posts/2017-07-12-lens-tutorial-1.html

SimpleLens.hs

{-# LANGUAGE RankNTypes #-}

module Main where

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

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

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

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

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

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

viewName :: Person -> String
viewName (Person pName pAge) = getConst $ (\ppName -> Person ppName pAge) <$> Const pName

viewAge :: Person -> Int
viewAge (Person pName pAge) = getConst $ (\ppAge -> Person pName ppAge) <$> Const pAge

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

setName :: String -> Person -> Person
setName newName (Person _ pAge) = runIdentity $ (\ppName -> Person ppName pAge) <$> Identity newName

setAge :: Int -> Person -> Person
setAge newAge (Person pName _) = runIdentity $ (\ppAge -> Person pName ppAge) <$> Identity newAge

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

overName :: (String -> String) -> Person -> Person
overName f (Person pName pAge) = runIdentity $ (\ppName -> Person ppName pAge) <$> Identity (f pName)

overAge :: (Int -> Int) -> Person -> Person
overAge f (Person pName pAge) = runIdentity $ (\ppAge -> Person pName ppAge) <$> Identity (f pAge)

data Person2 = Person2 {
      name' :: String
    , phone :: Phone
    } deriving (Eq, Read, Show)

data Phone = Phone {
      number :: String
    } deriving (Eq, Read, Show)

__name :: SimpleLens Person2 String
__name f (Person2 pName pPhone) = (\ppName -> Person2 ppName pPhone) <$> f pName

__phone :: SimpleLens Person2 Phone
__phone f (Person2 pName pPhone) = (\ppPhone -> Person2 pName ppPhone) <$> f pPhone

__number :: SimpleLens Phone String
__number f (Phone pNumber) = (\ppNumber -> Phone ppNumber) <$> f pNumber

main :: IO ()
main = do
  let p = Person "Marina" 21
      n = view _name p
      a = view _age p
  putStrLn "name"
  print n
  putStrLn "age"
  print a

  let p = Person "Marina" 21
      p1 = set _name "namae" p
      p2 = set _age 1 p1
  putStrLn "set"
  print p1
  print p2

  let p = Person "Marina" 21
      p1 = over _name (\n -> n ++ "&" ++ n) p
      p2 = over _age (+ 2) p1
  putStrLn "over"
  print p1
  print p2

  let p = Person2 "Marina" (Phone "0123")
      n = view (__phone . __number) p

      p2 = set (__phone . __number) "9999" p
      p3 = over (__phone . __number) (++ "!") p
  putStrLn "compose"
  print n
  print p2
  print p3