Skip to content

Added enum instance for Date and date implementation of adjust #73

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 6 commits into from
Oct 25, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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