{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, FlexibleContexts #-}
-- | Operations with dates
module Data.Dates
  (DateTime (..),
   Time (..),
   WeekDay (..),
   parseDate, parseDateTime,
   pDate, pDateTime, pTime,
   pDateInterval,
   getCurrentDateTime,
   tryRead, tryReadInt,
   DateIntervalType (..),
   DateInterval (..),
   dayToDateTime, dateTimeToDay,
   weekdayToInterval,
   weekdayNumber,
   intToWeekday,
   dateWeekDay,
   lastMonday, nextMonday,
   modifyDate,
   datesDifference,
   addInterval, negateInterval, minusInterval,
   addTime
  ) where

import Prelude.Unicode
import Data.Char (toUpper)
import Data.List
import Data.Time.Calendar
  ( Day, toGregorian, fromGregorian, addDays, addGregorianMonthsClip
  , addGregorianYearsClip, toModifiedJulianDay )
import Data.Time.Calendar.WeekDate (toWeekDate)
import Data.Time.LocalTime
  ( getZonedTime, zonedTimeToLocalTime, localDay, localTimeOfDay
  , todHour, todMin, todSec )
import Text.Parsec
import Data.Generics
import Data.Char (toLower)

import Data.Dates.Types
import Data.Dates.Internal

data DateIntervalType = Day | Week | Month | Year
  deriving (DateIntervalType -> DateIntervalType -> Bool
(DateIntervalType -> DateIntervalType -> Bool)
-> (DateIntervalType -> DateIntervalType -> Bool)
-> Eq DateIntervalType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateIntervalType -> DateIntervalType -> Bool
$c/= :: DateIntervalType -> DateIntervalType -> Bool
== :: DateIntervalType -> DateIntervalType -> Bool
$c== :: DateIntervalType -> DateIntervalType -> Bool
Eq,Int -> DateIntervalType -> ShowS
[DateIntervalType] -> ShowS
DateIntervalType -> String
(Int -> DateIntervalType -> ShowS)
-> (DateIntervalType -> String)
-> ([DateIntervalType] -> ShowS)
-> Show DateIntervalType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateIntervalType] -> ShowS
$cshowList :: [DateIntervalType] -> ShowS
show :: DateIntervalType -> String
$cshow :: DateIntervalType -> String
showsPrec :: Int -> DateIntervalType -> ShowS
$cshowsPrec :: Int -> DateIntervalType -> ShowS
Show,ReadPrec [DateIntervalType]
ReadPrec DateIntervalType
Int -> ReadS DateIntervalType
ReadS [DateIntervalType]
(Int -> ReadS DateIntervalType)
-> ReadS [DateIntervalType]
-> ReadPrec DateIntervalType
-> ReadPrec [DateIntervalType]
-> Read DateIntervalType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DateIntervalType]
$creadListPrec :: ReadPrec [DateIntervalType]
readPrec :: ReadPrec DateIntervalType
$creadPrec :: ReadPrec DateIntervalType
readList :: ReadS [DateIntervalType]
$creadList :: ReadS [DateIntervalType]
readsPrec :: Int -> ReadS DateIntervalType
$creadsPrec :: Int -> ReadS DateIntervalType
Read,Typeable DateIntervalType
DataType
Constr
Typeable DateIntervalType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DateIntervalType -> c DateIntervalType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DateIntervalType)
-> (DateIntervalType -> Constr)
-> (DateIntervalType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DateIntervalType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DateIntervalType))
-> ((forall b. Data b => b -> b)
    -> DateIntervalType -> DateIntervalType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DateIntervalType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DateIntervalType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DateIntervalType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DateIntervalType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DateIntervalType -> m DateIntervalType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DateIntervalType -> m DateIntervalType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DateIntervalType -> m DateIntervalType)
-> Data DateIntervalType
DateIntervalType -> DataType
DateIntervalType -> Constr
(forall b. Data b => b -> b)
-> DateIntervalType -> DateIntervalType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateIntervalType -> c DateIntervalType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateIntervalType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DateIntervalType -> u
forall u. (forall d. Data d => d -> u) -> DateIntervalType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateIntervalType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateIntervalType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DateIntervalType -> m DateIntervalType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DateIntervalType -> m DateIntervalType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateIntervalType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateIntervalType -> c DateIntervalType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DateIntervalType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DateIntervalType)
$cYear :: Constr
$cMonth :: Constr
$cWeek :: Constr
$cDay :: Constr
$tDateIntervalType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DateIntervalType -> m DateIntervalType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DateIntervalType -> m DateIntervalType
gmapMp :: (forall d. Data d => d -> m d)
-> DateIntervalType -> m DateIntervalType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DateIntervalType -> m DateIntervalType
gmapM :: (forall d. Data d => d -> m d)
-> DateIntervalType -> m DateIntervalType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DateIntervalType -> m DateIntervalType
gmapQi :: Int -> (forall d. Data d => d -> u) -> DateIntervalType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DateIntervalType -> u
gmapQ :: (forall d. Data d => d -> u) -> DateIntervalType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DateIntervalType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateIntervalType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateIntervalType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateIntervalType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateIntervalType -> r
gmapT :: (forall b. Data b => b -> b)
-> DateIntervalType -> DateIntervalType
$cgmapT :: (forall b. Data b => b -> b)
-> DateIntervalType -> DateIntervalType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DateIntervalType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DateIntervalType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DateIntervalType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DateIntervalType)
dataTypeOf :: DateIntervalType -> DataType
$cdataTypeOf :: DateIntervalType -> DataType
toConstr :: DateIntervalType -> Constr
$ctoConstr :: DateIntervalType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateIntervalType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateIntervalType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateIntervalType -> c DateIntervalType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateIntervalType -> c DateIntervalType
$cp1Data :: Typeable DateIntervalType
Data,Typeable)

data DateInterval = Days ℤ
                  | Weeks ℤ
                  | Months ℤ
                  | Years ℤ
  deriving (DateInterval -> DateInterval -> Bool
(DateInterval -> DateInterval -> Bool)
-> (DateInterval -> DateInterval -> Bool) -> Eq DateInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateInterval -> DateInterval -> Bool
$c/= :: DateInterval -> DateInterval -> Bool
== :: DateInterval -> DateInterval -> Bool
$c== :: DateInterval -> DateInterval -> Bool
Eq,Int -> DateInterval -> ShowS
[DateInterval] -> ShowS
DateInterval -> String
(Int -> DateInterval -> ShowS)
-> (DateInterval -> String)
-> ([DateInterval] -> ShowS)
-> Show DateInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateInterval] -> ShowS
$cshowList :: [DateInterval] -> ShowS
show :: DateInterval -> String
$cshow :: DateInterval -> String
showsPrec :: Int -> DateInterval -> ShowS
$cshowsPrec :: Int -> DateInterval -> ShowS
Show,Typeable DateInterval
DataType
Constr
Typeable DateInterval
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DateInterval -> c DateInterval)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DateInterval)
-> (DateInterval -> Constr)
-> (DateInterval -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DateInterval))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DateInterval))
-> ((forall b. Data b => b -> b) -> DateInterval -> DateInterval)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DateInterval -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DateInterval -> r)
-> (forall u. (forall d. Data d => d -> u) -> DateInterval -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DateInterval -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DateInterval -> m DateInterval)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DateInterval -> m DateInterval)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DateInterval -> m DateInterval)
-> Data DateInterval
DateInterval -> DataType
DateInterval -> Constr
(forall b. Data b => b -> b) -> DateInterval -> DateInterval
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateInterval -> c DateInterval
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateInterval
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DateInterval -> u
forall u. (forall d. Data d => d -> u) -> DateInterval -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateInterval -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateInterval -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DateInterval -> m DateInterval
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DateInterval -> m DateInterval
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateInterval
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateInterval -> c DateInterval
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DateInterval)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DateInterval)
$cYears :: Constr
$cMonths :: Constr
$cWeeks :: Constr
$cDays :: Constr
$tDateInterval :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DateInterval -> m DateInterval
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DateInterval -> m DateInterval
gmapMp :: (forall d. Data d => d -> m d) -> DateInterval -> m DateInterval
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DateInterval -> m DateInterval
gmapM :: (forall d. Data d => d -> m d) -> DateInterval -> m DateInterval
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DateInterval -> m DateInterval
gmapQi :: Int -> (forall d. Data d => d -> u) -> DateInterval -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DateInterval -> u
gmapQ :: (forall d. Data d => d -> u) -> DateInterval -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DateInterval -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateInterval -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateInterval -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateInterval -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateInterval -> r
gmapT :: (forall b. Data b => b -> b) -> DateInterval -> DateInterval
$cgmapT :: (forall b. Data b => b -> b) -> DateInterval -> DateInterval
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DateInterval)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DateInterval)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DateInterval)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DateInterval)
dataTypeOf :: DateInterval -> DataType
$cdataTypeOf :: DateInterval -> DataType
toConstr :: DateInterval -> Constr
$ctoConstr :: DateInterval -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateInterval
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateInterval
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateInterval -> c DateInterval
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateInterval -> c DateInterval
$cp1Data :: Typeable DateInterval
Data,Typeable)

data WeekDay =
    Monday
  | Tuesday
  | Wednesday
  | Thursday
  | Friday
  | Saturday
  | Sunday
  deriving (WeekDay -> WeekDay -> Bool
(WeekDay -> WeekDay -> Bool)
-> (WeekDay -> WeekDay -> Bool) -> Eq WeekDay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeekDay -> WeekDay -> Bool
$c/= :: WeekDay -> WeekDay -> Bool
== :: WeekDay -> WeekDay -> Bool
$c== :: WeekDay -> WeekDay -> Bool
Eq, Int -> WeekDay -> ShowS
[WeekDay] -> ShowS
WeekDay -> String
(Int -> WeekDay -> ShowS)
-> (WeekDay -> String) -> ([WeekDay] -> ShowS) -> Show WeekDay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WeekDay] -> ShowS
$cshowList :: [WeekDay] -> ShowS
show :: WeekDay -> String
$cshow :: WeekDay -> String
showsPrec :: Int -> WeekDay -> ShowS
$cshowsPrec :: Int -> WeekDay -> ShowS
Show, ReadPrec [WeekDay]
ReadPrec WeekDay
Int -> ReadS WeekDay
ReadS [WeekDay]
(Int -> ReadS WeekDay)
-> ReadS [WeekDay]
-> ReadPrec WeekDay
-> ReadPrec [WeekDay]
-> Read WeekDay
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WeekDay]
$creadListPrec :: ReadPrec [WeekDay]
readPrec :: ReadPrec WeekDay
$creadPrec :: ReadPrec WeekDay
readList :: ReadS [WeekDay]
$creadList :: ReadS [WeekDay]
readsPrec :: Int -> ReadS WeekDay
$creadsPrec :: Int -> ReadS WeekDay
Read, Eq WeekDay
Eq WeekDay
-> (WeekDay -> WeekDay -> Ordering)
-> (WeekDay -> WeekDay -> Bool)
-> (WeekDay -> WeekDay -> Bool)
-> (WeekDay -> WeekDay -> Bool)
-> (WeekDay -> WeekDay -> Bool)
-> (WeekDay -> WeekDay -> WeekDay)
-> (WeekDay -> WeekDay -> WeekDay)
-> Ord WeekDay
WeekDay -> WeekDay -> Bool
WeekDay -> WeekDay -> Ordering
WeekDay -> WeekDay -> WeekDay
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WeekDay -> WeekDay -> WeekDay
$cmin :: WeekDay -> WeekDay -> WeekDay
max :: WeekDay -> WeekDay -> WeekDay
$cmax :: WeekDay -> WeekDay -> WeekDay
>= :: WeekDay -> WeekDay -> Bool
$c>= :: WeekDay -> WeekDay -> Bool
> :: WeekDay -> WeekDay -> Bool
$c> :: WeekDay -> WeekDay -> Bool
<= :: WeekDay -> WeekDay -> Bool
$c<= :: WeekDay -> WeekDay -> Bool
< :: WeekDay -> WeekDay -> Bool
$c< :: WeekDay -> WeekDay -> Bool
compare :: WeekDay -> WeekDay -> Ordering
$ccompare :: WeekDay -> WeekDay -> Ordering
$cp1Ord :: Eq WeekDay
Ord, Int -> WeekDay
WeekDay -> Int
WeekDay -> [WeekDay]
WeekDay -> WeekDay
WeekDay -> WeekDay -> [WeekDay]
WeekDay -> WeekDay -> WeekDay -> [WeekDay]
(WeekDay -> WeekDay)
-> (WeekDay -> WeekDay)
-> (Int -> WeekDay)
-> (WeekDay -> Int)
-> (WeekDay -> [WeekDay])
-> (WeekDay -> WeekDay -> [WeekDay])
-> (WeekDay -> WeekDay -> [WeekDay])
-> (WeekDay -> WeekDay -> WeekDay -> [WeekDay])
-> Enum WeekDay
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WeekDay -> WeekDay -> WeekDay -> [WeekDay]
$cenumFromThenTo :: WeekDay -> WeekDay -> WeekDay -> [WeekDay]
enumFromTo :: WeekDay -> WeekDay -> [WeekDay]
$cenumFromTo :: WeekDay -> WeekDay -> [WeekDay]
enumFromThen :: WeekDay -> WeekDay -> [WeekDay]
$cenumFromThen :: WeekDay -> WeekDay -> [WeekDay]
enumFrom :: WeekDay -> [WeekDay]
$cenumFrom :: WeekDay -> [WeekDay]
fromEnum :: WeekDay -> Int
$cfromEnum :: WeekDay -> Int
toEnum :: Int -> WeekDay
$ctoEnum :: Int -> WeekDay
pred :: WeekDay -> WeekDay
$cpred :: WeekDay -> WeekDay
succ :: WeekDay -> WeekDay
$csucc :: WeekDay -> WeekDay
Enum, WeekDay
WeekDay -> WeekDay -> Bounded WeekDay
forall a. a -> a -> Bounded a
maxBound :: WeekDay
$cmaxBound :: WeekDay
minBound :: WeekDay
$cminBound :: WeekDay
Bounded, Typeable WeekDay
DataType
Constr
Typeable WeekDay
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WeekDay -> c WeekDay)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WeekDay)
-> (WeekDay -> Constr)
-> (WeekDay -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WeekDay))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WeekDay))
-> ((forall b. Data b => b -> b) -> WeekDay -> WeekDay)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WeekDay -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WeekDay -> r)
-> (forall u. (forall d. Data d => d -> u) -> WeekDay -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> WeekDay -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WeekDay -> m WeekDay)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WeekDay -> m WeekDay)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WeekDay -> m WeekDay)
-> Data WeekDay
WeekDay -> DataType
WeekDay -> Constr
(forall b. Data b => b -> b) -> WeekDay -> WeekDay
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WeekDay -> c WeekDay
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WeekDay
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WeekDay -> u
forall u. (forall d. Data d => d -> u) -> WeekDay -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WeekDay -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WeekDay -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WeekDay -> m WeekDay
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WeekDay -> m WeekDay
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WeekDay
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WeekDay -> c WeekDay
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WeekDay)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WeekDay)
$cSunday :: Constr
$cSaturday :: Constr
$cFriday :: Constr
$cThursday :: Constr
$cWednesday :: Constr
$cTuesday :: Constr
$cMonday :: Constr
$tWeekDay :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WeekDay -> m WeekDay
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WeekDay -> m WeekDay
gmapMp :: (forall d. Data d => d -> m d) -> WeekDay -> m WeekDay
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WeekDay -> m WeekDay
gmapM :: (forall d. Data d => d -> m d) -> WeekDay -> m WeekDay
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WeekDay -> m WeekDay
gmapQi :: Int -> (forall d. Data d => d -> u) -> WeekDay -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WeekDay -> u
gmapQ :: (forall d. Data d => d -> u) -> WeekDay -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WeekDay -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WeekDay -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WeekDay -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WeekDay -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WeekDay -> r
gmapT :: (forall b. Data b => b -> b) -> WeekDay -> WeekDay
$cgmapT :: (forall b. Data b => b -> b) -> WeekDay -> WeekDay
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WeekDay)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WeekDay)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WeekDay)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WeekDay)
dataTypeOf :: WeekDay -> DataType
$cdataTypeOf :: WeekDay -> DataType
toConstr :: WeekDay -> Constr
$ctoConstr :: WeekDay -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WeekDay
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WeekDay
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WeekDay -> c WeekDay
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WeekDay -> c WeekDay
$cp1Data :: Typeable WeekDay
Data, Typeable)

