Merge pull request #73 from mschristiansen/enum

Added enum instance for Date and date implementation of adjust

Author: kritzcreek

src/Data/Date.purs

@@ -9,16 +9,18 @@ module Data.Date
   , diff
   , isLeapYear
   , lastDayOfMonth
+  , adjust
   , module Data.Date.Component
   ) where
 
 import Prelude
 
 import Data.Date.Component (Day, Month(..), Weekday(..), Year)
-import Data.Enum (toEnum, fromEnum)
+import Data.Enum (class Enum, toEnum, fromEnum, succ, pred)
 import Data.Function.Uncurried (Fn3, runFn3, Fn4, runFn4, Fn6, runFn6)
-import Data.Maybe (Maybe(..), fromJust)
-import Data.Time.Duration (class Duration, Milliseconds, toDuration)
+import Data.Int (fromNumber)
+import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing)
+import Data.Time.Duration (class Duration, Days(..), Milliseconds, toDuration)
 import Partial.Unsafe (unsafePartial)
 
 -- | A date value in the Gregorian calendar.
@@ -51,6 +53,24 @@ instance boundedDate :: Bounded Date where
 instance showDate :: Show Date where
   show (Date y m d) = "(Date " <> show y <> " " <> show m <> " " <> show d <> ")"
 
+instance enumDate :: Enum Date where
+  succ (Date y m d) = Date <$> y' <*> pure m' <*> d'
+    where
+      d' = if isNothing sd then toEnum 1 else sd
+      m' = if isNothing sd then fromMaybe January sm else m
+      y' = if isNothing sd && isNothing sm then succ y else Just y
+      sd = let v = succ d in if v > Just l then Nothing else v
+      sm = succ m
+      l = lastDayOfMonth y m
+  pred (Date y m d) = Date <$> y' <*> pure m' <*> d'
+    where
+      d' = if isNothing pd then Just l else pd
+      m' = if isNothing pd then fromMaybe December pm else m
+      y' = if isNothing pd && isNothing pm then pred y else Just y
+      pd = pred d
+      pm = pred m
+      l = lastDayOfMonth y m'
+
 -- | The year component of a date value.
 year :: Date -> Year
 year (Date y _ _) = y
@@ -69,6 +89,26 @@ weekday = unsafePartial \(Date y m d) ->
   let n = runFn3 calcWeekday y (fromEnum m) d
   in if n == 0 then fromJust (toEnum 7) else fromJust (toEnum n)
 
+-- | Adjusts a date with a Duration in days. The number of days must
+-- | already be an integer and fall within the valid range of values
+-- | for the Int type.
+adjust :: Days -> Date -> Maybe Date
+adjust (Days n) date = fromNumber n >>= flip adj date
+  where
+    adj 0 dt           = Just dt
+    adj i (Date y m d) = adj i' =<< dt'
+      where
+        i'  | low       = j
+            | hi        = j - fromEnum l - 1
+            | otherwise = 0
+        dt' | low       = pred =<< Date y m <$> toEnum 1
+            | hi        = succ (Date y m l)
+            | otherwise = Date y m <$> toEnum j
+        j   = i + fromEnum d
+        low = j < 1
+        hi  = j > fromEnum l
+        l   = lastDayOfMonth y (if low then fromMaybe December (pred m) else m)
+
 -- | Calculates the difference between two dates, returning the result as a
 -- | duration.
 diff :: forall d. Duration d => Date -> Date -> d

test/Test/Main.purs

@@ -117,6 +117,8 @@ main = do
   let d1 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.January <*> toEnum 1
   let d2 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.February <*> toEnum 1
   let d3 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.March <*> toEnum 1
+  let d4 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2018 <*> pure Date.September <*> toEnum 26
+  let d5 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 1988 <*> pure Date.August <*> toEnum 15
 
   log "Check that diff behaves as expected"
   assert $ Date.diff d2 d1 == Duration.Days 31.0
@@ -132,6 +134,14 @@ main = do
   assert $ Date.month epochDate == bottom
   assert $ Date.day epochDate == bottom
 
+  log "Check that adjust behaves as expected"
+  assert $ Date.adjust (Duration.Days 31.0) d1 == Just d2
+  assert $ Date.adjust (Duration.Days 999.0) d1 == Just d4
+  assert $ Date.adjust (Duration.Days 10000.0) d5 == Just d1
+  assert $ Date.adjust (Duration.Days (-31.0)) d2 == Just d1
+  assert $ Date.adjust (Duration.Days (- 999.0)) d4 == Just d1
+  assert $ Date.adjust (Duration.Days (-10000.0)) d1 == Just d5
+
   -- datetime ----------------------------------------------------------------
 
   let dt1 = DateTime.DateTime d1 t1