lens-datetime 0.1.1 → 0.2

raw patch · 2 files changed

+143/−68 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Time/Lens.hs +131/−59
• lens-datetime.cabal +12/−9

@@ -8,8 +8,8 @@  /Usage:/ -Basic interface consists of the following six lenses: 'year',-'month', 'day', 'hour', 'minute' and 'second' with which you can+Basic interface consists of the following six lenses: 'years',+'months', 'days', 'hours', 'minutes' and 'seconds' with which you can access the corresponding \"fields\" of 'LocalTime' and 'UTCTime' in a unified way. Also, use 'date' and 'time' if you want to access the 'Day' and 'TimeOfDay' parts as a whole.@@ -32,17 +32,17 @@  Then you can use the above lenses as follows: ->>> aLocal ^. year+>>> aLocal ^. years 2013->>> aUTC ^. month+>>> aUTC ^. months 8->>> aDay ^. day+>>> aDay ^. days 22 >>> aLocal & time .~ midnight 2013-08-22 00:00:00->>> aUTC & day .~ 1 & month .~ 1+>>> aUTC & days .~ 1 & months .~ 1 2013-01-01 02:04:18.9 UTC->>> aLocal & hour +~ 1            -- But see the note below!+>>> aLocal & hours +~ 1            -- But see the note below! 2013-08-22 14:45:28  @@ -50,21 +50,21 @@  For 'LocalTime' and 'UTCTime' these lenses provide the most straightforward implementation: via 'toGregorian'/'fromGregorian'-in the case of 'year', 'month' and 'day'; and directly to the-fields of 'TimeOfDay' in the case of 'hour', 'minute' and 'second'.+in the case of 'years', 'months' and 'days'; and directly to the+fields of 'TimeOfDay' in the case of 'hours', 'minutes' and 'seconds'.  Which means, on one hand, that the date \"parts\" will be clipped to valid values: ->>> aLocal & month +~ 12+>>> aLocal & months +~ 12 2013-12-22 13:45:28        -- instead of: 2014-08-22 13:45:28->>> aUTC & day +~ 100+>>> aUTC & days +~ 100 2013-08-31 02:04:18.9 UTC  -- instead of: 2013-11-30 02:04:18.9 UTC  And on the other hand, that the time \"parts\" will not roll over and produce invalid values: ->>> aLocal & minute +~ 120+>>> aLocal & minutes +~ 120 2013-08-22 13:165:28       -- instead of: 2013-08-22 15:45:28  Also, this means that the date lenses are not proper lenses: they@@ -76,17 +76,17 @@ value. Instead use the 'FlexibleDateTime' mechanism and the 'flexDT' isomorphism, which correctly rolls over: ->>> aLocal & flexDT.month +~ 12+>>> aLocal & flexDT.months +~ 12 2014-08-22 13:45:28->>> aUTC & flexDT.day +~ 100+>>> aUTC & flexDT.days +~ 100 2013-11-30 02:04:18.9 UTC->>> aLocal & flexDT.minute +~ 120+>>> aLocal & flexDT.minutes +~ 120 2013-08-22 15:45:28  If you need to set multiple fields try to make only one round-trip via flexDT: ->>> aLocal & flexDT %~ ((day +~ 7) . (hour +~ 2))+>>> aLocal & flexDT %~ ((days +~ 7) . (hours +~ 2)) 2013-08-22 13:45:28  Note that even with 'flexDT' we completely ignore all the issues@@ -108,9 +108,9 @@ >        print (tz, t ^. utcInTZ tz) > >  printInLocal baseT->  printInLocal $ baseT & flexDT %~ ((day +~ 1) . (hour +~ 0) . (minute +~ 5))->  printInLocal $ baseT & flexDT %~ ((day +~ 1) . (hour +~ 1) . (minute +~ 5))->  printInLocal $ baseT & flexDT %~ ((day +~ 1) . (hour +~ 2) . (minute +~ 5))+>  printInLocal $ baseT & flexDT %~ ((days +~ 1) . (hours +~ 0) . (minutes +~ 5))+>  printInLocal $ baseT & flexDT %~ ((days +~ 1) . (hours +~ 1) . (minutes +~ 5))+>  printInLocal $ baseT & flexDT %~ ((days +~ 1) . (hours +~ 2) . (minutes +~ 5))  >>> dstExample (CEST,2013-10-26 02:00:00)@@ -126,18 +126,22 @@ module Data.Time.Lens (   -- * Lenses for the date parts     Dateable(..)-  , year, month, day+  , years, months, days   -- * Lenses for the time parts   , Timeable(..)-  , hour, minute, second+  , hours, minutes, seconds   -- * Support for the correct roll-over of fields+  , FlexDateTime(..)   , FlexDate(..)   , FlexTime(..)   , FlexibleDateTime(..)+  , FlexibleDate(..)+  , FlexibleTime(..)   -- * Miscellaneous   , utcInTZ   , utcAsLocal   , julianDay+  , julianDT   , gregorianDate   ) where @@ -156,10 +160,12 @@                          , flexDay :: Int                          } deriving (Show) -data FlexTime = FlexTime { flexDate :: FlexDate-                         , flexTOD :: TimeOfDay-                         } deriving (Show)+data FlexDateTime = FlexDateTime { flexDate :: FlexDate+                                 , flexTOD :: TimeOfDay+                                 } deriving (Show) +newtype FlexTime = FlexTime TimeOfDay deriving (Show)+ flexDateTriple :: Iso' FlexDate (Integer,Int,Int) flexDateTriple = iso (\(FlexDate y m d) -> (y,m,d)) (\(y,m,d) -> FlexDate y m d) {-# INLINE flexDateTriple #-}@@ -184,17 +190,17 @@ -- -- See examples in the general overview part. class FlexibleDateTime a where-  flexDT :: Lens' a FlexTime+  flexDT :: Lens' a FlexDateTime  instance FlexibleDateTime LocalTime where   {-# INLINE flexDT #-}   flexDT = lens convert rollOver     where-      convert (LocalTime d t) = FlexTime (d ^. gregorianUnflex) t+      convert (LocalTime d t) = FlexDateTime (d ^. gregorianUnflex) t       {-# INLINE convert #-}        {-# INLINABLE rollOver #-}-      rollOver _ (FlexTime (FlexDate y m d) tod) = result+      rollOver _ (FlexDateTime (FlexDate y m d) tod) = result         where           (secs0, p0) = properFraction $ tod ^. from diffTOD           (secs, p) = if p0 < 0 then (secs0 - 1, p0 + 1) else (secs0, p0)@@ -211,6 +217,55 @@   flexDT = utcAsLocal.flexDT   {-# INLINE flexDT #-} +-- | Type class to provide correct roll-over behavior for date lenses.+--+-- Used exactly as 'flexDT', but for values that have only \"date\"+-- and no \"time\" part.+class FlexibleDate a where+  flexD :: Lens' a FlexDate++instance FlexibleDate Day where+  {-# INLINE flexD #-}+  flexD = lens (view gregorianUnflex) rollOver+    where+      {-# INLINABLE rollOver #-}+      rollOver _ (FlexDate y m d) = result+        where+          date0 = if m >= 1 && m <= 12+                  then fromGregorian y m 1+                  else fromGregorian y 1 1 & addGregorianMonthsRollOver (fromIntegral $ m-1)+          result = addDays (fromIntegral $ d  - 1) date0++-- | Type class to provide correct roll-over behavior for time lenses.+--+-- Used exactly as 'flexDT', but for values that have only \"time\"+-- and no \"date\" part.+--+-- If the time rolls-over more than 24 hours the day carry is+-- discarded. Ex.:+--+-- >>> let t = TimeOfDay 1 12 3+-- >>> t+-- 01:12:03+-- >>> t & flexT.seconds +~ (-7200)+-- 23:12:03+--+class FlexibleTime a where+  flexT :: Lens' a FlexTime++instance FlexibleTime TimeOfDay where+  {-# INLINABLE flexT #-}+  flexT = lens FlexTime rollOver+    where+      {-# INLINABLE rollOver #-}+      rollOver _ (FlexTime tod) = tod'+        where+          secs0 :: Int+          (secs0, p0) = properFraction $ tod ^. from diffTOD+          (secs, p) = if p0 < 0 then (secs0 - 1, p0 + 1) else (secs0, p0)+          secs1 = secs `mod` (24*60*60)+          tod' = (fromIntegral secs1 + p) ^. diffTOD+ -------------------------------------------------------------------------------- -- Date parts @@ -219,12 +274,12 @@ -- You can implement either of the two methods. class Dateable a where   date :: Lens' a Day-  date = dateFlex.from gregorianUnflex+  date = _dateFlex.from gregorianUnflex   {-# INLINE date #-} -  dateFlex :: Lens' a FlexDate-  dateFlex = date.gregorianUnflex-  {-# INLINE dateFlex #-}+  _dateFlex :: Lens' a FlexDate+  _dateFlex = date.gregorianUnflex+  {-# INLINE _dateFlex #-}  instance Dateable UTCTime where   date f (UTCTime d t) = flip UTCTime t <$> f d@@ -239,12 +294,12 @@   {-# INLINE date #-}  instance Dateable FlexDate where-  dateFlex = id-  {-# INLINE dateFlex #-}+  _dateFlex = id+  {-# INLINE _dateFlex #-} -instance Dateable FlexTime where-  dateFlex f (FlexTime d t) = flip FlexTime t <$> f d-  {-# INLINE dateFlex #-}+instance Dateable FlexDateTime where+  _dateFlex f (FlexDateTime d t) = flip FlexDateTime t <$> f d+  {-# INLINE _dateFlex #-}  -- | View 'Day' as an 'Integer' day number in the Julian calendar. --@@ -260,6 +315,20 @@ gregorianDate = iso toGregorian (\(y,m,d) -> fromGregorian y m d) {-# INLINE gregorianDate #-} +-- | View 'LocalTime' as a fractional day in the modified Julian calendar.+--+-- See the description of 'ModifiedJulianDay' and 'timeOfDayToDayFraction'.+julianDT :: Iso' LocalTime Rational+julianDT = iso there back+  where+    {-# INLINE there #-}+    there (LocalTime d tod) =+      fromIntegral (toModifiedJulianDay d) + timeOfDayToDayFraction tod+    {-# INLINE back #-}+    back r = let (d,t) = properFraction r in+      LocalTime (ModifiedJulianDay d) (dayFractionToTimeOfDay t)+{-# INLINE julianDT #-}+ -- | Lens into the year value of a 'Dateable'. -- -- Warning: this is not a proper lens for 'LocalTime' and 'UTCTime':@@ -267,9 +336,9 @@ -- year value in a date is modified the month and day values might -- also change. This happens when the original date was a February -- 29th and we change to a non-leap year.-year :: Dateable d => Lens' d Integer-year = dateFlex._1-{-# INLINE year #-}+years :: Dateable d => Lens' d Integer+years = _dateFlex._1+{-# INLINE years #-}  -- | Lens into the month value of a 'Dateable'. --@@ -278,9 +347,9 @@ -- month value will be clipped to a valid month value. Also note that -- the day value might also be modified (clipped to a valid day in -- that month).-month :: Dateable d => Lens' d Int-month = dateFlex._2-{-# INLINE month #-}+months :: Dateable d => Lens' d Int+months = _dateFlex._2+{-# INLINE months #-}  -- | Lens into the day value of a 'Dateable'. --@@ -288,9 +357,9 @@ -- it only obeys the lens laws if used with valid values. The updated -- day value will be clipped to a valid day value in the given -- year-month.-day :: Dateable d => Lens' d Int-day = dateFlex._3-{-# INLINE day #-}+days :: Dateable d => Lens' d Int+days = _dateFlex._3+{-# INLINE days #-}  -------------------------------------------------------------------------------- -- Time of day parts@@ -324,39 +393,42 @@   time = id   {-# INLINE time #-} -instance Timeable FlexTime where-  time f (FlexTime d t) = FlexTime d <$> f t+instance Timeable FlexDateTime where+  time f (FlexDateTime d t) = FlexDateTime d <$> f t   {-# INLINE time #-} +instance Timeable FlexTime where+  time f (FlexTime t) = FlexTime <$> f t+ -- | Lens into the hour value of a 'Timeable'. -- -- Warning: this is not a proper lens for 'UTCTime': it only obeys the -- lens laws if used with valid values.-hour :: Timeable t => Lens' t Int-hour = time.hour'+hours :: Timeable t => Lens' t Int+hours = time.hours'   where-    hour' f (TimeOfDay h m s) = (\h' -> TimeOfDay h' m s) <$> f h-{-# INLINE hour #-}+    hours' f (TimeOfDay h m s) = (\h' -> TimeOfDay h' m s) <$> f h+{-# INLINE hours #-}  -- | Lens into the minute value of a 'Timeable'. -- -- Warning: this is not a proper lens for 'UTCTime': it only obeys the -- lens laws if used with valid values.-minute :: Timeable t => Lens' t Int-minute = time.minute'+minutes :: Timeable t => Lens' t Int+minutes = time.minutes'   where-    minute' f (TimeOfDay h m s) = (\m' -> TimeOfDay h m' s) <$> f m-{-# INLINE minute #-}+    minutes' f (TimeOfDay h m s) = (\m' -> TimeOfDay h m' s) <$> f m+{-# INLINE minutes #-}  -- | Lens into the second value of a 'Timeable'. -- -- Warning: this is not a proper lens for 'UTCTime': it only obeys the -- lens laws if used with valid values.-second :: Timeable t => Lens' t Pico-second = time.second'+seconds :: Timeable t => Lens' t Pico+seconds = time.seconds'   where-    second' f (TimeOfDay h m s) = TimeOfDay h m <$> f s-{-# INLINE second #-}+    seconds' f (TimeOfDay h m s) = TimeOfDay h m <$> f s+{-# INLINE seconds #-}  -------------------------------------------------------------------------------- -- Misc