-- | Weekday as interval from Monday, so that
-- weekdayToInterval Monday == 0 and
-- weekdayToInterval Sunday == 6.
weekdayToInterval ∷ WeekDay → DateInterval
weekdayToInterval :: WeekDay -> DateInterval
weekdayToInterval WeekDay
wd = ℤ -> DateInterval
Days (Int -> ℤ
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ℤ) -> Int -> ℤ
forall a b. (a -> b) -> a -> b
$ WeekDay -> Int
forall a. Enum a => a -> Int
fromEnum WeekDay
wd)

-- | Number of weekday, with Monday == 1 and Sunday == 7.
weekdayNumber ∷ WeekDay → Int
weekdayNumber :: WeekDay -> Int
weekdayNumber WeekDay
wd = WeekDay -> Int
forall a. Enum a => a -> Int
fromEnum WeekDay
wd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Reverse for weekdayNumber
intToWeekday ∷ Int → WeekDay
intToWeekday :: Int -> WeekDay
intToWeekday Int
i = Int -> WeekDay
forall a. Enum a => Int -> a
toEnum (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

lastMonday ∷ DateTime → DateTime
lastMonday :: DateTime -> DateTime
lastMonday DateTime
dt = DateTime
dt DateTime -> DateInterval -> DateTime
`minusInterval` WeekDay -> DateInterval
weekdayToInterval (DateTime -> WeekDay
dateWeekDay DateTime
dt)

nextMonday ∷ DateTime → DateTime
nextMonday :: DateTime -> DateTime
nextMonday DateTime
dt = DateTime -> DateTime
lastMonday DateTime
dt DateTime -> DateInterval -> DateTime
`addInterval` ℤ -> DateInterval
Weeks ℤ
1

-- | Get current date and time.
getCurrentDateTime ∷  IO DateTime
getCurrentDateTime :: IO DateTime
getCurrentDateTime = do
  ZonedTime
zt ← IO ZonedTime
getZonedTime
  let lt :: LocalTime
lt = ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
zt
      ld :: Day
ld = LocalTime -> Day
localDay LocalTime
lt
      ltod :: TimeOfDay
ltod = LocalTime -> TimeOfDay
localTimeOfDay LocalTime
lt
      (ℤ
y,Int
m,Int
d) = Day -> (ℤ, Int, Int)
toGregorian Day
ld
      h :: Int
h = TimeOfDay -> Int
todHour TimeOfDay
ltod
      mins :: Int
mins = TimeOfDay -> Int
todMin TimeOfDay
ltod
      s :: Int
s = Pico -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Pico -> Int) -> Pico -> Int
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> Pico
todSec TimeOfDay
ltod
  DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> IO DateTime) -> DateTime -> IO DateTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> Int -> DateTime
DateTime (ℤ -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ℤ
y) Int
m Int
d Int
h Int
mins Int
s

