{-|
Date parsing and utilities for hledger.
For date and time values, we use the standard Day and UTCTime types.
A 'SmartDate' is a date which may be partially-specified or relative.
Eg 2008\/12\/31, but also 2008\/12, 12\/31, tomorrow, last week, next year.
We represent these as a triple of strings like (\"2008\",\"12\",\"\"),
(\"\",\"\",\"tomorrow\"), (\"\",\"last\",\"week\").
A 'DateSpan' is the span of time between two specific calendar dates, or
an open-ended span where one or both dates are unspecified. (A date span
with both ends unspecified matches all dates.)
An 'Interval' is ledger's "reporting interval" - weekly, monthly,
quarterly, etc.
-}moduleHledger.Data.DateswhereimportData.Time.FormatimportData.Time.Calendar.OrdinalDateimportSafe(readMay)importSystem.Locale(defaultTimeLocale)importText.ParserCombinators.ParsecimportHledger.Data.TypesimportHledger.Data.UtilsshowDate::Day->StringshowDate=formatTimedefaultTimeLocale"%C%y/%m/%d"getCurrentDay::IODaygetCurrentDay=dot<-getZonedTimereturn$localDay(zonedTimeToLocalTimet)elapsedSeconds::Fractionala=>UTCTime->UTCTime->aelapsedSecondst1=realToFrac.diffUTCTimet1-- | Split a DateSpan into one or more consecutive spans at the specified interval.splitSpan::Interval->DateSpan->[DateSpan]splitSpan_(DateSpanNothingNothing)=[DateSpanNothingNothing]splitSpanNoIntervals=[s]splitSpanDailys=splitspanstartofdaynextdayssplitSpanWeeklys=splitspanstartofweeknextweekssplitSpanMonthlys=splitspanstartofmonthnextmonthssplitSpanQuarterlys=splitspanstartofquarternextquarterssplitSpanYearlys=splitspanstartofyearnextyearssplitspan::(Day->Day)->(Day->Day)->DateSpan->[DateSpan]splitspan__(DateSpanNothingNothing)=[]splitspanstartnext(DateSpanNothing(Juste))=[DateSpan(Just$starte)(Just$next$starte)]splitspanstartnext(DateSpan(Justb)Nothing)=[DateSpan(Just$startb)(Just$next$startb)]splitspanstartnextspan@(DateSpan(Justb)(Juste))|b==e=[span]|otherwise=splitspan'startnextspanwheresplitspan'startnext(DateSpan(Justb)(Juste))|b>=e=[]|otherwise=DateSpan(Justs)(Justn):splitspan'startnext(DateSpan(Justn)(Juste))wheres=startbn=nextssplitspan'___=error"won't happen, avoids warnings"-- | Count the days in a DateSpan, or if it is open-ended return Nothing.daysInSpan::DateSpan->MaybeIntegerdaysInSpan(DateSpan(Justd1)(Justd2))=Just$diffDaysd2d1daysInSpan_=Nothing-- | Does the span include the given date ?spanContainsDate::DateSpan->Day->BoolspanContainsDate(DateSpanNothingNothing)_=TruespanContainsDate(DateSpanNothing(Juste))d=d<espanContainsDate(DateSpan(Justb)Nothing)d=d>=bspanContainsDate(DateSpan(Justb)(Juste))d=d>=b&&d<e-- | Combine two datespans, filling any unspecified dates in the first-- with dates from the second.orDatesFrom(DateSpana1b1)(DateSpana2b2)=DateSpanabwherea=ifisJusta1thena1elsea2b=ifisJustb1thenb1elseb2-- | Parse a period expression to an Interval and overall DateSpan using-- the provided reference date, or raise an error.parsePeriodExpr::Day->String->(Interval,DateSpan)parsePeriodExprrefdateexpr=(interval,span)where(interval,span)=fromparse$parsewith(periodexprrefdate)expr-- | Convert a single smart date string to a date span using the provided-- reference date, or raise an error.spanFromSmartDateString::Day->String->DateSpanspanFromSmartDateStringrefdates=spanFromSmartDaterefdatesdatewheresdate=fromparse$parsewithsmartdateonlysspanFromSmartDate::Day->SmartDate->DateSpanspanFromSmartDaterefdatesdate=DateSpan(Justb)(Juste)where(ry,rm,_)=toGregorianrefdate(b,e)=spansdatespan::SmartDate->(Day,Day)span("","","today")=(refdate,nextdayrefdate)span("","this","day")=(refdate,nextdayrefdate)span("","","yesterday")=(prevdayrefdate,refdate)span("","last","day")=(prevdayrefdate,refdate)span("","","tomorrow")=(nextdayrefdate,addDays2refdate)span("","next","day")=(nextdayrefdate,addDays2refdate)span("","last","week")=(prevweekrefdate,thisweekrefdate)span("","this","week")=(thisweekrefdate,nextweekrefdate)span("","next","week")=(nextweekrefdate,startofweek$addDays14refdate)span("","last","month")=(prevmonthrefdate,thismonthrefdate)span("","this","month")=(thismonthrefdate,nextmonthrefdate)span("","next","month")=(nextmonthrefdate,startofmonth$addGregorianMonthsClip2refdate)span("","last","quarter")=(prevquarterrefdate,thisquarterrefdate)span("","this","quarter")=(thisquarterrefdate,nextquarterrefdate)span("","next","quarter")=(nextquarterrefdate,startofquarter$addGregorianMonthsClip6refdate)span("","last","year")=(prevyearrefdate,thisyearrefdate)span("","this","year")=(thisyearrefdate,nextyearrefdate)span("","next","year")=(nextyearrefdate,startofyear$addGregorianYearsClip2refdate)span("","",d)=(day,nextdayday)whereday=fromGregorianryrm(readd)span("",m,"")=(startofmonthday,nextmonthday)whereday=fromGregorianry(readm)1span("",m,d)=(day,nextdayday)whereday=fromGregorianry(readm)(readd)span(y,"","")=(startofyearday,nextyearday)whereday=fromGregorian(ready)11span(y,m,"")=(startofmonthday,nextmonthday)whereday=fromGregorian(ready)(readm)1span(y,m,d)=(day,nextdayday)whereday=fromGregorian(ready)(readm)(readd)showDay::Day->StringshowDayday=printf"%04d/%02d/%02d"ymdwhere(y,m,d)=toGregorianday-- | Convert a smart date string to an explicit yyyy\/mm\/dd string using-- the provided reference date, or raise an error.fixSmartDateStr::Day->String->StringfixSmartDateStrts=eitherparseerrorid$fixSmartDateStrEitherts-- | A safe version of fixSmartDateStr.fixSmartDateStrEither::Day->String->EitherParseErrorStringfixSmartDateStrEitherts=caseparsewithsmartdateonly(lowercases)ofRightsd->Right$showDay$fixSmartDatetsdLefte->Lefte-- | Convert a SmartDate to an absolute date using the provided reference date.fixSmartDate::Day->SmartDate->DayfixSmartDaterefdatesdate=fixsdatewherefix::SmartDate->Dayfix("","","today")=fromGregorianryrmrdfix("","this","day")=fromGregorianryrmrdfix("","","yesterday")=prevdayrefdatefix("","last","day")=prevdayrefdatefix("","","tomorrow")=nextdayrefdatefix("","next","day")=nextdayrefdatefix("","last","week")=prevweekrefdatefix("","this","week")=thisweekrefdatefix("","next","week")=nextweekrefdatefix("","last","month")=prevmonthrefdatefix("","this","month")=thismonthrefdatefix("","next","month")=nextmonthrefdatefix("","last","quarter")=prevquarterrefdatefix("","this","quarter")=thisquarterrefdatefix("","next","quarter")=nextquarterrefdatefix("","last","year")=prevyearrefdatefix("","this","year")=thisyearrefdatefix("","next","year")=nextyearrefdatefix("","",d)=fromGregorianryrm(readd)fix("",m,"")=fromGregorianry(readm)1fix("",m,d)=fromGregorianry(readm)(readd)fix(y,"","")=fromGregorian(ready)11fix(y,m,"")=fromGregorian(ready)(readm)1fix(y,m,d)=fromGregorian(ready)(readm)(readd)(ry,rm,rd)=toGregorianrefdateprevday::Day->Dayprevday=addDays(-1)nextday=addDays1startofday=idthisweek=startofweekprevweek=startofweek.addDays(-7)nextweek=startofweek.addDays7startofweekday=fromMondayStartWeekyw1where(y,_,_)=toGregorianday(w,_)=mondayStartWeekdaythismonth=startofmonthprevmonth=startofmonth.addGregorianMonthsClip(-1)nextmonth=startofmonth.addGregorianMonthsClip1startofmonthday=fromGregorianym1where(y,m,_)=toGregoriandaythisquarter=startofquarterprevquarter=startofquarter.addGregorianMonthsClip(-3)nextquarter=startofquarter.addGregorianMonthsClip3startofquarterday=fromGregoriany(firstmonthofquarterm)1where(y,m,_)=toGregoriandayfirstmonthofquarterm=((m-1)`div`3)*3+1thisyear=startofyearprevyear=startofyear.addGregorianYearsClip(-1)nextyear=startofyear.addGregorianYearsClip1startofyearday=fromGregoriany11where(y,_,_)=toGregorianday------------------------------------------------------------------------ parsingfirstJustms=casedropWhile(==Nothing)msof[]->Nothing(md:_)->md-- | Parse a couple of date-time string formats to a time type.parsedatetimeM::String->MaybeLocalTimeparsedatetimeMs=firstJust[parseTimedefaultTimeLocale"%Y/%m/%d %H:%M:%S"s,parseTimedefaultTimeLocale"%Y-%m-%d %H:%M:%S"s]-- | Parse a couple of date string formats to a time type.parsedateM::String->MaybeDayparsedateMs=firstJust[parseTimedefaultTimeLocale"%Y/%m/%d"s,parseTimedefaultTimeLocale"%Y-%m-%d"s]-- | Parse a date-time string to a time type, or raise an error.parsedatetime::String->LocalTimeparsedatetimes=fromMaybe(error$"could not parse timestamp \""++s++"\"")(parsedatetimeMs)-- | Parse a date string to a time type, or raise an error.parsedate::String->Dayparsedates=fromMaybe(error$"could not parse date \""++s++"\"")(parsedateMs)-- | Parse a time string to a time type using the provided pattern, or-- return the default.parsetimewith::ParseTimet=>String->String->t->tparsetimewithpatsdef=fromMaybedef$parseTimedefaultTimeLocalepats{-|
Parse a date in any of the formats allowed in ledger's period expressions,
and maybe some others:
> 2004
> 2004/10
> 2004/10/1
> 10/1
> 21
> october, oct
> yesterday, today, tomorrow
> (not yet) this/next/last week/day/month/quarter/year
Returns a SmartDate, to be converted to a full date later (see fixSmartDate).
Assumes any text in the parse stream has been lowercased.
-}smartdate::GenParserCharstSmartDatesmartdate=do(y,m,d)<-choice'[yyyymmdd,ymd,ym,md,y,d,month,mon,today,yesterday,tomorrow,lastthisnextthing]return(y,m,d)-- | Like smartdate, but there must be nothing other than whitespace after the date.smartdateonly::GenParserCharstSmartDatesmartdateonly=dod<-smartdatemanyspacenonewlineeofreturnddatesepchar=oneOf"/-."validYear,validMonth,validDay::String->BoolvalidYears=lengths>=4&&isJust(readMays::MaybeInt)validMonths=maybeFalse(\n->n>=1&&n<=12)$readMaysvalidDays=maybeFalse(\n->n>=1&&n<=31)$readMays-- failIfInvalidYear, failIfInvalidMonth, failIfInvalidDay :: afailIfInvalidYears=unless(validYears)$fail$"bad year number: "++sfailIfInvalidMonths=unless(validMonths)$fail$"bad month number: "++sfailIfInvalidDays=unless(validDays)$fail$"bad day number: "++syyyymmdd::GenParserCharstSmartDateyyyymmdd=doy<-count4digitm<-count2digitfailIfInvalidMonthmd<-count2digitfailIfInvalidDaydreturn(y,m,d)ymd::GenParserCharstSmartDateymd=doy<-many1digitfailIfInvalidYearydatesepcharm<-many1digitfailIfInvalidMonthmdatesepchard<-many1digitfailIfInvalidDaydreturn$(y,m,d)ym::GenParserCharstSmartDateym=doy<-many1digitfailIfInvalidYearydatesepcharm<-many1digitfailIfInvalidMonthmreturn(y,m,"")y::GenParserCharstSmartDatey=doy<-many1digitfailIfInvalidYearyreturn(y,"","")d::GenParserCharstSmartDated=dod<-many1digitfailIfInvalidDaydreturn("","",d)md::GenParserCharstSmartDatemd=dom<-many1digitfailIfInvalidMonthmdatesepchard<-many1digitfailIfInvalidDaydreturn("",m,d)months=["january","february","march","april","may","june","july","august","september","october","november","december"]monthabbrevs=["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]weekdays=["monday","tuesday","wednesday","thursday","friday","saturday","sunday"]weekdayabbrevs=["mon","tue","wed","thu","fri","sat","sun"]monthIndexs=maybe0(+1)$lowercases`elemIndex`monthsmonIndexs=maybe0(+1)$lowercases`elemIndex`monthabbrevsmonth::GenParserCharstSmartDatemonth=dom<-choice$map(try.string)monthsleti=monthIndexmreturn("",showi,"")mon::GenParserCharstSmartDatemon=dom<-choice$map(try.string)monthabbrevsleti=monIndexmreturn("",showi,"")today,yesterday,tomorrow::GenParserCharstSmartDatetoday=string"today">>return("","","today")yesterday=string"yesterday">>return("","","yesterday")tomorrow=string"tomorrow">>return("","","tomorrow")lastthisnextthing::GenParserCharstSmartDatelastthisnextthing=dor<-choice[string"last",string"this",string"next"]manyspacenonewline-- make the space optional for easier scriptingp<-choice[string"day",string"week",string"month",string"quarter",string"year"]-- XXX support these in fixSmartDate-- ++ (map string $ months ++ monthabbrevs ++ weekdays ++ weekdayabbrevs)return("",r,p)periodexpr::Day->GenParserCharst(Interval,DateSpan)periodexprrdate=choice$maptry[intervalanddateperiodexprrdate,intervalperiodexpr,dateperiodexprrdate,(return(NoInterval,DateSpanNothingNothing))]intervalanddateperiodexpr::Day->GenParserCharst(Interval,DateSpan)intervalanddateperiodexprrdate=domanyspacenonewlinei<-periodexprintervalmanyspacenonewlines<-periodexprdatespanrdatereturn(i,s)intervalperiodexpr::GenParserCharst(Interval,DateSpan)intervalperiodexpr=domanyspacenonewlinei<-periodexprintervalreturn(i,DateSpanNothingNothing)dateperiodexpr::Day->GenParserCharst(Interval,DateSpan)dateperiodexprrdate=domanyspacenonewlines<-periodexprdatespanrdatereturn(NoInterval,s)periodexprinterval::GenParserCharstIntervalperiodexprinterval=choice$maptry[tryinterval"day""daily"Daily,tryinterval"week""weekly"Weekly,tryinterval"month""monthly"Monthly,tryinterval"quarter""quarterly"Quarterly,tryinterval"year""yearly"Yearly]wheretryintervals1s2v=choice[try(string$"every "++s1),try(strings2)]>>returnvperiodexprdatespan::Day->GenParserCharstDateSpanperiodexprdatespanrdate=choice$maptry[doubledatespanrdate,fromdatespanrdate,todatespanrdate,justdatespanrdate]doubledatespan::Day->GenParserCharstDateSpandoubledatespanrdate=dooptional(string"from">>manyspacenonewline)b<-smartdatemanyspacenonewlineoptional(string"to">>manyspacenonewline)e<-smartdatereturn$DateSpan(Just$fixSmartDaterdateb)(Just$fixSmartDaterdatee)fromdatespan::Day->GenParserCharstDateSpanfromdatespanrdate=dostring"from">>manyspacenonewlineb<-smartdatereturn$DateSpan(Just$fixSmartDaterdateb)Nothingtodatespan::Day->GenParserCharstDateSpantodatespanrdate=dostring"to">>manyspacenonewlinee<-smartdatereturn$DateSpanNothing(Just$fixSmartDaterdatee)justdatespan::Day->GenParserCharstDateSpanjustdatespanrdate=dooptional(string"in">>manyspacenonewline)d<-smartdatereturn$spanFromSmartDaterdatedmkdatespan::String->String->DateSpanmkdatespanb=DateSpan(Just$parsedateb).Just.parsedatenulldatespan=DateSpanNothingNothingnulldate=parsedate"1900/01/01"tests_Dates=TestList["splitSpan"~:doletgives(interval,span)=(splitSpanintervalspan`is`)(NoInterval,mkdatespan"2008/01/01""2009/01/01")`gives`[mkdatespan"2008/01/01""2009/01/01"](Quarterly,mkdatespan"2008/01/01""2009/01/01")`gives`[mkdatespan"2008/01/01""2008/04/01",mkdatespan"2008/04/01""2008/07/01",mkdatespan"2008/07/01""2008/10/01",mkdatespan"2008/10/01""2009/01/01"](Quarterly,nulldatespan)`gives`[nulldatespan](Daily,mkdatespan"2008/01/01""2008/01/01")`gives`[mkdatespan"2008/01/01""2008/01/01"](Quarterly,mkdatespan"2008/01/01""2008/01/01")`gives`[mkdatespan"2008/01/01""2008/01/01"]]