-- Copyright (C) 2004 David Roundy---- This program is free software; you can redistribute it and/or modify-- it under the terms of the GNU General Public License as published by-- the Free Software Foundation; either version 2, or (at your option)-- any later version.---- This program is distributed in the hope that it will be useful,-- but WITHOUT ANY WARRANTY; without even the implied warranty of-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-- GNU General Public License for more details.---- You should have received a copy of the GNU General Public License-- along with this program; see the file COPYING. If not, write to-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,-- Boston, MA 02110-1301, USA.{-# OPTIONS_GHC -fglasgow-exts #-}{-# LANGUAGE ExistentialQuantification #-}moduleDateMatcher(parseDateMatcher-- for debugging only,DateMatcher(..),getMatchers)whereimportControl.Exception(catchJust,userErrors)importData.Maybe(isJust)importSystem.TimeimportIsoDate(parseDate,englishDateTime,englishInterval,englishLast,iso8601_interval,resetCalendar,subtractFromMCal,getLocalTz,MCalendarTime(..),toMCalendarTime,unsafeToCalendarTime,unsetTime,)importText.ParserCombinators.Parsec(eof,parse,ParseError)-- | 'withinDay' @x y@ is true if @x <= y < (x + one_day)@-- Note that this converts the two dates to @ClockTime@ to avoid-- any timezone-related errorswithinDay::CalendarTime->CalendarTime->BoolwithinDayab=within(Just$toClockTimea)(Just(addToClockTimeday$toClockTimea))(toClockTimeb)whereday=TimeDiff0010000-- | 'dateRange' @x1 x2 y@ is true if @x1 <= y < x2@-- Since @x1@ and @x2@ can be underspecified, we simply assume the-- first date that they could stand for.dateRange::MaybeMCalendarTime->MaybeMCalendarTime->CalendarTime->BooldateRangeabc=cDateRange(fmapunsafeToCalendarTimea)(fmapunsafeToCalendarTimeb)c-- | 'cDateRange' @x1 x2 y@ is true if @x1 <= y < x2@cDateRange::MaybeCalendarTime->MaybeCalendarTime->CalendarTime->BoolcDateRangeabc=within(fmaptoClockTimea)(fmaptoClockTimeb)(toClockTimec)-- | 'within' @x1 x2 y@ is true if @x1 <= y < x2@within::MaybeClockTime->MaybeClockTime->ClockTime->Boolwithin(Juststart)(Justend)time=start<=time&&time<endwithinNothing(Justend)time=time<endwithin(Juststart)Nothingtime=start<=timewithin___=undefined-- | 'samePartialDate' @range exact@ is true if @exact@ falls-- within the a range of dates represented by @range@.-- The purpose of this function is to support matching on partially-- specified dates. That is, if you only specify the date 2007,-- this function should match any dates within that year. On the-- other hand, if you specify 2007-01, this function will match any-- dates within that month. This function only matches up to the-- second.samePartialDate::MCalendarTime->CalendarTime->BoolsamePartialDateab_=within(JustclockA)(Just$addToClockTimeintervalclockA)(toClockTimecalB)whereinterval|isJust(mctSeca)=second|isJust(mctMina)=minute|isJust(mctHoura)=hour|isJust(mctYDaya)=day|mctWeeka=maybeweek(constday)(mctWDaya)|isJust(mctDaya)=day|isJust(mctMontha)=month|otherwise=yearyear=TimeDiff1000000month=TimeDiff0100000week=TimeDiff0070000day=TimeDiff0010000hour=TimeDiff0001000minute=TimeDiff0000100second=TimeDiff0000010--clockA=toClockTime$unsafeToCalendarTimeacalB=resetCalendarb_-- | A 'DateMatcher' combines a potential parse for a date string-- with a "matcher" function that operates on a given date.-- We use an existential type on the matcher to allow-- the date string to either be interpreted as a point in time-- or as an interval.dataDateMatcher=foralld.(Showd)=>DMString-- name(EitherParseErrord)-- parser(d->CalendarTime->Bool)-- matcher-- | 'parseDateMatcher' @s@ return the first matcher in-- 'getMatchers' that can parse 's'parseDateMatcher::String->IO(CalendarTime->Bool)parseDateMatcherd=domatcher<-tryMatchers`fmap`getMatchersd-- Hack: test the matcher against the current date and discard the results.-- We just want to make sure it won't throw any exceptions when we use it for real.matcher`fmap`now>>=(`seq`returnmatcher)`catchUserError`-- If the user enters a date > maxint seconds ago, the toClockTime-- function cannot work.\e->ife=="Time.toClockTime: invalid input"thenerror"Can't handle dates that far back!"elseerrorewherecatchUserError=catchJustuserErrors-- | 'getMatchers' @d@ returns the list of matchers that will be-- applied on @d@. If you wish to extend the date parsing code,-- this will likely be the function that you modify to do so.getMatchers::String->IO[DateMatcher]getMatchersd=dorightNow<-nowletmidnightToday=unsetTimerightNowmRightNow=toMCalendarTimerightNowmatchIsoInterval(Leftdur)=dateRange(Just$dur`subtractFromMCal`mRightNow)(JustmRightNow)matchIsoInterval(Right(a,b))=dateRange(Justa)(Justb)tzNow<-getLocalTzreturn-- note that the order of these is quite important as some matchers-- can match the same date.[DM"from English date"(parseDateWith$englishLastmidnightToday)(\(a,_)->cDateRange(Justa)Nothing),DM"specific English date"(parseDateWith$englishDateTimemidnightToday)withinDay,DM"English interval"(parseDateWith$englishIntervalrightNow)(uncurrycDateRange),DM"ISO 8601 interval"(parseDateWith$iso8601_intervaltzNow)matchIsoInterval,DM"CVS, ISO 8601, or old style date"(parseDatetzNowd)samePartialDate]wheretillEofp=do{x<-p;eof;returnx}parseDateWithp=parse(tillEofp)""d-- | 'tryMatchers' @ms@ returns the first successful match in @ms@-- It is an error if there are no matchestryMatchers::[DateMatcher]->(CalendarTime->Bool)tryMatchers(DM_parsedmatcher:ms)=caseparsedofLeft_->tryMatchersmsRightd->matcherdtryMatchers[]=error"Can't support fancy dates."-- darcs-doc: self-explanatorynow::IOCalendarTimenow=getClockTime>>=toCalendarTime