1-- | ISO 8601 Ordinal Date format 2module Data.Time.Calendar.OrdinalDate where 3 4import Data.Time.Calendar.Days 5import Data.Time.Calendar.Private 6 7-- | Convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar), 8-- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31. 9toOrdinalDate :: Day -> (Integer,Int) 10toOrdinalDate (ModifiedJulianDay mjd) = (year,yd) where 11 a = mjd + 678575 12 quadcent = div a 146097 13 b = mod a 146097 14 cent = min (div b 36524) 3 15 c = b - (cent * 36524) 16 quad = div c 1461 17 d = mod c 1461 18 y = min (div d 365) 3 19 yd = fromInteger (d - (y * 365) + 1) 20 year = quadcent * 400 + cent * 100 + quad * 4 + y + 1 21 22-- | Convert from ISO 8601 Ordinal Date format. 23-- Invalid day numbers will be clipped to the correct range (1 to 365 or 366). 24fromOrdinalDate :: Integer -> Int -> Day 25fromOrdinalDate year day = ModifiedJulianDay mjd where 26 y = year - 1 27 mjd = (fromIntegral (clip 1 (if isLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576 28 29-- | Convert from ISO 8601 Ordinal Date format. 30-- Invalid day numbers return 'Nothing' 31fromOrdinalDateValid :: Integer -> Int -> Maybe Day 32fromOrdinalDateValid year day = do 33 day' <- clipValid 1 (if isLeapYear year then 366 else 365) day 34 let 35 y = year - 1 36 mjd = (fromIntegral day') + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576 37 return (ModifiedJulianDay mjd) 38 39-- | Show in ISO 8601 Ordinal Date format (yyyy-ddd) 40showOrdinalDate :: Day -> String 41showOrdinalDate date = (show4 y) ++ "-" ++ (show3 d) where 42 (y,d) = toOrdinalDate date 43 44-- | Is this year a leap year according to the proleptic Gregorian calendar? 45isLeapYear :: Integer -> Bool 46isLeapYear year = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0)) 47 48-- | Get the number of the Monday-starting week in the year and the day of the week. 49-- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as @%W@ in 'Data.Time.Format.formatTime'). 50-- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime'). 51mondayStartWeek :: Day -> (Int,Int) 52mondayStartWeek date = (fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7) + 1) where 53 yd = snd (toOrdinalDate date) 54 d = (toModifiedJulianDay date) + 2 55 k = d - (toInteger yd) 56 57-- | Get the number of the Sunday-starting week in the year and the day of the week. 58-- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as @%U@ in 'Data.Time.Format.formatTime'). 59-- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime'). 60sundayStartWeek :: Day -> (Int,Int) 61sundayStartWeek date =(fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7)) where 62 yd = snd (toOrdinalDate date) 63 d = (toModifiedJulianDay date) + 3 64 k = d - (toInteger yd) 65 66-- | The inverse of 'mondayStartWeek'. Get a 'Day' given the year, 67-- the number of the Monday-starting week, and the day of the week. 68-- The first Monday is the first day of week 1, any earlier days in the year 69-- are week 0 (as @%W@ in 'Data.Time.Format.formatTime'). 70fromMondayStartWeek :: Integer -- ^ Year. 71 -> Int -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime'). 72 -> Int -- ^ Day of week. 73 -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime'). 74 -> Day 75fromMondayStartWeek year w d = let 76 -- first day of the year 77 firstDay = fromOrdinalDate year 1 78 79 -- 0-based year day of first monday of the year 80 zbFirstMonday = (5 - toModifiedJulianDay firstDay) `mod` 7 81 82 -- 0-based week of year 83 zbWeek = w - 1 84 85 -- 0-based day of week 86 zbDay = d - 1 87 88 -- 0-based day in year 89 zbYearDay = zbFirstMonday + 7 * toInteger zbWeek + toInteger zbDay 90 91 in addDays zbYearDay firstDay 92 93fromMondayStartWeekValid :: Integer -- ^ Year. 94 -> Int -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime'). 95 -> Int -- ^ Day of week. 96 -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime'). 97 -> Maybe Day 98fromMondayStartWeekValid year w d = do 99 d' <- clipValid 1 7 d 100 let 101 -- first day of the year 102 firstDay = fromOrdinalDate year 1 103 104 -- 0-based week of year 105 zbFirstMonday = (5 - toModifiedJulianDay firstDay) `mod` 7 106 107 -- 0-based week number 108 zbWeek = w - 1 109 110 -- 0-based day of week 111 zbDay = d' - 1 112 113 -- 0-based day in year 114 zbYearDay = zbFirstMonday + 7 * toInteger zbWeek + toInteger zbDay 115 116 zbYearDay' <- clipValid 0 (if isLeapYear year then 365 else 364) zbYearDay 117 return $ addDays zbYearDay' firstDay 118 119-- | The inverse of 'sundayStartWeek'. Get a 'Day' given the year and 120-- the number of the day of a Sunday-starting week. 121-- The first Sunday is the first day of week 1, any earlier days in the 122-- year are week 0 (as @%U@ in 'Data.Time.Format.formatTime'). 123fromSundayStartWeek :: Integer -- ^ Year. 124 -> Int -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime'). 125 -> Int -- ^ Day of week 126 -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime'). 127 -> Day 128fromSundayStartWeek year w d = let 129 -- first day of the year 130 firstDay = fromOrdinalDate year 1 131 132 -- 0-based year day of first monday of the year 133 zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7 134 135 -- 0-based week of year 136 zbWeek = w - 1 137 138 -- 0-based day of week 139 zbDay = d 140 141 -- 0-based day in year 142 zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay 143 144 in addDays zbYearDay firstDay 145 146fromSundayStartWeekValid :: Integer -- ^ Year. 147 -> Int -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime'). 148 -> Int -- ^ Day of week. 149 -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime'). 150 -> Maybe Day 151fromSundayStartWeekValid year w d = do 152 d' <- clipValid 0 6 d 153 let 154 -- first day of the year 155 firstDay = fromOrdinalDate year 1 156 157 -- 0-based week of year 158 zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7 159 160 -- 0-based week number 161 zbWeek = w - 1 162 163 -- 0-based day of week 164 zbDay = d' 165 166 -- 0-based day in year 167 zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay 168 169 zbYearDay' <- clipValid 0 (if isLeapYear year then 365 else 364) zbYearDay 170 return $ addDays zbYearDay' firstDay 171