-- | Get weekday of given date.
dateWeekDay ∷ DateTime → WeekDay
dateWeekDay :: DateTime -> WeekDay
dateWeekDay DateTime
dt =
  let (ℤ
_,Int
_,Int
wd) = Day -> (ℤ, Int, Int)
toWeekDate (DateTime -> Day
dateTimeToDay DateTime
dt)
  in  Int -> WeekDay
intToWeekday Int
wd

uppercase ∷ String → String
uppercase :: ShowS
uppercase = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper

isPrefixOfI ∷  String → String → Bool
String
p isPrefixOfI :: String -> String -> Bool
`isPrefixOfI` String
s = (ShowS
uppercase String
p) String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (ShowS
uppercase String
s)

lookupS ∷ String → [(String,a)] → Maybe a
lookupS :: String -> [(String, a)] -> Maybe a
lookupS String
_ [] = Maybe a
forall a. Maybe a
Nothing
lookupS String
k ((String
k',a
v):[(String, a)]
other) | String
k String -> String -> Bool
`isPrefixOfI` String
k' = a -> Maybe a
forall a. a -> Maybe a
Just a
v
                         | Bool
otherwise          = String -> [(String, a)] -> Maybe a
forall a. String -> [(String, a)] -> Maybe a
lookupS String
k [(String, a)]
other

monthsN ∷ [(String,Int)]
monthsN :: [(String, Int)]
monthsN = [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
months [Int
1..]

lookupMonth ∷ String → Maybe Int
lookupMonth :: String -> Maybe Int
lookupMonth String
n = String -> [(String, Int)] -> Maybe Int
forall a. String -> [(String, a)] -> Maybe a
lookupS String
n [(String, Int)]
monthsN

date ∷  Int → Int → Int → DateTime
date :: Int -> Int -> Int -> DateTime
date Int
y Int
m Int
d = Int -> Int -> Int -> Int -> Int -> Int -> DateTime
DateTime Int
y Int
m Int
d Int
0 Int
0 Int
0

addTime ∷  DateTime → Time → DateTime
addTime :: DateTime -> Time -> DateTime
addTime DateTime
dt Time
t = DateTime
dt {
                 hour :: Int
hour = Time -> Int
tHour Time
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DateTime -> Int
hour DateTime
dt,
                 minute :: Int
minute = Time -> Int
tMinute Time
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DateTime -> Int
minute DateTime
dt,
                 second :: Int
second = Time -> Int
tSecond Time
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DateTime -> Int
second DateTime
dt }

euroNumDate ∷ Stream s m Char => ParsecT s st m DateTime
euroNumDate :: ParsecT s st m DateTime
euroNumDate = do
  Int
d ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pDay
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  Int
m ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pMonth
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  Int
y ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pYear
  DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s st m DateTime)
-> DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DateTime
date Int
y Int
m Int
d

americanDate ∷ Stream s m Char => ParsecT s st m DateTime
americanDate :: ParsecT s st m DateTime
americanDate = do
  Int
y ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pYear
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
  Int
m ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pMonth
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
  Int
d ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pDay
  DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s st m DateTime)
-> DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DateTime
date Int
y Int
m Int
d

euroNumDate' ∷ Stream s m Char => Int → ParsecT s st m DateTime
euroNumDate' :: Int -> ParsecT s st m DateTime
euroNumDate' Int
year = do
  Int
d ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pDay
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  Int
m ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pMonth
  DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s st m DateTime)
-> DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DateTime
date Int
year Int
m Int
d

americanDate' ∷ Stream s m Char => Int → ParsecT s st m DateTime
americanDate' :: Int -> ParsecT s st m DateTime
americanDate' Int
year = do
  Int
m ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pMonth
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
  Int
d ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pDay
  DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s st m DateTime)
-> DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DateTime
date Int
year Int
m Int
d

strDate ∷ Stream s m Char => ParsecT s st m DateTime
strDate :: ParsecT s st m DateTime
strDate = do
  Int
d ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pDay
  ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  String
ms ← ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
  case String -> Maybe Int
lookupMonth String
ms of
    Maybe Int
Nothing → String -> ParsecT s st m DateTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT s st m DateTime)
-> String -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ String
"unknown month: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
ms
    Just Int
m  → do
      ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
      Int
y ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pYear
      ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT s st m Char -> ParsecT s st m ())
-> ParsecT s st m Char -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
      DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s st m DateTime)
-> DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DateTime
date Int
y Int
m Int
d

strDate' ∷ Stream s m Char => Int → ParsecT s st m DateTime
strDate' :: Int -> ParsecT s st m DateTime
strDate' Int
year = do
  Int
d ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
pDay
  ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  String
ms ← ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
  case String -> Maybe Int
lookupMonth String
ms of
    Maybe Int
Nothing → String -> ParsecT s st m DateTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT s st m DateTime)
-> String -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ String
"unknown month: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
ms
    Just Int
m  → DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s st m DateTime)
-> DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DateTime
date Int
year Int
m Int
d

time24 ∷ Stream s m Char => ParsecT s st m Time
time24 :: ParsecT s st m Time
time24 = do
  Int
h ← Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
2 Int
23
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  Int
m ← Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
2 Int
59
  Maybe Char
x ← ParsecT s st m Char -> ParsecT s st m (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT s st m Char -> ParsecT s st m (Maybe Char))
-> ParsecT s st m Char -> ParsecT s st m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  case Maybe Char
x of
    Maybe Char
Nothing → Time -> ParsecT s st m Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Time -> ParsecT s st m Time) -> Time -> ParsecT s st m Time
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Time
Time Int
h Int
m Int
0
    Just Char
_ → do
      Int
s ← Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
2 Int
59
      ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
      Time -> ParsecT s st m Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Time -> ParsecT s st m Time) -> Time -> ParsecT s st m Time
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Time
Time Int
h Int
m Int
s

ampm ∷ Stream s m Char => ParsecT s st m Int
ampm :: ParsecT s st m Int
ampm = do
  String
s ← ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
  case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
s of
    String
"AM" → Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    String
"PM" → Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
12
    String
_ → String -> ParsecT s st m Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"AM/PM expected"

time12 ∷ Stream s m Char => ParsecT s st m Time
time12 :: ParsecT s st m Time
time12 = do
  Int
h ← Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
2 Int
12
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  Int
m ← Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
2 Int
59
  Maybe Char
x ← ParsecT s st m Char -> ParsecT s st m (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT s st m Char -> ParsecT s st m (Maybe Char))
-> ParsecT s st m Char -> ParsecT s st m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  Int
s ← case Maybe Char
x of
            Maybe Char
Nothing → Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
            Just Char
_  → Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
2 Int
59
  ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  Int
