Snippets of Lens In Haskell

module Main where

import Control.Lens ( lens, Lens', Lens, view, set )
-- imported from the package lens

foo :: (Int, (Int, Bool))
foo = (1, (2, True))

-- Task 1: Read the first element of foo
read1st :: (a, b) -> a
read1st (x, _) = x
-- >>> read1st foo
-- 1

-- Task 2: Write the 3 to the second element of foo
write2nd :: (a, (b, c)) -> b -> (a, (b, c))
write2nd (x, (y, z)) newy = (x, (newy, z))

-- >>> write2nd foo 3
-- (1,(3,True))

-- Task 3: Write the False to the second element of foo
write2ndHeter :: (a, (b, c)) -> d -> (a, (d, c))
write2ndHeter (x, (y, z)) newy = (x, (newy, z))

-- >>> write2ndHeter foo False
-- (1,(False,True))

-- Lens

-- Lens' type constructor assumes two parameters: object and focus.
-- to implement a lens, you need to provide a getter and a setter
_left :: Lens' (a, b) a
_left = lens getter setter
  where
    getter :: (a, b) -> a
    getter (x, _) = x
    setter :: (a, b) -> a -> (a, b)
    setter (_, y) newx = (newx, y)

_right :: Lens' (a, b) b
_right = lens getter setter
  where
    getter :: (a, b) -> b
    getter (_, y) = y
    setter :: (a, b) -> b -> (a, b)
    setter (x, _) newy = (x, newy)

-- use view to read, use set to write
read1st' :: (a, b) -> a
read1st' = view _left
-- >>> read1st' foo
-- 1

-- you can compose (.) lens to get a new lens
write2nd' :: (a, (b, c)) -> b -> (a, (b, c))
write2nd' obj new = set _2nd new obj
    where _2nd = _right . _left
-- >>> write2nd' foo 3
-- (1,(3,True))

-- to implement write2ndHeter, which modifies the type of the object,
-- we need to reach the full power of Lens.
-- use Lens instead of Lens'
-- type Lens' s a = Lens s s a a
-- Lens type constructor assumes four parameters:
-- object, new object, focus, new focus

_left' :: Lens (a, b) (a', b) a a'
_left' = lens getter setter
  where
    getter :: (a, b) -> a
    getter (x, _) = x
    setter :: (a, b) -> a' -> (a', b)
    setter (_, y) newx = (newx, y)

_right' :: Lens (a, b) (a, b') b b'
_right' = lens getter setter
  where
    getter :: (a, b) -> b
    getter (_, y) = y
    setter :: (a, b) -> b' -> (a, b')
    setter (x, _) newy = (x, newy)

write2ndHeter' :: (a, (b, c)) -> d -> (a, (d, c))
write2ndHeter' obj new = set _2nd new obj
    where _2nd = _right' . _left'

-- >>> write2ndHeter' foo False
-- (1,(False,True))

main :: IO ()
main = putStrLn "Hello, Lens!"