    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE NoMonoLocalBinds    #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies        #-}
    {-|

    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,
    in 5 days, in -3 quarters.
    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.

    'Period' will probably replace DateSpan in due course.

    -}

    -- XXX fromGregorian silently clips bad dates, use fromGregorianValid instead ?

    module Hledger.Data.Dates (
      -- * Misc date handling utilities
      fromEFDay,
      modifyEFDay,
      getCurrentDay,
      getCurrentMonth,
      getCurrentYear,
      nulldate,
      spanContainsDate,
      periodContainsDate,
      parsedateM,
      showDate,
      showEFDate,
      showDateSpan,
      showDateSpanDebug,
      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,
      spansFromBoundaries,
      groupByDateSpan,
      fixSmartDate,
      fixSmartDateStr,
      fixSmartDateStrEither,
      fixSmartDateStrEither',
      yearp,
      daysInSpan,

      tests_Dates
    , intervalBoundaryBefore)
    where

    import Prelude hiding (Applicative(..))
    import Control.Applicative (Applicative(..))
    import Control.Applicative.Permutations
    import Control.Monad (guard, unless)
    import qualified Control.Monad.Fail as Fail (MonadFail, fail)
    import Data.Char (digitToInt, isDigit, ord)
    import Data.Default (def)
    import Data.Foldable (asum)
    import Data.Function (on)
    import Data.Functor (($>))
    import Data.List (elemIndex, group, sort, sortBy)
    import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
    import Data.Ord (comparing)
    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
        (Day, addDays, addGregorianYearsClip, addGregorianMonthsClip, diffDays,
         fromGregorian, fromGregorianValid, toGregorian)
    import Data.Time.Calendar.OrdinalDate (fromMondayStartWeek, mondayStartWeek)
    import Data.Time.Clock (UTCTime, diffUTCTime)
    import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime)
    import Safe (headMay, lastMay, maximumMay, minimumMay)
    import Text.Megaparsec
    import Text.Megaparsec.Char (char, char', digitChar, string, string')
    import Text.Megaparsec.Char.Lexer (decimal, signed)
    import Text.Printf (printf)

    import Hledger.Data.Types
    import Hledger.Data.Period
    import Hledger.Utils

    -- Help ppShow parse and line-wrap DateSpans better in debug output.
    instance Show DateSpan where
        show :: DateSpan -> [Char]
    show DateSpan
    s = [Char]
    "DateSpan " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    T.unpack (DateSpan -> Text
    showDateSpan DateSpan
    s)

    showDate :: Day -> Text
    showDate :: Day -> Text
    showDate = [Char] -> Text
    T.pack ([Char] -> Text) -> (Day -> [Char]) -> Day -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> [Char]
    forall a. Show a => a -> [Char]
    show

    showEFDate :: EFDay -> Text
    showEFDate :: EFDay -> Text
    showEFDate = Day -> Text
    showDate (Day -> Text) -> (EFDay -> Day) -> EFDay -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EFDay -> Day
    fromEFDay

    -- | Render a datespan as a display string, abbreviating into a
    -- compact form if possible.
    -- Warning, hides whether dates are Exact or Flex.
    showDateSpan :: DateSpan -> Text
    showDateSpan :: DateSpan -> Text
    showDateSpan = Period -> Text
    showPeriod (Period -> Text) -> (DateSpan -> Period) -> DateSpan -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DateSpan -> Period
    dateSpanAsPeriod

    -- | Show a DateSpan with its begin/end dates, exact or flex.
    showDateSpanDebug :: DateSpan -> String
    showDateSpanDebug :: DateSpan -> [Char]
    showDateSpanDebug (DateSpan Maybe EFDay
    b Maybe EFDay
    e)= [Char]
    "DateSpan (" [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Maybe EFDay -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe EFDay
    b [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    ") (" [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Maybe EFDay -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe EFDay
    e [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    ")"

    -- | Like showDateSpan, but show month spans as just the abbreviated month name
    -- in the current locale.
    showDateSpanMonthAbbrev :: DateSpan -> Text
    showDateSpanMonthAbbrev :: DateSpan -> Text
    showDateSpanMonthAbbrev = Period -> Text
    showPeriodMonthAbbrev (Period -> Text) -> (DateSpan -> Period) -> DateSpan -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DateSpan -> Period
    dateSpanAsPeriod

    -- | Get the current local date.
    getCurrentDay :: IO Day
    getCurrentDay :: IO Day
    getCurrentDay = LocalTime -> Day
    localDay (LocalTime -> Day) -> (ZonedTime -> LocalTime) -> ZonedTime -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ZonedTime -> LocalTime
    zonedTimeToLocalTime (ZonedTime -> Day) -> IO ZonedTime -> IO Day
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO ZonedTime
    getZonedTime

    -- | Get the current local month number.
    getCurrentMonth :: IO Int
    getCurrentMonth :: IO Int
    getCurrentMonth = (Integer, Int, Int) -> Int
    forall {a} {b} {c}. (a, b, c) -> b
    second3 ((Integer, Int, Int) -> Int)
    -> (Day -> (Integer, Int, Int)) -> Day -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> (Integer, Int, Int)
    toGregorian (Day -> Int) -> IO Day -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Day
    getCurrentDay

    -- | Get the current local year.
    getCurrentYear :: IO Integer
    getCurrentYear :: IO Integer
    getCurrentYear = (Integer, Int, Int) -> Integer
    forall {a} {b} {c}. (a, b, c) -> a
    first3 ((Integer, Int, Int) -> Integer)
    -> (Day -> (Integer, Int, Int)) -> Day -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> (Integer, Int, Int)
    toGregorian (Day -> Integer) -> IO Day -> IO Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Day
    getCurrentDay

    elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
    elapsedSeconds :: forall a. Fractional a => UTCTime -> UTCTime -> a
    elapsedSeconds UTCTime
    t1 = NominalDiffTime -> a
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac (NominalDiffTime -> a)
    -> (UTCTime -> NominalDiffTime) -> UTCTime -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    t1

    spanStart :: DateSpan -> Maybe Day
    spanStart :: DateSpan -> Maybe Day
    spanStart (DateSpan Maybe EFDay
    d Maybe EFDay
    _) = EFDay -> Day
    fromEFDay (EFDay -> Day) -> Maybe EFDay -> Maybe Day
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe EFDay
    d

    spanEnd :: DateSpan -> Maybe Day
    spanEnd :: DateSpan -> Maybe Day
    spanEnd (DateSpan Maybe EFDay
    _ Maybe EFDay
    d) = EFDay -> Day
    fromEFDay (EFDay -> Day) -> Maybe EFDay -> Maybe Day
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe EFDay
    d

    spanStartDate :: DateSpan -> Maybe EFDay
    spanStartDate :: DateSpan -> Maybe EFDay
    spanStartDate (DateSpan Maybe EFDay
    d Maybe EFDay
    _) = Maybe EFDay
    d

    spanEndDate :: DateSpan -> Maybe EFDay
    spanEndDate :: DateSpan -> Maybe EFDay
    spanEndDate (DateSpan Maybe EFDay
    _ Maybe EFDay
    d) = Maybe EFDay
    d

    spanStartYear :: DateSpan -> Maybe Year
    spanStartYear :: DateSpan -> Maybe Integer
    spanStartYear (DateSpan Maybe EFDay
    d Maybe EFDay
    _) = (EFDay -> Integer) -> Maybe EFDay -> Maybe Integer
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Integer, Int, Int) -> Integer
    forall {a} {b} {c}. (a, b, c) -> a
    first3 ((Integer, Int, Int) -> Integer)
    -> (EFDay -> (Integer, Int, Int)) -> EFDay -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> (Integer, Int, Int)
    toGregorian (Day -> (Integer, Int, Int))
    -> (EFDay -> Day) -> EFDay -> (Integer, Int, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EFDay -> Day
    fromEFDay) Maybe EFDay
    d

    spanEndYear :: DateSpan -> Maybe Year
    spanEndYear :: DateSpan -> Maybe Integer
    spanEndYear (DateSpan Maybe EFDay
    d Maybe EFDay
    _) = (EFDay -> Integer) -> Maybe EFDay -> Maybe Integer
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Integer, Int, Int) -> Integer
    forall {a} {b} {c}. (a, b, c) -> a
    first3 ((Integer, Int, Int) -> Integer)
    -> (EFDay -> (Integer, Int, Int)) -> EFDay -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> (Integer, Int, Int)
    toGregorian(Day -> (Integer, Int, Int))
    -> (EFDay -> Day) -> EFDay -> (Integer, Int, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EFDay -> Day
    fromEFDay) Maybe EFDay
    d

    -- | Get the 0-2 years mentioned explicitly in a DateSpan.
    spanYears :: DateSpan -> [Year]
    spanYears :: DateSpan -> [Integer]
    spanYears (DateSpan Maybe EFDay
    ma Maybe EFDay
    mb) = (Maybe EFDay -> Maybe Integer) -> [Maybe EFDay] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((EFDay -> Integer) -> Maybe EFDay -> Maybe Integer
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Integer, Int, Int) -> Integer
    forall {a} {b} {c}. (a, b, c) -> a
    first3 ((Integer, Int, Int) -> Integer)
    -> (EFDay -> (Integer, Int, Int)) -> EFDay -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> (Integer, Int, Int)
    toGregorian(Day -> (Integer, Int, Int))
    -> (EFDay -> Day) -> EFDay -> (Integer, Int, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EFDay -> Day
    fromEFDay)) [Maybe EFDay
    ma,Maybe EFDay
    mb]

    -- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra

    -- | Get overall span enclosing multiple sequentially ordered spans.
    -- The start and end date will be exact or flexible depending on
    -- the first span's start date and last span's end date.
    spansSpan :: [DateSpan] -> DateSpan
    spansSpan :: [DateSpan] -> DateSpan
    spansSpan [DateSpan]
    spans = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (DateSpan -> Maybe EFDay
    spanStartDate (DateSpan -> Maybe EFDay) -> Maybe DateSpan -> Maybe EFDay
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [DateSpan] -> Maybe DateSpan
    forall a. [a] -> Maybe a
    headMay [DateSpan]
    spans) (DateSpan -> Maybe EFDay
    spanEndDate (DateSpan -> Maybe EFDay) -> Maybe DateSpan -> Maybe EFDay
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [DateSpan] -> Maybe DateSpan
    forall a. [a] -> Maybe a
    lastMay [DateSpan]
    spans)

    -- | Split a DateSpan into consecutive exact spans of the specified Interval.
    -- If the first argument is true and the interval is Weeks, Months, Quarters or Years,
    -- the start date will be adjusted backward if needed to nearest natural interval boundary
    -- (a monday, first of month, first of quarter or first of year).
    -- If no interval is specified, the original span is returned.
    -- If the original span is the null date span, ie unbounded, the null date span is returned.
    -- If the original span is empty, eg if the end date is <= the start date, no spans are returned.
    --
    -- ==== Examples:
    -- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan True i $ DateSpan (Just $ Flex $ fromGregorian y1 m1 d1) (Just $ Flex $ fromGregorian y2 m2 d2)
    -- >>> t NoInterval 2008 01 01 2009 01 01
    -- [DateSpan 2008]
    -- >>> t (Quarters 1) 2008 01 01 2009 01 01
    -- [DateSpan 2008Q1,DateSpan 2008Q2,DateSpan 2008Q3,DateSpan 2008Q4]
    -- >>> splitSpan True (Quarters 1) nulldatespan
    -- [DateSpan ..]
    -- >>> t (Days 1) 2008 01 01 2008 01 01  -- an empty datespan
    -- []
    -- >>> t (Quarters 1) 2008 01 01 2008 01 01
    -- []
    -- >>> t (Months 1) 2008 01 01 2008 04 01
    -- [DateSpan 2008-01,DateSpan 2008-02,DateSpan 2008-03]
    -- >>> t (Months 2) 2008 01 01 2008 04 01
    -- [DateSpan 2008-01-01..2008-02-29,DateSpan 2008-03-01..2008-04-30]
    -- >>> t (Weeks 1) 2008 01 01 2008 01 15
    -- [DateSpan 2007-12-31W01,DateSpan 2008-01-07W02,DateSpan 2008-01-14W03]
    -- >>> t (Weeks 2) 2008 01 01 2008 01 15
    -- [DateSpan 2007-12-31..2008-01-13,DateSpan 2008-01-14..2008-01-27]
    -- >>> t (DayOfMonth 2) 2008 01 01 2008 04 01
    -- [DateSpan 2007-12-02..2008-01-01,DateSpan 2008-01-02..2008-02-01,DateSpan 2008-02-02..2008-03-01,DateSpan 2008-03-02..2008-04-01]
    -- >>> t (WeekdayOfMonth 2 4) 2011 01 01 2011 02 15
    -- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09]
    -- >>> t (DaysOfWeek [2]) 2011 01 01 2011 01 15
    -- [DateSpan 2010-12-28..2011-01-03,DateSpan 2011-01-04..2011-01-10,DateSpan 2011-01-11..2011-01-17]
    -- >>> t (DayOfYear 11 29) 2011 10 01 2011 10 15
    -- [DateSpan 2010-11-29..2011-11-28]
    -- >>> t (DayOfYear 11 29) 2011 12 01 2012 12 15
    -- [DateSpan 2011-11-29..2012-11-28,DateSpan 2012-11-29..2013-11-28]
    --
    splitSpan :: Bool -> Interval -> DateSpan -> [DateSpan]
    splitSpan :: Bool -> Interval -> DateSpan -> [DateSpan]
    splitSpan Bool
    _ Interval
    _ (DateSpan Maybe EFDay
    Nothing Maybe EFDay
    Nothing) = [Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan Maybe EFDay
    forall a. Maybe a
    Nothing Maybe EFDay
    forall a. Maybe a
    Nothing]
    splitSpan Bool
    _ Interval
    _ DateSpan
    ds | DateSpan -> Bool
    isEmptySpan DateSpan
    ds = []
    splitSpan Bool
    _ Interval
    _ ds :: DateSpan
    ds@(DateSpan (Just EFDay
    s) (Just EFDay
    e)) | EFDay
    s EFDay -> EFDay -> Bool
    forall a. Eq a => a -> a -> Bool
    == EFDay
    e = [DateSpan
    ds]
    splitSpan Bool
    _ Interval
    NoInterval DateSpan
    ds = [DateSpan
    ds]
    splitSpan Bool
    _ (Days Int
    n) DateSpan
    ds = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    forall a. a -> a
    id Integer -> Day -> Day
    addDays Int
    n                    DateSpan
    ds
    splitSpan Bool
    adjust (Weeks Int
    n)    DateSpan
    ds = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan (if Bool
    adjust then Day -> Day
    startofweek    else Day -> Day
    forall a. a -> a
    id) Integer -> Day -> Day
    addDays (Int
    7Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n)                DateSpan
    ds
    splitSpan Bool
    adjust (Months Int
    n)   DateSpan
    ds = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan (if Bool
    adjust then Day -> Day
    startofmonth   else Day -> Day
    forall a. a -> a
    id) Integer -> Day -> Day
    addGregorianMonthsClip Int
    n     DateSpan
    ds
    splitSpan Bool
    adjust (Quarters Int
    n) DateSpan
    ds = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan (if Bool
    adjust then Day -> Day
    startofquarter else Day -> Day
    forall a. a -> a
    id) Integer -> Day -> Day
    addGregorianMonthsClip (Int
    3Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n) DateSpan
    ds
    splitSpan Bool
    adjust (Years Int
    n)    DateSpan
    ds = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan (if Bool
    adjust then Day -> Day
    startofyear    else Day -> Day
    forall a. a -> a
    id) Integer -> Day -> Day
    addGregorianYearsClip Int
    n      DateSpan
    ds
    splitSpan Bool
    _ (DayOfMonth Int
    dom)  DateSpan
    ds = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan (Int -> Day -> Day
    nthdayofmonthcontaining Int
    dom) (Int -> Integer -> Day -> Day
    addGregorianMonthsToMonthday Int
    dom) Int
    1 DateSpan
    ds
    splitSpan Bool
    _ (DayOfYear Int
    m Int
    n)   DateSpan
    ds = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan (Int -> Int -> Day -> Day
    nthdayofyearcontaining Int
    m Int
    n) (Integer -> Day -> Day
    addGregorianYearsClip) Int
    1 DateSpan
    ds
    splitSpan Bool
    _ (WeekdayOfMonth Int
    n Int
    wd) DateSpan
    ds = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan (Int -> Int -> Day -> Day
    nthweekdayofmonthcontaining Int
    n Int
    wd) Integer -> Day -> Day
    advancemonths Int
    1 DateSpan
    ds
      where
        advancemonths :: Integer -> Day -> Day
    advancemonths Integer
    0 = Day -> Day
    forall a. a -> a
    id
        advancemonths Integer
    w = Int -> Int -> Day -> Day
    advancetonthweekday Int
    n Int
    wd (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Day
    startofmonth (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addGregorianMonthsClip Integer
    w
    splitSpan Bool
    _ (DaysOfWeek [])         DateSpan
    ds = [DateSpan
    ds]
    splitSpan Bool
    _ (DaysOfWeek days :: [Int]
    days@(Int
    n:[Int]
    _)) DateSpan
    ds = Day -> [Day] -> [DateSpan]
    spansFromBoundaries Day
    e [Day]
    bdrys
      where
        (Day
    s, Day
    e) = (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)
    dateSpanSplitLimits (Int -> Day -> Day
    nthdayofweekcontaining Int
    n) Day -> Day
    nextday DateSpan
    ds
        bdrys :: [Day]
    bdrys = (Integer -> [Day]) -> [Integer] -> [Day]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (((Day -> Day) -> [Day] -> [Day]) -> [Day] -> (Day -> Day) -> [Day]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Day -> Day) -> [Day] -> [Day]
    forall a b. (a -> b) -> [a] -> [b]
    map [Day]
    starts ((Day -> Day) -> [Day])
    -> (Integer -> Day -> Day) -> Integer -> [Day]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addDays) [Integer
    0,Integer
    7..]
        -- The first representative of each weekday
        starts :: [Day]
    starts = (Int -> Day) -> [Int] -> [Day]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Int
    d -> Integer -> Day -> Day
    addDays (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n) (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Int -> Day -> Day
    nthdayofweekcontaining Int
    n Day
    s) [Int]
    days

    -- Like addGregorianMonthsClip, add one month to the given date, clipping when needed
    -- to fit it within the next month's length. But also, keep a target day of month in mind,
    -- and revert to that or as close to it as possible in subsequent longer months.
    -- Eg, using it to step through 31sts gives 1/31, 2/28, 3/31, 4/30, 5/31..
    addGregorianMonthsToMonthday :: MonthDay -> Integer -> Day -> Day
    addGregorianMonthsToMonthday :: Int -> Integer -> Day -> Day
    addGregorianMonthsToMonthday Int
    dom Integer
    n Day
    d =
      let (Integer
    y,Int
    m,Int
    _) = Day -> (Integer, Int, Int)
    toGregorian (Day -> (Integer, Int, Int)) -> Day -> (Integer, Int, Int)
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip Integer
    n Day
    d
      in Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    m Int
    dom

    -- Split the given span into exact spans using the provided helper functions:
    -- 1. The start function is applied to the span's start date to get the first sub-span's start date.
    -- 2. The addInterval function is used to calculate the subsequent spans' start dates,
    -- possibly with stride increased by the mult multiplier.
    -- It should adapt to spans of varying length, eg if splitting on "every 31st of month"
    -- addInterval should adjust to 28/29/30 in short months but return to 31 in the long months.
    splitspan :: (Day -> Day) -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan :: (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    start Integer -> Day -> Day
    addInterval Int
    mult DateSpan
    ds = Day -> [Day] -> [DateSpan]
    spansFromBoundaries Day
    e [Day]
    bdrys
      where
        (Day
    s, Day
    e) = (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)
    dateSpanSplitLimits Day -> Day
    start (Integer -> Day -> Day
    addInterval (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    mult)) DateSpan
    ds
        bdrys :: [Day]
    bdrys = (Int -> Day -> Day) -> [Int] -> Day -> [Day]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Integer -> Day -> Day
    addInterval (Integer -> Day -> Day) -> (Int -> Integer) -> Int -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger) [Int
    0,Int
    mult..] (Day -> [Day]) -> Day -> [Day]
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    start Day
    s

    -- | Fill in missing start/end dates for calculating 'splitSpan'.
    dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)
    dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)
    dateSpanSplitLimits Day -> Day
    start Day -> Day
    _    (DateSpan (Just EFDay
    s) (Just EFDay
    e)) = (Day -> Day
    start (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ EFDay -> Day
    fromEFDay EFDay
    s, EFDay -> Day
    fromEFDay EFDay
    e)
    dateSpanSplitLimits Day -> Day
    start Day -> Day
    next (DateSpan (Just EFDay
    s) Maybe EFDay
    Nothing)  = (Day -> Day
    start (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ EFDay -> Day
    fromEFDay EFDay
    s, Day -> Day
    next (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    start (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ EFDay -> Day
    fromEFDay EFDay
    s)
    dateSpanSplitLimits Day -> Day
    start Day -> Day
    next (DateSpan Maybe EFDay
    Nothing  (Just EFDay
    e)) = (Day -> Day
    start (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ EFDay -> Day
    fromEFDay EFDay
    e, Day -> Day
    next (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    start (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ EFDay -> Day
    fromEFDay EFDay
    e)
    dateSpanSplitLimits Day -> Day
    _     Day -> Day
    _    (DateSpan Maybe EFDay
    Nothing   Maybe EFDay
    Nothing) = [Char] -> (Day, Day)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "dateSpanSplitLimits: should not be nulldatespan"  -- PARTIAL: This case should have been handled in splitSpan

    -- | Construct a list of exact 'DateSpan's from a list of boundaries, which fit within a given range.
    spansFromBoundaries :: Day -> [Day] -> [DateSpan]
    spansFromBoundaries :: Day -> [Day] -> [DateSpan]
    spansFromBoundaries Day
    e [Day]
    bdrys = (Day -> Day -> DateSpan) -> [Day] -> [Day] -> [DateSpan]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (Maybe EFDay -> Maybe EFDay -> DateSpan)
    -> (Day -> Maybe EFDay) -> Day -> Day -> DateSpan
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> (Day -> EFDay) -> Day -> Maybe EFDay
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> EFDay
    Exact)) ((Day -> Bool) -> [Day] -> [Day]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    < Day
    e) [Day]
    bdrys) ([Day] -> [DateSpan]) -> [Day] -> [DateSpan]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Day] -> [Day]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [Day]
    bdrys

    -- | Count the days in a DateSpan, or if it is open-ended return Nothing.
    daysInSpan :: DateSpan -> Maybe Integer
    daysInSpan :: DateSpan -> Maybe Integer
    daysInSpan (DateSpan (Just EFDay
    d1) (Just EFDay
    d2)) = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ Day -> Day -> Integer
    diffDays (EFDay -> Day
    fromEFDay EFDay
    d2) (EFDay -> Day
    fromEFDay EFDay
    d1)
    daysInSpan DateSpan
    _ = Maybe Integer
    forall a. Maybe a
    Nothing

    -- | Is this an empty span, ie closed with the end date on or before the start date ?
    isEmptySpan :: DateSpan -> Bool
    isEmptySpan :: DateSpan -> Bool
    isEmptySpan (DateSpan (Just EFDay
    s) (Just EFDay
    e)) = EFDay
    e EFDay -> EFDay -> Bool
    forall a. Ord a => a -> a -> Bool
    <= EFDay
    s
    isEmptySpan DateSpan
    _                            = Bool
    False

    -- | Does the span include the given date ?
    spanContainsDate :: DateSpan -> Day -> Bool
    spanContainsDate :: DateSpan -> Day -> Bool
    spanContainsDate (DateSpan Maybe EFDay
    Nothing Maybe EFDay
    Nothing)   Day
    _ = Bool
    True
    spanContainsDate (DateSpan Maybe EFDay
    Nothing (Just EFDay
    e))  Day
    d = Day
    d Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    < EFDay -> Day
    fromEFDay EFDay
    e
    spanContainsDate (DateSpan (Just EFDay
    b) Maybe EFDay
    Nothing)  Day
    d = Day
    d Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= EFDay -> Day
    fromEFDay EFDay
    b
    spanContainsDate (DateSpan (Just EFDay
    b) (Just EFDay
    e)) Day
    d = Day
    d Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= EFDay -> Day
    fromEFDay EFDay
    b Bool -> Bool -> Bool
    && Day
    d Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    < EFDay -> Day
    fromEFDay EFDay
    e

    -- | Does the period include the given date ?
    -- (Here to avoid import cycle).
    periodContainsDate :: Period -> Day -> Bool
    periodContainsDate :: Period -> Day -> Bool
    periodContainsDate Period
    p = DateSpan -> Day -> Bool
    spanContainsDate (Period -> DateSpan
    periodAsDateSpan Period
    p)

    -- | Group elements based on where they fall in a list of 'DateSpan's without
    -- gaps. The precondition is not checked.
    groupByDateSpan :: Bool -> (a -> Day) -> [DateSpan] -> [a] -> [(DateSpan, [a])]
    groupByDateSpan :: forall a.
    Bool -> (a -> Day) -> [DateSpan] -> [a] -> [(DateSpan, [a])]
    groupByDateSpan Bool
    showempty a -> Day
    date [DateSpan]
    colspans =
          [DateSpan] -> [(Day, a)] -> [(DateSpan, [a])]
    groupByCols [DateSpan]
    colspans
        ([(Day, a)] -> [(DateSpan, [a])])
    -> ([a] -> [(Day, a)]) -> [a] -> [(DateSpan, [a])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Day, a) -> Bool) -> [(Day, a)] -> [(Day, a)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Day -> Bool
    beforeStart (Day -> Bool) -> ((Day, a) -> Day) -> (Day, a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Day, a) -> Day
    forall a b. (a, b) -> a
    fst)
        ([(Day, a)] -> [(Day, a)])
    -> ([a] -> [(Day, a)]) -> [a] -> [(Day, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Day, a) -> (Day, a) -> Ordering) -> [(Day, a)] -> [(Day, a)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((Day, a) -> Day) -> (Day, a) -> (Day, a) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Day, a) -> Day
    forall a b. (a, b) -> a
    fst)
        ([(Day, a)] -> [(Day, a)])
    -> ([a] -> [(Day, a)]) -> [a] -> [(Day, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> (Day, a)) -> [a] -> [(Day, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\a
    x -> (a -> Day
    date a
    x, a
    x))
      where
        groupByCols :: [DateSpan] -> [(Day, a)] -> [(DateSpan, [a])]
    groupByCols []     [(Day, a)]
    _  = []
        groupByCols (DateSpan
    c:[DateSpan]
    cs) [] = if Bool
    showempty then (DateSpan
    c, []) (DateSpan, [a]) -> [(DateSpan, [a])] -> [(DateSpan, [a])]
    forall a. a -> [a] -> [a]
    : [DateSpan] -> [(Day, a)] -> [(DateSpan, [a])]
    groupByCols [DateSpan]
    cs [] else []
        groupByCols (DateSpan
    c:[DateSpan]
    cs) [(Day, a)]
    ps = (DateSpan
    c, ((Day, a) -> a) -> [(Day, a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Day, a) -> a
    forall a b. (a, b) -> b
    snd [(Day, a)]
    matches) (DateSpan, [a]) -> [(DateSpan, [a])] -> [(DateSpan, [a])]
    forall a. a -> [a] -> [a]
    : [DateSpan] -> [(Day, a)] -> [(DateSpan, [a])]
    groupByCols [DateSpan]
    cs [(Day, a)]
    later
          where ([(Day, a)]
    matches, [(Day, a)]
    later) = ((Day, a) -> Bool) -> [(Day, a)] -> ([(Day, a)], [(Day, a)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span ((DateSpan -> Maybe Day
    spanEnd DateSpan
    c Maybe Day -> Maybe Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >) (Maybe Day -> Bool) -> ((Day, a) -> Maybe Day) -> (Day, a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> ((Day, a) -> Day) -> (Day, a) -> Maybe Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Day, a) -> Day
    forall a b. (a, b) -> a
    fst) [(Day, a)]
    ps

        beforeStart :: Day -> Bool
    beforeStart = (Day -> Bool) -> (Day -> Day -> Bool) -> Maybe Day -> Day -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool -> Day -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    (>) (Maybe Day -> Day -> Bool) -> Maybe Day -> Day -> Bool
    forall a b. (a -> b) -> a -> b
    $ DateSpan -> Maybe Day
    spanStart (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [DateSpan] -> Maybe DateSpan
    forall a. [a] -> Maybe a
    headMay [DateSpan]
    colspans

    -- | Calculate the intersection of a number of datespans.
    spansIntersect :: [DateSpan] -> DateSpan
    spansIntersect [] = DateSpan
    nulldatespan
    spansIntersect [DateSpan
    d] = DateSpan
    d
    spansIntersect (DateSpan
    d:[DateSpan]
    ds) = DateSpan
    d DateSpan -> DateSpan -> DateSpan
    `spanIntersect` ([DateSpan] -> DateSpan
    spansIntersect [DateSpan]
    ds)

    -- | Calculate the intersection of two datespans.
    --
    -- For non-intersecting spans, gives an empty span beginning on the second's start date:
    -- >>> DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ Flex $ fromGregorian 2018 01 03) (Just $ Flex $ fromGregorian 2018 01 05)
    -- DateSpan 2018-01-03..2018-01-02
    spanIntersect :: DateSpan -> DateSpan -> DateSpan
    spanIntersect (DateSpan Maybe EFDay
    b1 Maybe EFDay
    e1) (DateSpan Maybe EFDay
    b2 Maybe EFDay
    e2) = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan Maybe EFDay
    b Maybe EFDay
    e
        where
          b :: Maybe EFDay
    b = Maybe EFDay -> Maybe EFDay -> Maybe EFDay
    forall {a}. Ord a => Maybe a -> Maybe a -> Maybe a
    latest Maybe EFDay
    b1 Maybe EFDay
    b2
          e :: Maybe EFDay
    e = Maybe EFDay -> Maybe EFDay -> Maybe EFDay
    forall {a}. Ord a => Maybe a -> Maybe a -> Maybe a
    earliest Maybe EFDay
    e1 Maybe EFDay
    e2

    -- | Fill any unspecified dates in the first span with the dates from
    -- the second one. Sort of a one-way spanIntersect.
    spanDefaultsFrom :: DateSpan -> DateSpan -> DateSpan
    spanDefaultsFrom (DateSpan Maybe EFDay
    a1 Maybe EFDay
    b1) (DateSpan Maybe EFDay
    a2 Maybe EFDay
    b2) = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan Maybe EFDay
    a Maybe EFDay
    b
        where a :: Maybe EFDay
    a = if Maybe EFDay -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe EFDay
    a1 then Maybe EFDay
    a1 else Maybe EFDay
    a2
              b :: Maybe EFDay
    b = if Maybe EFDay -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe EFDay
    b1 then Maybe EFDay
    b1 else Maybe EFDay
    b2

    -- | Calculate the union of a number of datespans.
    spansUnion :: [DateSpan] -> DateSpan
    spansUnion [] = DateSpan
    nulldatespan
    spansUnion [DateSpan
    d] = DateSpan
    d
    spansUnion (DateSpan
    d:[DateSpan]
    ds) = DateSpan
    d DateSpan -> DateSpan -> DateSpan
    `spanUnion` ([DateSpan] -> DateSpan
    spansUnion [DateSpan]
    ds)

    -- | Calculate the union of two datespans.
    spanUnion :: DateSpan -> DateSpan -> DateSpan
    spanUnion (DateSpan Maybe EFDay
    b1 Maybe EFDay
    e1) (DateSpan Maybe EFDay
    b2 Maybe EFDay
    e2) = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan Maybe EFDay
    b Maybe EFDay
    e
        where
          b :: Maybe EFDay
    b = Maybe EFDay -> Maybe EFDay -> Maybe EFDay
    forall {a}. Ord a => Maybe a -> Maybe a -> Maybe a
    earliest Maybe EFDay
    b1 Maybe EFDay
    b2
          e :: Maybe EFDay
    e = Maybe EFDay -> Maybe EFDay -> Maybe EFDay
    forall {a}. Ord a => Maybe a -> Maybe a -> Maybe a
    latest Maybe EFDay
    e1 Maybe EFDay
    e2

    latest :: Maybe a -> Maybe a -> Maybe a
    latest Maybe a
    d Maybe a
    Nothing = Maybe a
    d
    latest Maybe a
    Nothing Maybe a
    d = Maybe a
    d
    latest (Just a
    d1) (Just a
    d2) = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ a -> a -> a
    forall a. Ord a => a -> a -> a
    max a
    d1 a
    d2

    earliest :: Maybe a -> Maybe a -> Maybe a
    earliest Maybe a
    d Maybe a
    Nothing = Maybe a
    d
    earliest Maybe a
    Nothing Maybe a
    d = Maybe a
    d
    earliest (Just a
    d1) (Just a
    d2) = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ a -> a -> a
    forall a. Ord a => a -> a -> a
    min a
    d1 a
    d2

    -- | Calculate the minimal DateSpan containing all of the given Days (in the
    -- usual exclusive-end-date sense: beginning on the earliest, and ending on
    -- the day after the latest).
    daysSpan :: [Day] -> DateSpan
    daysSpan :: [Day] -> DateSpan
    daysSpan [Day]
    ds = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (Day -> EFDay
    Exact (Day -> EFDay) -> Maybe Day -> Maybe EFDay
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Day] -> Maybe Day
    forall a. Ord a => [a] -> Maybe a
    minimumMay [Day]
    ds) (Day -> EFDay
    Exact (Day -> EFDay) -> (Day -> Day) -> Day -> EFDay
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addDays Integer
    1 (Day -> EFDay) -> Maybe Day -> Maybe EFDay
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Day] -> Maybe Day
    forall a. Ord a => [a] -> Maybe a
    maximumMay [Day]
    ds)

    -- | Select the DateSpan containing a given Day, if any, from a given list of
    -- DateSpans.
    --
    -- If the DateSpans are non-overlapping, this returns the unique containing
    -- DateSpan, if it exists. If the DateSpans are overlapping, it will return the
    -- containing DateSpan with the latest start date, and then latest end date.

    -- Note: This will currently return `DateSpan (Just s) (Just e)` before it will
    -- return `DateSpan (Just s) Nothing`. It's unclear which behaviour is desired.
    -- This is irrelevant at the moment as it's never applied to any list with
    -- overlapping DateSpans.
    latestSpanContaining :: [DateSpan] -> Day -> Maybe DateSpan
    latestSpanContaining :: [DateSpan] -> Day -> Maybe DateSpan
    latestSpanContaining [DateSpan]
    datespans = Day -> Maybe DateSpan
    go
      where
        go :: Day -> Maybe DateSpan
    go Day
    day = do
            DateSpan
    spn <- DateSpan -> Set DateSpan -> Maybe DateSpan
    forall a. Ord a => a -> Set a -> Maybe a
    Set.lookupLT DateSpan
    supSpan Set DateSpan
    spanSet
            Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ DateSpan -> Day -> Bool
    spanContainsDate DateSpan
    spn Day
    day
            DateSpan -> Maybe DateSpan
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DateSpan
    spn
          where
            -- The smallest DateSpan larger than any DateSpan containing day.
            supSpan :: DateSpan
    supSpan = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays Integer
    1 Day
    day) Maybe EFDay
    forall a. Maybe a
    Nothing

        spanSet :: Set DateSpan
    spanSet = [DateSpan] -> Set DateSpan
    forall a. Ord a => [a] -> Set a
    Set.fromList ([DateSpan] -> Set DateSpan) -> [DateSpan] -> Set DateSpan
    forall a b. (a -> b) -> a -> b
    $ (DateSpan -> Bool) -> [DateSpan] -> [DateSpan]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (DateSpan -> Bool) -> DateSpan -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DateSpan -> Bool
    isEmptySpan) [DateSpan]
    datespans

    -- | Parse a period expression to an Interval and overall DateSpan using
    -- the provided reference date, or return a parse error.
    parsePeriodExpr
      :: Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
    parsePeriodExpr :: Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
    parsePeriodExpr Day
    refdate Text
    s = Parsec HledgerParseErrorData Text (Interval, DateSpan)
    -> Text -> Either HledgerParseErrors (Interval, DateSpan)
    forall e a.
    Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
    parsewith (Day -> Parsec HledgerParseErrorData Text (Interval, DateSpan)
    forall (m :: * -> *). Day -> TextParser m (Interval, DateSpan)
    periodexprp Day
    refdate Parsec HledgerParseErrorData Text (Interval, DateSpan)
    -> ParsecT HledgerParseErrorData Text Identity ()
    -> Parsec HledgerParseErrorData Text (Interval, DateSpan)
    forall a b.
    ParsecT HledgerParseErrorData Text Identity a
    -> ParsecT HledgerParseErrorData Text Identity b
    -> ParsecT HledgerParseErrorData Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text Identity ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof) (Text -> Text
    T.toLower Text
    s)

    -- | Like parsePeriodExpr, but call error' on failure.
    parsePeriodExpr' :: Day -> Text -> (Interval, DateSpan)
    parsePeriodExpr' :: Day -> Text -> (Interval, DateSpan)
    parsePeriodExpr' Day
    refdate Text
    s =
      (HledgerParseErrors -> (Interval, DateSpan))
    -> ((Interval, DateSpan) -> (Interval, DateSpan))
    -> Either HledgerParseErrors (Interval, DateSpan)
    -> (Interval, DateSpan)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([Char] -> (Interval, DateSpan)
    forall a. [Char] -> a
    error' ([Char] -> (Interval, DateSpan))
    -> (HledgerParseErrors -> [Char])
    -> HledgerParseErrors
    -> (Interval, DateSpan)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char]
    "failed to parse:" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++) ([Char] -> [Char])
    -> (HledgerParseErrors -> [Char]) -> HledgerParseErrors -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HledgerParseErrors -> [Char]
    customErrorBundlePretty) (Interval, DateSpan) -> (Interval, DateSpan)
    forall a. a -> a
    id (Either HledgerParseErrors (Interval, DateSpan)
     -> (Interval, DateSpan))
    -> Either HledgerParseErrors (Interval, DateSpan)
    -> (Interval, DateSpan)
    forall a b. (a -> b) -> a -> b
    $  -- PARTIAL:
      Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
    parsePeriodExpr Day
    refdate Text
    s

    -- | Show a DateSpan as a human-readable pseudo-period-expression string.
    -- dateSpanAsText :: DateSpan -> String
    -- dateSpanAsText (DateSpan Nothing Nothing)   = "all"
    -- dateSpanAsText (DateSpan Nothing (Just e))  = printf "to %s" (show e)
    -- dateSpanAsText (DateSpan (Just b) Nothing)  = printf "from %s" (show b)
    -- dateSpanAsText (DateSpan (Just b) (Just e)) = printf "%s to %s" (show b) (show e)

    -- | Convert a single smart date string to a date span using the provided
    -- reference date, or raise an error.
    -- spanFromSmartDateString :: Day -> String -> DateSpan
    -- spanFromSmartDateString refdate s = spanFromSmartDate refdate sdate
    --     where
    --       sdate = fromparse $ parsewith smartdateonly s

    spanFromSmartDate :: Day -> SmartDate -> DateSpan
    spanFromSmartDate :: Day -> SmartDate -> DateSpan
    spanFromSmartDate Day
    refdate SmartDate
    sdate = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just EFDay
    b) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just EFDay
    e)
        where
          (Integer
    ry,Int
    rm,Int
    _) = Day -> (Integer, Int, Int)
    toGregorian Day
    refdate
          (EFDay
    b,EFDay
    e) = SmartDate -> (EFDay, EFDay)
    span' SmartDate
    sdate
            where
              span' :: SmartDate -> (EFDay, EFDay)
              span' :: SmartDate -> (EFDay, EFDay)
    span' (SmartCompleteDate Day
    day)       = (Day -> EFDay
    Exact Day
    day, Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    nextday Day
    day)
              span' (SmartAssumeStart Integer
    y Maybe Int
    Nothing)  = (Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    startofyear Day
    day, Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    nextyear Day
    day) where day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    1 Int
    1
              span' (SmartAssumeStart Integer
    y (Just Int
    m)) = (Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    startofmonth Day
    day, Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    nextmonth Day
    day) where day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    m Int
    1
              span' (SmartFromReference Maybe Int
    m Int
    d)      = (Day -> EFDay
    Exact Day
    day, Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    nextday Day
    day) where day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    ry (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    rm Maybe Int
    m) Int
    d
              span' (SmartMonth Int
    m)                = (Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    startofmonth Day
    day, Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    nextmonth Day
    day) where day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    ry Int
    m Int
    1
              span' (SmartRelative Integer
    n SmartInterval
    Day)         = (Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays Integer
    n Day
    refdate, Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays (Integer
    nInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) Day
    refdate)
              span' (SmartRelative Integer
    n SmartInterval
    Week)        = (Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays (Integer
    7Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    n) Day
    d, Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays (Integer
    7Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    nInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    7) Day
    d) where d :: Day
    d = Day -> Day
    thisweek Day
    refdate
              span' (SmartRelative Integer
    n SmartInterval
    Month)       = (Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip Integer
    n Day
    d, Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip (Integer
    nInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) Day
    d) where d :: Day
    d = Day -> Day
    thismonth Day
    refdate
              span' (SmartRelative Integer
    n SmartInterval
    Quarter)     = (Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip (Integer
    3Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    n) Day
    d, Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip (Integer
    3Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    nInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    3) Day
    d) where d :: Day
    d = Day -> Day
    thisquarter Day
    refdate
              span' (SmartRelative Integer
    n SmartInterval
    Year)        = (Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianYearsClip Integer
    n Day
    d, Day -> EFDay
    Flex (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianYearsClip (Integer
    nInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) Day
    d) where d :: Day
    d = Day -> Day
    thisyear Day
    refdate

    -- showDay :: Day -> String
    -- showDay day = printf "%04d/%02d/%02d" y m d where (y,m,d) = toGregorian day

    -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using
    -- the provided reference date, or raise an error.
    fixSmartDateStr :: Day -> Text -> Text
    fixSmartDateStr :: Day -> Text -> Text
    fixSmartDateStr Day
    d Text
    s =
      (HledgerParseErrors -> Text)
    -> (Text -> Text) -> Either HledgerParseErrors Text -> Text
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([Char] -> Text
    forall a. [Char] -> a
    error' ([Char] -> Text)
    -> (HledgerParseErrors -> [Char]) -> HledgerParseErrors -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char] -> [Char] -> [Char]
    forall r. PrintfType r => [Char] -> r
    printf [Char]
    "could not parse date %s %s" (Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    s) ([Char] -> [Char])
    -> (HledgerParseErrors -> [Char]) -> HledgerParseErrors -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HledgerParseErrors -> [Char]
    forall a. Show a => a -> [Char]
    show) Text -> Text
    forall a. a -> a
    id (Either HledgerParseErrors Text -> Text)
    -> Either HledgerParseErrors Text -> Text
    forall a b. (a -> b) -> a -> b
    $  -- PARTIAL:
      (Day -> Text -> Either HledgerParseErrors Text
    fixSmartDateStrEither Day
    d Text
    s :: Either HledgerParseErrors Text)

    -- | A safe version of fixSmartDateStr.
    fixSmartDateStrEither :: Day -> Text -> Either HledgerParseErrors Text
    fixSmartDateStrEither :: Day -> Text -> Either HledgerParseErrors Text
    fixSmartDateStrEither Day
    d = (EFDay -> Text)
    -> Either HledgerParseErrors EFDay
    -> Either HledgerParseErrors Text
    forall a b.
    (a -> b)
    -> Either HledgerParseErrors a -> Either HledgerParseErrors b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap EFDay -> Text
    showEFDate (Either HledgerParseErrors EFDay -> Either HledgerParseErrors Text)
    -> (Text -> Either HledgerParseErrors EFDay)
    -> Text
    -> Either HledgerParseErrors Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Text -> Either HledgerParseErrors EFDay
    fixSmartDateStrEither' Day
    d

    fixSmartDateStrEither'
      :: Day -> Text -> Either HledgerParseErrors EFDay
    fixSmartDateStrEither' :: Day -> Text -> Either HledgerParseErrors EFDay
    fixSmartDateStrEither' Day
    d Text
    s = case Parsec HledgerParseErrorData Text SmartDate
    -> Text -> Either HledgerParseErrors SmartDate
    forall e a.
    Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
    parsewith Parsec HledgerParseErrorData Text SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdateonly (Text -> Text
    T.toLower Text
    s) of
                                   Right SmartDate
    sd -> EFDay -> Either HledgerParseErrors EFDay
    forall a b. b -> Either a b
    Right (EFDay -> Either HledgerParseErrors EFDay)
    -> EFDay -> Either HledgerParseErrors EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> SmartDate -> EFDay
    fixSmartDate Day
    d SmartDate
    sd
                                   Left HledgerParseErrors
    e -> HledgerParseErrors -> Either HledgerParseErrors EFDay
    forall a b. a -> Either a b
    Left HledgerParseErrors
    e

    -- | Convert a SmartDate to a specific date using the provided reference date.
    -- This date will be exact or flexible depending on whether the day was
    -- specified exactly. (Missing least-significant parts produces a flex date.)
    --
    -- ==== Examples:
    -- >>> :set -XOverloadedStrings
    -- >>> let t = fixSmartDateStr (fromGregorian 2008 11 26)
    -- >>> t "0000-01-01"
    -- "0000-01-01"
    -- >>> t "1999-12-02"
    -- "1999-12-02"
    -- >>> t "1999.12.02"
    -- "1999-12-02"
    -- >>> t "1999/3/2"
    -- "1999-03-02"
    -- >>> t "19990302"
    -- "1999-03-02"
    -- >>> t "2008/2"
    -- "2008-02-01"
    -- >>> t "0020/2"
    -- "0020-02-01"
    -- >>> t "1000"
    -- "1000-01-01"
    -- >>> t "4/2"
    -- "2008-04-02"
    -- >>> t "2"
    -- "2008-11-02"
    -- >>> t "January"
    -- "2008-01-01"
    -- >>> t "feb"
    -- "2008-02-01"
    -- >>> t "today"
    -- "2008-11-26"
    -- >>> t "yesterday"
    -- "2008-11-25"
    -- >>> t "tomorrow"
    -- "2008-11-27"
    -- >>> t "this day"
    -- "2008-11-26"
    -- >>> t "last day"
    -- "2008-11-25"
    -- >>> t "next day"
    -- "2008-11-27"
    -- >>> t "this week"  -- last monday
    -- "2008-11-24"
    -- >>> t "last week"  -- previous monday
    -- "2008-11-17"
    -- >>> t "next week"  -- next monday
    -- "2008-12-01"
    -- >>> t "this month"
    -- "2008-11-01"
    -- >>> t "last month"
    -- "2008-10-01"
    -- >>> t "next month"
    -- "2008-12-01"
    -- >>> t "this quarter"
    -- "2008-10-01"
    -- >>> t "last quarter"
    -- "2008-07-01"
    -- >>> t "next quarter"
    -- "2009-01-01"
    -- >>> t "this year"
    -- "2008-01-01"
    -- >>> t "last year"
    -- "2007-01-01"
    -- >>> t "next year"
    -- "2009-01-01"
    --
    -- t "last wed"
    -- "2008-11-19"
    -- t "next friday"
    -- "2008-11-28"
    -- t "next january"
    -- "2009-01-01"
    --
    -- >>> t "in 5 days"
    -- "2008-12-01"
    -- >>> t "in 7 months"
    -- "2009-06-01"
    -- >>> t "in -2 weeks"
    -- "2008-11-10"
    -- >>> t "1 quarter ago"
    -- "2008-07-01"
    -- >>> t "1 week ahead"
    -- "2008-12-01"
    fixSmartDate :: Day -> SmartDate -> EFDay
    fixSmartDate :: Day -> SmartDate -> EFDay
    fixSmartDate Day
    refdate = SmartDate -> EFDay
    fix
      where
        fix :: SmartDate -> EFDay
        fix :: SmartDate -> EFDay
    fix (SmartCompleteDate Day
    d)     = Day -> EFDay
    Exact Day
    d
        fix (SmartAssumeStart Integer
    y Maybe Int
    m)    = Day -> EFDay
    Flex  (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    y (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    1 Maybe Int
    m) Int
    1
        fix (SmartFromReference Maybe Int
    m Int
    d)  = Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    ry (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    rm Maybe Int
    m) Int
    d
        fix (SmartMonth Int
    m)            = Day -> EFDay
    Flex  (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    ry Int
    m Int
    1
        fix (SmartRelative Integer
    n SmartInterval
    Day)     = Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays Integer
    n Day
    refdate
        fix (SmartRelative Integer
    n SmartInterval
    Week)    = Day -> EFDay
    Flex  (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays (Integer
    7Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    n) (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    thisweek Day
    refdate
        fix (SmartRelative Integer
    n SmartInterval
    Month)   = Day -> EFDay
    Flex  (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip Integer
    n (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    thismonth Day
    refdate
        fix (SmartRelative Integer
    n SmartInterval
    Quarter) = Day -> EFDay
    Flex  (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip (Integer
    3Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    n) (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    thisquarter Day
    refdate
        fix (SmartRelative Integer
    n SmartInterval
    Year)    = Day -> EFDay
    Flex  (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianYearsClip Integer
    n (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    thisyear Day
    refdate
        (Integer
    ry, Int
    rm, Int
    _) = Day -> (Integer, Int, Int)
    toGregorian Day
    refdate

    prevday :: Day -> Day
    prevday :: Day -> Day
    prevday = Integer -> Day -> Day
    addDays (-Integer
    1)
    nextday :: Day -> Day
    nextday = Integer -> Day -> Day
    addDays Integer
    1

    thisweek :: Day -> Day
    thisweek = Day -> Day
    startofweek
    prevweek :: Day -> Day
    prevweek = Day -> Day
    startofweek (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addDays (-Integer
    7)
    nextweek :: Day -> Day
    nextweek = Day -> Day
    startofweek (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addDays Integer
    7
    startofweek :: Day -> Day
    startofweek Day
    day = Integer -> Int -> Int -> Day
    fromMondayStartWeek Integer
    y Int
    w Int
    1
        where
          (Integer
    y,Int
    _,Int
    _) = Day -> (Integer, Int, Int)
    toGregorian Day
    day
          (Int
    w,Int
    _) = Day -> (Int, Int)
    mondayStartWeek Day
    day

    thismonth :: Day -> Day
    thismonth = Day -> Day
    startofmonth
    prevmonth :: Day -> Day
    prevmonth = Day -> Day
    startofmonth (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addGregorianMonthsClip (-Integer
    1)
    nextmonth :: Day -> Day
    nextmonth = Day -> Day
    startofmonth (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addGregorianMonthsClip Integer
    1
    startofmonth :: Day -> Day
    startofmonth Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    m Int
    1 where (Integer
    y,Int
    m,Int
    _) = Day -> (Integer, Int, Int)
    toGregorian Day
    day
    nthdayofmonth :: Int -> Day -> Day
    nthdayofmonth Int
    d Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    m Int
    d where (Integer
    y,Int
    m,Int
    _) = Day -> (Integer, Int, Int)
    toGregorian Day
    day

    thisquarter :: Day -> Day
    thisquarter = Day -> Day
    startofquarter
    startofquarter :: Day -> Day
    startofquarter Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y (Int -> Int
    forall {a}. Integral a => a -> a
    firstmonthofquarter Int
    m) Int
    1
        where
          (Integer
    y,Int
    m,Int
    _) = Day -> (Integer, Int, Int)
    toGregorian Day
    day
          firstmonthofquarter :: a -> a
    firstmonthofquarter a
    m2 = ((a
    m2a -> a -> a
    forall a. Num a => a -> a -> a
    -a
    1) a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` a
    3) a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    3 a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1

    thisyear :: Day -> Day
    thisyear = Day -> Day
    startofyear
    prevyear :: Day -> Day
    prevyear = Day -> Day
    startofyear (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addGregorianYearsClip (-Integer
    1)
    nextyear :: Day -> Day
    nextyear = Day -> Day
    startofyear (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addGregorianYearsClip Integer
    1
    startofyear :: Day -> Day
    startofyear Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    1 Int
    1 where (Integer
    y,Int
    _,Int
    _) = Day -> (Integer, Int, Int)
    toGregorian Day
    day

    -- Get the natural start for the given interval that falls on or before the given day,
    -- when applicable. Works for Weeks, Months, Quarters, Years, eg.
    intervalBoundaryBefore :: Interval -> Day -> Day
    intervalBoundaryBefore :: Interval -> Day -> Day
    intervalBoundaryBefore Interval
    i Day
    d =
      case Bool -> Interval -> DateSpan -> [DateSpan]
    splitSpan Bool
    True Interval
    i (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    d) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays Integer
    1 Day
    d)) of
        (DateSpan (Just EFDay
    start) Maybe EFDay
    _:[DateSpan]
    _) -> EFDay -> Day
    fromEFDay EFDay
    start
        [DateSpan]
    _ -> Day
    d

    -- | For given date d find year-long interval that starts on given
    -- MM/DD of year and covers it.
    -- The given MM and DD should be basically valid (1-12 & 1-31),
    -- or an error is raised.
    --
    -- Examples: lets take 2017-11-22. Year-long intervals covering it that
    -- starts before Nov 22 will start in 2017. However
    -- intervals that start after Nov 23rd should start in 2016:
    -- >>> let wed22nd = fromGregorian 2017 11 22
    -- >>> nthdayofyearcontaining 11 21 wed22nd
    -- 2017-11-21
    -- >>> nthdayofyearcontaining 11 22 wed22nd
    -- 2017-11-22
    -- >>> nthdayofyearcontaining 11 23 wed22nd
    -- 2016-11-23
    -- >>> nthdayofyearcontaining 12 02 wed22nd
    -- 2016-12-02
    -- >>> nthdayofyearcontaining 12 31 wed22nd
    -- 2016-12-31
    -- >>> nthdayofyearcontaining 1 1 wed22nd
    -- 2017-01-01
    nthdayofyearcontaining :: Month -> MonthDay -> Day -> Day
    nthdayofyearcontaining :: Int -> Int -> Day -> Day
    nthdayofyearcontaining Int
    m Int
    mdy Day
    date
      -- PARTIAL:
      | Bool -> Bool
    not (Int -> Bool
    validMonth Int
    m)  = [Char] -> Day
    forall a. [Char] -> a
    error' ([Char] -> Day) -> [Char] -> Day
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "nthdayofyearcontaining: invalid month "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    m
      | Bool -> Bool
    not (Int -> Bool
    validDay   Int
    mdy) = [Char] -> Day
    forall a. [Char] -> a
    error' ([Char] -> Day) -> [Char] -> Day
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "nthdayofyearcontaining: invalid day "  [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    mdy
      | Day
    mmddOfSameYear Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Day
    date = Day
    mmddOfSameYear
      | Bool
    otherwise = Day
    mmddOfPrevYear
      where mmddOfSameYear :: Day
    mmddOfSameYear = Integer -> Day -> Day
    addDays (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    mdyInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    1) (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN (Int
    mInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Day -> Day
    nextmonth Day
    s
            mmddOfPrevYear :: Day
    mmddOfPrevYear = Integer -> Day -> Day
    addDays (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    mdyInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    1) (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN (Int
    mInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Day -> Day
    nextmonth (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    prevyear Day
    s
            s :: Day
    s = Day -> Day
    startofyear Day
    date

    -- | For a given date d find the month-long period that starts on day n of a month
    -- that includes d. (It will begin on day n or either d's month or the previous month.)
    -- The given day of month should be in the range 1-31, or an error will be raised.
    --
    -- Examples: lets take 2017-11-22. Month-long intervals covering it that
    -- start on 1st-22nd of month will start in Nov. However
    -- intervals that start on 23rd-30th of month should start in Oct:
    -- >>> let wed22nd = fromGregorian 2017 11 22
    -- >>> nthdayofmonthcontaining 1 wed22nd
    -- 2017-11-01
    -- >>> nthdayofmonthcontaining 12 wed22nd
    -- 2017-11-12
    -- >>> nthdayofmonthcontaining 22 wed22nd
    -- 2017-11-22
    -- >>> nthdayofmonthcontaining 23 wed22nd
    -- 2017-10-23
    -- >>> nthdayofmonthcontaining 30 wed22nd
    -- 2017-10-30
    nthdayofmonthcontaining :: MonthDay -> Day -> Day
    nthdayofmonthcontaining :: Int -> Day -> Day
    nthdayofmonthcontaining Int
    mdy Day
    date
      -- PARTIAL:
      | Bool -> Bool
    not (Int -> Bool
    validDay Int
    mdy) = [Char] -> Day
    forall a. [Char] -> a
    error' ([Char] -> Day) -> [Char] -> Day
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "nthdayofmonthcontaining: invalid day "  [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    mdy
      | Day
    nthOfSameMonth Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Day
    date = Day
    nthOfSameMonth
      | Bool
    otherwise = Day
    nthOfPrevMonth
      where nthOfSameMonth :: Day
    nthOfSameMonth = Int -> Day -> Day
    nthdayofmonth Int
    mdy Day
    s
            nthOfPrevMonth :: Day
    nthOfPrevMonth = Int -> Day -> Day
    nthdayofmonth Int
    mdy (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    prevmonth Day
    s
            s :: Day
    s = Day -> Day
    startofmonth Day
    date

    -- | For given date d find week-long interval that starts on nth day of week
    -- and covers it.
    --
    -- Examples: 2017-11-22 is Wed. Week-long intervals that cover it and
    -- start on Mon, Tue or Wed will start in the same week. However
    -- intervals that start on Thu or Fri should start in prev week:
    -- >>> let wed22nd = fromGregorian 2017 11 22
    -- >>> nthdayofweekcontaining 1 wed22nd
    -- 2017-11-20
    -- >>> nthdayofweekcontaining 2 wed22nd
    -- 2017-11-21
    -- >>> nthdayofweekcontaining 3 wed22nd
    -- 2017-11-22
    -- >>> nthdayofweekcontaining 4 wed22nd
    -- 2017-11-16
    -- >>> nthdayofweekcontaining 5 wed22nd
    -- 2017-11-17
    nthdayofweekcontaining :: WeekDay -> Day -> Day
    nthdayofweekcontaining :: Int -> Day -> Day
    nthdayofweekcontaining Int
    n Day
    d | Day
    nthOfSameWeek Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Day
    d = Day
    nthOfSameWeek
                               | Bool
    otherwise = Day
    nthOfPrevWeek
        where nthOfSameWeek :: Day
    nthOfSameWeek = Integer -> Day -> Day
    addDays (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    nInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    1) Day
    s
              nthOfPrevWeek :: Day
    nthOfPrevWeek = Integer -> Day -> Day
    addDays (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    nInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    1) (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    prevweek Day
    s
              s :: Day
    s = Day -> Day
    startofweek Day
    d

    -- | For given date d find month-long interval that starts on nth weekday of month
    -- and covers it.
    --
    -- Examples: 2017-11-22 is 3rd Wed of Nov. Month-long intervals that cover it and
    -- start on 1st-4th Wed will start in Nov. However
    -- intervals that start on 4th Thu or Fri or later should start in Oct:
    -- >>> let wed22nd = fromGregorian 2017 11 22
    -- >>> nthweekdayofmonthcontaining 1 3 wed22nd
    -- 2017-11-01
    -- >>> nthweekdayofmonthcontaining 3 2 wed22nd
    -- 2017-11-21
    -- >>> nthweekdayofmonthcontaining 4 3 wed22nd
    -- 2017-11-22
    -- >>> nthweekdayofmonthcontaining 4 4 wed22nd
    -- 2017-10-26
    -- >>> nthweekdayofmonthcontaining 4 5 wed22nd
    -- 2017-10-27
    nthweekdayofmonthcontaining :: Int -> WeekDay -> Day -> Day
    nthweekdayofmonthcontaining :: Int -> Int -> Day -> Day
    nthweekdayofmonthcontaining Int
    n Int
    wd Day
    d | Day
    nthWeekdaySameMonth Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Day
    d  = Day
    nthWeekdaySameMonth
                                       | Bool
    otherwise = Day
    nthWeekdayPrevMonth
        where nthWeekdaySameMonth :: Day
    nthWeekdaySameMonth = Int -> Int -> Day -> Day
    advancetonthweekday Int
    n Int
    wd (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    startofmonth Day
    d
              nthWeekdayPrevMonth :: Day
    nthWeekdayPrevMonth = Int -> Int -> Day -> Day
    advancetonthweekday Int
    n Int
    wd (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    prevmonth Day
    d

    -- | Advance to nth weekday wd after given start day s
    -- Can call error.
    advancetonthweekday :: Int -> WeekDay -> Day -> Day
    advancetonthweekday :: Int -> Int -> Day -> Day
    advancetonthweekday Int
    n Int
    wd Day
    s =
      -- PARTIAL:
      Day -> (Day -> Day) -> Maybe Day -> Day
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Day
    forall {a}. a
    err (Int -> Day -> Day
    forall {a}. Integral a => a -> Day -> Day
    addWeeks (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)) (Maybe Day -> Day) -> Maybe Day -> Day
    forall a b. (a -> b) -> a -> b
    $ (Day -> Bool) -> [Day] -> Maybe Day
    forall {a}. (a -> Bool) -> [a] -> Maybe a
    firstMatch (Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >=Day
    s) ([Day] -> Maybe Day) -> [Day] -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ (Day -> Day) -> Day -> [Day]
    forall a. (a -> a) -> a -> [a]
    iterate (Integer -> Day -> Day
    forall {a}. Integral a => a -> Day -> Day
    addWeeks Integer
    1) (Day -> [Day]) -> Day -> [Day]
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    firstweekday Day
    s
      where
        err :: a
    err = [Char] -> a
    forall a. [Char] -> a
    error' [Char]
    "advancetonthweekday: should not happen"
        addWeeks :: a -> Day -> Day
    addWeeks a
    k = Integer -> Day -> Day
    addDays (Integer
    7 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * a -> Integer
    forall a. Integral a => a -> Integer
    toInteger a
    k)
        firstMatch :: (a -> Bool) -> [a] -> Maybe a
    firstMatch a -> Bool
    p = [a] -> Maybe a
    forall a. [a] -> Maybe a
    headMay ([a] -> Maybe a) -> ([a] -> [a]) -> [a] -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Bool
    p)
        firstweekday :: Day -> Day
    firstweekday = Integer -> Day -> Day
    addDays (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    wdInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    1) (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Day
    startofweek

    ----------------------------------------------------------------------
    -- parsing

    -- -- | Parse a couple of date-time string formats to a time type.
    -- parsedatetimeM :: String -> Maybe LocalTime
    -- parsedatetimeM s = asum [
    --     parseTimeM TruedefaultTimeLocale "%Y/%m/%d %H:%M:%S" s,
    --     parseTimeM TruedefaultTimeLocale "%Y-%m-%d %H:%M:%S" s
    --     ]

    -- | Try to parse a couple of date string formats:
    -- `YYYY-MM-DD`, `YYYY/MM/DD` or `YYYY.MM.DD`, with leading zeros required.
    -- For internal use, not quite the same as the journal's "simple dates".
    -- >>> parsedateM "2008/02/03"
    -- Just 2008-02-03
    -- >>> parsedateM "2008/02/03/"
    -- Nothing
    -- >>> parsedateM "2008/02/30"
    -- Nothing
    parsedateM :: String -> Maybe Day
    parsedateM :: [Char] -> Maybe Day
    parsedateM [Char]
    s = [Maybe Day] -> Maybe Day
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    asum [
         Bool -> TimeLocale -> [Char] -> [Char] -> Maybe Day
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> [Char] -> [Char] -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale [Char]
    "%Y-%m-%d" [Char]
    s,
         Bool -> TimeLocale -> [Char] -> [Char] -> Maybe Day
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> [Char] -> [Char] -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale [Char]
    "%Y/%m/%d" [Char]
    s,
         Bool -> TimeLocale -> [Char] -> [Char] -> Maybe Day
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> [Char] -> [Char] -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale [Char]
    "%Y.%m.%d" [Char]
    s
         ]

    {-|
    Parse a date in any of the formats allowed in Ledger's period expressions, and some others.
    Assumes any text in the parse stream has been lowercased.
    Returns a SmartDate, to be converted to a full date later (see fixSmartDate).

    Examples:

    > 2004                                        (start of year, which must have 4+ digits)
    > 2004/10                                     (start of month, which must be 1-12)
    > 2004/10/1                                   (exact date, day must be 1-31)
    > 10/1                                        (month and day in current year)
    > 21                                          (day in current month)
    > october, oct                                (start of month in current year)
    > yesterday, today, tomorrow                  (-1, 0, 1 days from today)
    > last/this/next day/week/month/quarter/year  (-1, 0, 1 periods from the current period)
    > in n days/weeks/months/quarters/years       (n periods from the current period)
    > n days/weeks/months/quarters/years ago      (-n periods from the current period)
    > 20181201                                    (8 digit YYYYMMDD with valid year month and day)
    > 201812                                      (6 digit YYYYMM with valid year and month)

    Note malformed digit sequences might give surprising results:

    > 201813                                      (6 digits with an invalid month is parsed as start of 6-digit year)
    > 20181301                                    (8 digits with an invalid month is parsed as start of 8-digit year)
    > 20181232                                    (8 digits with an invalid day gives an error)
    > 201801012                                   (9+ digits beginning with a valid YYYYMMDD gives an error)

    Eg:

    YYYYMMDD is parsed as year-month-date if those parts are valid
    (>=4 digits, 1-12, and 1-31 respectively):
    >>> parsewith (smartdate <* eof) "20181201"
    Right (SmartCompleteDate 2018-12-01)

    YYYYMM is parsed as year-month-01 if year and month are valid:
    >>> parsewith (smartdate <* eof) "201804"
    Right (SmartAssumeStart 2018 (Just 4))

    With an invalid month, it's parsed as a year:
    >>> parsewith (smartdate <* eof) "201813"
    Right (SmartAssumeStart 201813 Nothing)

    A 9+ digit number beginning with valid YYYYMMDD gives an error:
    >>> parsewith (smartdate <* eof) "201801012"
    Left (...)

    Big numbers not beginning with a valid YYYYMMDD are parsed as a year:
    >>> parsewith (smartdate <* eof) "201813012"
    Right (SmartAssumeStart 201813012 Nothing)

    -}
    smartdate :: TextParser m SmartDate
    smartdate :: forall (m :: * -> *). TextParser m SmartDate
    smartdate = [TextParser m SmartDate] -> TextParser m SmartDate
    forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
    choice'
      -- XXX maybe obscures date errors ? see ledgerdate
        [ TextParser m SmartDate
    relativeP
        , TextParser m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    yyyymmdd, TextParser m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    ymd
        , (\(Int
    m,Int
    d) -> Maybe Int -> Int -> SmartDate
    SmartFromReference (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    m) Int
    d) ((Int, Int) -> SmartDate)
    -> ParsecT HledgerParseErrorData Text m (Int, Int)
    -> TextParser m SmartDate
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT HledgerParseErrorData Text m (Int, Int)
    forall (m :: * -> *). TextParser m (Int, Int)
    md
        , SmartDate -> TextParser m SmartDate
    forall (m :: * -> *). MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate (SmartDate -> TextParser m SmartDate)
    -> (Int -> SmartDate) -> Int -> TextParser m SmartDate
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Int -> Int -> SmartDate
    SmartFromReference Maybe Int
    forall a. Maybe a
    Nothing (Int -> TextParser m SmartDate)
    -> ParsecT HledgerParseErrorData Text m Int
    -> TextParser m SmartDate
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ParsecT HledgerParseErrorData Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal
        , Int -> SmartDate
    SmartMonth (Int -> SmartDate)
    -> ParsecT HledgerParseErrorData Text m Int
    -> TextParser m SmartDate
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT HledgerParseErrorData Text m Int
    forall (m :: * -> *). TextParser m Int
    month ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Int
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ParsecT HledgerParseErrorData Text m Int
    forall (m :: * -> *). TextParser m Int
    mon)
        , Integer -> SmartInterval -> SmartDate
    SmartRelative Integer
    0    SmartInterval
    Day SmartDate
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> TextParser m SmartDate
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "today"
        , Integer -> SmartInterval -> SmartDate
    SmartRelative (-Integer
    1) SmartInterval
    Day SmartDate
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> TextParser m SmartDate
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "yesterday"
        , Integer -> SmartInterval -> SmartDate
    SmartRelative Integer
    1    SmartInterval
    Day SmartDate
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> TextParser m SmartDate
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "tomorrow"
        ]
      where
        relativeP :: TextParser m SmartDate
    relativeP = do
            ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text))
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT HledgerParseErrorData Text m (Tokens Text)
     -> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text)))
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text))
    forall a b. (a -> b) -> a -> b
    $ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "in" ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces
            Integer
    num      <- ParsecT HledgerParseErrorData Text m Integer
    forall {m :: * -> *}. ParsecT HledgerParseErrorData Text m Integer
    seqP ParsecT HledgerParseErrorData Text m Integer
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Integer
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces
            SmartInterval
    interval <- ParsecT HledgerParseErrorData Text m SmartInterval
    intervalP ParsecT HledgerParseErrorData Text m SmartInterval
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m SmartInterval
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces
            Integer -> Integer
    sign     <- [ParsecT HledgerParseErrorData Text m (Integer -> Integer)]
    -> ParsecT HledgerParseErrorData Text m (Integer -> Integer)
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [Integer -> Integer
    forall a. Num a => a -> a
    negate (Integer -> Integer)
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Integer -> Integer)
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "ago", Integer -> Integer
    forall a. a -> a
    id (Integer -> Integer)
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Integer -> Integer)
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "ahead", (Integer -> Integer)
    -> ParsecT HledgerParseErrorData Text m (Integer -> Integer)
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Integer -> Integer
    forall a. a -> a
    id]
            SmartDate -> TextParser m SmartDate
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SmartDate -> TextParser m SmartDate)
    -> SmartDate -> TextParser m SmartDate
    forall a b. (a -> b) -> a -> b
    $ Integer -> SmartInterval -> SmartDate
    SmartRelative (Integer -> Integer
    sign Integer
    num) SmartInterval
    interval

        seqP :: ParsecT HledgerParseErrorData Text m Integer
    seqP = [ParsecT HledgerParseErrorData Text m Integer]
    -> ParsecT HledgerParseErrorData Text m Integer
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [ Integer
    0 Integer
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Integer
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "this", -Integer
    1 Integer
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Integer
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "last", Integer
    1 Integer
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Integer
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "next", ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Integer
    -> ParsecT HledgerParseErrorData Text m Integer
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m () -> m a -> m a
    signed ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m Integer
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal ]
        intervalP :: ParsecT HledgerParseErrorData Text m SmartInterval
    intervalP = [ParsecT HledgerParseErrorData Text m SmartInterval]
    -> ParsecT HledgerParseErrorData Text m SmartInterval
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [ SmartInterval
    Day SmartInterval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m SmartInterval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "day", SmartInterval
    Week SmartInterval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m SmartInterval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "week", SmartInterval
    Month SmartInterval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m SmartInterval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "month"
                           , SmartInterval
    Quarter SmartInterval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m SmartInterval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "quarter", SmartInterval
    Year SmartInterval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m SmartInterval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "year" ] ParsecT HledgerParseErrorData Text m SmartInterval
    -> ParsecT HledgerParseErrorData Text m (Maybe Char)
    -> ParsecT HledgerParseErrorData Text m SmartInterval
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m Char
    -> ParsecT HledgerParseErrorData Text m (Maybe Char)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char' Char
    Token Text
    's')

    -- | Like smartdate, but there must be nothing other than whitespace after the date.
    smartdateonly :: TextParser m SmartDate
    smartdateonly :: forall (m :: * -> *). TextParser m SmartDate
    smartdateonly = TextParser m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate TextParser m SmartDate
    -> ParsecT HledgerParseErrorData Text m ()
    -> TextParser m SmartDate
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces TextParser m SmartDate
    -> ParsecT HledgerParseErrorData Text m ()
    -> TextParser m SmartDate
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof

    datesepchars :: String
    datesepchars :: [Char]
    datesepchars = [Char]
    "/-."

    datesepchar :: TextParser m Char
    datesepchar :: forall (m :: * -> *). TextParser m Char
    datesepchar = (Token Text -> Bool)
    -> ParsecT HledgerParseErrorData Text m (Token Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    (Token s -> Bool) -> m (Token s)
    satisfy Char -> Bool
    Token Text -> Bool
    isDateSepChar

    isDateSepChar :: Char -> Bool
    isDateSepChar :: Char -> Bool
    isDateSepChar Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.'

    validMonth, validDay :: Int -> Bool
    validMonth :: Int -> Bool
    validMonth Int
    n = Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    1 Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    12
    validDay :: Int -> Bool
    validDay Int
    n = Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    1 Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    31

    failIfInvalidDate :: Fail.MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate :: forall (m :: * -> *). MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate SmartDate
    s = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    isValid ([Char] -> m ()
    forall a. [Char] -> m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    Fail.fail ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "bad smart date: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SmartDate -> [Char]
    forall a. Show a => a -> [Char]
    show SmartDate
    s) m () -> SmartDate -> m SmartDate
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> SmartDate
    s
      where isValid :: Bool
    isValid = case SmartDate
    s of
                SmartAssumeStart Integer
    _ (Just Int
    m) -> Int -> Bool
    validMonth Int
    m
                SmartFromReference Maybe Int
    mm Int
    d     -> Maybe Day -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Day -> Bool) -> Maybe Day -> Bool
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Maybe Day
    fromGregorianValid Integer
    2004 (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    1 Maybe Int
    mm) Int
    d
                SmartMonth Int
    m                -> Int -> Bool
    validMonth Int
    m
                SmartDate
    _                           -> Bool
    True

    showBadDate :: Integer -> Int -> Int -> String
    showBadDate :: Integer -> Int -> Int -> [Char]
    showBadDate Integer
    y Int
    m Int
    d = [Char]
    "bad smart date: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    y [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    m [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    d

    yyyymmdd :: TextParser m SmartDate
    yyyymmdd :: forall (m :: * -> *). TextParser m SmartDate
    yyyymmdd = do
      Integer
    y <- [Char] -> Integer
    forall a. Read a => [Char] -> a
    read ([Char] -> Integer)
    -> ParsecT HledgerParseErrorData Text m [Char]
    -> ParsecT HledgerParseErrorData Text m Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> ParsecT HledgerParseErrorData Text m Char
    -> ParsecT HledgerParseErrorData Text m [Char]
    forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
    count Int
    4 ParsecT HledgerParseErrorData Text m Char
    ParsecT HledgerParseErrorData Text m (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    digitChar
      Int
    m <- [Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> Int)
    -> ParsecT HledgerParseErrorData Text m [Char]
    -> ParsecT HledgerParseErrorData Text m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> ParsecT HledgerParseErrorData Text m Char
    -> ParsecT HledgerParseErrorData Text m [Char]
    forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
    count Int
    2 ParsecT HledgerParseErrorData Text m Char
    ParsecT HledgerParseErrorData Text m (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    digitChar
      Maybe Int
    mdy <- ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Maybe Int)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT HledgerParseErrorData Text m Int
     -> ParsecT HledgerParseErrorData Text m (Maybe Int))
    -> ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> Int)
    -> ParsecT HledgerParseErrorData Text m [Char]
    -> ParsecT HledgerParseErrorData Text m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> ParsecT HledgerParseErrorData Text m Char
    -> ParsecT HledgerParseErrorData Text m [Char]
    forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
    count Int
    2 ParsecT HledgerParseErrorData Text m Char
    ParsecT HledgerParseErrorData Text m (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    digitChar
      case Maybe Int
    mdy of
          Maybe Int
    Nothing -> SmartDate -> TextParser m SmartDate
    forall (m :: * -> *). MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate (SmartDate -> TextParser m SmartDate)
    -> SmartDate -> TextParser m SmartDate
    forall a b. (a -> b) -> a -> b
    $ Integer -> Maybe Int -> SmartDate
    SmartAssumeStart Integer
    y (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    m)
          Just Int
    d  -> TextParser m SmartDate
    -> (Day -> TextParser m SmartDate)
    -> Maybe Day
    -> TextParser m SmartDate
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> TextParser m SmartDate
    forall a. [Char] -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    Fail.fail ([Char] -> TextParser m SmartDate)
    -> [Char] -> TextParser m SmartDate
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> [Char]
    showBadDate Integer
    y Int
    m Int
    d) (SmartDate -> TextParser m SmartDate
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SmartDate -> TextParser m SmartDate)
    -> (Day -> SmartDate) -> Day -> TextParser m SmartDate
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> SmartDate
    SmartCompleteDate) (Maybe Day -> TextParser m SmartDate)
    -> Maybe Day -> TextParser m SmartDate
    forall a b. (a -> b) -> a -> b
    $
                       Integer -> Int -> Int -> Maybe Day
    fromGregorianValid Integer
    y Int
    m Int
    d

    ymd :: TextParser m SmartDate
    ymd :: forall (m :: * -> *). TextParser m SmartDate
    ymd = do
        Integer
    y <- TextParser m Integer
    forall {m :: * -> *}. ParsecT HledgerParseErrorData Text m Integer
    yearp
        Maybe (Either Int Day)
    emd <- ParsecT HledgerParseErrorData Text m (Either Int Day)
    -> ParsecT HledgerParseErrorData Text m (Maybe (Either Int Day))
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT HledgerParseErrorData Text m (Either Int Day)
     -> ParsecT HledgerParseErrorData Text m (Maybe (Either Int Day)))
    -> (ParsecT HledgerParseErrorData Text m (Either Int Day)
        -> ParsecT HledgerParseErrorData Text m (Either Int Day))
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    -> ParsecT HledgerParseErrorData Text m (Maybe (Either Int Day))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT HledgerParseErrorData Text m (Either Int Day)
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT HledgerParseErrorData Text m (Either Int Day)
     -> ParsecT HledgerParseErrorData Text m (Maybe (Either Int Day)))
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    -> ParsecT HledgerParseErrorData Text m (Maybe (Either Int Day))
    forall a b. (a -> b) -> a -> b
    $ do
            Char
    sep <- TextParser m Char
    forall (m :: * -> *). TextParser m Char
    datesepchar
            Int
    m <- ParsecT HledgerParseErrorData Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal
            Bool
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Int -> Bool
    validMonth Int
    m) (ParsecT HledgerParseErrorData Text m ()
     -> ParsecT HledgerParseErrorData Text m ())
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ParsecT HledgerParseErrorData Text m ()
    forall a. [Char] -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    Fail.fail ([Char]
    "Bad month " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    m)
            Either Int Day
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    forall (m :: * -> *) a. Alternative m => a -> m a -> m a
    option (Int -> Either Int Day
    forall a b. a -> Either a b
    Left Int
    m) (ParsecT HledgerParseErrorData Text m (Either Int Day)
     -> ParsecT HledgerParseErrorData Text m (Either Int Day))
    -> (ParsecT HledgerParseErrorData Text m (Either Int Day)
        -> ParsecT HledgerParseErrorData Text m (Either Int Day))
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT HledgerParseErrorData Text m (Either Int Day)
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT HledgerParseErrorData Text m (Either Int Day)
     -> ParsecT HledgerParseErrorData Text m (Either Int Day))
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    forall a b. (a -> b) -> a -> b
    $ Day -> Either Int Day
    forall a b. b -> Either a b
    Right (Day -> Either Int Day)
    -> ParsecT HledgerParseErrorData Text m Day
    -> ParsecT HledgerParseErrorData Text m (Either Int Day)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
                Char
    _ <- Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token Text
    sep
                Int
    d <- ParsecT HledgerParseErrorData Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal
                ParsecT HledgerParseErrorData Text m Day
    -> (Day -> ParsecT HledgerParseErrorData Text m Day)
    -> Maybe Day
    -> ParsecT HledgerParseErrorData Text m Day
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> ParsecT HledgerParseErrorData Text m Day
    forall a. [Char] -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    Fail.fail ([Char] -> ParsecT HledgerParseErrorData Text m Day)
    -> [Char] -> ParsecT HledgerParseErrorData Text m Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> [Char]
    showBadDate Integer
    y Int
    m Int
    d) Day -> ParsecT HledgerParseErrorData Text m Day
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Day -> ParsecT HledgerParseErrorData Text m Day)
    -> Maybe Day -> ParsecT HledgerParseErrorData Text m Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Maybe Day
    fromGregorianValid Integer
    y Int
    m Int
    d
        SmartDate -> TextParser m SmartDate
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SmartDate -> TextParser m SmartDate)
    -> SmartDate -> TextParser m SmartDate
    forall a b. (a -> b) -> a -> b
    $ case Maybe (Either Int Day)
    emd of
            Maybe (Either Int Day)
    Nothing          -> Integer -> Maybe Int -> SmartDate
    SmartAssumeStart Integer
    y Maybe Int
    forall a. Maybe a
    Nothing
            Just (Left Int
    m)    -> Integer -> Maybe Int -> SmartDate
    SmartAssumeStart Integer
    y (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    m)
            Just (Right Day
    day) -> Day -> SmartDate
    SmartCompleteDate Day
    day

    md :: TextParser m (Month, MonthDay)
    md :: forall (m :: * -> *). TextParser m (Int, Int)
    md = do
      Int
    m <- ParsecT HledgerParseErrorData Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal
      TextParser m Char
    forall (m :: * -> *). TextParser m Char
    datesepchar
      Int
    d <- ParsecT HledgerParseErrorData Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal
      SmartDate
    _ <- SmartDate -> ParsecT HledgerParseErrorData Text m SmartDate
    forall (m :: * -> *). MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate (SmartDate -> ParsecT HledgerParseErrorData Text m SmartDate)
    -> SmartDate -> ParsecT HledgerParseErrorData Text m SmartDate
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Int -> SmartDate
    SmartFromReference (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    m) Int
    d
      (Int, Int) -> TextParser m (Int, Int)
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    m, Int
    d)

    -- | Parse a year number from a Text, making sure that at least four digits are
    -- used.
    yearp :: TextParser m Integer
    yearp :: forall {m :: * -> *}. ParsecT HledgerParseErrorData Text m Integer
    yearp = do
      Text
    year <- Maybe [Char]
    -> (Token Text -> Bool)
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
    takeWhile1P ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    "year") Char -> Bool
    Token Text -> Bool
    isDigit
      Bool
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text -> Int
    T.length Text
    year Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    4) (ParsecT HledgerParseErrorData Text m ()
     -> ParsecT HledgerParseErrorData Text m ())
    -> ([Char] -> ParsecT HledgerParseErrorData Text m ())
    -> [Char]
    -> ParsecT HledgerParseErrorData Text m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ParsecT HledgerParseErrorData Text m ()
    forall a. [Char] -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    Fail.fail ([Char] -> ParsecT HledgerParseErrorData Text m ())
    -> [Char] -> ParsecT HledgerParseErrorData Text m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Year must contain at least 4 digits: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Char]
    T.unpack Text
    year
      Integer -> TextParser m Integer
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> TextParser m Integer)
    -> Integer -> TextParser m Integer
    forall a b. (a -> b) -> a -> b
    $ Text -> Integer
    readDecimal Text
    year

    -- These are compared case insensitively, and should all be kept lower case.
    months :: [Tokens Text]
    months         = [Tokens Text
    "january",Tokens Text
    "february",Tokens Text
    "march",Tokens Text
    "april",Tokens Text
    "may",Tokens Text
    "june",
                      Tokens Text
    "july",Tokens Text
    "august",Tokens Text
    "september",Tokens Text
    "october",Tokens Text
    "november",Tokens Text
    "december"]
    monthabbrevs :: [Tokens Text]
    monthabbrevs   = [Tokens Text
    "jan",Tokens Text
    "feb",Tokens Text
    "mar",Tokens Text
    "apr",Tokens Text
    "may",Tokens Text
    "jun",Tokens Text
    "jul",Tokens Text
    "aug",Tokens Text
    "sep",Tokens Text
    "oct",Tokens Text
    "nov",Tokens Text
    "dec"]
    weekdays :: [Tokens Text]
    weekdays       = [Tokens Text
    "monday",Tokens Text
    "tuesday",Tokens Text
    "wednesday",Tokens Text
    "thursday",Tokens Text
    "friday",Tokens Text
    "saturday",Tokens Text
    "sunday"]
    weekdayabbrevs :: [Text]
    weekdayabbrevs = [Text
    "mon",Text
    "tue",Text
    "wed",Text
    "thu",Text
    "fri",Text
    "sat",Text
    "sun"]

    month, mon :: TextParser m Month
    month :: forall (m :: * -> *). TextParser m Int
    month = [ParsecT HledgerParseErrorData Text m Int]
    -> ParsecT HledgerParseErrorData Text m Int
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice ([ParsecT HledgerParseErrorData Text m Int]
     -> ParsecT HledgerParseErrorData Text m Int)
    -> [ParsecT HledgerParseErrorData Text m Int]
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b. (a -> b) -> a -> b
    $ (Int -> Tokens Text -> ParsecT HledgerParseErrorData Text m Int)
    -> [Int]
    -> [Tokens Text]
    -> [ParsecT HledgerParseErrorData Text m Int]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Int
    i Tokens Text
    m -> Int
    i Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    m) [Int
    1..Int
    12] [Tokens Text]
    months
    mon :: forall (m :: * -> *). TextParser m Int
    mon   = [ParsecT HledgerParseErrorData Text m Int]
    -> ParsecT HledgerParseErrorData Text m Int
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice ([ParsecT HledgerParseErrorData Text m Int]
     -> ParsecT HledgerParseErrorData Text m Int)
    -> [ParsecT HledgerParseErrorData Text m Int]
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b. (a -> b) -> a -> b
    $ (Int -> Tokens Text -> ParsecT HledgerParseErrorData Text m Int)
    -> [Int]
    -> [Tokens Text]
    -> [ParsecT HledgerParseErrorData Text m Int]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Int
    i Tokens Text
    m -> Int
    i Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    m) [Int
    1..Int
    12] [Tokens Text]
    monthabbrevs

    weekday :: TextParser m Int
    weekday :: forall (m :: * -> *). TextParser m Int
    weekday = do
      Text
    wday <- Text -> Text
    T.toLower (Text -> Text)
    -> ParsecT HledgerParseErrorData Text m Text
    -> ParsecT HledgerParseErrorData Text m Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([ParsecT HledgerParseErrorData Text m Text]
    -> ParsecT HledgerParseErrorData Text m Text
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice ([ParsecT HledgerParseErrorData Text m Text]
     -> ParsecT HledgerParseErrorData Text m Text)
    -> ([Tokens Text] -> [ParsecT HledgerParseErrorData Text m Text])
    -> [Tokens Text]
    -> ParsecT HledgerParseErrorData Text m Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tokens Text -> ParsecT HledgerParseErrorData Text m Text)
    -> [Tokens Text] -> [ParsecT HledgerParseErrorData Text m Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Tokens Text -> ParsecT HledgerParseErrorData Text m Text
    Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' ([Tokens Text] -> ParsecT HledgerParseErrorData Text m Text)
    -> [Tokens Text] -> ParsecT HledgerParseErrorData Text m Text
    forall a b. (a -> b) -> a -> b
    $ [Tokens Text]
    weekdays [Tokens Text] -> [Tokens Text] -> [Tokens Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text]
    [Tokens Text]
    weekdayabbrevs)
      case [Maybe Int] -> [Int]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Int] -> [Int]) -> [Maybe Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ [Text
    wday Text -> [Text] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    `elemIndex` [Text]
    [Tokens Text]
    weekdays, Text
    wday Text -> [Text] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    `elemIndex` [Text]
    weekdayabbrevs] of
        (Int
    i:[Int]
    _) -> Int -> TextParser m Int
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
        []    -> [Char] -> TextParser m Int
    forall a. [Char] -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    Fail.fail ([Char] -> TextParser m Int) -> [Char] -> TextParser m Int
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "weekday: should not happen: attempted to find " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
                             Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    wday [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    " in " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Tokens Text] -> [Char]
    forall a. Show a => a -> [Char]
    show ([Tokens Text]
    weekdays [Tokens Text] -> [Tokens Text] -> [Tokens Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text]
    [Tokens Text]
    weekdayabbrevs)

    weekdaysp :: TextParser m [Int]
    weekdaysp :: forall (m :: * -> *). TextParser m [Int]
    weekdaysp = ([Int] -> Int) -> [[Int]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Int] -> Int
    forall a. HasCallStack => [a] -> a
    head ([[Int]] -> [Int]) -> ([Int] -> [[Int]]) -> [Int] -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> [[Int]]
    forall a. Eq a => [a] -> [[a]]
    group ([Int] -> [[Int]]) -> ([Int] -> [Int]) -> [Int] -> [[Int]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> [Int]
    forall a. Ord a => [a] -> [a]
    sort ([Int] -> [Int])
    -> ParsecT HledgerParseErrorData Text m [Int]
    -> ParsecT HledgerParseErrorData Text m [Int]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m [Int]
    forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
    sepBy1 ParsecT HledgerParseErrorData Text m Int
    forall (m :: * -> *). TextParser m Int
    weekday (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    ",")

    -- | Parse a period expression, specifying a date span and optionally
    -- a reporting interval. Requires a reference "today" date for
    -- resolving any relative start/end dates (only; it is not needed for
    -- parsing the reporting interval).
    --
    -- >>> let p = parsePeriodExpr (fromGregorian 2008 11 26)
    -- >>> p "from Aug to Oct"
    -- Right (NoInterval,DateSpan 2008-08-01..2008-09-30)
    -- >>> p "aug to oct"
    -- Right (NoInterval,DateSpan 2008-08-01..2008-09-30)
    -- >>> p "2009q2"
    -- Right (NoInterval,DateSpan 2009Q2)
    -- >>> p "Q3"
    -- Right (NoInterval,DateSpan 2008Q3)
    -- >>> p "every 3 days in Aug"
    -- Right (Days 3,DateSpan 2008-08)
    -- >>> p "daily from aug"
    -- Right (Days 1,DateSpan 2008-08-01..)
    -- >>> p "every week to 2009"
    -- Right (Weeks 1,DateSpan ..2008-12-31)
    -- >>> p "every 2nd day of month"
    -- Right (DayOfMonth 2,DateSpan ..)
    -- >>> p "every 2nd day"
    -- Right (DayOfMonth 2,DateSpan ..)
    -- >>> p "every 2nd day 2009.."
    -- Right (DayOfMonth 2,DateSpan 2009-01-01..)
    -- >>> p "every 2nd day 2009-"
    -- Right (DayOfMonth 2,DateSpan 2009-01-01..)
    -- >>> p "every 29th Nov"
    -- Right (DayOfYear 11 29,DateSpan ..)
    -- >>> p "every 29th nov ..2009"
    -- Right (DayOfYear 11 29,DateSpan ..2008-12-31)
    -- >>> p "every nov 29th"
    -- Right (DayOfYear 11 29,DateSpan ..)
    -- >>> p "every Nov 29th 2009.."
    -- Right (DayOfYear 11 29,DateSpan 2009-01-01..)
    -- >>> p "every 11/29 from 2009"
    -- Right (DayOfYear 11 29,DateSpan 2009-01-01..)
    -- >>> p "every 11/29 since 2009"
    -- Right (DayOfYear 11 29,DateSpan 2009-01-01..)
    -- >>> p "every 2nd Thursday of month to 2009"
    -- Right (WeekdayOfMonth 2 4,DateSpan ..2008-12-31)
    -- >>> p "every 1st monday of month to 2009"
    -- Right (WeekdayOfMonth 1 1,DateSpan ..2008-12-31)
    -- >>> p "every tue"
    -- Right (DaysOfWeek [2],DateSpan ..)
    -- >>> p "every 2nd day of week"
    -- Right (DaysOfWeek [2],DateSpan ..)
    -- >>> p "every 2nd day of month"
    -- Right (DayOfMonth 2,DateSpan ..)
    -- >>> p "every 2nd day"
    -- Right (DayOfMonth 2,DateSpan ..)
    -- >>> p "every 2nd day 2009.."
    -- Right (DayOfMonth 2,DateSpan 2009-01-01..)
    -- >>> p "every 2nd day of month 2009.."
    -- Right (DayOfMonth 2,DateSpan 2009-01-01..)
    periodexprp :: Day -> TextParser m (Interval, DateSpan)
    periodexprp :: forall (m :: * -> *). Day -> TextParser m (Interval, DateSpan)
    periodexprp Day
    rdate = do
      ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces
      [TextParser m (Interval, DateSpan)]
    -> TextParser m (Interval, DateSpan)
    forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
    choice' [ Day -> TextParser m (Interval, DateSpan)
    forall (m :: * -> *). Day -> TextParser m (Interval, DateSpan)
    intervalanddateperiodexprp Day
    rdate
              , (,) Interval
    NoInterval (DateSpan -> (Interval, DateSpan))
    -> ParsecT HledgerParseErrorData Text m DateSpan
    -> TextParser m (Interval, DateSpan)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Day -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (m :: * -> *). Day -> TextParser m DateSpan
    periodexprdatespanp Day
    rdate
              ]

    -- Parse a reporting interval and a date span.
    intervalanddateperiodexprp :: Day -> TextParser m (Interval, DateSpan)
    intervalanddateperiodexprp :: forall (m :: * -> *). Day -> TextParser m (Interval, DateSpan)
    intervalanddateperiodexprp Day
    rdate = do
      Interval
    i <- TextParser m Interval
    forall (m :: * -> *). TextParser m Interval
    reportingintervalp
      DateSpan
    s <- DateSpan
    -> ParsecT HledgerParseErrorData Text m DateSpan
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (m :: * -> *) a. Alternative m => a -> m a -> m a
    option DateSpan
    forall a. Default a => a
    def (ParsecT HledgerParseErrorData Text m DateSpan
     -> ParsecT HledgerParseErrorData Text m DateSpan)
    -> (ParsecT HledgerParseErrorData Text m DateSpan
        -> ParsecT HledgerParseErrorData Text m DateSpan)
    -> ParsecT HledgerParseErrorData Text m DateSpan
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT HledgerParseErrorData Text m DateSpan
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT HledgerParseErrorData Text m DateSpan
     -> ParsecT HledgerParseErrorData Text m DateSpan)
    -> ParsecT HledgerParseErrorData Text m DateSpan
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall a b. (a -> b) -> a -> b
    $ do
          ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces
          Day -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (m :: * -> *). Day -> TextParser m DateSpan
    periodexprdatespanp Day
    rdate
      (Interval, DateSpan) -> TextParser m (Interval, DateSpan)
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Interval
    i,DateSpan
    s)

    -- Parse a reporting interval.
    reportingintervalp :: TextParser m Interval
    reportingintervalp :: forall (m :: * -> *). TextParser m Interval
    reportingintervalp = [TextParser m Interval] -> TextParser m Interval
    forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
    choice'
        [ Text -> Text -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    Text -> Text -> (Int -> Interval) -> TextParser m Interval
    tryinterval Text
    "day"     Text
    "daily"     Int -> Interval
    Days
        , Text -> Text -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    Text -> Text -> (Int -> Interval) -> TextParser m Interval
    tryinterval Text
    "month"   Text
    "monthly"   Int -> Interval
    Months
        , Text -> Text -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    Text -> Text -> (Int -> Interval) -> TextParser m Interval
    tryinterval Text
    "quarter" Text
    "quarterly" Int -> Interval
    Quarters
        , Text -> Text -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    Text -> Text -> (Int -> Interval) -> TextParser m Interval
    tryinterval Text
    "year"    Text
    "yearly"    Int -> Interval
    Years
        , Int -> Interval
    Weeks Int
    2 Interval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> TextParser m Interval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "biweekly"
        , Int -> Interval
    Weeks Int
    2 Interval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> TextParser m Interval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "fortnightly"
        , Int -> Interval
    Months Int
    2 Interval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> TextParser m Interval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "bimonthly"
        , Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "every" ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
    -> TextParser m Interval -> TextParser m Interval
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [TextParser m Interval] -> TextParser m Interval
    forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
    choice'
            [ [Int] -> Interval
    DaysOfWeek ([Int] -> Interval) -> (Int -> [Int]) -> Int -> Interval
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Int]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int -> Interval)
    -> ParsecT HledgerParseErrorData Text m Int
    -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT HledgerParseErrorData Text m Int
    nth ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "day" ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Text
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall {s} {m :: * -> *}.
    (Token s ~ Char, IsString (Tokens s), FoldCase (Tokens s),
     Stream s) =>
    Tokens s -> ParsecT HledgerParseErrorData s m (Tokens s)
    of_ Text
    Tokens Text
    "week")
            , Int -> Interval
    DayOfMonth (Int -> Interval)
    -> ParsecT HledgerParseErrorData Text m Int
    -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT HledgerParseErrorData Text m Int
    nth ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "day" ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Maybe Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text
    -> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text))
    forall {s} {m :: * -> *}.
    (Token s ~ Char, Stream s, IsString (Tokens s),
     FoldCase (Tokens s)) =>
    Tokens s -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s))
    optOf_ Text
    Tokens Text
    "month")
            , (Int -> Int -> Interval)
    -> ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Int
    -> TextParser m Interval
    forall a b c.
    (a -> b -> c)
    -> ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Int -> Int -> Interval
    WeekdayOfMonth ParsecT HledgerParseErrorData Text m Int
    nth (ParsecT HledgerParseErrorData Text m Int -> TextParser m Interval)
    -> ParsecT HledgerParseErrorData Text m Int
    -> TextParser m Interval
    forall a b. (a -> b) -> a -> b
    $ ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m Int
    forall (m :: * -> *). TextParser m Int
    weekday ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Maybe Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text
    -> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text))
    forall {s} {m :: * -> *}.
    (Token s ~ Char, Stream s, IsString (Tokens s),
     FoldCase (Tokens s)) =>
    Tokens s -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s))
    optOf_ Text
    Tokens Text
    "month"
            , (Int -> Int -> Interval) -> (Int, Int) -> Interval
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Int -> Int -> Interval
    DayOfYear ((Int, Int) -> Interval)
    -> ParsecT HledgerParseErrorData Text m (Int, Int)
    -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT HledgerParseErrorData Text m (Int, Int)
    forall (m :: * -> *). TextParser m (Int, Int)
    md ParsecT HledgerParseErrorData Text m (Int, Int)
    -> ParsecT HledgerParseErrorData Text m (Maybe Text)
    -> ParsecT HledgerParseErrorData Text m (Int, Int)
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text
    -> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text))
    forall {s} {m :: * -> *}.
    (Token s ~ Char, Stream s, IsString (Tokens s),
     FoldCase (Tokens s)) =>
    Tokens s -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s))
    optOf_ Text
    Tokens Text
    "year")
            , [Int] -> Interval
    DaysOfWeek ([Int] -> Interval)
    -> ParsecT HledgerParseErrorData Text m [Int]
    -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT HledgerParseErrorData Text m [Int]
    forall (m :: * -> *). TextParser m [Int]
    weekdaysp
            , [Int] -> Interval
    DaysOfWeek [Int
    1..Int
    5] Interval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> TextParser m Interval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "weekday"
            , [Int] -> Interval
    DaysOfWeek [Int
    6..Int
    7] Interval
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> TextParser m Interval
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "weekendday"
            , TextParser m Interval
    d_o_y TextParser m Interval
    -> ParsecT HledgerParseErrorData Text m (Maybe Text)
    -> TextParser m Interval
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text
    -> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text))
    forall {s} {m :: * -> *}.
    (Token s ~ Char, Stream s, IsString (Tokens s),
     FoldCase (Tokens s)) =>
    Tokens s -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s))
    optOf_ Text
    Tokens Text
    "year"
            ]
        -- NB: the ordering is important here since the parse for `every weekday`
        -- would match the `tryinterval` first and then error on `d`. Perhaps it
        -- would be clearer to factor some of this into the `every` choice or other
        -- left-factorings.
        , Text -> Text -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    Text -> Text -> (Int -> Interval) -> TextParser m Interval
    tryinterval Text
    "week"    Text
    "weekly"    Int -> Interval
    Weeks
        ]
      where
        of_ :: Tokens s -> ParsecT HledgerParseErrorData s m (Tokens s)
    of_ Tokens s
    period =
          ParsecT HledgerParseErrorData s m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData s m ()
    -> ParsecT HledgerParseErrorData s m (Tokens s)
    -> ParsecT HledgerParseErrorData s m (Tokens s)
    forall a b.
    ParsecT HledgerParseErrorData s m a
    -> ParsecT HledgerParseErrorData s m b
    -> ParsecT HledgerParseErrorData s m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Tokens s -> ParsecT HledgerParseErrorData s m (Tokens s)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens s
    "of" ParsecT HledgerParseErrorData s m (Tokens s)
    -> ParsecT HledgerParseErrorData s m ()
    -> ParsecT HledgerParseErrorData s m ()
    forall a b.
    ParsecT HledgerParseErrorData s m a
    -> ParsecT HledgerParseErrorData s m b
    -> ParsecT HledgerParseErrorData s m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData s m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData s m ()
    -> ParsecT HledgerParseErrorData s m (Tokens s)
    -> ParsecT HledgerParseErrorData s m (Tokens s)
    forall a b.
    ParsecT HledgerParseErrorData s m a
    -> ParsecT HledgerParseErrorData s m b
    -> ParsecT HledgerParseErrorData s m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Tokens s -> ParsecT HledgerParseErrorData s m (Tokens s)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens s
    period

        optOf_ :: Tokens s -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s))
    optOf_ Tokens s
    period = ParsecT HledgerParseErrorData s m (Tokens s)
    -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s))
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT HledgerParseErrorData s m (Tokens s)
     -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s)))
    -> (ParsecT HledgerParseErrorData s m (Tokens s)
        -> ParsecT HledgerParseErrorData s m (Tokens s))
    -> ParsecT HledgerParseErrorData s m (Tokens s)
    -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT HledgerParseErrorData s m (Tokens s)
    -> ParsecT HledgerParseErrorData s m (Tokens s)
    forall a.
    ParsecT HledgerParseErrorData s m a
    -> ParsecT HledgerParseErrorData s m a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT HledgerParseErrorData s m (Tokens s)
     -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s)))
    -> ParsecT HledgerParseErrorData s m (Tokens s)
    -> ParsecT HledgerParseErrorData s m (Maybe (Tokens s))
    forall a b. (a -> b) -> a -> b
    $ Tokens s -> ParsecT HledgerParseErrorData s m (Tokens s)
    forall {s} {m :: * -> *}.
    (Token s ~ Char, IsString (Tokens s), FoldCase (Tokens s),
     Stream s) =>
    Tokens s -> ParsecT HledgerParseErrorData s m (Tokens s)
    of_ Tokens s
    period

        nth :: ParsecT HledgerParseErrorData Text m Int
    nth = ParsecT HledgerParseErrorData Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* [ParsecT HledgerParseErrorData Text m (Tokens Text)]
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice ((Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text))
    -> [Tokens Text]
    -> [ParsecT HledgerParseErrorData Text m (Tokens Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' [Tokens Text
    "st",Tokens Text
    "nd",Tokens Text
    "rd",Tokens Text
    "th"])
        d_o_y :: TextParser m Interval
    d_o_y = Permutation (ParsecT HledgerParseErrorData Text m) Interval
    -> TextParser m Interval
    forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
    runPermutation (Permutation (ParsecT HledgerParseErrorData Text m) Interval
     -> TextParser m Interval)
    -> Permutation (ParsecT HledgerParseErrorData Text m) Interval
    -> TextParser m Interval
    forall a b. (a -> b) -> a -> b
    $ (Int -> Int -> Interval)
    -> Permutation (ParsecT HledgerParseErrorData Text m) Int
    -> Permutation (ParsecT HledgerParseErrorData Text m) Int
    -> Permutation (ParsecT HledgerParseErrorData Text m) Interval
    forall a b c.
    (a -> b -> c)
    -> Permutation (ParsecT HledgerParseErrorData Text m) a
    -> Permutation (ParsecT HledgerParseErrorData Text m) b
    -> Permutation (ParsecT HledgerParseErrorData Text m) c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Int -> Int -> Interval
    DayOfYear (ParsecT HledgerParseErrorData Text m Int
    -> Permutation (ParsecT HledgerParseErrorData Text m) Int
    forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
    toPermutation (ParsecT HledgerParseErrorData Text m Int
     -> Permutation (ParsecT HledgerParseErrorData Text m) Int)
    -> ParsecT HledgerParseErrorData Text m Int
    -> Permutation (ParsecT HledgerParseErrorData Text m) Int
    forall a b. (a -> b) -> a -> b
    $ (ParsecT HledgerParseErrorData Text m Int
    forall (m :: * -> *). TextParser m Int
    month ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Int
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ParsecT HledgerParseErrorData Text m Int
    forall (m :: * -> *). TextParser m Int
    mon) ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces)
                                                  (ParsecT HledgerParseErrorData Text m Int
    -> Permutation (ParsecT HledgerParseErrorData Text m) Int
    forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
    toPermutation (ParsecT HledgerParseErrorData Text m Int
     -> Permutation (ParsecT HledgerParseErrorData Text m) Int)
    -> ParsecT HledgerParseErrorData Text m Int
    -> Permutation (ParsecT HledgerParseErrorData Text m) Int
    forall a b. (a -> b) -> a -> b
    $ ParsecT HledgerParseErrorData Text m Int
    nth ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces)

        -- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days".
        tryinterval :: Text -> Text -> (Int -> Interval) -> TextParser m Interval
        tryinterval :: forall (m :: * -> *).
    Text -> Text -> (Int -> Interval) -> TextParser m Interval
    tryinterval Text
    singular Text
    compact Int -> Interval
    intcons = Int -> Interval
    intcons (Int -> Interval)
    -> ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ParsecT HledgerParseErrorData Text m Int]
    -> ParsecT HledgerParseErrorData Text m Int
    forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
    choice'
            [ Int
    1 Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Text
    Tokens Text
    compact
            , Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "every" ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [ParsecT HledgerParseErrorData Text m Int]
    -> ParsecT HledgerParseErrorData Text m Int
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice
                [ Int
    1 Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Text
    Tokens Text
    singular
                , ParsecT HledgerParseErrorData Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m Int
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m Int
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' (Text
    singular Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "s")
                ]
            ]

    periodexprdatespanp :: Day -> TextParser m DateSpan
    periodexprdatespanp :: forall (m :: * -> *). Day -> TextParser m DateSpan
    periodexprdatespanp Day
    rdate = [ParsecT HledgerParseErrorData Text m DateSpan]
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice ([ParsecT HledgerParseErrorData Text m DateSpan]
     -> ParsecT HledgerParseErrorData Text m DateSpan)
    -> [ParsecT HledgerParseErrorData Text m DateSpan]
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall a b. (a -> b) -> a -> b
    $ (ParsecT HledgerParseErrorData Text m DateSpan
     -> ParsecT HledgerParseErrorData Text m DateSpan)
    -> [ParsecT HledgerParseErrorData Text m DateSpan]
    -> [ParsecT HledgerParseErrorData Text m DateSpan]
    forall a b. (a -> b) -> [a] -> [b]
    map ParsecT HledgerParseErrorData Text m DateSpan
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try [
                                Day -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (m :: * -> *). Day -> TextParser m DateSpan
    doubledatespanp Day
    rdate,
                                Day -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (m :: * -> *). Day -> TextParser m DateSpan
    quarterdatespanp Day
    rdate,
                                Day -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (m :: * -> *). Day -> TextParser m DateSpan
    fromdatespanp Day
    rdate,
                                Day -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (m :: * -> *). Day -> TextParser m DateSpan
    todatespanp Day
    rdate,
                                Day -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (m :: * -> *). Day -> TextParser m DateSpan
    justdatespanp Day
    rdate
                               ]

    -- |
    -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "20180101-201804"
    -- Right DateSpan 2018Q1
    -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "2017..2018"
    -- Right DateSpan 2017
    -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "2017-2018"
    -- Right DateSpan 2017
    -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "2017-01-2018"
    -- Right DateSpan 2017
    -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "2017-01-01-2018"
    -- Right DateSpan 2017
    doubledatespanp :: Day -> TextParser m DateSpan
    doubledatespanp :: forall (m :: * -> *). Day -> TextParser m DateSpan
    doubledatespanp Day
    rdate = (SmartDate -> SmartDate -> DateSpan)
    -> ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall a b c.
    (a -> b -> c)
    -> ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 SmartDate -> SmartDate -> DateSpan
    fromToSpan
        (ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m (Maybe ())
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional ((Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "from" ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "since") ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces) ParsecT HledgerParseErrorData Text m (Maybe ())
    -> ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m SmartDate
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate)
        (ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [ParsecT HledgerParseErrorData Text m (Tokens Text)]
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "to", Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "..", Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "-"]
        ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m SmartDate
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate)
      where
        fromToSpan :: SmartDate -> SmartDate -> DateSpan
    fromToSpan = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (Maybe EFDay -> Maybe EFDay -> DateSpan)
    -> (SmartDate -> Maybe EFDay) -> SmartDate -> SmartDate -> DateSpan
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay)
    -> (SmartDate -> EFDay) -> SmartDate -> Maybe EFDay
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> SmartDate -> EFDay
    fixSmartDate Day
    rdate)

    -- |
    -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "q1"
    -- Right DateSpan 2018Q1
    -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "Q1"
    -- Right DateSpan 2018Q1
    -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "2020q4"
    -- Right DateSpan 2020Q4
    quarterdatespanp :: Day -> TextParser m DateSpan
    quarterdatespanp :: forall (m :: * -> *). Day -> TextParser m DateSpan
    quarterdatespanp Day
    rdate = do
        Integer
    y <- TextParser m Integer
    forall {m :: * -> *}. ParsecT HledgerParseErrorData Text m Integer
    yearp TextParser m Integer
    -> TextParser m Integer -> TextParser m Integer
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Integer -> TextParser m Integer
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Integer, Int, Int) -> Integer
    forall {a} {b} {c}. (a, b, c) -> a
    first3 ((Integer, Int, Int) -> Integer) -> (Integer, Int, Int) -> Integer
    forall a b. (a -> b) -> a -> b
    $ Day -> (Integer, Int, Int)
    toGregorian Day
    rdate)
        Char
    q <- Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char' Char
    Token Text
    'q' ParsecT HledgerParseErrorData Text m Char
    -> ParsecT HledgerParseErrorData Text m Char
    -> ParsecT HledgerParseErrorData Text m Char
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Token Text -> Bool)
    -> ParsecT HledgerParseErrorData Text m (Token Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    (Token s -> Bool) -> m (Token s)
    satisfy Char -> Bool
    Token Text -> Bool
    is4Digit
        DateSpan -> TextParser m DateSpan
    forall a. a -> ParsecT HledgerParseErrorData Text m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DateSpan -> TextParser m DateSpan)
    -> (Period -> DateSpan) -> Period -> TextParser m DateSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Period -> DateSpan
    periodAsDateSpan (Period -> TextParser m DateSpan)
    -> Period -> TextParser m DateSpan
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Period
    QuarterPeriod Integer
    y (Char -> Int
    digitToInt Char
    q)
      where
        is4Digit :: Char -> Bool
    is4Digit Char
    c = (Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    '1') :: Word) Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word
    3

    fromdatespanp :: Day -> TextParser m DateSpan
    fromdatespanp :: forall (m :: * -> *). Day -> TextParser m DateSpan
    fromdatespanp Day
    rdate = SmartDate -> DateSpan
    fromSpan (SmartDate -> DateSpan)
    -> ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ParsecT HledgerParseErrorData Text m SmartDate]
    -> ParsecT HledgerParseErrorData Text m SmartDate
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice
        [ (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "from" ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall a.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "since") ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m SmartDate
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate
        , ParsecT HledgerParseErrorData Text m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m SmartDate
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* [ParsecT HledgerParseErrorData Text m (Tokens Text)]
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "..", Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "-"]
        ]
      where
        fromSpan :: SmartDate -> DateSpan
    fromSpan SmartDate
    b = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> SmartDate -> EFDay
    fixSmartDate Day
    rdate SmartDate
    b) Maybe EFDay
    forall a. Maybe a
    Nothing

    todatespanp :: Day -> TextParser m DateSpan
    todatespanp :: forall (m :: * -> *). Day -> TextParser m DateSpan
    todatespanp Day
    rdate =
        [ParsecT HledgerParseErrorData Text m (Tokens Text)]
    -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "to", Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "until", Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "..", Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "-"]
        ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces
        ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m DateSpan
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan Maybe EFDay
    forall a. Maybe a
    Nothing (Maybe EFDay -> DateSpan)
    -> (SmartDate -> Maybe EFDay) -> SmartDate -> DateSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay)
    -> (SmartDate -> EFDay) -> SmartDate -> Maybe EFDay
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> SmartDate -> EFDay
    fixSmartDate Day
    rdate (SmartDate -> DateSpan)
    -> ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT HledgerParseErrorData Text m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate)

    justdatespanp :: Day -> TextParser m DateSpan
    justdatespanp :: forall (m :: * -> *). Day -> TextParser m DateSpan
    justdatespanp Day
    rdate =
        ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m (Maybe ())
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' Tokens Text
    "in" ParsecT HledgerParseErrorData Text m (Tokens Text)
    -> ParsecT HledgerParseErrorData Text m ()
    -> ParsecT HledgerParseErrorData Text m ()
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT HledgerParseErrorData Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT HledgerParseErrorData s m ()
    skipNonNewlineSpaces)
        ParsecT HledgerParseErrorData Text m (Maybe ())
    -> ParsecT HledgerParseErrorData Text m DateSpan
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall a b.
    ParsecT HledgerParseErrorData Text m a
    -> ParsecT HledgerParseErrorData Text m b
    -> ParsecT HledgerParseErrorData Text m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Day -> SmartDate -> DateSpan
    spanFromSmartDate Day
    rdate (SmartDate -> DateSpan)
    -> ParsecT HledgerParseErrorData Text m SmartDate
    -> ParsecT HledgerParseErrorData Text m DateSpan
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT HledgerParseErrorData Text m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate)

    nulldatespan :: DateSpan
    nulldatespan :: DateSpan
    nulldatespan = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan Maybe EFDay
    forall a. Maybe a
    Nothing Maybe EFDay
    forall a. Maybe a
    Nothing

    -- | An exact datespan of zero length, that matches no date.
    emptydatespan :: DateSpan
    emptydatespan :: DateSpan
    emptydatespan = Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays Integer
    1 Day
    nulldate) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    nulldate)

    nulldate :: Day
    nulldate :: Day
    nulldate = Integer -> Int -> Int -> Day
    fromGregorian Integer
    0 Int
    1 Int
    1

    -- tests

    tests_Dates :: TestTree
    tests_Dates = [Char] -> [TestTree] -> TestTree
    testGroup [Char]
    "Dates"
      [ [Char] -> Assertion -> TestTree
    testCase [Char]
    "weekday" (Assertion -> TestTree) -> Assertion -> TestTree
    forall a b. (a -> b) -> a -> b
    $ do
          Bool -> Interval -> DateSpan -> [DateSpan]
    splitSpan Bool
    False ([Int] -> Interval
    DaysOfWeek [Int
    1..Int
    5]) (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    01) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    08))
            [DateSpan] -> [DateSpan] -> Assertion
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
    @?= [ (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    06 Int
    28) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    06 Int
    29))
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    06 Int
    29) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    06 Int
    30))
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    06 Int
    30) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    01))
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    01) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    02))
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    02) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    05))
                -- next week
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    05) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    06))
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    06) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    07))
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    07) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    08))
                ]

          Bool -> Interval -> DateSpan -> [DateSpan]
    splitSpan Bool
    False ([Int] -> Interval
    DaysOfWeek [Int
    1, Int
    5]) (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    01) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    08))
            [DateSpan] -> [DateSpan] -> Assertion
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
    @?= [ (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    06 Int
    28) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    02))
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    02) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    05))
                -- next week
                , (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    05) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact (Day -> EFDay) -> Day -> EFDay
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    07 Int
    09))
                ]

      , [Char] -> Assertion -> TestTree
    testCase [Char]
    "match dayOfWeek" (Assertion -> TestTree) -> Assertion -> TestTree
    forall a b. (a -> b) -> a -> b
    $ do
          let dayofweek :: Int -> DateSpan -> [DateSpan]
    dayofweek Int
    n = (Day -> Day)
    -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
    splitspan (Int -> Day -> Day
    nthdayofweekcontaining Int
    n) (\Integer
    w -> (if Integer
    w Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    0 then Day -> Day
    forall a. a -> a
    id else Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Day -> Day
    nextday (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    w) Day -> Day
    nextweek)) Int
    1
              matchdow :: DateSpan -> Int -> Assertion
    matchdow DateSpan
    ds Int
    day = Bool -> Interval -> DateSpan -> [DateSpan]
    splitSpan Bool
    False ([Int] -> Interval
    DaysOfWeek [Int
    day]) DateSpan
    ds [DateSpan] -> [DateSpan] -> Assertion
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
    @?= Int -> DateSpan -> [DateSpan]
    dayofweek Int
    day DateSpan
    ds
              ys2021 :: Day
    ys2021 = Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    01 Int
    01
              ye2021 :: Day
    ye2021 = Integer -> Int -> Int -> Day
    fromGregorian Integer
    2021 Int
    12 Int
    31
              ys2022 :: Day
    ys2022 = Integer -> Int -> Int -> Day
    fromGregorian Integer
    2022 Int
    01 Int
    01
          (Int -> Assertion) -> [Int] -> Assertion
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (DateSpan -> Int -> Assertion
    matchdow (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ys2021) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ye2021))) [Int
    1..Int
    7]
          (Int -> Assertion) -> [Int] -> Assertion
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (DateSpan -> Int -> Assertion
    matchdow (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ys2021) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ys2022))) [Int
    1..Int
    7]
          (Int -> Assertion) -> [Int] -> Assertion
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (DateSpan -> Int -> Assertion
    matchdow (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ye2021) (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ys2022))) [Int
    1..Int
    7]

          (Int -> Assertion) -> [Int] -> Assertion
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (DateSpan -> Int -> Assertion
    matchdow (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ye2021) Maybe EFDay
    forall a. Maybe a
    Nothing)) [Int
    1..Int
    7]
          (Int -> Assertion) -> [Int] -> Assertion
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (DateSpan -> Int -> Assertion
    matchdow (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ys2022) Maybe EFDay
    forall a. Maybe a
    Nothing)) [Int
    1..Int
    7]

          (Int -> Assertion) -> [Int] -> Assertion
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (DateSpan -> Int -> Assertion
    matchdow (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan Maybe EFDay
    forall a. Maybe a
    Nothing (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ye2021))) [Int
    1..Int
    7]
          (Int -> Assertion) -> [Int] -> Assertion
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (DateSpan -> Int -> Assertion
    matchdow (Maybe EFDay -> Maybe EFDay -> DateSpan
    DateSpan Maybe EFDay
    forall a. Maybe a
    Nothing (EFDay -> Maybe EFDay
    forall a. a -> Maybe a
    Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
    forall a b. (a -> b) -> a -> b
    $ Day -> EFDay
    Exact Day
    ys2022))) [Int
    1..Int
    7]

      ]