hd ← ParsecT s st m Int
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Int
ampm
  Time -> ParsecT s st m Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Time -> ParsecT s st m Time) -> Time -> ParsecT s st m Time
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Time
Time (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hd) Int
m Int
s

pTime ∷ Stream s m Char => ParsecT s st m Time
pTime :: ParsecT s st m Time
pTime = [ParsecT s st m Time] -> ParsecT s st m Time
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT s st m Time] -> ParsecT s st m Time)
-> [ParsecT s st m Time] -> ParsecT s st m Time
forall a b. (a -> b) -> a -> b
$ (ParsecT s st m Time -> ParsecT s st m Time)
-> [ParsecT s st m Time] -> [ParsecT s st m Time]
forall a b. (a -> b) -> [a] -> [b]
map ParsecT s st m Time -> ParsecT s st m Time
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try [ParsecT s st m Time
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Time
time12, ParsecT s st m Time
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Time
time24]

pAbsDateTime ∷ Stream s m Char => Int → ParsecT s st m DateTime
pAbsDateTime :: Int -> ParsecT s st m DateTime
pAbsDateTime Int
year = do
  DateTime
date ← [ParsecT s st m DateTime] -> ParsecT s st m DateTime
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT s st m DateTime] -> ParsecT s st m DateTime)
-> [ParsecT s st m DateTime] -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ (ParsecT s st m DateTime -> ParsecT s st m DateTime)
-> [ParsecT s st m DateTime] -> [ParsecT s st m DateTime]
forall a b. (a -> b) -> [a] -> [b]
map ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([ParsecT s st m DateTime] -> [ParsecT s st m DateTime])
-> [ParsecT s st m DateTime] -> [ParsecT s st m DateTime]
forall a b. (a -> b) -> a -> b
$ ((Int -> ParsecT s st m DateTime) -> ParsecT s st m DateTime)
-> [Int -> ParsecT s st m DateTime] -> [ParsecT s st m DateTime]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> ParsecT s st m DateTime) -> Int -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int
year) ([Int -> ParsecT s st m DateTime] -> [ParsecT s st m DateTime])
-> [Int -> ParsecT s st m DateTime] -> [ParsecT s st m DateTime]
forall a b. (a -> b) -> a -> b
$ [
                              ParsecT s st m DateTime -> Int -> ParsecT s st m DateTime
forall a b. a -> b -> a
const ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateTime
euroNumDate,
                              ParsecT s st m DateTime -> Int -> ParsecT s st m DateTime
forall a b. a -> b -> a
const ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateTime
americanDate,
                              ParsecT s st m DateTime -> Int -> ParsecT s st m DateTime
forall a b. a -> b -> a
const ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateTime
strDate,
                              Int -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> ParsecT s st m DateTime
strDate',
                              Int -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> ParsecT s st m DateTime
euroNumDate',
                              Int -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> ParsecT s st m DateTime
americanDate']
  ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT s st m Char -> ParsecT s st m ())
-> ParsecT s st m Char -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
  Maybe Char
s ← ParsecT s st m Char -> ParsecT s st m (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  case Maybe Char
s of
    Maybe Char
Nothing → DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
date
    Just Char
_ → do
      Time
t ← ParsecT s st m Time
forall s (m :: * -> *) st. Stream s m Char => ParsecT s st m Time
pTime
      DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s st m DateTime)
-> DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime
date DateTime -> Time -> DateTime
`addTime` Time
t

pAbsDate ∷ Stream s m Char => Int → ParsecT s st m DateTime
pAbsDate :: Int -> ParsecT s st m DateTime
pAbsDate Int
year =
  [ParsecT s st m DateTime] -> ParsecT s st m DateTime
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT s st m DateTime] -> ParsecT s st m DateTime)
-> [ParsecT s st m DateTime] -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ (ParsecT s st m DateTime -> ParsecT s st m DateTime)
-> [ParsecT s st m DateTime] -> [ParsecT s st m DateTime]
forall a b. (a -> b) -> [a] -> [b]
map ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([ParsecT s st m DateTime] -> [ParsecT s st m DateTime])
-> [ParsecT s st m DateTime] -> [ParsecT s st m DateTime]
forall a b. (a -> b) -> a -> b
$ ((Int -> ParsecT s st m DateTime) -> ParsecT s st m DateTime)
-> [Int -> ParsecT s st m DateTime] -> [ParsecT s st m DateTime]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> ParsecT s st m DateTime) -> Int -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int
year) ([Int -> ParsecT s st m DateTime] -> [ParsecT s st m DateTime])
-> [Int -> ParsecT s st m DateTime] -> [ParsecT s st m DateTime]
forall a b. (a -> b) -> a -> b
$ [
                          ParsecT s st m DateTime -> Int -> ParsecT s st m DateTime
forall a b. a -> b -> a
const ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateTime
euroNumDate,
                          ParsecT s st m DateTime -> Int -> ParsecT s st m DateTime
forall a b. a -> b -> a
const ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateTime
americanDate,
                          ParsecT s st m DateTime -> Int -> ParsecT s st m DateTime
forall a b. a -> b -> a
const ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateTime
strDate,
                          Int -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> ParsecT s st m DateTime
strDate',
                          Int -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> ParsecT s st m DateTime
euroNumDate',
                          Int -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> ParsecT s st m DateTime
americanDate']

-- | Convert date from DateTime to Day
dateTimeToDay ∷  DateTime → Day
dateTimeToDay :: DateTime -> Day
dateTimeToDay DateTime
dt = ℤ -> Int -> Int -> Day
fromGregorian (Int -> ℤ
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ℤ) -> Int -> ℤ
forall a b. (a -> b) -> a -> b
$ DateTime -> Int
year DateTime
dt) (DateTime -> Int
month DateTime
dt) (DateTime -> Int
day DateTime
dt)

-- | Convert date from Day to DateTime
dayToDateTime ∷  Day → DateTime
dayToDateTime :: Day -> DateTime
dayToDateTime Day
dt = 
  let (ℤ
y,Int
m,Int
d) = Day -> (ℤ, Int, Int)
toGregorian Day
dt
  in  Int -> Int -> Int -> DateTime
date (ℤ -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ℤ
y) Int
m Int
d

-- | Modify DateTime with pure function on Day
modifyDate ∷  (t → Day → Day) → t → DateTime → DateTime
modifyDate :: (t -> Day -> Day) -> t -> DateTime -> DateTime
modifyDate t -> Day -> Day
fn t
x DateTime
dt =
  let date :: DateTime
date = Day -> DateTime
dayToDateTime (Day -> DateTime) -> Day -> DateTime
forall a b. (a -> b) -> a -> b
$ t -> Day -> Day
fn t
x (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ DateTime -> Day
dateTimeToDay DateTime
dt
  in  DateTime
date {hour :: Int
hour   = DateTime -> Int
hour   DateTime
dt,
            minute :: Int
minute = DateTime -> Int
minute DateTime
dt,
            second :: Int
second = DateTime -> Int
second DateTime
dt}

-- | Add date interval to DateTime
addInterval ∷  DateTime → DateInterval → DateTime
addInterval :: DateTime -> DateInterval -> DateTime
addInterval DateTime
dt (Days ℤ
ds) = (ℤ -> Day -> Day) -> ℤ -> DateTime -> DateTime
forall t. (t -> Day -> Day) -> t -> DateTime -> DateTime
modifyDate ℤ -> Day -> Day
addDays ℤ
ds DateTime
dt
addInterval DateTime
dt (Weeks ℤ
ws) = (ℤ -> Day -> Day) -> ℤ -> DateTime -> DateTime
forall t. (t -> Day -> Day) -> t -> DateTime -> DateTime
modifyDate ℤ -> Day -> Day
addDays (ℤ
wsℤ -> ℤ -> ℤ
forall a. Num a => a -> a -> a
*ℤ
7) DateTime
dt
addInterval DateTime
dt (Months ℤ
ms) = (ℤ -> Day -> Day) -> ℤ -> DateTime -> DateTime
forall t. (t -> Day -> Day) -> t -> DateTime -> DateTime
modifyDate ℤ -> Day -> Day
addGregorianMonthsClip ℤ
ms DateTime
dt
addInterval DateTime
dt (Years ℤ
ys) = (ℤ -> Day -> Day) -> ℤ -> DateTime -> DateTime
forall t. (t -> Day -> Day) -> t -> DateTime -> DateTime
modifyDate ℤ -> Day -> Day
addGregorianYearsClip ℤ
ys DateTime
dt

-- | Negate DateInterval value: Days 3 → Days (-3).
negateInterval ∷ DateInterval → DateInterval
negateInterval :: DateInterval -> DateInterval
negateInterval (Days ℤ
n)   = ℤ -> DateInterval
Days (ℤ -> ℤ
forall a. Num a => a -> a
negate ℤ
n)
negateInterval (Weeks ℤ
n)  = ℤ -> DateInterval
Weeks (ℤ -> ℤ
forall a. Num a => a -> a
negate ℤ
n)
negateInterval (Months ℤ
n) = ℤ -> DateInterval
Months (ℤ -> ℤ
forall a. Num a => a -> a
negate ℤ
n)
negateInterval (Years ℤ
n)  = ℤ -> DateInterval
Years (ℤ -> ℤ
forall a. Num a => a -> a
negate ℤ
n)

-- | Subtract DateInterval from DateTime.
minusInterval ∷ DateTime → DateInterval → DateTime
minusInterval :: DateTime -> DateInterval -> DateTime
minusInterval DateTime
date DateInterval
int = DateTime
date DateTime -> DateInterval -> DateTime
`addInterval` DateInterval -> DateInterval
negateInterval DateInterval
int

-- | Number of days between two dates
datesDifference ∷ DateTime → DateTime → Integer
datesDifference :: DateTime -> DateTime -> ℤ
datesDifference DateTime
d1 DateTime
d2 =
  ℤ -> ℤ
forall a. Num a => a -> a
abs (ℤ -> ℤ) -> ℤ -> ℤ
forall a b. (a -> b) -> a -> b
$ Day -> ℤ
toModifiedJulianDay (DateTime -> Day
dateTimeToDay DateTime
d1) ℤ -> ℤ -> ℤ
forall a. Num a => a -> a -> a
-
        Day -> ℤ
toModifiedJulianDay (DateTime -> Day
dateTimeToDay DateTime
d2)

maybePlural ∷ Stream s m Char => String → ParsecT s st m String
maybePlural :: String -> ParsecT s st m String
maybePlural String
str = do
  String
r ← String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
str
  ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT s st m Char -> ParsecT s st m ())
-> ParsecT s st m Char -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
's'
  String -> ParsecT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
capitalize String
r)

pDateIntervalType ∷ Stream s m Char => ParsecT s st m DateIntervalType
pDateIntervalType :: ParsecT s st m DateIntervalType
pDateIntervalType = do
  String
s ← [ParsecT s st m String] -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT s st m String] -> ParsecT s st m String)
-> [ParsecT s st m String] -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ (String -> ParsecT s st m String)
-> [String] -> [ParsecT s st m String]
forall a b. (a -> b) -> [a] -> [b]
map String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
maybePlural [String
"day", String
"week", String
"month", String
"year"]
  case Char -> Char
toLower (String -> Char
forall a. [a] -> a
head String
s) of
    Char
'd' → DateIntervalType -> ParsecT s st m DateIntervalType
forall (m :: * -> *) a. Monad m => a -> m a
return DateIntervalType
Day
    Char
'w' → DateIntervalType -> ParsecT s st m DateIntervalType
forall (m :: * -> *) a. Monad m => a -> m a
return DateIntervalType
Week
    Char
'm' → DateIntervalType -> ParsecT s st m DateIntervalType
forall (m :: * -> *) a. Monad m => a -> m a
return DateIntervalType
Month
    Char
'y' → DateIntervalType -> ParsecT s st m DateIntervalType
forall (m :: * -> *) a. Monad m => a -> m a
return DateIntervalType
Year
    Char
_ → String -> ParsecT s st m DateIntervalType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT s st m DateIntervalType)
-> String -> ParsecT s st m DateIntervalType
forall a b. (a -> b) -> a -> b
$ String
"Unknown date interval type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

pDateInterval ∷ Stream s m Char => ParsecT s st m DateInterval
pDateInterval :: ParsecT s st m DateInterval
pDateInterval = do
  String
n ← ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  ParsecT s st m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  DateIntervalType
tp ← ParsecT s st m DateIntervalType
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateIntervalType
pDateIntervalType
  case DateIntervalType
tp of
    DateIntervalType
