SimpleLens.hs

{-# LANGUAGE TemplateHaskell #-}
module Main where

import Control.Lens

data Arc = Arc
           { _degree :: Int
           , _minute :: Int
           , _second :: Int } deriving Show
                              
data Location = Location
                { _latitude :: Arc
                , _longitude :: Arc } deriving Show
                                  
data Person = Person
              { _name :: String
              , _age  :: Int
              , _email :: String
              , _descendants :: [Person]
              , _homeLocation :: Location } deriving Show

makeLenses ''Arc
makeLenses ''Location
makeLenses ''Person

person1 = Person "Joe Blogs" 32 "[email protected]"
          [
            Person "Marry Blogs" 5 "" []
            (Location (Arc 23 54 10) (Arc 11 42 50))
          , Person "John Blogs" 13 "" []
            (Location (Arc 23 54 12) (Arc 11 42 33)) 
          ]
          (Location (Arc 23 54 5) (Arc 11 42 59))

getLocation :: Person -> Location
getLocation = view homeLocation

setLocation :: Location -> Person -> Person
setLocation = set homeLocation

getLocationR :: Person -> Location 
getLocationR (Person { _homeLocation = loc }) = loc

setLocationR :: Location -> Person -> Person
setLocationR loc p = p { _homeLocation = loc }

updateLatDegreeR p = 
  p {
    _homeLocation = (_homeLocation p) {
       _latitude = (_latitude (_homeLocation p)) {
          _degree = _degree (_latitude (_homeLocation p)) + 10
       }             
    }               
  }

updateLatDegree = homeLocation.latitude.degree +~ 10

incAllDesAge = descendants.traversed.age +~ 1

forAge a = filtered (\p -> p^.age >= a)
incAllAgesWith a = descendants.traversed.(forAge a).age +~ 1

{--
person1^.(lens getLocationR (flip $ setLocationR)).latitude.degree
=> 23
person1^.(lens (view homeLocation) (flip $ set homeLocation)).latitude.degree
=> 23

person1^.descendants & length
=> 2

:t (homeLocation.latitude) :: Lens' Person Arc
=> (homeLocation.latitude) :: Functor f => (Arc -> f Arc) -> Person -> f Person

incAllAgesWith 10 $ person1
=> Person { ... }
--}