{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PackageImports #-}
module Hledger.Data.Dates (
getCurrentDay,
getCurrentMonth,
getCurrentYear,
nulldate,
spanContainsDate,
periodContainsDate,
parsedateM,
showDate,
showDateSpan,
showDateSpanMonthAbbrev,
elapsedSeconds,
prevday,
periodexprp,
parsePeriodExpr,
parsePeriodExpr',
nulldatespan,
emptydatespan,
datesepchar,
datesepchars,
isDateSepChar,
spanStart,
spanEnd,
spanStartYear,
spanEndYear,
spanYears,
spansSpan,
spanIntersect,
spansIntersect,
spanDefaultsFrom,
spanUnion,
spansUnion,
daysSpan,
latestSpanContaining,
smartdate,
splitSpan,
fixSmartDate,
fixSmartDateStr,
fixSmartDateStrEither,
fixSmartDateStrEither',
yearp,
daysInSpan,
maybePeriod,
)
where
import Prelude ()
import "base-compat-batteries" Prelude.Compat hiding (fail)
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (MonadFail, fail)
import Control.Applicative (liftA2)
import Control.Applicative.Permutations
import Control.Monad (guard, unless)
import "base-compat-batteries" Data.List.Compat
import Data.Char (digitToInt, isDigit, ord)
import Data.Default
import Data.Foldable (asum)
import Data.Function (on)
import Data.Maybe
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Format hiding (months)
import Data.Time.Calendar
import Data.Time.Calendar.OrdinalDate
import Data.Time.Clock
import Data.Time.LocalTime
import Safe (headMay, lastMay, maximumMay, minimumMay)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Custom
import Text.Printf
import Hledger.Data.Types
import Hledger.Data.Period
import Hledger.Utils
instance Show DateSpan where
show s = "DateSpan " ++ showDateSpan s
showDate :: Day -> String
showDate = show
showDateSpan :: DateSpan -> String
showDateSpan = showPeriod . dateSpanAsPeriod
showDateSpanMonthAbbrev :: DateSpan -> String
showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod
getCurrentDay :: IO Day
getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime
getCurrentMonth :: IO Int
getCurrentMonth = second3 . toGregorian <$> getCurrentDay
getCurrentYear :: IO Integer
getCurrentYear = first3 . toGregorian <$> getCurrentDay
elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
elapsedSeconds t1 = realToFrac . diffUTCTime t1
spanStart :: DateSpan -> Maybe Day
spanStart (DateSpan d _) = d
spanEnd :: DateSpan -> Maybe Day
spanEnd (DateSpan _ d) = d
spanStartYear :: DateSpan -> Maybe Year
spanStartYear (DateSpan d _) = fmap (first3 . toGregorian) d
spanEndYear :: DateSpan -> Maybe Year
spanEndYear (DateSpan d _) = fmap (first3 . toGregorian) d
spanYears :: DateSpan -> [Year]
spanYears (DateSpan ma mb) = mapMaybe (fmap (first3 . toGregorian)) [ma,mb]
spansSpan :: [DateSpan] -> DateSpan
spansSpan spans = DateSpan (maybe Nothing spanStart $ headMay spans) (maybe Nothing spanEnd $ lastMay spans)
splitSpan :: Interval -> DateSpan -> [DateSpan]
splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
splitSpan _ s | isEmptySpan s = []
splitSpan NoInterval s = [s]
splitSpan (Days n) s = splitspan startofday (applyN n nextday) s
splitSpan (Weeks n) s = splitspan startofweek (applyN n nextweek) s
splitSpan (Months n) s = splitspan startofmonth (applyN n nextmonth) s
splitSpan (Quarters n) s = splitspan startofquarter (applyN n nextquarter) s
splitSpan (Years n) s = splitspan startofyear (applyN n nextyear) s
splitSpan (DayOfMonth n) s = splitspan (nthdayofmonthcontaining n) (nthdayofmonth n . nextmonth) s
splitSpan (WeekdayOfMonth n wd) s = splitspan (nthweekdayofmonthcontaining n wd) (advancetonthweekday n wd . nextmonth) s
splitSpan (DayOfWeek n) s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) s
splitSpan (DayOfYear m n) s = splitspan (nthdayofyearcontaining m n) (applyN (n-1) nextday . applyN (m-1) nextmonth . nextyear) s
splitspan :: (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
splitspan _ _ (DateSpan Nothing Nothing) = []
splitspan start next (DateSpan Nothing (Just e)) = splitspan start next (DateSpan (Just $ start e) (Just $ next $ start e))
splitspan start next (DateSpan (Just s) Nothing) = splitspan start next (DateSpan (Just $ start s) (Just $ next $ start s))
splitspan start next span@(DateSpan (Just s) (Just e))
| s == e = [span]
| otherwise = splitspan' start next span
where
splitspan' start next (DateSpan (Just s) (Just e))
| s >= e = []
| otherwise = DateSpan (Just subs) (Just sube) : splitspan' start next (DateSpan (Just sube) (Just e))
where subs = start s
sube = next subs
splitspan' _ _ _ = error' "won't happen, avoids warnings"
daysInSpan :: DateSpan -> Maybe Integer
daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays d2 d1
daysInSpan _ = Nothing
isEmptySpan :: DateSpan -> Bool
isEmptySpan (DateSpan (Just s) (Just e)) = e <= s
isEmptySpan _ = False
spanContainsDate :: DateSpan -> Day -> Bool
spanContainsDate (DateSpan Nothing Nothing) _ = True
spanContainsDate (DateSpan Nothing (Just e)) d = d < e
spanContainsDate (DateSpan (Just b) Nothing) d = d >= b
spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e
periodContainsDate :: Period -> Day -> Bool
periodContainsDate p = spanContainsDate (periodAsDateSpan p)
spansIntersect [] = nulldatespan
spansIntersect [d] = d
spansIntersect (d:ds) = d `spanIntersect` (spansIntersect ds)
spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
where
b = latest b1 b2
e = earliest e1 e2
spanDefaultsFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b
where a = if isJust a1 then a1 else a2
b = if isJust b1 then b1 else b2
spansUnion [] = nulldatespan
spansUnion [d] = d
spansUnion (d:ds) = d `spanUnion` (spansUnion ds)
spanUnion (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
where
b = earliest b1 b2
e = latest e1 e2
latest d Nothing = d
latest Nothing d = d
latest (Just d1) (Just d2) = Just $ max d1 d2
earliest d Nothing = d
earliest Nothing d = d
earliest (Just d1) (Just d2) = Just $ min d1 d2
daysSpan :: [Day] -> DateSpan
daysSpan ds = DateSpan (minimumMay ds) (addDays 1 <$> maximumMay ds)
latestSpanContaining :: [DateSpan] -> Day -> Maybe DateSpan
latestSpanContaining datespans = go
where
go day = do
span <- Set.lookupLT supSpan spanSet
guard $ spanContainsDate span day
return span
where
supSpan = DateSpan (Just $ addDays 1 day) Nothing
spanSet = Set.fromList $ filter (not . isEmptySpan) datespans
parsePeriodExpr
:: Day -> Text -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s)
parsePeriodExpr' :: Day -> Text -> (Interval, DateSpan)
parsePeriodExpr' refdate s =
either (error' . ("failed to parse:" ++) . customErrorBundlePretty) id $
parsePeriodExpr refdate s
maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate
spanFromSmartDate :: Day -> SmartDate -> DateSpan
spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
where
(ry,rm,_) = toGregorian refdate
(b,e) = span sdate
span :: SmartDate -> (Day,Day)
span (SmartRelative This Day) = (refdate, nextday refdate)
span (SmartRelative Last Day) = (prevday refdate, refdate)
span (SmartRelative Next Day) = (nextday refdate, addDays 2 refdate)
span (SmartRelative This Week) = (thisweek refdate, nextweek refdate)
span (SmartRelative Last Week) = (prevweek refdate, thisweek refdate)
span (SmartRelative Next Week) = (nextweek refdate, startofweek $ addDays 14 refdate)
span (SmartRelative This Month) = (thismonth refdate, nextmonth refdate)
span (SmartRelative Last Month) = (prevmonth refdate, thismonth refdate)
span (SmartRelative Next Month) = (nextmonth refdate, startofmonth $ addGregorianMonthsClip 2 refdate)
span (SmartRelative This Quarter) = (thisquarter refdate, nextquarter refdate)
span (SmartRelative Last Quarter) = (prevquarter refdate, thisquarter refdate)
span (SmartRelative Next Quarter) = (nextquarter refdate, startofquarter $ addGregorianMonthsClip 6 refdate)
span (SmartRelative This Year) = (thisyear refdate, nextyear refdate)
span (SmartRelative Last Year) = (prevyear refdate, thisyear refdate)
span (SmartRelative Next Year) = (nextyear refdate, startofyear $ addGregorianYearsClip 2 refdate)
span (SmartAssumeStart y Nothing) = (startofyear day, nextyear day) where day = fromGregorian y 1 1
span (SmartAssumeStart y (Just (m, Nothing))) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1
span (SmartAssumeStart y (Just (m, Just d))) = (day, nextday day) where day = fromGregorian y m d
span (SmartFromReference m d) = (day, nextday day) where day = fromGregorian ry (fromMaybe rm m) d
span (SmartMonth m) = (startofmonth day, nextmonth day) where day = fromGregorian ry m 1
fixSmartDateStr :: Day -> Text -> String
fixSmartDateStr d s =
either (error' . printf "could not parse date %s %s" (show s) . show) id $
(fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String)
fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String
fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d
fixSmartDateStrEither'
:: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
Right sd -> Right $ fixSmartDate d sd
Left e -> Left e
fixSmartDate :: Day -> SmartDate -> Day
fixSmartDate refdate = fix
where
fix :: SmartDate -> Day
fix (SmartRelative This Day) = refdate
fix (SmartRelative Last Day) = prevday refdate
fix (SmartRelative Next Day) = nextday refdate
fix (SmartRelative This Week) = thisweek refdate
fix (SmartRelative Last Week) = prevweek refdate
fix (SmartRelative Next Week) = nextweek refdate
fix (SmartRelative This Month) = thismonth refdate
fix (SmartRelative Last Month) = prevmonth refdate
fix (SmartRelative Next Month) = nextmonth refdate
fix (SmartRelative This Quarter) = thisquarter refdate
fix (SmartRelative Last Quarter) = prevquarter refdate
fix (SmartRelative Next Quarter) = nextquarter refdate
fix (SmartRelative This Year) = thisyear refdate
fix (SmartRelative Last Year) = prevyear refdate
fix (SmartRelative Next Year) = nextyear refdate
fix (SmartAssumeStart y md) = fromGregorian y (maybe 1 fst md) (fromMaybe 1 $ snd =<< md)
fix (SmartFromReference m d) = fromGregorian ry (fromMaybe rm m) d
fix (SmartMonth m) = fromGregorian ry m 1
(ry, rm, _) = toGregorian refdate
prevday :: Day -> Day
prevday = addDays (-1)
nextday = addDays 1
startofday = id
thisweek = startofweek
prevweek = startofweek . addDays (-7)
nextweek = startofweek . addDays 7
startofweek day = fromMondayStartWeek y w 1
where
(y,_,_) = toGregorian day
(w,_) = mondayStartWeek day
thismonth = startofmonth
prevmonth = startofmonth . addGregorianMonthsClip (-1)
nextmonth = startofmonth . addGregorianMonthsClip 1
startofmonth day = fromGregorian y m 1 where (y,m,_) = toGregorian day
nthdayofmonth d day = fromGregorian y m d where (y,m,_) = toGregorian day
thisquarter = startofquarter
prevquarter = startofquarter . addGregorianMonthsClip (-3)
nextquarter = startofquarter . addGregorianMonthsClip 3
startofquarter day = fromGregorian y (firstmonthofquarter m) 1
where
(y,m,_) = toGregorian day
firstmonthofquarter m = ((m-1) `div` 3) * 3 + 1
thisyear = startofyear
prevyear = startofyear . addGregorianYearsClip (-1)
nextyear = startofyear . addGregorianYearsClip 1
startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
nthdayofyearcontaining :: Month -> MonthDay -> Day -> Day
nthdayofyearcontaining m md date
| not (validMonth m) = error' $ "nthdayofyearcontaining: invalid month "++show m
| not (validDay md) = error' $ "nthdayofyearcontaining: invalid day " ++show md
| mmddOfSameYear <= date = mmddOfSameYear
| otherwise = mmddOfPrevYear
where mmddOfSameYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth s
mmddOfPrevYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth $ prevyear s
s = startofyear date
nthdayofmonthcontaining :: MonthDay -> Day -> Day
nthdayofmonthcontaining md date
| not (validDay md) = error' $ "nthdayofmonthcontaining: invalid day " ++show md
| nthOfSameMonth <= date = nthOfSameMonth
| otherwise = nthOfPrevMonth
where nthOfSameMonth = nthdayofmonth md s
nthOfPrevMonth = nthdayofmonth md $ prevmonth s
s = startofmonth date
nthdayofweekcontaining :: WeekDay -> Day -> Day
nthdayofweekcontaining n d | nthOfSameWeek <= d = nthOfSameWeek
| otherwise = nthOfPrevWeek
where nthOfSameWeek = addDays (toInteger n-1) s
nthOfPrevWeek = addDays (toInteger n-1) $ prevweek s
s = startofweek d
nthweekdayofmonthcontaining :: Int -> WeekDay -> Day -> Day
nthweekdayofmonthcontaining n wd d | nthWeekdaySameMonth <= d = nthWeekdaySameMonth
| otherwise = nthWeekdayPrevMonth
where nthWeekdaySameMonth = advancetonthweekday n wd $ startofmonth d
nthWeekdayPrevMonth = advancetonthweekday n wd $ prevmonth d
advancetonthweekday :: Int -> WeekDay -> Day -> Day
advancetonthweekday n wd s =
maybe err (addWeeks (n-1)) $ firstMatch (>=s) $ iterate (addWeeks 1) $ firstweekday s
where
err = error' "advancetonthweekday: should not happen"
addWeeks k = addDays (7 * toInteger k)
firstMatch p = headMay . dropWhile (not . p)
firstweekday = addDays (toInteger wd-1) . startofweek
parsedateM :: String -> Maybe Day
parsedateM s = asum [
parseTimeM True defaultTimeLocale "%Y-%m-%d" s,
parseTimeM True defaultTimeLocale "%Y/%m/%d" s,
parseTimeM True defaultTimeLocale "%Y.%m.%d" s
]
smartdate :: TextParser m SmartDate
smartdate = choice'
[ yyyymmdd, ymd
, (\(m,d) -> SmartFromReference (Just m) d) <$> md
, (SmartFromReference Nothing <$> decimal) >>= failIfInvalidDate
, SmartMonth <$> (month <|> mon)
, SmartRelative This Day <$ string' "today"
, SmartRelative Last Day <$ string' "yesterday"
, SmartRelative Next Day <$ string' "tomorrow"
, liftA2 SmartRelative (seqP <* skipNonNewlineSpaces) intervalP
]
where
seqP = choice [This <$ string' "this", Last <$ string' "last", Next <$ string' "next"]
intervalP = choice [Day <$ string' "day", Week <$ string' "week", Month <$ string' "month",
Quarter <$ string' "quarter", Year <$ string' "year"]
smartdateonly :: TextParser m SmartDate
smartdateonly = smartdate <* skipNonNewlineSpaces <* eof
datesepchars :: String
datesepchars = "/-."
datesepchar :: TextParser m Char
datesepchar = satisfy isDateSepChar
isDateSepChar :: Char -> Bool
isDateSepChar c = c == '-' || c == '/' || c == '.'
validMonth, validDay :: Int -> Bool
validMonth n = n >= 1 && n <= 12
validDay n = n >= 1 && n <= 31
failIfInvalidDate :: Fail.MonadFail m => SmartDate -> m SmartDate
failIfInvalidDate s = unless isValid (Fail.fail $ "bad smart date: " ++ show s) *> return s
where isValid = case s of
SmartAssumeStart y (Just (m, md)) -> isJust $ fromGregorianValid y m (fromMaybe 1 md)
SmartFromReference mm d -> isJust $ fromGregorianValid 2004 (fromMaybe 1 mm) d
SmartMonth m -> validMonth m
_ -> True
yyyymmdd :: TextParser m SmartDate
yyyymmdd = do
y <- read <$> count 4 digitChar
m <- read <$> count 2 digitChar
d <- optional $ read <$> count 2 digitChar
let date = SmartAssumeStart y $ Just (m, d)
failIfInvalidDate date
ymd :: TextParser m SmartDate
ymd = liftA2 SmartAssumeStart yearp (optional $ try monthday) >>= failIfInvalidDate
where monthday = do
sep <- datesepchar
liftA2 (,) decimal . optional $ char sep *> decimal
md :: TextParser m (Month, MonthDay)
md = do
m <- decimal
datesepchar
d <- decimal
_ <- failIfInvalidDate $ SmartFromReference (Just m) d
return (m, d)
yearp :: TextParser m Integer
yearp = do
year <- takeWhile1P (Just "year") isDigit
unless (T.length year >= 4) . Fail.fail $ "Year must contain at least 4 digits: " <> T.unpack year
return $ readDecimal year
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"]
month, mon :: TextParser m Month
month = choice $ zipWith (\i m -> i <$ string' m) [1..12] months
mon = choice $ zipWith (\i m -> i <$ string' m) [1..12] monthabbrevs
weekday :: TextParser m Int
weekday = do
wday <- T.toLower <$> (choice . map string' $ weekdays ++ weekdayabbrevs)
case catMaybes $ [wday `elemIndex` weekdays, wday `elemIndex` weekdayabbrevs] of
(i:_) -> return (i+1)
[] -> Fail.fail $ "weekday: should not happen: attempted to find " <>
show wday <> " in " <> show (weekdays ++ weekdayabbrevs)
periodexprp :: Day -> TextParser m (Interval, DateSpan)
periodexprp rdate = do
skipNonNewlineSpaces
choice' [ intervalanddateperiodexprp rdate
, (,) NoInterval <$> periodexprdatespanp rdate
]
intervalanddateperiodexprp :: Day -> TextParser m (Interval, DateSpan)
intervalanddateperiodexprp rdate = do
i <- reportingintervalp
s <- option def . try $ do
skipNonNewlineSpaces
periodexprdatespanp rdate
return (i,s)
reportingintervalp :: TextParser m Interval
reportingintervalp = choice'
[ tryinterval "day" "daily" Days
, tryinterval "week" "weekly" Weeks
, tryinterval "month" "monthly" Months
, tryinterval "quarter" "quarterly" Quarters
, tryinterval "year" "yearly" Years
, Weeks 2 <$ string' "biweekly"
, Weeks 2 <$ string' "fortnightly"
, Months 2 <$ string' "bimonthly"
, string' "every" *> skipNonNewlineSpaces *> choice'
[ DayOfWeek <$> (nth <* skipNonNewlineSpaces <* string' "day" <* of_ "week")
, DayOfMonth <$> (nth <* skipNonNewlineSpaces <* string' "day" <* optOf_ "month")
, liftA2 WeekdayOfMonth nth $ skipNonNewlineSpaces *> weekday <* optOf_ "month"
, uncurry DayOfYear <$> (md <* optOf_ "year")
, DayOfWeek <$> weekday
, d_o_y <* optOf_ "year"
]
]
where
of_ period =
skipNonNewlineSpaces *> string' "of" *> skipNonNewlineSpaces *> string' period
optOf_ period = optional . try $ of_ period
nth = decimal <* choice (map string' ["st","nd","rd","th"])
d_o_y = runPermutation $ liftA2 DayOfYear (toPermutation $ (month <|> mon) <* skipNonNewlineSpaces)
(toPermutation $ nth <* skipNonNewlineSpaces)
tryinterval :: String -> String -> (Int -> Interval) -> TextParser m Interval
tryinterval singular compact intcons = intcons <$> choice'
[ 1 <$ string' compact'
, string' "every" *> skipNonNewlineSpaces *> choice
[ 1 <$ string' singular'
, decimal <* skipNonNewlineSpaces <* string' plural'
]
]
where
compact' = T.pack compact
singular' = T.pack singular
plural' = T.pack $ singular ++ "s"
periodexprdatespanp :: Day -> TextParser m DateSpan
periodexprdatespanp rdate = choice $ map try [
doubledatespanp rdate,
quarterdatespanp rdate,
fromdatespanp rdate,
todatespanp rdate,
justdatespanp rdate
]
doubledatespanp :: Day -> TextParser m DateSpan
doubledatespanp rdate = liftA2 fromToSpan
(optional (string' "from" *> skipNonNewlineSpaces) *> smartdate)
(skipNonNewlineSpaces *> choice [string' "to", string "..", string "-"]
*> skipNonNewlineSpaces *> smartdate)
where
fromToSpan = DateSpan `on` (Just . fixSmartDate rdate)
quarterdatespanp :: Day -> TextParser m DateSpan
quarterdatespanp rdate = do
y <- yearp <|> pure (first3 $ toGregorian rdate)
q <- char' 'q' *> satisfy is4Digit
return . periodAsDateSpan $ QuarterPeriod y (digitToInt q)
where
is4Digit c = (fromIntegral (ord c - ord '1') :: Word) <= 3
fromdatespanp :: Day -> TextParser m DateSpan
fromdatespanp rdate = fromSpan <$> choice
[ string' "from" *> skipNonNewlineSpaces *> smartdate
, smartdate <* choice [string "..", string "-"]
]
where
fromSpan b = DateSpan (Just $ fixSmartDate rdate b) Nothing
todatespanp :: Day -> TextParser m DateSpan
todatespanp rdate =
choice [string' "to", string' "until", string "..", string "-"]
*> skipNonNewlineSpaces
*> (DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate)
justdatespanp :: Day -> TextParser m DateSpan
justdatespanp rdate =
optional (string' "in" *> skipNonNewlineSpaces)
*> (spanFromSmartDate rdate <$> smartdate)
nulldatespan :: DateSpan
nulldatespan = DateSpan Nothing Nothing
emptydatespan :: DateSpan
emptydatespan = DateSpan (Just $ addDays 1 nulldate) (Just nulldate)
nulldate :: Day
nulldate = fromGregorian 0 1 1