@@ -1,5 +1,5 @@ name: lens-datetime-version: 0.1.1+version: 0.2 license: BSD3 license-file: LICENSE author: Mihaly Barasz <mihaly@barasz.com>@@ -15,7 +15,10 @@ description:   The @lens-datetime@ library provides a unified lens based accessors   to the various types in @Data.Time.Clock@, @Data.Time.Calendar@ and-  @Data.Time.LocalTime@.+  @Data.Time.LocalTime@. This library only tries to make some of the+  common use-cases convenient, it doesn't aim for completeness. If you+  want completeness and/or efficiency try the @thyme@ package instead+  (<http://hackage.haskell.org/package/thyme>).   .   Demonstration of basic uses.   .@@ -34,25 +37,25 @@   .   You can then do the following:   .-  >> aLocal ^. year+  >> aLocal ^. years   >2013-  >> aUTC ^. month+  >> aUTC ^. months   >8   >> aLocal & time .~ midnight   >2013-08-22 00:00:00-  >> aUTC & day .~ 1 & month .~ 1+  >> aUTC & days .~ 1 & months .~ 1   >2013-01-01 02:04:18.9 UTC   .   You can manipulate the date-time values with proper roll-over   behavior via the @FlexibleDateTime@ mechanism:   .-  >> aLocal & flexDT.month +~ 12+  >> aLocal & flexDT.months +~ 12   >2014-08-22 13:45:28-  >> aUTC & flexDT.day +~ 100+  >> aUTC & flexDT.days +~ 100   >2013-11-30 02:04:18.9 UTC-  >> aLocal & flexDT.minute +~ 120+  >> aLocal & flexDT.minutes +~ 120   >2013-08-22 15:45:28-  >> aLocal & flexDT %~ ((day +~ 7) . (hour +~ 2))+  >> aLocal & flexDT %~ ((days +~ 7) . (hours +~ 2))   >2013-08-22 13:45:28  extra-source-files: