module Data.Time.Calendar.Days (
Day (..),
addDays,
diffDays,
DayPeriod (..),
periodAllDays,
periodLength,
periodFromDay,
periodToDay,
periodToDayValid,
) where
import Control.DeepSeq
import Data.Data
import Data.Ix
newtype Day = ModifiedJulianDay
{ toModifiedJulianDay :: Integer
}
deriving (Eq, Ord, Data, Typeable)
instance NFData Day where
rnf (ModifiedJulianDay a) = rnf a
instance Enum Day where
succ (ModifiedJulianDay a) = ModifiedJulianDay (succ a)
pred (ModifiedJulianDay a) = ModifiedJulianDay (pred a)
toEnum = ModifiedJulianDay . toEnum
fromEnum (ModifiedJulianDay a) = fromEnum a
enumFrom (ModifiedJulianDay a) = fmap ModifiedJulianDay (enumFrom a)
enumFromThen (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromThen a b)
enumFromTo (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromTo a b)
enumFromThenTo (ModifiedJulianDay a) (ModifiedJulianDay b) (ModifiedJulianDay c) =
fmap ModifiedJulianDay (enumFromThenTo a b c)
instance Ix Day where
range (ModifiedJulianDay a, ModifiedJulianDay b) = fmap ModifiedJulianDay (range (a, b))
index (ModifiedJulianDay a, ModifiedJulianDay b) (ModifiedJulianDay c) = index (a, b) c
inRange (ModifiedJulianDay a, ModifiedJulianDay b) (ModifiedJulianDay c) = inRange (a, b) c
rangeSize (ModifiedJulianDay a, ModifiedJulianDay b) = rangeSize (a, b)
addDays :: Integer -> Day -> Day
addDays n (ModifiedJulianDay a) = ModifiedJulianDay (a + n)
diffDays :: Day -> Day -> Integer
diffDays (ModifiedJulianDay a) (ModifiedJulianDay b) = a b
class Ord p => DayPeriod p where
periodFirstDay :: p -> Day
periodLastDay :: p -> Day
dayPeriod :: Day -> p
periodAllDays :: DayPeriod p => p -> [Day]
periodAllDays p = [periodFirstDay p .. periodLastDay p]
periodLength :: DayPeriod p => p -> Int
periodLength p = succ $ fromInteger $ diffDays (periodLastDay p) (periodFirstDay p)
periodFromDay :: DayPeriod p => Day -> (p, Int)
periodFromDay d = let
p = dayPeriod d
dt = succ $ fromInteger $ diffDays d $ periodFirstDay p
in (p, dt)
periodToDay :: DayPeriod p => p -> Int -> Day
periodToDay p i = addDays (toInteger $ pred i) $ periodFirstDay p
periodToDayValid :: DayPeriod p => p -> Int -> Maybe Day
periodToDayValid p i = let
d = periodToDay p i
in if fst (periodFromDay d) == p then Just d else Nothing
instance DayPeriod Day where
periodFirstDay = id
periodLastDay = id
dayPeriod = id