Skip to content

Commit

Permalink
Merge pull request #73 from mschristiansen/enum
Browse files Browse the repository at this point in the history
Added enum instance for Date and date implementation of adjust
  • Loading branch information
kritzcreek authored Oct 25, 2018
2 parents ffdd94f + ae79529 commit 525691e
Show file tree
Hide file tree
Showing 2 changed files with 53 additions and 3 deletions.
46 changes: 43 additions & 3 deletions src/Data/Date.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
10 changes: 10 additions & 0 deletions test/Test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 525691e

Please sign in to comment.