Day →   ℤ -> DateInterval
Days   (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Week →  ℤ -> DateInterval
Weeks  (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Month → ℤ -> DateInterval
Months (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Year →  ℤ -> DateInterval
Years  (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n

pRelDate ∷ Stream s m Char => DateTime → ParsecT s st m DateTime
pRelDate :: DateTime -> ParsecT s st m DateTime
pRelDate DateTime
date = do
  DateInterval
offs ← ParsecT s st m DateInterval -> ParsecT s st m DateInterval
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m DateInterval
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateInterval
futureDate
     ParsecT s st m DateInterval
-> ParsecT s st m DateInterval -> ParsecT s st m DateInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m DateInterval -> ParsecT s st m DateInterval
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m DateInterval
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateInterval
passDate
     ParsecT s st m DateInterval
-> ParsecT s st m DateInterval -> ParsecT s st m DateInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m DateInterval -> ParsecT s st m DateInterval
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m DateInterval
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateInterval
today
     ParsecT s st m DateInterval
-> ParsecT s st m DateInterval -> ParsecT s st m DateInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m DateInterval -> ParsecT s st m DateInterval
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m DateInterval
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateInterval
tomorrow
     ParsecT s st m DateInterval
-> ParsecT s st m DateInterval -> ParsecT s st m DateInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m DateInterval
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateInterval
yesterday
  DateTime -> ParsecT s st m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s st m DateTime)
-> DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime
date DateTime -> DateInterval -> DateTime
`addInterval` DateInterval
offs

lastDate ∷ Stream s m Char => DateTime → ParsecT s st m DateTime
lastDate :: DateTime -> ParsecT s st m DateTime
lastDate DateTime
now = do
    String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"last"
    ParsecT s st m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m DateTime
forall u. ParsecT s u m DateTime
byweek ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m DateTime
forall u. ParsecT s u m DateTime
bymonth ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m DateTime
forall u. ParsecT s u m DateTime
byyear
  where
    byweek :: ParsecT s u m DateTime
byweek = do
      WeekDay
wd ← ParsecT s u m WeekDay -> ParsecT s u m WeekDay
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"week" ParsecT s u m String
-> ParsecT s u m WeekDay -> ParsecT s u m WeekDay
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WeekDay -> ParsecT s u m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Monday) ParsecT s u m WeekDay
-> ParsecT s u m WeekDay -> ParsecT s u m WeekDay
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m WeekDay
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m WeekDay
pWeekDay
      let monday :: DateTime
monday = DateTime -> DateTime
lastMonday DateTime
now
          monday' :: DateTime
monday' = if WeekDay
wd WeekDay -> WeekDay -> Bool
forall a. Ord a => a -> a -> Bool
> DateTime -> WeekDay
dateWeekDay DateTime
now
                      then DateTime
monday DateTime -> DateInterval -> DateTime
`minusInterval` ℤ -> DateInterval
Weeks ℤ
1
                      else DateTime
monday
      DateTime -> ParsecT s u m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s u m DateTime)
-> DateTime -> ParsecT s u m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime
monday' DateTime -> DateInterval -> DateTime
`addInterval` WeekDay -> DateInterval
weekdayToInterval WeekDay
wd

    bymonth :: ParsecT s u m DateTime
bymonth = do
      String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"month"
      DateTime -> ParsecT s u m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s u m DateTime)
-> DateTime -> ParsecT s u m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime
now {day :: Int
day = Int
1}

    byyear :: ParsecT s u m DateTime
byyear = do
      String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"year"
      DateTime -> ParsecT s u m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s u m DateTime)
-> DateTime -> ParsecT s u m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime
now {month :: Int
month = Int
1, day :: Int
day = Int
1}

nextDate ∷ Stream s m Char => DateTime → ParsecT s st m DateTime
nextDate :: DateTime -> ParsecT s st m DateTime
nextDate DateTime
now = do
    String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"next"
    ParsecT s st m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m DateTime
forall u. ParsecT s u m DateTime
byweek ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m DateTime
forall u. ParsecT s u m DateTime
bymonth ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m DateTime
forall u. ParsecT s u m DateTime
byyear
  where
    byweek :: ParsecT s u m DateTime
byweek = do
      WeekDay
wd ← ParsecT s u m WeekDay -> ParsecT s u m WeekDay
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"week" ParsecT s u m String
-> ParsecT s u m WeekDay -> ParsecT s u m WeekDay
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WeekDay -> ParsecT s u m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Monday) ParsecT s u m WeekDay
-> ParsecT s u m WeekDay -> ParsecT s u m WeekDay
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m WeekDay
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m WeekDay
pWeekDay
      let monday :: DateTime
monday = DateTime -> DateTime
nextMonday DateTime
now
          monday' :: DateTime
monday' = if WeekDay
wd WeekDay -> WeekDay -> Bool
forall a. Ord a => a -> a -> Bool
> DateTime -> WeekDay
dateWeekDay DateTime
now
                      then DateTime
monday DateTime -> DateInterval -> DateTime
`minusInterval` ℤ -> DateInterval
Weeks ℤ
1
                      else DateTime
monday
      DateTime -> ParsecT s u m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ParsecT s u m DateTime)
-> DateTime -> ParsecT s u m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime
monday' DateTime -> DateInterval -> DateTime
`addInterval` WeekDay -> DateInterval
weekdayToInterval WeekDay
wd

    bymonth :: ParsecT s u m DateTime
bymonth = do
      String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"month"
      DateTime -> ParsecT s u m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime
now DateTime -> DateInterval -> DateTime
`addInterval` ℤ -> DateInterval
Months ℤ
1) {day :: Int
day = Int
1}

    byyear :: ParsecT s u m DateTime
byyear = do
      String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"year"
      DateTime -> ParsecT s u m DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime
now DateTime -> DateInterval -> DateTime
`addInterval` ℤ -> DateInterval
Years ℤ
1) {month :: Int
month = Int
1, day :: Int
day = Int
1}

pWeekDay ∷ Stream s m Char => ParsecT s st m WeekDay
pWeekDay :: ParsecT s st m WeekDay
pWeekDay = do
  String
w ← ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"mondaytueswnhrfi")
  case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
w of
    String
"monday"    → WeekDay -> ParsecT s st m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Monday
    String
"tuesday"   → WeekDay -> ParsecT s st m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Tuesday
    String
"wednesday" → WeekDay -> ParsecT s st m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Wednesday
    String
"thursday"  → WeekDay -> ParsecT s st m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Thursday
    String
"friday"    → WeekDay -> ParsecT s st m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Friday
    String
"saturday"  → WeekDay -> ParsecT s st m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Saturday
    String
"sunday"    → WeekDay -> ParsecT s st m WeekDay
forall (m :: * -> *) a. Monad m => a -> m a
return WeekDay
Sunday
    String
_           → String -> ParsecT s st m WeekDay
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT s st m WeekDay)
-> String -> ParsecT s st m WeekDay
forall a b. (a -> b) -> a -> b
$ String
"Unknown weekday: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
w

