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

    Date parsing and utilities for hledger.

    For date and time values, we use the standard Day and UTCTime types.

    A 'SmartDate' is a date which may be partially-specified or relative.
    Eg 2008\/12\/31, but also 2008\/12, 12\/31, tomorrow, last week, next year.
    We represent these as a triple of strings like (\"2008\",\"12\",\"\"),
    (\"\",\"\",\"tomorrow\"), (\"\",\"last\",\"week\").

    A 'DateSpan' is the span of time between two specific calendar dates, or
    an open-ended span where one or both dates are unspecified. (A date span
    with both ends unspecified matches all dates.)

    An 'Interval' is ledger's \"reporting interval\" - weekly, monthly,
    quarterly, etc.

    '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
      getCurrentDay,
      getCurrentMonth,
      getCurrentYear,
      nulldate,
      spanContainsDate,
      periodContainsDate,
      parsedateM,
      showDate,
      showDateSpan,
      showDateSpanMonthAbbrev,
      elapsedSeconds,
      prevday,
      periodexprp,
      parsePeriodExpr,
      parsePeriodExpr',
      nulldatespan,
      emptydatespan,
      datesepchar,
      datesepchars,
      isDateSepChar,
      spanStart,
      spanEnd,
      spanStartYear,
      spanEndYear,
      spanYears,
      spansSpan,
      spanIntersect,
      spansIntersect,
      spanDefaultsFrom,
      spanUnion,
      spansUnion,
      daysSpan,
      latestSpanContaining,
      smartdate,
      splitSpan,
      fixSmartDate,
      fixSmartDateStr,
      fixSmartDateStrEither,
      fixSmartDateStrEither',
      yearp,
      daysInSpan,
      maybePeriod,
    )
    where

    import Prelude ()
    import "base-compat-batteries" Prelude.Compat hiding (fail)
    import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (MonadFail, fail)
    import Control.Applicative (liftA2)
    import Control.Applicative.Permutations
    import Control.Monad (guard, unless)
    import "base-compat-batteries" Data.List.Compat
    import Data.Char (digitToInt, isDigit, ord)
    import Data.Default
    import Data.Foldable (asum)
    import Data.Function (on)
    import Data.Maybe
    import qualified Data.Set as Set
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Time.Format hiding (months)
    import Data.Time.Calendar
    import Data.Time.Calendar.OrdinalDate
    import Data.Time.Clock
    import Data.Time.LocalTime
    import Safe (headMay, lastMay, maximumMay, minimumMay)
    import Text.Megaparsec
    import Text.Megaparsec.Char
    import Text.Megaparsec.Char.Lexer (decimal)
    import Text.Megaparsec.Custom
    import Text.Printf

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

    -- Help ppShow parse and line-wrap DateSpans better in debug output.
    instance Show DateSpan where
        show :: DateSpan -> String
    show s :: DateSpan
    s = "DateSpan " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ DateSpan -> String
    showDateSpan DateSpan
    s
        -- show s = "DateSpan \"" ++ showDateSpan s ++ "\"" -- quotes to help pretty-show

    showDate :: Day -> String
    showDate :: Day -> String
    showDate = Day -> String
    forall a. Show a => a -> String
    show

    -- | Render a datespan as a display string, abbreviating into a
    -- compact form if possible.
    showDateSpan :: DateSpan -> String
    showDateSpan :: DateSpan -> String
    showDateSpan = Period -> String
    showPeriod (Period -> String) -> (DateSpan -> Period) -> DateSpan -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DateSpan -> Period
    dateSpanAsPeriod

    -- | Like showDateSpan, but show month spans as just the abbreviated month name
    -- in the current locale.
    showDateSpanMonthAbbrev :: DateSpan -> String
    showDateSpanMonthAbbrev :: DateSpan -> String
    showDateSpanMonthAbbrev = Period -> String
    showPeriodMonthAbbrev (Period -> String) -> (DateSpan -> Period) -> DateSpan -> String
    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 :: UTCTime -> UTCTime -> a
    elapsedSeconds t1 :: 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 d :: Maybe Day
    d _) = Maybe Day
    d

    spanEnd :: DateSpan -> Maybe Day
    spanEnd :: DateSpan -> Maybe Day
    spanEnd (DateSpan _ d :: Maybe Day
    d) = Maybe Day
    d

    spanStartYear :: DateSpan -> Maybe Year
    spanStartYear :: DateSpan -> Maybe Integer
    spanStartYear (DateSpan d :: Maybe Day
    d _) = (Day -> Integer) -> Maybe Day -> Maybe Integer
    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)
    -> (Day -> (Integer, Int, Int)) -> Day -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> (Integer, Int, Int)
    toGregorian) Maybe Day
    d

    spanEndYear :: DateSpan -> Maybe Year
    spanEndYear :: DateSpan -> Maybe Integer
    spanEndYear (DateSpan d :: Maybe Day
    d _) = (Day -> Integer) -> Maybe Day -> Maybe Integer
    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)
    -> (Day -> (Integer, Int, Int)) -> Day -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> (Integer, Int, Int)
    toGregorian) Maybe Day
    d

    -- | Get the 0-2 years mentioned explicitly in a DateSpan.
    spanYears :: DateSpan -> [Year]
    spanYears :: DateSpan -> [Integer]
    spanYears (DateSpan ma :: Maybe Day
    ma mb :: Maybe Day
    mb) = (Maybe Day -> Maybe Integer) -> [Maybe Day] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((Day -> Integer) -> Maybe Day -> Maybe Integer
    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)
    -> (Day -> (Integer, Int, Int)) -> Day -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> (Integer, Int, Int)
    toGregorian)) [Maybe Day
    ma,Maybe Day
    mb]

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

    -- | Get overall span enclosing multiple sequentially ordered spans.
    spansSpan :: [DateSpan] -> DateSpan
    spansSpan :: [DateSpan] -> DateSpan
    spansSpan spans :: [DateSpan]
    spans = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Maybe Day -> (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe Day
    forall a. Maybe a
    Nothing DateSpan -> Maybe Day
    spanStart (Maybe DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ [DateSpan] -> Maybe DateSpan
    forall a. [a] -> Maybe a
    headMay [DateSpan]
    spans) (Maybe Day -> (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe Day
    forall a. Maybe a
    Nothing DateSpan -> Maybe Day
    spanEnd (Maybe DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ [DateSpan] -> Maybe DateSpan
    forall a. [a] -> Maybe a
    lastMay [DateSpan]
    spans)

    -- | Split a DateSpan into consecutive whole spans of the specified interval
    -- which fully encompass the original span (and a little more when necessary).
    -- 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 i $ DateSpan (Just $ fromGregorian y1 m1 d1) (Just $ 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 (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 (DayOfWeek 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 :: Interval -> DateSpan -> [DateSpan]
    splitSpan :: Interval -> DateSpan -> [DateSpan]
    splitSpan _ (DateSpan Nothing Nothing) = [Maybe Day -> Maybe Day -> DateSpan
    DateSpan Maybe Day
    forall a. Maybe a
    Nothing Maybe Day
    forall a. Maybe a
    Nothing]
    splitSpan _ s :: DateSpan
    s | DateSpan -> Bool
    isEmptySpan DateSpan
    s = []
    splitSpan NoInterval     s :: DateSpan
    s = [DateSpan
    s]
    splitSpan (Days n :: Int
    n)       s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    forall a. a -> a
    startofday     (Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN Int
    n Day -> Day
    nextday)     DateSpan
    s
    splitSpan (Weeks n :: Int
    n)      s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    startofweek    (Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN Int
    n Day -> Day
    nextweek)    DateSpan
    s
    splitSpan (Months n :: Int
    n)     s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    startofmonth   (Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN Int
    n Day -> Day
    nextmonth)   DateSpan
    s
    splitSpan (Quarters n :: Int
    n)   s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    startofquarter (Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN Int
    n Day -> Day
    nextquarter) DateSpan
    s
    splitSpan (Years n :: Int
    n)      s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    startofyear    (Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN Int
    n Day -> Day
    nextyear)    DateSpan
    s
    splitSpan (DayOfMonth n :: Int
    n) s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan (Int -> Day -> Day
    nthdayofmonthcontaining Int
    n) (Int -> Day -> Day
    nthdayofmonth Int
    n (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Day
    nextmonth) DateSpan
    s
    splitSpan (WeekdayOfMonth n :: Int
    n wd :: Int
    wd) s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan (Int -> Int -> Day -> Day
    nthweekdayofmonthcontaining Int
    n Int
    wd) (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
    nextmonth) DateSpan
    s
    splitSpan (DayOfWeek n :: Int
    n)  s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan (Int -> Day -> Day
    nthdayofweekcontaining Int
    n)  (Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) Day -> Day
    nextday (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Day
    nextweek)  DateSpan
    s
    splitSpan (DayOfYear m :: Int
    m n :: Int
    n) s :: DateSpan
    s = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan (Int -> Int -> Day -> Day
    nthdayofyearcontaining Int
    m Int
    n) (Int -> (Day -> Day) -> Day -> Day
    forall a. Int -> (a -> a) -> a -> a
    applyN (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -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 (Int
    mInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) Day -> Day
    nextmonth (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Day
    nextyear) DateSpan
    s
    -- splitSpan (WeekOfYear n)    s = splitspan startofweek    (applyN n nextweek)    s
    -- splitSpan (MonthOfYear n)   s = splitspan startofmonth   (applyN n nextmonth)   s
    -- splitSpan (QuarterOfYear n) s = splitspan startofquarter (applyN n nextquarter) s

    -- Split the given span using the provided helper functions:
    -- start is applied to the span's start date to get the first sub-span's start date
    -- next is applied to a sub-span's start date to get the next sub-span's start date
    splitspan :: (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan :: (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan _ _ (DateSpan Nothing Nothing) = []
    splitspan start :: Day -> Day
    start next :: Day -> Day
    next (DateSpan Nothing (Just e :: Day
    e)) = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    start Day -> Day
    next (Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    start Day
    e) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    next (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    start Day
    e))
    splitspan start :: Day -> Day
    start next :: Day -> Day
    next (DateSpan (Just s :: Day
    s) Nothing) = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan Day -> Day
    start Day -> Day
    next (Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    start Day
    s) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    next (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    start Day
    s))
    splitspan start :: Day -> Day
    start next :: Day -> Day
    next span :: DateSpan
    span@(DateSpan (Just s :: Day
    s) (Just e :: Day
    e))
        | Day
    s Day -> Day -> Bool
    forall a. Eq a => a -> a -> Bool
    == Day
    e = [DateSpan
    span]
        | Bool
    otherwise = (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan' Day -> Day
    start Day -> Day
    next DateSpan
    span
        where
          splitspan' :: (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan' start :: Day -> Day
    start next :: Day -> Day
    next (DateSpan (Just s :: Day
    s) (Just e :: Day
    e))
              | Day
    s Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Day
    e = []
              | Bool
    otherwise = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    subs) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    sube) DateSpan -> [DateSpan] -> [DateSpan]
    forall a. a -> [a] -> [a]
    : (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]
    splitspan' Day -> Day
    start Day -> Day
    next (Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    sube) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    e))
              where subs :: Day
    subs = Day -> Day
    start Day
    s
                    sube :: Day
    sube = Day -> Day
    next Day
    subs
          splitspan' _ _ _ = String -> [DateSpan]
    forall a. String -> a
    error' "won't happen, avoids warnings"  -- PARTIAL:

    -- | 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 d1 :: Day
    d1) (Just d2 :: Day
    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 Day
    d2 Day
    d1
    daysInSpan _ = 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 s :: Day
    s) (Just e :: Day
    e)) = Day
    e Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Day
    s
    isEmptySpan _                            = Bool
    False

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

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

    -- | Calculate the intersection of a number of datespans.
    spansIntersect :: [DateSpan] -> DateSpan
    spansIntersect [] = DateSpan
    nulldatespan
    spansIntersect [d :: DateSpan
    d] = DateSpan
    d
    spansIntersect (d :: DateSpan
    d:ds :: [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 $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ fromGregorian 2018 01 03) (Just $ fromGregorian 2018 01 05)
    -- DateSpan 2018-01-03..2018-01-02
    spanIntersect :: DateSpan -> DateSpan -> DateSpan
    spanIntersect (DateSpan b1 :: Maybe Day
    b1 e1 :: Maybe Day
    e1) (DateSpan b2 :: Maybe Day
    b2 e2 :: Maybe Day
    e2) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan Maybe Day
    b Maybe Day
    e
        where
          b :: Maybe Day
    b = Maybe Day -> Maybe Day -> Maybe Day
    forall a. Ord a => Maybe a -> Maybe a -> Maybe a
    latest Maybe Day
    b1 Maybe Day
    b2
          e :: Maybe Day
    e = Maybe Day -> Maybe Day -> Maybe Day
    forall a. Ord a => Maybe a -> Maybe a -> Maybe a
    earliest Maybe Day
    e1 Maybe Day
    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 a1 :: Maybe Day
    a1 b1 :: Maybe Day
    b1) (DateSpan a2 :: Maybe Day
    a2 b2 :: Maybe Day
    b2) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan Maybe Day
    a Maybe Day
    b
        where a :: Maybe Day
    a = if Maybe Day -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Day
    a1 then Maybe Day
    a1 else Maybe Day
    a2
              b :: Maybe Day
    b = if Maybe Day -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Day
    b1 then Maybe Day
    b1 else Maybe Day
    b2

    -- | Calculate the union of a number of datespans.
    spansUnion :: [DateSpan] -> DateSpan
    spansUnion [] = DateSpan
    nulldatespan
    spansUnion [d :: DateSpan
    d] = DateSpan
    d
    spansUnion (d :: DateSpan
    d:ds :: [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 b1 :: Maybe Day
    b1 e1 :: Maybe Day
    e1) (DateSpan b2 :: Maybe Day
    b2 e2 :: Maybe Day
    e2) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan Maybe Day
    b Maybe Day
    e
        where
          b :: Maybe Day
    b = Maybe Day -> Maybe Day -> Maybe Day
    forall a. Ord a => Maybe a -> Maybe a -> Maybe a
    earliest Maybe Day
    b1 Maybe Day
    b2
          e :: Maybe Day
    e = Maybe Day -> Maybe Day -> Maybe Day
    forall a. Ord a => Maybe a -> Maybe a -> Maybe a
    latest Maybe Day
    e1 Maybe Day
    e2

    latest :: Maybe a -> Maybe a -> Maybe a
    latest d :: Maybe a
    d Nothing = Maybe a
    d
    latest Nothing d :: Maybe a
    d = Maybe a
    d
    latest (Just d1 :: a
    d1) (Just d2 :: 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 d :: Maybe a
    d Nothing = Maybe a
    d
    earliest Nothing d :: Maybe a
    d = Maybe a
    d
    earliest (Just d1 :: a
    d1) (Just d2 :: 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 ds :: [Day]
    ds = Maybe Day -> Maybe Day -> DateSpan
    DateSpan ([Day] -> Maybe Day
    forall a. Ord a => [a] -> Maybe a
    minimumMay [Day]
    ds) (Integer -> Day -> Day
    addDays 1 (Day -> Day) -> Maybe Day -> Maybe Day
    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 datespans :: [DateSpan]
    datespans = Day -> Maybe DateSpan
    go
      where
        go :: Day -> Maybe DateSpan
    go day :: Day
    day = do
            DateSpan
    span <- 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
    span Day
    day
            DateSpan -> Maybe DateSpan
    forall (m :: * -> *) a. Monad m => a -> m a
    return DateSpan
    span
          where
            -- The smallest DateSpan larger than any DateSpan containing day.
            supSpan :: DateSpan
    supSpan = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays 1 Day
    day) Maybe Day
    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 (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
    parsePeriodExpr :: Day
    -> Text
    -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
    parsePeriodExpr refdate :: Day
    refdate s :: Text
    s = Parsec CustomErr Text (Interval, DateSpan)
    -> Text
    -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
    forall e a.
    Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
    parsewith (Day -> Parsec CustomErr Text (Interval, DateSpan)
    forall (m :: * -> *). Day -> TextParser m (Interval, DateSpan)
    periodexprp Day
    refdate Parsec CustomErr Text (Interval, DateSpan)
    -> ParsecT CustomErr Text Identity ()
    -> Parsec CustomErr Text (Interval, DateSpan)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT CustomErr 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' refdate :: Day
    refdate s :: Text
    s =
      (ParseErrorBundle Text CustomErr -> (Interval, DateSpan))
    -> ((Interval, DateSpan) -> (Interval, DateSpan))
    -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
    -> (Interval, DateSpan)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> (Interval, DateSpan)
    forall a. String -> a
    error' (String -> (Interval, DateSpan))
    -> (ParseErrorBundle Text CustomErr -> String)
    -> ParseErrorBundle Text CustomErr
    -> (Interval, DateSpan)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ("failed to parse:" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS
    -> (ParseErrorBundle Text CustomErr -> String)
    -> ParseErrorBundle Text CustomErr
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseErrorBundle Text CustomErr -> String
    customErrorBundlePretty) (Interval, DateSpan) -> (Interval, DateSpan)
    forall a. a -> a
    id (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
     -> (Interval, DateSpan))
    -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
    -> (Interval, DateSpan)
    forall a b. (a -> b) -> a -> b
    $  -- PARTIAL:
      Day
    -> Text
    -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
    parsePeriodExpr Day
    refdate Text
    s

    maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
    maybePeriod :: Day -> Text -> Maybe (Interval, DateSpan)
    maybePeriod refdate :: Day
    refdate = (ParseErrorBundle Text CustomErr -> Maybe (Interval, DateSpan))
    -> ((Interval, DateSpan) -> Maybe (Interval, DateSpan))
    -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
    -> Maybe (Interval, DateSpan)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe (Interval, DateSpan)
    -> ParseErrorBundle Text CustomErr -> Maybe (Interval, DateSpan)
    forall a b. a -> b -> a
    const Maybe (Interval, DateSpan)
    forall a. Maybe a
    Nothing) (Interval, DateSpan) -> Maybe (Interval, DateSpan)
    forall a. a -> Maybe a
    Just (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
     -> Maybe (Interval, DateSpan))
    -> (Text
        -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan))
    -> Text
    -> Maybe (Interval, DateSpan)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day
    -> Text
    -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
    parsePeriodExpr Day
    refdate

    -- | 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 refdate :: Day
    refdate sdate :: SmartDate
    sdate = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    b) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    e)
        where
          (ry :: Integer
    ry,rm :: Int
    rm,_) = Day -> (Integer, Int, Int)
    toGregorian Day
    refdate
          (b :: Day
    b,e :: Day
    e) = SmartDate -> (Day, Day)
    span SmartDate
    sdate
          span :: SmartDate -> (Day,Day)
          span :: SmartDate -> (Day, Day)
    span (SmartRelative This Day)                 = (Day
    refdate, Day -> Day
    nextday Day
    refdate)
          span (SmartRelative Last Day)                 = (Day -> Day
    prevday Day
    refdate, Day
    refdate)
          span (SmartRelative Next Day)                 = (Day -> Day
    nextday Day
    refdate, Integer -> Day -> Day
    addDays 2 Day
    refdate)
          span (SmartRelative This Week)                = (Day -> Day
    thisweek Day
    refdate, Day -> Day
    nextweek Day
    refdate)
          span (SmartRelative Last Week)                = (Day -> Day
    prevweek Day
    refdate, Day -> Day
    thisweek Day
    refdate)
          span (SmartRelative Next Week)                = (Day -> Day
    nextweek Day
    refdate, Day -> Day
    startofweek (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays 14 Day
    refdate)
          span (SmartRelative This Month)               = (Day -> Day
    thismonth Day
    refdate, Day -> Day
    nextmonth Day
    refdate)
          span (SmartRelative Last Month)               = (Day -> Day
    prevmonth Day
    refdate, Day -> Day
    thismonth Day
    refdate)
          span (SmartRelative Next Month)               = (Day -> Day
    nextmonth Day
    refdate, Day -> Day
    startofmonth (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip 2 Day
    refdate)
          span (SmartRelative This Quarter)             = (Day -> Day
    thisquarter Day
    refdate, Day -> Day
    nextquarter Day
    refdate)
          span (SmartRelative Last Quarter)             = (Day -> Day
    prevquarter Day
    refdate, Day -> Day
    thisquarter Day
    refdate)
          span (SmartRelative Next Quarter)             = (Day -> Day
    nextquarter Day
    refdate, Day -> Day
    startofquarter (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianMonthsClip 6 Day
    refdate)
          span (SmartRelative This Year)                = (Day -> Day
    thisyear Day
    refdate, Day -> Day
    nextyear Day
    refdate)
          span (SmartRelative Last Year)                = (Day -> Day
    prevyear Day
    refdate, Day -> Day
    thisyear Day
    refdate)
          span (SmartRelative Next Year)                = (Day -> Day
    nextyear Day
    refdate, Day -> Day
    startofyear (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addGregorianYearsClip 2 Day
    refdate)
          span (SmartAssumeStart y :: Integer
    y Nothing)             = (Day -> Day
    startofyear Day
    day, Day -> Day
    nextyear Day
    day) where day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y 1 1
          span (SmartAssumeStart y :: Integer
    y (Just (m :: Int
    m, Nothing))) = (Day -> Day
    startofmonth Day
    day, Day -> Day
    nextmonth Day
    day) where day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    m 1
          span (SmartAssumeStart y :: Integer
    y (Just (m :: Int
    m, Just d :: Int
    d)))  = (Day
    day, Day -> Day
    nextday Day
    day) where day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    m Int
    d
          span (SmartFromReference m :: Maybe Int
    m d :: Int
    d)                 = (Day
    day, 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 m :: Int
    m)                           = (Day -> Day
    startofmonth Day
    day, Day -> Day
    nextmonth Day
    day) where day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    ry Int
    m 1

    -- 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 -> String
    fixSmartDateStr :: Day -> Text -> String
    fixSmartDateStr d :: Day
    d s :: Text
    s =
      (ParseErrorBundle Text CustomErr -> String)
    -> ShowS
    -> Either (ParseErrorBundle Text CustomErr) String
    -> String
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ShowS
    forall a. String -> a
    error' ShowS
    -> (ParseErrorBundle Text CustomErr -> String)
    -> ParseErrorBundle Text CustomErr
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> ShowS
    forall r. PrintfType r => String -> r
    printf "could not parse date %s %s" (Text -> String
    forall a. Show a => a -> String
    show Text
    s) ShowS
    -> (ParseErrorBundle Text CustomErr -> String)
    -> ParseErrorBundle Text CustomErr
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseErrorBundle Text CustomErr -> String
    forall a. Show a => a -> String
    show) ShowS
    forall a. a -> a
    id (Either (ParseErrorBundle Text CustomErr) String -> String)
    -> Either (ParseErrorBundle Text CustomErr) String -> String
    forall a b. (a -> b) -> a -> b
    $  -- PARTIAL:
      (Day -> Text -> Either (ParseErrorBundle Text CustomErr) String
    fixSmartDateStrEither Day
    d Text
    s :: Either (ParseErrorBundle Text CustomErr) String)

    -- | A safe version of fixSmartDateStr.
    fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String
    fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String
    fixSmartDateStrEither d :: Day
    d = (Day -> String)
    -> Either (ParseErrorBundle Text CustomErr) Day
    -> Either (ParseErrorBundle Text CustomErr) String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Day -> String
    showDate (Either (ParseErrorBundle Text CustomErr) Day
     -> Either (ParseErrorBundle Text CustomErr) String)
    -> (Text -> Either (ParseErrorBundle Text CustomErr) Day)
    -> Text
    -> Either (ParseErrorBundle Text CustomErr) String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
    fixSmartDateStrEither' Day
    d

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

    -- | Convert a SmartDate to an absolute date using the provided reference 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"
    --
    fixSmartDate :: Day -> SmartDate -> Day
    fixSmartDate :: Day -> SmartDate -> Day
    fixSmartDate refdate :: Day
    refdate = SmartDate -> Day
    fix
      where
        fix :: SmartDate -> Day
        fix :: SmartDate -> Day
    fix (SmartRelative This Day)     = Day
    refdate
        fix (SmartRelative Last Day)     = Day -> Day
    prevday Day
    refdate
        fix (SmartRelative Next Day)     = Day -> Day
    nextday Day
    refdate
        fix (SmartRelative This Week)    = Day -> Day
    thisweek Day
    refdate
        fix (SmartRelative Last Week)    = Day -> Day
    prevweek Day
    refdate
        fix (SmartRelative Next Week)    = Day -> Day
    nextweek Day
    refdate
        fix (SmartRelative This Month)   = Day -> Day
    thismonth Day
    refdate
        fix (SmartRelative Last Month)   = Day -> Day
    prevmonth Day
    refdate
        fix (SmartRelative Next Month)   = Day -> Day
    nextmonth Day
    refdate
        fix (SmartRelative This Quarter) = Day -> Day
    thisquarter Day
    refdate
        fix (SmartRelative Last Quarter) = Day -> Day
    prevquarter Day
    refdate
        fix (SmartRelative Next Quarter) = Day -> Day
    nextquarter Day
    refdate
        fix (SmartRelative This Year)    = Day -> Day
    thisyear Day
    refdate
        fix (SmartRelative Last Year)    = Day -> Day
    prevyear Day
    refdate
        fix (SmartRelative Next Year)    = Day -> Day
    nextyear Day
    refdate
        fix (SmartAssumeStart y :: Integer
    y md :: Maybe (Int, Maybe Int)
    md)      = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y (Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe 1 (Int, Maybe Int) -> Int
    forall a b. (a, b) -> a
    fst Maybe (Int, Maybe Int)
    md) (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe 1 (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Int, Maybe Int) -> Maybe Int
    forall a b. (a, b) -> b
    snd ((Int, Maybe Int) -> Maybe Int)
    -> Maybe (Int, Maybe Int) -> Maybe Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe (Int, Maybe Int)
    md)
        fix (SmartFromReference m :: Maybe Int
    m d :: Int
    d)     = 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 m :: Int
    m)               = Integer -> Int -> Int -> Day
    fromGregorian Integer
    ry Int
    m 1
        (ry :: Integer
    ry, rm :: Int
    rm, _) = Day -> (Integer, Int, Int)
    toGregorian Day
    refdate

    prevday :: Day -> Day
    prevday :: Day -> Day
    prevday = Integer -> Day -> Day
    addDays (-1)
    nextday :: Day -> Day
    nextday = Integer -> Day -> Day
    addDays 1
    startofday :: a -> a
    startofday = a -> a
    forall a. a -> a
    id

    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 (-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 7
    startofweek :: Day -> Day
    startofweek day :: Day
    day = Integer -> Int -> Int -> Day
    fromMondayStartWeek Integer
    y Int
    w 1
        where
          (y :: Integer
    y,_,_) = Day -> (Integer, Int, Int)
    toGregorian Day
    day
          (w :: Int
    w,_) = 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 (-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 1
    startofmonth :: Day -> Day
    startofmonth day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    m 1 where (y :: Integer
    y,m :: Int
    m,_) = Day -> (Integer, Int, Int)
    toGregorian Day
    day
    nthdayofmonth :: Int -> Day -> Day
    nthdayofmonth d :: Int
    d day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y Int
    m Int
    d where (y :: Integer
    y,m :: Int
    m,_) = Day -> (Integer, Int, Int)
    toGregorian Day
    day

    thisquarter :: Day -> Day
    thisquarter = Day -> Day
    startofquarter
    prevquarter :: Day -> Day
    prevquarter = Day -> Day
    startofquarter (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addGregorianMonthsClip (-3)
    nextquarter :: Day -> Day
    nextquarter = Day -> Day
    startofquarter (Day -> Day) -> (Day -> Day) -> Day -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Day -> Day
    addGregorianMonthsClip 3
    startofquarter :: Day -> Day
    startofquarter day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y (Int -> Int
    forall a. Integral a => a -> a
    firstmonthofquarter Int
    m) 1
        where
          (y :: Integer
    y,m :: Int
    m,_) = Day -> (Integer, Int, Int)
    toGregorian Day
    day
          firstmonthofquarter :: a -> a
    firstmonthofquarter m :: a
    m = ((a
    ma -> a -> a
    forall a. Num a => a -> a -> a
    -1) a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` 3) a -> a -> a
    forall a. Num a => a -> a -> a
    * 3 a -> a -> a
    forall a. Num 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 (-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 1
    startofyear :: Day -> Day
    startofyear day :: Day
    day = Integer -> Int -> Int -> Day
    fromGregorian Integer
    y 1 1 where (y :: Integer
    y,_,_) = Day -> (Integer, Int, Int)
    toGregorian Day
    day

    -- | 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 m :: Int
    m md :: Int
    md date :: Day
    date
      -- PARTIAL:
      | Bool -> Bool
    not (Int -> Bool
    validMonth Int
    m)  = String -> Day
    forall a. String -> a
    error' (String -> Day) -> String -> Day
    forall a b. (a -> b) -> a -> b
    $ "nthdayofyearcontaining: invalid month "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    m
      | Bool -> Bool
    not (Int -> Bool
    validDay   Int
    md) = String -> Day
    forall a. String -> a
    error' (String -> Day) -> String -> Day
    forall a b. (a -> b) -> a -> b
    $ "nthdayofyearcontaining: invalid day "  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    md
      | 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
    mdInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -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
    -1) Day -> Day
    nextmonth Day
    s
            mmddOfPrevYear :: Day
    mmddOfPrevYear = Integer -> Day -> Day
    addDays (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    mdInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -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
    -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 given date d find month-long interval that starts on nth day of month
    -- and covers it.
    -- The given day of month should be basically valid (1-31), or an error is 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 md :: Int
    md date :: Day
    date
      -- PARTIAL:
      | Bool -> Bool
    not (Int -> Bool
    validDay Int
    md) = String -> Day
    forall a. String -> a
    error' (String -> Day) -> String -> Day
    forall a b. (a -> b) -> a -> b
    $ "nthdayofmonthcontaining: invalid day "  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    md
      | 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
    md Day
    s
            nthOfPrevMonth :: Day
    nthOfPrevMonth = Int -> Day -> Day
    nthdayofmonth Int
    md (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 n :: Int
    n d :: 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
    -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
    -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 n :: Int
    n wd :: Int
    wd d :: 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 n :: Int
    n wd :: Int
    wd s :: 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
    -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 1) (Day -> [Day]) -> Day -> [Day]
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    firstweekday Day
    s
      where
        err :: a
    err = String -> a
    forall a. String -> a
    error' "advancetonthweekday: should not happen"
        addWeeks :: a -> Day -> Day
    addWeeks k :: a
    k = Integer -> Day -> Day
    addDays (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 p :: 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
    -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 [
    --     parseTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" s,
    --     parseTime defaultTimeLocale "%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 :: String -> Maybe Day
    parsedateM s :: String
    s = [Maybe Day] -> Maybe Day
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    asum [
         Bool -> TimeLocale -> String -> String -> Maybe Day
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale "%Y-%m-%d" String
    s,
         Bool -> TimeLocale -> String -> String -> Maybe Day
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale "%Y/%m/%d" String
    s,
         Bool -> TimeLocale -> String -> String -> Maybe Day
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale "%Y.%m.%d" String
    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)
    > 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 (SmartAssumeStart 2018 (Just (12,Just 1)))

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

    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 :: 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
    forall (m :: * -> *). TextParser m SmartDate
    yyyymmdd, TextParser m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    ymd
        , (\(m :: Int
    m,d :: Int
    d) -> Maybe Int -> Int -> SmartDate
    SmartFromReference (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    m) Int
    d) ((Int, Int) -> SmartDate)
    -> ParsecT CustomErr Text m (Int, Int) -> TextParser m SmartDate
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT CustomErr Text m (Int, Int)
    forall (m :: * -> *). TextParser m (Int, Int)
    md
        , (Maybe Int -> Int -> SmartDate
    SmartFromReference Maybe Int
    forall a. Maybe a
    Nothing (Int -> SmartDate)
    -> ParsecT CustomErr Text m Int -> TextParser m SmartDate
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT CustomErr Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal) TextParser m SmartDate
    -> (SmartDate -> TextParser m SmartDate) -> TextParser m SmartDate
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= SmartDate -> TextParser m SmartDate
    forall (m :: * -> *). MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate
        , Int -> SmartDate
    SmartMonth (Int -> SmartDate)
    -> ParsecT CustomErr Text m Int -> TextParser m SmartDate
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT CustomErr Text m Int
    forall (m :: * -> *). TextParser m Int
    month ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ParsecT CustomErr Text m Int
    forall (m :: * -> *). TextParser m Int
    mon)
        , SmartSequence -> SmartInterval -> SmartDate
    SmartRelative SmartSequence
    This SmartInterval
    Day SmartDate
    -> ParsecT CustomErr Text m Text -> TextParser m SmartDate
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "today"
        , SmartSequence -> SmartInterval -> SmartDate
    SmartRelative SmartSequence
    Last SmartInterval
    Day SmartDate
    -> ParsecT CustomErr Text m Text -> TextParser m SmartDate
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "yesterday"
        , SmartSequence -> SmartInterval -> SmartDate
    SmartRelative SmartSequence
    Next SmartInterval
    Day SmartDate
    -> ParsecT CustomErr Text m Text -> TextParser m SmartDate
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "tomorrow"
        , (SmartSequence -> SmartInterval -> SmartDate)
    -> ParsecT CustomErr Text m SmartSequence
    -> ParsecT CustomErr Text m SmartInterval
    -> TextParser m SmartDate
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 SmartSequence -> SmartInterval -> SmartDate
    SmartRelative (ParsecT CustomErr Text m SmartSequence
    seqP ParsecT CustomErr Text m SmartSequence
    -> ParsecT CustomErr Text m ()
    -> ParsecT CustomErr Text m SmartSequence
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces) ParsecT CustomErr Text m SmartInterval
    intervalP
        ]
      where
        seqP :: ParsecT CustomErr Text m SmartSequence
    seqP = [ParsecT CustomErr Text m SmartSequence]
    -> ParsecT CustomErr Text m SmartSequence
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [SmartSequence
    This SmartSequence
    -> ParsecT CustomErr Text m (Tokens Text)
    -> ParsecT CustomErr Text m SmartSequence
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "this", SmartSequence
    Last SmartSequence
    -> ParsecT CustomErr Text m (Tokens Text)
    -> ParsecT CustomErr Text m SmartSequence
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "last", SmartSequence
    Next SmartSequence
    -> ParsecT CustomErr Text m (Tokens Text)
    -> ParsecT CustomErr Text m SmartSequence
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "next"]
        intervalP :: ParsecT CustomErr Text m SmartInterval
    intervalP = [ParsecT CustomErr Text m SmartInterval]
    -> ParsecT CustomErr Text m SmartInterval
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [SmartInterval
    Day SmartInterval
    -> ParsecT CustomErr Text m (Tokens Text)
    -> ParsecT CustomErr Text m SmartInterval
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "day", SmartInterval
    Week SmartInterval
    -> ParsecT CustomErr Text m (Tokens Text)
    -> ParsecT CustomErr Text m SmartInterval
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "week", SmartInterval
    Month SmartInterval
    -> ParsecT CustomErr Text m (Tokens Text)
    -> ParsecT CustomErr Text m SmartInterval
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "month",
                            SmartInterval
    Quarter SmartInterval
    -> ParsecT CustomErr Text m (Tokens Text)
    -> ParsecT CustomErr Text m SmartInterval
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "quarter", SmartInterval
    Year SmartInterval
    -> ParsecT CustomErr Text m (Tokens Text)
    -> ParsecT CustomErr Text m SmartInterval
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "year"]

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

    datesepchars :: String
    datesepchars :: String
    datesepchars = "/-."

    datesepchar :: TextParser m Char
    datesepchar :: TextParser m Char
    datesepchar = (Token Text -> Bool) -> ParsecT CustomErr 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 c :: Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '-' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '/' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '.'

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

    failIfInvalidDate :: Fail.MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate :: SmartDate -> m SmartDate
    failIfInvalidDate s :: SmartDate
    s = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    isValid (String -> m ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ "bad smart date: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ SmartDate -> String
    forall a. Show a => a -> String
    show SmartDate
    s) m () -> m SmartDate -> m SmartDate
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> SmartDate -> m SmartDate
    forall (m :: * -> *) a. Monad m => a -> m a
    return SmartDate
    s
      where isValid :: Bool
    isValid = case SmartDate
    s of
                SmartAssumeStart y :: Integer
    y (Just (m :: Int
    m, md :: Maybe Int
    md)) -> 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
    y Int
    m (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe 1 Maybe Int
    md)
                SmartFromReference mm :: Maybe Int
    mm d :: 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 2004 (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe 1 Maybe Int
    mm) Int
    d
                SmartMonth m :: Int
    m                      -> Int -> Bool
    validMonth Int
    m
                _                                 -> Bool
    True

    yyyymmdd :: TextParser m SmartDate
    yyyymmdd :: TextParser m SmartDate
    yyyymmdd = do
      Integer
    y <- String -> Integer
    forall a. Read a => String -> a
    read (String -> Integer)
    -> ParsecT CustomErr Text m String
    -> ParsecT CustomErr Text m Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
    forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
    count 4 ParsecT CustomErr Text m Char
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    digitChar
      Int
    m <- String -> Int
    forall a. Read a => String -> a
    read (String -> Int)
    -> ParsecT CustomErr Text m String -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
    forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
    count 2 ParsecT CustomErr Text m Char
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    digitChar
      Maybe Int
    d <- ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m (Maybe Int)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT CustomErr Text m Int
     -> ParsecT CustomErr Text m (Maybe Int))
    -> ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ String -> Int
    forall a. Read a => String -> a
    read (String -> Int)
    -> ParsecT CustomErr Text m String -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
    forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
    count 2 ParsecT CustomErr Text m Char
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    digitChar
      let date :: SmartDate
    date = Integer -> Maybe (Int, Maybe Int) -> SmartDate
    SmartAssumeStart Integer
    y (Maybe (Int, Maybe Int) -> SmartDate)
    -> Maybe (Int, Maybe Int) -> SmartDate
    forall a b. (a -> b) -> a -> b
    $ (Int, Maybe Int) -> Maybe (Int, Maybe Int)
    forall a. a -> Maybe a
    Just (Int
    m, Maybe Int
    d)
      SmartDate -> TextParser m SmartDate
    forall (m :: * -> *). MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate SmartDate
    date

    ymd :: TextParser m SmartDate
    ymd :: TextParser m SmartDate
    ymd = (Integer -> Maybe (Int, Maybe Int) -> SmartDate)
    -> ParsecT CustomErr Text m Integer
    -> ParsecT CustomErr Text m (Maybe (Int, Maybe Int))
    -> TextParser m SmartDate
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Integer -> Maybe (Int, Maybe Int) -> SmartDate
    SmartAssumeStart ParsecT CustomErr Text m Integer
    forall (m :: * -> *). TextParser m Integer
    yearp (ParsecT CustomErr Text m (Int, Maybe Int)
    -> ParsecT CustomErr Text m (Maybe (Int, Maybe Int))
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT CustomErr Text m (Int, Maybe Int)
     -> ParsecT CustomErr Text m (Maybe (Int, Maybe Int)))
    -> ParsecT CustomErr Text m (Int, Maybe Int)
    -> ParsecT CustomErr Text m (Maybe (Int, Maybe Int))
    forall a b. (a -> b) -> a -> b
    $ ParsecT CustomErr Text m (Int, Maybe Int)
    -> ParsecT CustomErr Text m (Int, Maybe Int)
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try ParsecT CustomErr Text m (Int, Maybe Int)
    forall (m :: * -> *). ParsecT CustomErr Text m (Int, Maybe Int)
    monthday) TextParser m SmartDate
    -> (SmartDate -> TextParser m SmartDate) -> TextParser m SmartDate
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= SmartDate -> TextParser m SmartDate
    forall (m :: * -> *). MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate
      where monthday :: ParsecT CustomErr Text m (Int, Maybe Int)
    monthday = do
                Char
    sep <- TextParser m Char
    forall (m :: * -> *). TextParser m Char
    datesepchar
                (Int -> Maybe Int -> (Int, Maybe Int))
    -> ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m (Maybe Int)
    -> ParsecT CustomErr Text m (Int, Maybe Int)
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (,) ParsecT CustomErr Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal (ParsecT CustomErr Text m (Maybe Int)
     -> ParsecT CustomErr Text m (Int, Maybe Int))
    -> (ParsecT CustomErr Text m Int
        -> ParsecT CustomErr Text m (Maybe Int))
    -> ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m (Int, Maybe Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m (Maybe Int)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT CustomErr Text m Int
     -> ParsecT CustomErr Text m (Int, Maybe Int))
    -> ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m (Int, Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ Token Text -> ParsecT CustomErr 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 TextParser m Char
    -> ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT CustomErr Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal

    md :: TextParser m (Month, MonthDay)
    md :: TextParser m (Int, Int)
    md = do
      Int
    m <- ParsecT CustomErr 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 CustomErr Text m Int
    forall e s (m :: * -> *) a.
    (MonadParsec e s m, Token s ~ Char, Num a) =>
    m a
    decimal
      SmartDate
    _ <- SmartDate -> ParsecT CustomErr Text m SmartDate
    forall (m :: * -> *). MonadFail m => SmartDate -> m SmartDate
    failIfInvalidDate (SmartDate -> ParsecT CustomErr Text m SmartDate)
    -> SmartDate -> ParsecT CustomErr 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 (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 :: TextParser m Integer
    yearp = do
      Text
    year <- Maybe String
    -> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe String -> (Token s -> Bool) -> m (Tokens s)
    takeWhile1P (String -> Maybe String
    forall a. a -> Maybe a
    Just "year") Char -> Bool
    Token Text -> Bool
    isDigit
      Bool -> ParsecT CustomErr Text m () -> ParsecT CustomErr 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
    >= 4) (ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ())
    -> (String -> ParsecT CustomErr Text m ())
    -> String
    -> ParsecT CustomErr Text m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ParsecT CustomErr Text m ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail (String -> ParsecT CustomErr Text m ())
    -> String -> ParsecT CustomErr Text m ()
    forall a b. (a -> b) -> a -> b
    $ "Year must contain at least 4 digits: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    T.unpack Text
    year
      Integer -> TextParser m Integer
    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 :: [Text]
    months         = ["january","february","march","april","may","june",
                      "july","august","september","october","november","december"]
    monthabbrevs :: [Text]
    monthabbrevs   = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]
    weekdays :: [Text]
    weekdays       = ["monday","tuesday","wednesday","thursday","friday","saturday","sunday"]
    weekdayabbrevs :: [Text]
    weekdayabbrevs = ["mon","tue","wed","thu","fri","sat","sun"]

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

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

    -- | 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 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 (DayOfWeek 2,DateSpan ..)
    -- >>> p "every 2nd day of week"
    -- Right (DayOfWeek 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 :: Day -> TextParser m (Interval, DateSpan)
    periodexprp rdate :: Day
    rdate = do
      ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr 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 CustomErr Text m DateSpan
    -> TextParser m (Interval, DateSpan)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Day -> ParsecT CustomErr 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 :: Day -> TextParser m (Interval, DateSpan)
    intervalanddateperiodexprp rdate :: Day
    rdate = do
      Interval
    i <- TextParser m Interval
    forall (m :: * -> *). TextParser m Interval
    reportingintervalp
      DateSpan
    s <- DateSpan
    -> ParsecT CustomErr Text m DateSpan
    -> ParsecT CustomErr Text m DateSpan
    forall (m :: * -> *) a. Alternative m => a -> m a -> m a
    option DateSpan
    forall a. Default a => a
    def (ParsecT CustomErr Text m DateSpan
     -> ParsecT CustomErr Text m DateSpan)
    -> (ParsecT CustomErr Text m DateSpan
        -> ParsecT CustomErr Text m DateSpan)
    -> ParsecT CustomErr Text m DateSpan
    -> ParsecT CustomErr Text m DateSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT CustomErr Text m DateSpan
    -> ParsecT CustomErr Text m DateSpan
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT CustomErr Text m DateSpan
     -> ParsecT CustomErr Text m DateSpan)
    -> ParsecT CustomErr Text m DateSpan
    -> ParsecT CustomErr Text m DateSpan
    forall a b. (a -> b) -> a -> b
    $ do
          ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces
          Day -> ParsecT CustomErr Text m DateSpan
    forall (m :: * -> *). Day -> TextParser m DateSpan
    periodexprdatespanp Day
    rdate
      (Interval, DateSpan) -> TextParser m (Interval, DateSpan)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Interval
    i,DateSpan
    s)

    -- Parse a reporting interval.
    reportingintervalp :: TextParser m Interval
    reportingintervalp :: TextParser m Interval
    reportingintervalp = [TextParser m Interval] -> TextParser m Interval
    forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
    choice'
        [ String -> String -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    String -> String -> (Int -> Interval) -> TextParser m Interval
    tryinterval "day"     "daily"     Int -> Interval
    Days
        , String -> String -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    String -> String -> (Int -> Interval) -> TextParser m Interval
    tryinterval "week"    "weekly"    Int -> Interval
    Weeks
        , String -> String -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    String -> String -> (Int -> Interval) -> TextParser m Interval
    tryinterval "month"   "monthly"   Int -> Interval
    Months
        , String -> String -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    String -> String -> (Int -> Interval) -> TextParser m Interval
    tryinterval "quarter" "quarterly" Int -> Interval
    Quarters
        , String -> String -> (Int -> Interval) -> TextParser m Interval
    forall (m :: * -> *).
    String -> String -> (Int -> Interval) -> TextParser m Interval
    tryinterval "year"    "yearly"    Int -> Interval
    Years
        , Int -> Interval
    Weeks 2 Interval -> ParsecT CustomErr Text m Text -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "biweekly"
        , Int -> Interval
    Weeks 2 Interval -> ParsecT CustomErr Text m Text -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "fortnightly"
        , Int -> Interval
    Months 2 Interval -> ParsecT CustomErr Text m Text -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "bimonthly"
        , Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "every" ParsecT CustomErr Text m Text
    -> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces ParsecT CustomErr Text m ()
    -> TextParser m Interval -> TextParser m Interval
    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
    DayOfWeek (Int -> Interval)
    -> ParsecT CustomErr Text m Int -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT CustomErr Text m Int
    nth ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "day" ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall s (m :: * -> *).
    (IsString (Tokens s), FoldCase (Tokens s), Stream s,
     Token s ~ Char) =>
    Tokens s -> ParsecT CustomErr s m (Tokens s)
    of_ "week")
            , Int -> Interval
    DayOfMonth (Int -> Interval)
    -> ParsecT CustomErr Text m Int -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT CustomErr Text m Int
    nth ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "day" ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m (Maybe Text)
    -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT CustomErr Text m (Maybe (Tokens Text))
    forall s (m :: * -> *).
    (Stream s, IsString (Tokens s), FoldCase (Tokens s),
     Token s ~ Char) =>
    Tokens s -> ParsecT CustomErr s m (Maybe (Tokens s))
    optOf_ "month")
            , (Int -> Int -> Interval)
    -> ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m Int
    -> TextParser m Interval
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Int -> Int -> Interval
    WeekdayOfMonth ParsecT CustomErr Text m Int
    nth (ParsecT CustomErr Text m Int -> TextParser m Interval)
    -> ParsecT CustomErr Text m Int -> TextParser m Interval
    forall a b. (a -> b) -> a -> b
    $ ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces ParsecT CustomErr Text m ()
    -> ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT CustomErr Text m Int
    forall (m :: * -> *). TextParser m Int
    weekday ParsecT CustomErr Text m Int
    -> ParsecT CustomErr Text m (Maybe Text)
    -> ParsecT CustomErr Text m Int
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT CustomErr Text m (Maybe (Tokens Text))
    forall s (m :: * -> *).
    (Stream s, IsString (Tokens s), FoldCase (Tokens s),
     Token s ~ Char) =>
    Tokens s -> ParsecT CustomErr s m (Maybe (Tokens s))
    optOf_ "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 CustomErr Text m (Int, Int) -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT CustomErr Text m (Int, Int)
    forall (m :: * -> *). TextParser m (Int, Int)
    md ParsecT CustomErr Text m (Int, Int)
    -> ParsecT CustomErr Text m (Maybe Text)
    -> ParsecT CustomErr Text m (Int, Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT CustomErr Text m (Maybe (Tokens Text))
    forall s (m :: * -> *).
    (Stream s, IsString (Tokens s), FoldCase (Tokens s),
     Token s ~ Char) =>
    Tokens s -> ParsecT CustomErr s m (Maybe (Tokens s))
    optOf_ "year")
            , Int -> Interval
    DayOfWeek (Int -> Interval)
    -> ParsecT CustomErr Text m Int -> TextParser m Interval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT CustomErr Text m Int
    forall (m :: * -> *). TextParser m Int
    weekday
            , TextParser m Interval
    d_o_y TextParser m Interval
    -> ParsecT CustomErr Text m (Maybe Text) -> TextParser m Interval
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Tokens Text -> ParsecT CustomErr Text m (Maybe (Tokens Text))
    forall s (m :: * -> *).
    (Stream s, IsString (Tokens s), FoldCase (Tokens s),
     Token s ~ Char) =>
    Tokens s -> ParsecT CustomErr s m (Maybe (Tokens s))
    optOf_ "year"
            ]
        ]
      where
        of_ :: Tokens s -> ParsecT CustomErr s m (Tokens s)
    of_ period :: Tokens s
    period =
          ParsecT CustomErr s m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces ParsecT CustomErr s m ()
    -> ParsecT CustomErr s m (Tokens s)
    -> ParsecT CustomErr s m (Tokens s)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Tokens s -> ParsecT CustomErr s m (Tokens s)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "of" ParsecT CustomErr s m (Tokens s)
    -> ParsecT CustomErr s m () -> ParsecT CustomErr s m ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT CustomErr s m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces ParsecT CustomErr s m ()
    -> ParsecT CustomErr s m (Tokens s)
    -> ParsecT CustomErr s m (Tokens s)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Tokens s -> ParsecT CustomErr 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 CustomErr s m (Maybe (Tokens s))
    optOf_ period :: Tokens s
    period = ParsecT CustomErr s m (Tokens s)
    -> ParsecT CustomErr s m (Maybe (Tokens s))
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT CustomErr s m (Tokens s)
     -> ParsecT CustomErr s m (Maybe (Tokens s)))
    -> (ParsecT CustomErr s m (Tokens s)
        -> ParsecT CustomErr s m (Tokens s))
    -> ParsecT CustomErr s m (Tokens s)
    -> ParsecT CustomErr s m (Maybe (Tokens s))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT CustomErr s m (Tokens s)
    -> ParsecT CustomErr s m (Tokens s)
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT CustomErr s m (Tokens s)
     -> ParsecT CustomErr s m (Maybe (Tokens s)))
    -> ParsecT CustomErr s m (Tokens s)
    -> ParsecT CustomErr s m (Maybe (Tokens s))
    forall a b. (a -> b) -> a -> b
    $ Tokens s -> ParsecT CustomErr s m (Tokens s)
    forall s (m :: * -> *).
    (IsString (Tokens s), FoldCase (Tokens s), Stream s,
     Token s ~ Char) =>
    Tokens s -> ParsecT CustomErr s m (Tokens s)
    of_ Tokens s
    period

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

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

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

    -- |
    -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "20180101-201804"
    -- Right DateSpan 2018Q1
    doubledatespanp :: Day -> TextParser m DateSpan
    doubledatespanp :: Day -> TextParser m DateSpan
    doubledatespanp rdate :: Day
    rdate = (SmartDate -> SmartDate -> DateSpan)
    -> ParsecT CustomErr Text m SmartDate
    -> ParsecT CustomErr Text m SmartDate
    -> TextParser m DateSpan
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 SmartDate -> SmartDate -> DateSpan
    fromToSpan
        (ParsecT CustomErr Text m () -> ParsecT CustomErr Text m (Maybe ())
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "from" ParsecT CustomErr Text m Text
    -> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces) ParsecT CustomErr Text m (Maybe ())
    -> ParsecT CustomErr Text m SmartDate
    -> ParsecT CustomErr Text m SmartDate
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT CustomErr Text m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate)
        (ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces ParsecT CustomErr Text m ()
    -> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [ParsecT CustomErr Text m Text] -> ParsecT CustomErr Text m Text
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    choice [Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, FoldCase (Tokens s)) =>
    Tokens s -> m (Tokens s)
    string' "to", Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string "..", Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string "-"]
        ParsecT CustomErr Text m Text
    -> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT CustomErr Text m ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces ParsecT CustomErr Text m ()
    -> ParsecT CustomErr Text m SmartDate
    -> ParsecT CustomErr Text m SmartDate
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT CustomErr Text m SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate)
      where
        fromToSpan :: SmartDate -> SmartDate -> DateSpan
    fromToSpan = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Maybe Day -> Maybe Day -> DateSpan)
    -> (SmartDate -> Maybe Day) -> SmartDate -> SmartDate -> DateSpan
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> (SmartDate -> Day) -> SmartDate -> Maybe Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> SmartDate -> Day
    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 :: Day -> TextParser m DateSpan
    quarterdatespanp rdate :: Day
    rdate = do
        Integer
    y <- TextParser m Integer
    forall (m :: * -> *). TextParser m Integer
    yearp TextParser m Integer
    -> TextParser m Integer -> TextParser m Integer
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Integer -> TextParser m Integer
    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 CustomErr Text m (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char' Token Text
    'q' ParsecT CustomErr Text m Char
    -> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Token Text -> Bool) -> ParsecT CustomErr 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 (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 c :: 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 '1') :: Word) Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 3

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

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

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

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

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

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