{-# LANGUAGE CPP #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PackageImports #-}
module Hledger.Data.Dates (
getCurrentDay,
getCurrentMonth,
getCurrentYear,
nulldate,
spanContainsDate,
periodContainsDate,
parsedateM,
parsedate,
showDate,
showDateSpan,
showDateSpanMonthAbbrev,
elapsedSeconds,
prevday,
periodexprp,
parsePeriodExpr,
parsePeriodExpr',
nulldatespan,
emptydatespan,
failIfInvalidYear,
failIfInvalidMonth,
failIfInvalidDay,
datesepchar,
datesepchars,
isDateSepChar,
spanStart,
spanEnd,
spansSpan,
spanIntersect,
spansIntersect,
spanDefaultsFrom,
spanUnion,
spansUnion,
daysSpan,
latestSpanContaining,
smartdate,
splitSpan,
fixSmartDate,
fixSmartDateStr,
fixSmartDateStrEither,
fixSmartDateStrEither',
daysInSpan,
maybePeriod,
mkdatespan,
)
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.Permutations
import Control.Monad (guard, unless)
import "base-compat-batteries" Data.List.Compat
import Data.Default
import Data.Foldable (asum)
import Data.Maybe
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format hiding (months)
#else
import Data.Time.Format
import System.Locale (TimeLocale, defaultTimeLocale)
#endif
import Data.Time.Calendar
import Data.Time.Calendar.OrdinalDate
import Data.Time.Clock
import Data.Time.LocalTime
import Safe (headMay, lastMay, readMay, maximumMay, minimumMay)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Custom
import Text.Printf
import Hledger.Data.Types
import Hledger.Data.Period
import Hledger.Utils
instance Show DateSpan where
show :: DateSpan -> String
show s :: DateSpan
s = "DateSpan " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DateSpan -> String
showDateSpan DateSpan
s
showDate :: Day -> String
showDate :: Day -> String
showDate = Day -> String
forall a. Show a => a -> String
show
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
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
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
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
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
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)
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 :: (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"
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
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
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
periodContainsDate :: Period -> Day -> Bool
periodContainsDate :: Period -> Day -> Bool
periodContainsDate p :: Period
p = DateSpan -> Day -> Bool
spanContainsDate (Period -> DateSpan
periodAsDateSpan Period
p)
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)
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
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
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)
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
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)
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
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
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)
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
$
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
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 ("","","today") = (Day
refdate, Day -> Day
nextday Day
refdate)
span ("","this","day") = (Day
refdate, Day -> Day
nextday Day
refdate)
span ("","","yesterday") = (Day -> Day
prevday Day
refdate, Day
refdate)
span ("","last","day") = (Day -> Day
prevday Day
refdate, Day
refdate)
span ("","","tomorrow") = (Day -> Day
nextday Day
refdate, Integer -> Day -> Day
addDays 2 Day
refdate)
span ("","next","day") = (Day -> Day
nextday Day
refdate, Integer -> Day -> Day
addDays 2 Day
refdate)
span ("","last","week") = (Day -> Day
prevweek Day
refdate, Day -> Day
thisweek Day
refdate)
span ("","this","week") = (Day -> Day
thisweek Day
refdate, Day -> Day
nextweek Day
refdate)
span ("","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 ("","last","month") = (Day -> Day
prevmonth Day
refdate, Day -> Day
thismonth Day
refdate)
span ("","this","month") = (Day -> Day
thismonth Day
refdate, Day -> Day
nextmonth Day
refdate)
span ("","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 ("","last","quarter") = (Day -> Day
prevquarter Day
refdate, Day -> Day
thisquarter Day
refdate)
span ("","this","quarter") = (Day -> Day
thisquarter Day
refdate, Day -> Day
nextquarter Day
refdate)
span ("","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 ("","last","year") = (Day -> Day
prevyear Day
refdate, Day -> Day
thisyear Day
refdate)
span ("","this","year") = (Day -> Day
thisyear Day
refdate, Day -> Day
nextyear Day
refdate)
span ("","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 ("","",d :: String
d) = (Day
day, Day -> Day
nextday Day
day) where day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian Integer
ry Int
rm (String -> Int
forall a. Read a => String -> a
read String
d)
span ("",m :: String
m,"") = (Day -> Day
startofmonth Day
day, Day -> Day
nextmonth Day
day) where day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian Integer
ry (String -> Int
forall a. Read a => String -> a
read String
m) 1
span ("",m :: String
m,d :: String
d) = (Day
day, Day -> Day
nextday Day
day) where day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian Integer
ry (String -> Int
forall a. Read a => String -> a
read String
m) (String -> Int
forall a. Read a => String -> a
read String
d)
span (y :: String
y,"","") = (Day -> Day
startofyear Day
day, Day -> Day
nextyear Day
day) where day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian (String -> Integer
forall a. Read a => String -> a
read String
y) 1 1
span (y :: String
y,m :: String
m,"") = (Day -> Day
startofmonth Day
day, Day -> Day
nextmonth Day
day) where day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian (String -> Integer
forall a. Read a => String -> a
read String
y) (String -> Int
forall a. Read a => String -> a
read String
m) 1
span (y :: String
y,m :: String
m,d :: String
d) = (Day
day, Day -> Day
nextday Day
day) where day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian (String -> Integer
forall a. Read a => String -> a
read String
y) (String -> Int
forall a. Read a => String -> a
read String
m) (String -> Int
forall a. Read a => String -> a
read String
d)
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
$
(Day -> Text -> Either (ParseErrorBundle Text CustomErr) String
fixSmartDateStrEither Day
d Text
s :: Either (ParseErrorBundle Text CustomErr) String)
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
fixSmartDate :: Day -> SmartDate -> Day
fixSmartDate :: Day -> SmartDate -> Day
fixSmartDate refdate :: Day
refdate = SmartDate -> Day
fix
where
fix :: SmartDate -> Day
fix :: SmartDate -> Day
fix ("", "", "today") = Integer -> Int -> Int -> Day
fromGregorian Integer
ry Int
rm Int
rd
fix ("", "this", "day") = Integer -> Int -> Int -> Day
fromGregorian Integer
ry Int
rm Int
rd
fix ("", "", "yesterday") = Day -> Day
prevday Day
refdate
fix ("", "last", "day") = Day -> Day
prevday Day
refdate
fix ("", "", "tomorrow") = Day -> Day
nextday Day
refdate
fix ("", "next", "day") = Day -> Day
nextday Day
refdate
fix ("", "last", "week") = Day -> Day
prevweek Day
refdate
fix ("", "this", "week") = Day -> Day
thisweek Day
refdate
fix ("", "next", "week") = Day -> Day
nextweek Day
refdate
fix ("", "last", "month") = Day -> Day
prevmonth Day
refdate
fix ("", "this", "month") = Day -> Day
thismonth Day
refdate
fix ("", "next", "month") = Day -> Day
nextmonth Day
refdate
fix ("", "last", "quarter") = Day -> Day
prevquarter Day
refdate
fix ("", "this", "quarter") = Day -> Day
thisquarter Day
refdate
fix ("", "next", "quarter") = Day -> Day
nextquarter Day
refdate
fix ("", "last", "year") = Day -> Day
prevyear Day
refdate
fix ("", "this", "year") = Day -> Day
thisyear Day
refdate
fix ("", "next", "year") = Day -> Day
nextyear Day
refdate
fix ("", "", d :: String
d) = Integer -> Int -> Int -> Day
fromGregorian Integer
ry Int
rm (String -> Int
forall a. Read a => String -> a
read String
d)
fix ("", m :: String
m, "") = Integer -> Int -> Int -> Day
fromGregorian Integer
ry (String -> Int
forall a. Read a => String -> a
read String
m) 1
fix ("", m :: String
m, d :: String
d) = Integer -> Int -> Int -> Day
fromGregorian Integer
ry (String -> Int
forall a. Read a => String -> a
read String
m) (String -> Int
forall a. Read a => String -> a
read String
d)
fix (y :: String
y, "", "") = Integer -> Int -> Int -> Day
fromGregorian (String -> Integer
forall a. Read a => String -> a
read String
y) 1 1
fix (y :: String
y, m :: String
m, "") = Integer -> Int -> Int -> Day
fromGregorian (String -> Integer
forall a. Read a => String -> a
read String
y) (String -> Int
forall a. Read a => String -> a
read String
m) 1
fix (y :: String
y, m :: String
m, d :: String
d) = Integer -> Int -> Int -> Day
fromGregorian (String -> Integer
forall a. Read a => String -> a
read String
y) (String -> Int
forall a. Read a => String -> a
read String
m) (String -> Int
forall a. Read a => String -> a
read String
d)
(ry :: Integer
ry, rm :: Int
rm, rd :: Int
rd) = 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
nthdayofyearcontaining :: Month -> MonthDay -> Day -> Day
nthdayofyearcontaining :: Int -> Int -> Day -> Day
nthdayofyearcontaining m :: Int
m md :: Int
md date :: Day
date
| Bool -> Bool
not (String -> Bool
validMonth (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show 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 (String -> Bool
validDay (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show 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 b. (Integral a, Num b) => a -> b
fromIntegral 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 b. (Integral a, Num b) => a -> b
fromIntegral 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
nthdayofmonthcontaining :: MonthDay -> Day -> Day
nthdayofmonthcontaining :: Int -> Day -> Day
nthdayofmonthcontaining md :: Int
md date :: Day
date
| Bool -> Bool
not (String -> Bool
validDay (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show 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
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 b. (Integral a, Num b) => a -> b
fromIntegral 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 b. (Integral a, Num b) => a -> b
fromIntegral 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
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
advancetonthweekday :: Int -> WeekDay -> Day -> Day
advancetonthweekday :: Int -> Int -> Day -> Day
advancetonthweekday n :: Int
n wd :: Int
wd s :: Day
s =
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 b. (Integral a, Num b) => a -> b
fromIntegral 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 b. (Integral a, Num b) => a -> b
fromIntegral 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
parsetime :: ParseTime t => TimeLocale -> String -> String -> Maybe t
parsetime :: TimeLocale -> String -> String -> Maybe t
parsetime =
#if MIN_VERSION_time(1,5,0)
Bool -> TimeLocale -> String -> String -> Maybe t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True
#else
parseTime
#endif
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 [
TimeLocale -> String -> String -> Maybe Day
forall t. ParseTime t => TimeLocale -> String -> String -> Maybe t
parsetime TimeLocale
defaultTimeLocale "%Y-%m-%d" String
s,
TimeLocale -> String -> String -> Maybe Day
forall t. ParseTime t => TimeLocale -> String -> String -> Maybe t
parsetime TimeLocale
defaultTimeLocale "%Y/%m/%d" String
s,
TimeLocale -> String -> String -> Maybe Day
forall t. ParseTime t => TimeLocale -> String -> String -> Maybe t
parsetime TimeLocale
defaultTimeLocale "%Y.%m.%d" String
s
]
parsedate :: String -> Day
parsedate :: String -> Day
parsedate s :: String
s = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (String -> Day
forall a. String -> a
error' (String -> Day) -> String -> Day
forall a b. (a -> b) -> a -> b
$ "could not parse date \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"")
(String -> Maybe Day
parsedateM String
s)
smartdate :: TextParser m SmartDate
smartdate :: TextParser m SmartDate
smartdate = do
(y :: String
y,m :: String
m,d :: String
d) <- [TextParser m SmartDate] -> TextParser m SmartDate
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' [TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
yyyymmdd, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
yyyymm, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
ymd, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
ym, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
md, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
y, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
d, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
month, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
mon, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
today, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
yesterday, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
tomorrow, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
lastthisnextthing]
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return (String
y,String
m,String
d)
smartdateonly :: TextParser m SmartDate
smartdateonly :: TextParser m SmartDate
smartdateonly = do
SmartDate
d <- TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
smartdate
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
ParsecT CustomErr Text m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return SmartDate
d
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
== '.'
validYear, validMonth, validDay :: String -> Bool
validYear :: String -> Bool
validYear s :: String
s = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 4 Bool -> Bool -> Bool
&& Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMay String
s :: Maybe Year)
validMonth :: String -> Bool
validMonth s :: String
s = Bool -> (Integer -> Bool) -> Maybe Integer -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\n :: Integer
n -> Integer
nInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>=1 Bool -> Bool -> Bool
&& Integer
nInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=12) (Maybe Integer -> Bool) -> Maybe Integer -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMay String
s
validDay :: String -> Bool
validDay s :: String
s = Bool -> (Integer -> Bool) -> Maybe Integer -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\n :: Integer
n -> Integer
nInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>=1 Bool -> Bool -> Bool
&& Integer
nInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=31) (Maybe Integer -> Bool) -> Maybe Integer -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMay String
s
failIfInvalidYear, failIfInvalidMonth, failIfInvalidDay :: (Fail.MonadFail m) => String -> m ()
failIfInvalidYear :: String -> m ()
failIfInvalidYear s :: String
s = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
validYear String
s) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "bad year number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
failIfInvalidMonth :: String -> m ()
failIfInvalidMonth s :: String
s = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
validMonth String
s) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "bad month number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
failIfInvalidDay :: String -> m ()
failIfInvalidDay s :: String
s = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
validDay String
s) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "bad day number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
yyyymmdd :: TextParser m SmartDate
yyyymmdd :: TextParser m SmartDate
yyyymmdd = do
String
y <- 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
String
m <- 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
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidMonth String
m
String
d <- 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
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidDay String
d
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return (String
y,String
m,String
d)
yyyymm :: TextParser m SmartDate
yyyymm :: TextParser m SmartDate
yyyymm = do
String
y <- 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
String
m <- 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
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidMonth String
m
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return (String
y,String
m,"01")
ymd :: TextParser m SmartDate
ymd :: TextParser m SmartDate
ymd = do
String
y <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidYear String
y
Char
sep <- ParsecT CustomErr Text m Char
forall (m :: * -> *). TextParser m Char
datesepchar
String
m <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidMonth String
m
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
String
d <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidDay String
d
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return (SmartDate -> TextParser m SmartDate)
-> SmartDate -> TextParser m SmartDate
forall a b. (a -> b) -> a -> b
$ (String
y,String
m,String
d)
ym :: TextParser m SmartDate
ym :: TextParser m SmartDate
ym = do
String
y <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidYear String
y
ParsecT CustomErr Text m Char
forall (m :: * -> *). TextParser m Char
datesepchar
String
m <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidMonth String
m
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return (String
y,String
m,"")
y :: TextParser m SmartDate
y :: TextParser m SmartDate
y = do
String
y <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidYear String
y
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return (String
y,"","")
d :: TextParser m SmartDate
d :: TextParser m SmartDate
d = do
String
d <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidDay String
d
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return ("","",String
d)
md :: TextParser m SmartDate
md :: TextParser m SmartDate
md = do
String
m <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidMonth String
m
ParsecT CustomErr Text m Char
forall (m :: * -> *). TextParser m Char
datesepchar
String
d <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
String -> ParsecT CustomErr Text m ()
forall (m :: * -> *). MonadFail m => String -> m ()
failIfInvalidDay String
d
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return ("",String
m,String
d)
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"]
monthIndex :: Text -> Int
monthIndex name :: Text
name = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
name Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Text]
months
monIndex :: Text -> Int
monIndex name :: Text
name = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
name Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Text]
monthabbrevs
month :: TextParser m SmartDate
month :: TextParser m SmartDate
month = do
Text
m <- [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)
-> [ParsecT CustomErr Text m Text] -> ParsecT CustomErr Text m Text
forall a b. (a -> b) -> a -> b
$ (Text -> ParsecT CustomErr Text m Text)
-> [Text] -> [ParsecT CustomErr Text m Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string') [Text]
months
let i :: Int
i = Text -> Int
monthIndex Text
m
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return ("",Int -> String
forall a. Show a => a -> String
show Int
i,"")
mon :: TextParser m SmartDate
mon :: TextParser m SmartDate
mon = do
Text
m <- [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)
-> [ParsecT CustomErr Text m Text] -> ParsecT CustomErr Text m Text
forall a b. (a -> b) -> a -> b
$ (Text -> ParsecT CustomErr Text m Text)
-> [Text] -> [ParsecT CustomErr Text m Text]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string') [Text]
monthabbrevs
let i :: Int
i = Text -> Int
monIndex Text
m
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return ("",Int -> String
forall a. Show a => a -> String
show Int
i,"")
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)
today,yesterday,tomorrow :: TextParser m SmartDate
today :: TextParser m SmartDate
today = 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" ParsecT CustomErr Text m Text
-> TextParser m SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return ("","","today")
yesterday :: TextParser m SmartDate
yesterday = 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" ParsecT CustomErr Text m Text
-> TextParser m SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return ("","","yesterday")
tomorrow :: TextParser m SmartDate
tomorrow = 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" ParsecT CustomErr Text m Text
-> TextParser m SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return ("","","tomorrow")
lastthisnextthing :: TextParser m SmartDate
lastthisnextthing :: TextParser m SmartDate
lastthisnextthing = do
Text
r <- [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)
-> [ParsecT CustomErr Text m Text] -> ParsecT CustomErr Text m Text
forall a b. (a -> b) -> a -> b
$ (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' [
"last"
,"this"
,"next"
]
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Text
p <- [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)
-> [ParsecT CustomErr Text m Text] -> ParsecT CustomErr Text m Text
forall a b. (a -> b) -> a -> b
$ (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' [
"day"
,"week"
,"month"
,"quarter"
,"year"
]
SmartDate -> TextParser m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return ("", Text -> String
T.unpack Text
r, Text -> String
T.unpack Text
p)
periodexprp :: Day -> TextParser m (Interval, DateSpan)
periodexprp :: Day -> TextParser m (Interval, DateSpan)
periodexprp rdate :: Day
rdate = do
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
[TextParser m (Interval, DateSpan)]
-> TextParser m (Interval, DateSpan)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
choice ([TextParser m (Interval, DateSpan)]
-> TextParser m (Interval, DateSpan))
-> [TextParser m (Interval, DateSpan)]
-> TextParser m (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ (TextParser m (Interval, DateSpan)
-> TextParser m (Interval, DateSpan))
-> [TextParser m (Interval, DateSpan)]
-> [TextParser m (Interval, DateSpan)]
forall a b. (a -> b) -> [a] -> [b]
map TextParser m (Interval, DateSpan)
-> TextParser m (Interval, DateSpan)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try [
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
]
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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)
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,
do 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"
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Weeks 2,
do 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"
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Months 2,
do 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Int
n <- ParsecT CustomErr Text m Int
forall (m :: * -> *). ParsecT CustomErr Text m Int
nth
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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"
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"
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
DayOfWeek Int
n,
do 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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 :: * -> *). ParsecT CustomErr Text m Int
weekday,
do 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Int
n <- ParsecT CustomErr Text m Int
forall (m :: * -> *). ParsecT CustomErr Text m Int
nth
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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"
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"
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
DayOfMonth Int
n,
do 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"
let mnth :: ParsecT CustomErr Text m Int
mnth = [TextParser m SmartDate] -> TextParser m SmartDate
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' [TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
month, TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
mon] TextParser m SmartDate
-> (SmartDate -> ParsecT CustomErr Text m Int)
-> ParsecT CustomErr Text m Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(_,m :: String
m,_) -> Int -> ParsecT CustomErr Text m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. Read a => String -> a
read String
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
DayOfYear (Int -> Int -> Interval)
-> Permutation (ParsecT CustomErr Text m) Int
-> Permutation (ParsecT CustomErr Text m) (Int -> Interval)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline 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 :: * -> *). ParsecT CustomErr Text m Int
mnth))
Permutation (ParsecT CustomErr Text m) (Int -> Interval)
-> Permutation (ParsecT CustomErr Text m) Int
-> Permutation (ParsecT CustomErr Text m) Interval
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline 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 :: * -> *). ParsecT CustomErr Text m Int
nth))
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"
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return Interval
d_o_y,
do 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
("",m :: String
m,d :: String
d) <- TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
md
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"
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Interval
DayOfYear (String -> Int
forall a. Read a => String -> a
read String
m) (String -> Int
forall a. Read a => String -> a
read String
d),
do 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Int
n <- ParsecT CustomErr Text m Int
forall (m :: * -> *). ParsecT CustomErr Text m Int
nth
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Int
wd <- ParsecT CustomErr Text m Int
forall (m :: * -> *). ParsecT CustomErr Text m Int
weekday
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"
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Interval
WeekdayOfMonth Int
n Int
wd
]
where
of_ :: Tokens s -> ParsecT CustomErr s m (Tokens s)
of_ period :: Tokens s
period = do
ParsecT CustomErr s m Char -> ParsecT CustomErr s m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr s m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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 Char -> ParsecT CustomErr s m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr s m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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 (Maybe (Tokens s))
forall a b. (a -> b) -> a -> b
$ 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 (Tokens s))
-> ParsecT CustomErr s m (Tokens s)
-> ParsecT CustomErr s m (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 = do String
n <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
[TextParser m Text] -> TextParser m Text
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' ([TextParser m Text] -> TextParser m Text)
-> [TextParser m Text] -> TextParser m Text
forall a b. (a -> b) -> a -> b
$ (Text -> TextParser m Text) -> [Text] -> [TextParser m Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> TextParser m Text
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' ["st","nd","rd","th"]
Int -> ParsecT CustomErr Text m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT CustomErr Text m Int)
-> Int -> ParsecT CustomErr Text m Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
n
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 =
[TextParser m Interval] -> TextParser m Interval
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' [
do 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'
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
intcons 1,
do 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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'
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
intcons 1,
do 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Int
n <- 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
<$> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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'
Interval -> TextParser m Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> TextParser m Interval)
-> Interval -> TextParser m Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
intcons Int
n
]
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
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
]
doubledatespanp :: Day -> TextParser m DateSpan
doubledatespanp :: Day -> TextParser m DateSpan
doubledatespanp rdate :: Day
rdate = do
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
SmartDate
b <- TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
smartdate
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
ParsecT CustomErr Text m () -> ParsecT CustomErr Text m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([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, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' "-"] ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 -> 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)
-> TextParser m SmartDate -> TextParser m DateSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextParser m SmartDate
forall (m :: * -> *). TextParser m SmartDate
smartdate
fromdatespanp :: Day -> TextParser m DateSpan
fromdatespanp :: Day -> TextParser m DateSpan
fromdatespanp rdate :: Day
rdate = do
SmartDate
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 [
do
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
ParsecT CustomErr Text m SmartDate
forall (m :: * -> *). TextParser m SmartDate
smartdate
,
do
SmartDate
d <- ParsecT CustomErr Text m SmartDate
forall (m :: * -> *). TextParser m SmartDate
smartdate
[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, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' "-"]
SmartDate -> ParsecT CustomErr Text m SmartDate
forall (m :: * -> *) a. Monad m => a -> m a
return SmartDate
d
]
DateSpan -> TextParser m DateSpan
forall (m :: * -> *) a. Monad m => a -> m a
return (DateSpan -> TextParser m DateSpan)
-> DateSpan -> TextParser m DateSpan
forall a b. (a -> b) -> a -> 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 = do
[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, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' "-"] ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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 = do
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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
mkdatespan :: String -> String -> DateSpan
mkdatespan :: String -> String -> DateSpan
mkdatespan b :: String
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
$ String -> Day
parsedate String
b) (Maybe Day -> DateSpan)
-> (String -> Maybe Day) -> String -> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> (String -> Day) -> String -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Day
parsedate
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
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