diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,1 @@ +Initial hacking done by Chris Heller . diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,6 @@ +time-recurrence is a Haskell library for working with recurring date/times. + +The iCalendar Specifcation (RFC 5545) is used for inspiration of this +library, however the library does not make an effort to track the RFC +at all times. A future Data.Time.Recurrence.RFC5545 library would be +a useful add-on for those in need of strict RFC compliance. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/Time/Recurrence.hs b/src/Data/Time/Recurrence.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Recurrence.hs @@ -0,0 +1,331 @@ +module Data.Time.Recurrence + ( + -- * The @WeekDay@ type + WeekDay (..) + + -- * The @Month@ type + , Month (..) + + -- * The @Recurrence@ type + , toUTCTime + + -- * Frequency Constrcutors for the @Recuurence@ type + , secondly + , minutely + , hourly + , daily + , weekly + , monthly + , yearly + + -- * Generates list of @Recurrence@ type + , recur + + -- * @Recurrence@ type rule effects + , withRules + , byMonth + , byWeekNumber + , byYearDay + ) + where + +import Data.List.Ordered (nub, nubSort) +import Data.Ord (comparing) +import Data.Time +import Data.Time.Calendar.OrdinalDate (fromOrdinalDate, toOrdinalDate) +import Data.Time.Calendar.WeekDate (fromWeekDate) + +-- | The base frequency of a Recurrence. +-- +-- The frequencies are chosen fromRFC 5545. +data Frequency + = Secondly -- ^ every second + | Minutely -- ^ every minute + | Hourly -- ^ every hour + | Daily -- ^ every day + | Weekly -- ^ every week + | Monthly -- ^ every month + | Yearly -- ^ every year + deriving (Show, Eq) + +-- | Symbolic week days. +-- +-- Note: The first Day of the Week is Monday +-- TODO: Move this to a more general library +data WeekDay + = Monday + | Tuesday + | Wednesday + | Thursday + | Friday + | Saturday + | Sunday + deriving (Show, Eq, Ord, Enum, Bounded) + +-- | Symbolic months. +-- +-- TODO: Move this to a more general library +data Month + = January + | February + | March + | April + | May + | June + | July + | August + | September + | October + | November + | December + deriving (Show, Eq, Ord, Bounded) + +instance Enum Month where + fromEnum January = 1 + fromEnum February = 2 + fromEnum March = 3 + fromEnum April = 4 + fromEnum May = 5 + fromEnum June = 6 + fromEnum July = 7 + fromEnum August = 8 + fromEnum September = 9 + fromEnum October = 10 + fromEnum November = 11 + fromEnum December = 12 + + toEnum 1 = January + toEnum 2 = February + toEnum 3 = March + toEnum 4 = April + toEnum 5 = May + toEnum 6 = June + toEnum 7 = July + toEnum 8 = August + toEnum 9 = September + toEnum 10 = October + toEnum 11 = November + toEnum 12 = December + + toEnum unmatched = error ("Month.toEnum: Cannot match " ++ show unmatched) + +-- | Recurrence data type +-- +-- This encapulates a point-in-time of a recurring series +-- from here we can compute the 'next' and 'prev' Recurrence +data Recurrence = R + { frequency :: Frequency -- ^ defines the base frequency + , pointInTime :: UTCTime -- ^ the current moment +-- , startOfWeek :: WeekDay -- ^ used in calculations on a week + -- TODO: compute accurately when this + -- is another value than Monday + -- ^ (RFC 5545 defaults to Monday) + , interval :: Integer -- ^ defines the step size + , rollOver :: Bool -- ^ for values that would exceed the base + -- frequency, we clip them to the freq + -- unless this is True + } + deriving (Show) + +toUTCTime :: Recurrence -> UTCTime +toUTCTime = pointInTime + +instance Eq Recurrence where + x == y = toUTCTime x == toUTCTime y + +instance Ord Recurrence where + x `compare` y = comparing toUTCTime x y + +-- | Moment data type +-- +-- Refinements work on a Moment, which is a UTCTime broken out into fields +data Moment = M + { year :: Integer -- ^ YYYY-January-dd + , month :: Month -- + , day :: Int -- + , hour :: Int -- ^ HH:MM:SS + , minute :: Int -- + , second :: Int -- +-- , week :: Int -- +-- , weekDay :: WeekDay -- + , yearDay :: Int -- + -- , daysInMonth :: Int -- + -- , leapYear :: Bool -- + } + deriving (Show) + +-- | moment conversions +moment :: UTCTime -> Moment +moment (UTCTime utcDay utcTime) = M y (toEnum m) d + hh mm (fromEnum ss) +-- wk (toEnum wkDay) + yDay +-- mDays +-- leap + where + (y, m, d) = toGregorian utcDay + (TimeOfDay hh mm ss) = timeToTimeOfDay utcTime +-- (_, wk, _ wkDay) = toWeekDate utcDay + yDay = snd $ toOrdinalDate utcDay +-- leap = isLeapYear y +-- mDays = monthLength leap m + +momentToUTCTime :: Moment -> UTCTime +momentToUTCTime m = UTCTime d t + where + d = fromGregorian (year m) (fromEnum $ month m) (day m) + t = timeOfDayToTime $ TimeOfDay (hour m) (minute m) (toEnum $ second m) + +-- UTCTime zero +utcEpoch :: UTCTime +utcEpoch = UTCTime (toEnum 0) 0 + +-- Default constructor. Use a more refined constructor instead +mkR :: Frequency -> Recurrence +mkR freq = R { frequency = freq + , pointInTime = utcEpoch +-- , startOfWeek = Monday + , interval = 1 + , rollOver = False + } + +-- | Base 'Recurrence' constructors. One for each of the Frequency types. +secondly :: Recurrence +secondly = mkR Secondly + +minutely :: Recurrence +minutely = mkR Minutely + +hourly :: Recurrence +hourly = mkR Hourly + +daily :: Recurrence +daily = mkR Daily + +weekly :: Recurrence +weekly = mkR Weekly + +monthly :: Recurrence +monthly = mkR Monthly + +yearly :: Recurrence +yearly = mkR Yearly + +-- useful time constants +oneSecond :: Integer +oneSecond = 1 + +oneMinute :: Integer +oneMinute = 60 * oneSecond + +oneHour :: Integer +oneHour = 60 * oneMinute + +oneDay :: Integer +oneDay = 24 * oneHour + +oneWeek :: Integer +oneWeek = 7 * oneDay + +-- UTCTime addition +addTime :: Integer -> UTCTime -> UTCTime +addTime i = addUTCTime (fromIntegral i) + +addUTCDays :: (Integer -> Day -> Day) -> Integer -> UTCTime -> UTCTime +addUTCDays f i (UTCTime d t) = UTCTime (f i d) t + +addMonthsClip :: Integer -> UTCTime -> UTCTime +addMonthsClip = addUTCDays addGregorianMonthsClip + +addMonthsRollOver :: Integer -> UTCTime -> UTCTime +addMonthsRollOver = addUTCDays addGregorianMonthsRollOver + +addMonths :: Bool -> Integer -> UTCTime -> UTCTime +addMonths b = if b then addMonthsRollOver else addMonthsClip + +addYearsClip :: Integer -> UTCTime -> UTCTime +addYearsClip = addUTCDays addGregorianYearsClip + +addYearsRollOver :: Integer -> UTCTime -> UTCTime +addYearsRollOver = addUTCDays addGregorianYearsRollOver + +addYears :: Bool -> Integer -> UTCTime -> UTCTime +addYears b = if b then addYearsRollOver else addYearsClip + +-- | Recurrence addition +scaleUTCTime :: (Integer -> UTCTime -> UTCTime) -> Integer -> Recurrence -> Recurrence +scaleUTCTime f m r = r{pointInTime = f (i * m) t} + where + i = interval r + t = pointInTime r + + +-- | Forward and backward drivers. +next :: Recurrence -> Recurrence +next r = + case frequency r of + Secondly -> scale oneSecond + Minutely -> scale oneMinute + Hourly -> scale oneHour + Daily -> scale oneDay + Weekly -> scale oneWeek + Monthly -> scaleUTCTime (addMonths $ rollOver r) 1 r + Yearly -> scaleUTCTime (addYears $ rollOver r) 1 r + where + scale s = scaleUTCTime addTime s r + +-- | Generate a infinite list of recurrences +recur :: Recurrence -> [Recurrence] +recur = iterate next + +-- | Takes a list of rule parts and apply them over a list of Recurrence +-- to generate a new list of Recurrence +withRules :: [Recurrence -> [Recurrence]] -> [Recurrence] -> [Recurrence] +withRules rs = nub . mapply (map concatMap rs) + where + mapply fs xs = foldl (\xs' f -> f xs') xs fs + +byMonth :: [Month] -> Recurrence -> [Recurrence] +byMonth ms = go + where + go :: Recurrence -> [Recurrence] + go r@(R{frequency=freq, pointInTime=t}) = + case freq of + Yearly -> map (expand r $ moment t) $ nubSort ms + _ -> [r | month (moment t) `elem` ms] + expand :: Recurrence -> Moment -> Month -> Recurrence + expand r mt m = r { pointInTime = momentToUTCTime $ mt { month = m } } + +byWeekNumber :: [Int] -> Recurrence -> [Recurrence] +byWeekNumber wks = go + where + go :: Recurrence -> [Recurrence] + go r@(R{frequency=freq, pointInTime=t}) = + case freq of + Yearly -> map (expand r $ moment t) $ nubSort wks + _ -> error ("Data.Time.Recurrence.byWeekNumber: Undefined on " ++ show r) + expand :: Recurrence -> Moment -> Int -> Recurrence + expand r mt wk = r {pointInTime = momentToUTCTime $ mt {year = y, month = toEnum m, day = d}} + where + (y, m, d) = toGregorian $ fromWeekDate (year mt) wk (day mt) + +byYearDay :: [Int] -> Recurrence -> [Recurrence] +byYearDay dys = go + where + normDay :: Int -> Int + normDay d = if d < 0 then 367 + d else d + normDays = nubSort $ map normDay dys + go :: Recurrence -> [Recurrence] + go r@(R{frequency=freq, pointInTime=t}) = + case freq of + Yearly -> map (expand r $ moment t) normDays + Hourly -> limit r + Minutely -> limit r + Secondly -> limit r + _ -> error ("Data.Time.Recurrence.byYearDay: Undefined on " ++ show r) + limit :: Recurrence -> [Recurrence] + limit r = [r | yearDay (moment $ pointInTime r) `elem` dys] + expand :: Recurrence -> Moment -> Int -> Recurrence + expand r mt dy = r {pointInTime = momentToUTCTime $ mt {year = y, month = toEnum m, day = d}} + where + (y, m, d) = toGregorian $ fromOrdinalDate (year mt) dy diff --git a/time-recurrence.cabal b/time-recurrence.cabal new file mode 100644 --- /dev/null +++ b/time-recurrence.cabal @@ -0,0 +1,75 @@ +-- time-recurrence.cabal auto-generated by cabal init. For additional +-- options, see +-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. +-- The name of the package. +Name: time-recurrence + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.1.1 + +-- A short (one-line) description of the package. +Synopsis: Generate recurring dates. + +-- A longer description of the package. +Description: time-recurrence is a library for generating + recurring dates. + + It is based on the iCalendar spec (RFC 5545). + However it makes no attempt to strictly follow + the spec. + +-- URL for the project homepage or repository. +Homepage: http://github.com/hellertime/time-recurrence + +-- The license under which the package is released. +License: LGPL-3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: Chris Heller + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: hellertime@gmail.com + +-- A copyright notice. +-- Copyright: + +Category: System + +Build-type: Simple + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + +-- Extra files to be distributed with the package, such as examples or +-- a README. +Extra-source-files: + README, AUTHORS + +source-repository head + type: git + location: http://github.com/hellertime/time-recurrence + +Library + hs-source-dirs: src + ghc-options: -Wall + + -- Modules exported by the library. + Exposed-modules: Data.Time.Recurrence + + -- Packages needed in order to build this package. + Build-depends: base >= 4 && < 5, + time >= 1.2 && < 1.2.0.6, + data-ordlist >= 0.4 && < 0.4.5 + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: +