futureDate ∷ Stream s m Char => ParsecT s st m DateInterval
futureDate :: ParsecT s st m DateInterval
futureDate = do
  String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"in "
  String
n ← ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
  DateIntervalType
tp ← ParsecT s st m DateIntervalType
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateIntervalType
pDateIntervalType
  case DateIntervalType
tp of
    DateIntervalType
Day →   ℤ -> DateInterval
Days   (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Week →  ℤ -> DateInterval
Weeks  (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Month → ℤ -> DateInterval
Months (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Year →  ℤ -> DateInterval
Years  (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n

passDate ∷ Stream s m Char => ParsecT s st m DateInterval
passDate :: ParsecT s st m DateInterval
passDate = do
  String
n ← ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
  DateIntervalType
tp ← ParsecT s st m DateIntervalType
forall s (m :: * -> *) st.
Stream s m Char =>
ParsecT s st m DateIntervalType
pDateIntervalType
  String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
" ago"
  case DateIntervalType
tp of
    DateIntervalType
Day →   (ℤ -> DateInterval
Days   (ℤ -> DateInterval) -> (ℤ -> ℤ) -> ℤ -> DateInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℤ -> ℤ
forall a. Num a => a -> a
negate) (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Week →  (ℤ -> DateInterval
Weeks  (ℤ -> DateInterval) -> (ℤ -> ℤ) -> ℤ -> DateInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℤ -> ℤ
forall a. Num a => a -> a
negate) (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Month → (ℤ -> DateInterval
Months (ℤ -> DateInterval) -> (ℤ -> ℤ) -> ℤ -> DateInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℤ -> ℤ
forall a. Num a => a -> a
negate) (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n
    DateIntervalType
Year →  (ℤ -> DateInterval
Years  (ℤ -> DateInterval) -> (ℤ -> ℤ) -> ℤ -> DateInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℤ -> ℤ
forall a. Num a => a -> a
negate) (ℤ -> DateInterval)
-> ParsecT s st m ℤ -> ParsecT s st m DateInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> ParsecT s st m ℤ
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt String
n

today ∷ Stream s m Char => ParsecT s st m DateInterval
today :: ParsecT s st m DateInterval
today = do
  String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"today" ParsecT s st m String
-> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"now"
  DateInterval -> ParsecT s st m DateInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (DateInterval -> ParsecT s st m DateInterval)
-> DateInterval -> ParsecT s st m DateInterval
forall a b. (a -> b) -> a -> b
$ ℤ -> DateInterval
Days ℤ
0

tomorrow ∷ Stream s m Char => ParsecT s st m DateInterval
tomorrow :: ParsecT s st m DateInterval
tomorrow = do
  String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"tomorrow"
  DateInterval -> ParsecT s st m DateInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (DateInterval -> ParsecT s st m DateInterval)
-> DateInterval -> ParsecT s st m DateInterval
forall a b. (a -> b) -> a -> b
$ ℤ -> DateInterval
Days ℤ
1

yesterday ∷ Stream s m Char => ParsecT s st m DateInterval
yesterday :: ParsecT s st m DateInterval
yesterday = do
  String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"yesterday"
  DateInterval -> ParsecT s st m DateInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (DateInterval -> ParsecT s st m DateInterval)
-> DateInterval -> ParsecT s st m DateInterval
forall a b. (a -> b) -> a -> b
$ ℤ -> DateInterval
Days (-ℤ
1)

pByWeek ∷ Stream s m Char => DateTime → ParsecT s st m DateTime
pByWeek :: DateTime -> ParsecT s st m DateTime
pByWeek DateTime
date =
  ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (DateTime -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
DateTime -> ParsecT s st m DateTime
lastDate DateTime
date) ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> DateTime -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
DateTime -> ParsecT s st m DateTime
nextDate DateTime
date

-- | Parsec parser for DateTime.
pDateTime ∷ Stream s m Char => DateTime       -- ^ Current date / time, to use as base for relative dates
          → ParsecT s st m DateTime
pDateTime :: DateTime -> ParsecT s st m DateTime
pDateTime DateTime
date =
      (ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m DateTime -> ParsecT s st m DateTime)
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
DateTime -> ParsecT s st m DateTime
pRelDate DateTime
date)
  ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m DateTime -> ParsecT s st m DateTime)
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
DateTime -> ParsecT s st m DateTime
pByWeek DateTime
date)
  ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m DateTime -> ParsecT s st m DateTime)
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> ParsecT s st m DateTime
pAbsDateTime (Int -> ParsecT s st m DateTime) -> Int -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime -> Int
year DateTime
date)

-- | Parsec parser for Date only.
pDate ∷ Stream s m Char => DateTime       -- ^ Current date / time, to use as base for relative dates
          → ParsecT s st m DateTime
pDate :: DateTime -> ParsecT s st m DateTime
pDate DateTime
date =
      (ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m DateTime -> ParsecT s st m DateTime)
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
DateTime -> ParsecT s st m DateTime
pRelDate DateTime
date)
  ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m DateTime -> ParsecT s st m DateTime)
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
DateTime -> ParsecT s st m DateTime
pByWeek DateTime
date)
  ParsecT s st m DateTime
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s st m DateTime -> ParsecT s st m DateTime
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m DateTime -> ParsecT s st m DateTime)
-> ParsecT s st m DateTime -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ Int -> ParsecT s st m DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> ParsecT s st m DateTime
pAbsDate (Int -> ParsecT s st m DateTime) -> Int -> ParsecT s st m DateTime
forall a b. (a -> b) -> a -> b
$ DateTime -> Int
year DateTime
date)

-- | Parse date
parseDate ∷ DateTime  -- ^ Current date / time, to use as base for relative dates
          → String    -- ^ String to parse
          → Either ParseError DateTime
parseDate :: DateTime -> String -> Either ParseError DateTime
parseDate DateTime
date String
s = Parsec String () DateTime
-> () -> String -> String -> Either ParseError DateTime
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser (DateTime -> Parsec String () DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
DateTime -> ParsecT s st m DateTime
pDate DateTime
date) () String
"" String
s

-- | Parse date and time
parseDateTime ∷ DateTime  -- ^ Current date / time, to use as base for relative dates
          → String    -- ^ String to parse
          → Either ParseError DateTime
parseDateTime :: DateTime -> String -> Either ParseError DateTime
parseDateTime DateTime
date String
s = Parsec String () DateTime
-> () -> String -> String -> Either ParseError DateTime
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser (DateTime -> Parsec String () DateTime
forall s (m :: * -> *) st.
Stream s m Char =>
DateTime -> ParsecT s st m DateTime
pDateTime DateTime
date) () String
"" String
s