← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to libraries/time/Data/Time/Calendar/MonthDay.hs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libraries/time/Data/Time/Calendar/MonthDay.hs
 
1
module Data.Time.Calendar.MonthDay
 
2
        (
 
3
        monthAndDayToDayOfYear,monthAndDayToDayOfYearValid,dayOfYearToMonthAndDay,monthLength
 
4
        ) where
 
5
 
 
6
import Data.Time.Calendar.Private
 
7
 
 
8
-- | convert month and day in the Gregorian or Julian calendars to day of year.
 
9
-- First arg is leap year flag
 
10
monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int
 
11
monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + day' where
 
12
        month' = clip 1 12 month
 
13
        day' = fromIntegral (clip 1 (monthLength' isLeap month') day)
 
14
        month'' = fromIntegral month'
 
15
        k = if month' <= 2 then 0 else if isLeap then -1 else -2
 
16
 
 
17
-- | convert month and day in the Gregorian or Julian calendars to day of year.
 
18
-- First arg is leap year flag
 
19
monthAndDayToDayOfYearValid :: Bool -> Int -> Int -> Maybe Int
 
20
monthAndDayToDayOfYearValid isLeap month day = do
 
21
        month' <- clipValid 1 12 month
 
22
        day' <- clipValid 1 (monthLength' isLeap month') day
 
23
        let
 
24
                day'' = fromIntegral day'
 
25
                month'' = fromIntegral month'
 
26
                k = if month' <= 2 then 0 else if isLeap then -1 else -2
 
27
        return ((div (367 * month'' - 362) 12) + k + day'')
 
28
 
 
29
-- | convert day of year in the Gregorian or Julian calendars to month and day.
 
30
-- First arg is leap year flag
 
31
dayOfYearToMonthAndDay :: Bool -> Int -> (Int,Int)
 
32
dayOfYearToMonthAndDay isLeap yd = findMonthDay (monthLengths isLeap) (clip 1 (if isLeap then 366 else 365) yd)
 
33
 
 
34
findMonthDay :: [Int] -> Int -> (Int,Int)
 
35
findMonthDay (n:ns) yd | yd > n = (\(m,d) -> (m + 1,d)) (findMonthDay ns (yd - n))
 
36
findMonthDay _ yd = (1,yd)
 
37
 
 
38
-- | the length of a given month in the Gregorian or Julian calendars.
 
39
-- First arg is leap year flag
 
40
monthLength :: Bool -> Int -> Int
 
41
monthLength isLeap month' = monthLength' isLeap (clip 1 12 month')
 
42
 
 
43
monthLength' :: Bool -> Int -> Int
 
44
monthLength' isLeap month' = (monthLengths isLeap) !! (month' - 1)
 
45
 
 
46
monthLengths :: Bool -> [Int]
 
47
monthLengths isleap = 
 
48
        [31,if isleap then 29 else 28,31,30,31,30,31,31,30,31,30,31]
 
49
        --J        F                   M  A  M  J  J  A  S  O  N  D