module Data.Time.Lens where
import Control.Lens
import qualified Data.Time as T
import Data.Fixed (Pico)
class HasDate a where
date :: Lens' a T.Day
instance HasDate T.UTCTime where
date = lens T.utctDay setDate
where
setDate t newDate = t{ T.utctDay = newDate }
dateLens selector adder = date `fmap` lens getter setter
where
getter t = T.toGregorian t ^. selector
setter t new = adder (fromIntegral $ new getter t) t
year :: HasDate a => Lens' a Integer
year = dateLens _1 T.addGregorianYearsRollOver
month :: HasDate a => Lens' a Int
month = dateLens _2 T.addGregorianMonthsRollOver
day :: HasDate a => Lens' a Int
day = dateLens _3 T.addDays
class HasTime a where
time :: Lens' a T.TimeOfDay
instance HasTime T.UTCTime where
time = lens get set
where
get = T.timeToTimeOfDay . T.utctDayTime
set t new = t{ T.utctDayTime = T.timeOfDayToTime new }
hour :: HasTime a => Lens' a Int
hour = time `fmap` lens T.todHour (\t new -> t{T.todHour = new})
minutes :: HasTime a => Lens' a Int
minutes = time `fmap` lens T.todMin (\t new -> t{T.todMin = new})
seconds :: HasTime a => Lens' a Pico
seconds = time `fmap` lens T.todSec (\t new -> t{T.todSec = new})