module Darcs.Util.IsoDate
( getIsoDateTime, readUTCDate, readUTCDateOldFashioned
, parseDate, getLocalTz
, englishDateTime, englishInterval, englishLast
, iso8601Interval, iso8601Duration
, cleanLocalDate, resetCalendar
, MCalendarTime(..), subtractFromMCal, addToMCal
, toMCalendarTime, unsafeToCalendarTime
, unsetTime, TimeInterval
, showIsoDateTime
) where
import Prelude ( (^) )
import Darcs.Prelude
import Text.ParserCombinators.Parsec
import System.Time
import System.IO.Unsafe ( unsafePerformIO )
import Data.Char ( toUpper, isDigit )
import Data.Maybe ( fromMaybe )
import Control.Monad ( liftM, liftM2 )
import qualified Data.ByteString.Char8 as BC
type TimeInterval = (Maybe CalendarTime, Maybe CalendarTime)
readUTCDate :: String -> CalendarTime
readUTCDate :: String -> CalendarTime
readUTCDate = Int -> String -> CalendarTime
readDate 0
cleanLocalDate :: String -> IO String
cleanLocalDate :: String -> IO String
cleanLocalDate str :: String
str =
do Int
tz <- IO Int
getLocalTz
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> (String -> String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> String
showIsoDateTime (CalendarTime -> String)
-> (String -> CalendarTime) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime)
-> (String -> CalendarTime) -> String -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> CalendarTime
readDate Int
tz (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
str
getLocalTz :: IO Int
getLocalTz :: IO Int
getLocalTz = CalendarTime -> Int
ctTZ (CalendarTime -> Int) -> IO CalendarTime -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (IO ClockTime
getClockTime IO ClockTime -> (ClockTime -> IO CalendarTime) -> IO CalendarTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ClockTime -> IO CalendarTime
toCalendarTime)
readDate :: Int -> String -> CalendarTime
readDate :: Int -> String -> CalendarTime
readDate tz :: Int
tz d :: String
d =
case Int -> String -> Either ParseError MCalendarTime
parseDate Int
tz String
d of
Left e :: ParseError
e -> String -> CalendarTime
forall a. HasCallStack => String -> a
error (String -> CalendarTime) -> String -> CalendarTime
forall a b. (a -> b) -> a -> b
$ "bad date: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
dString -> String -> String
forall a. [a] -> [a] -> [a]
++" - "String -> String -> String
forall a. [a] -> [a] -> [a]
++ParseError -> String
forall a. Show a => a -> String
show ParseError
e
Right ct :: MCalendarTime
ct -> CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime) -> CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
ct
readUTCDateOldFashioned :: String -> CalendarTime
readUTCDateOldFashioned :: String -> CalendarTime
readUTCDateOldFashioned d :: String
d =
case Int -> String -> Either ParseError MCalendarTime
parseDate 0 String
d of
Left e :: ParseError
e -> String -> CalendarTime
forall a. HasCallStack => String -> a
error (String -> CalendarTime) -> String -> CalendarTime
forall a b. (a -> b) -> a -> b
$ "bad date: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
dString -> String -> String
forall a. [a] -> [a] -> [a]
++" - "String -> String -> String
forall a. [a] -> [a] -> [a]
++ParseError -> String
forall a. Show a => a -> String
show ParseError
e
Right ct :: MCalendarTime
ct -> (MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
ct) { ctTZ :: Int
ctTZ = 0 }
parseDate :: Int -> String -> Either ParseError MCalendarTime
parseDate :: Int -> String -> Either ParseError MCalendarTime
parseDate tz :: Int
tz d :: String
d =
if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 14 Bool -> Bool -> Bool
&& (Char -> Bool) -> ByteString -> Bool
BC.all Char -> Bool
isDigit ByteString
bd
then MCalendarTime -> Either ParseError MCalendarTime
forall a b. b -> Either a b
Right (MCalendarTime -> Either ParseError MCalendarTime)
-> MCalendarTime -> Either ParseError MCalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime -> MCalendarTime) -> CalendarTime -> MCalendarTime
forall a b. (a -> b) -> a -> b
$
Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 4 ByteString
bd)
(Int -> Month
forall a. Enum a => Int -> a
toEnum (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (-1)) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 4 ByteString
bd)
(ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 6 ByteString
bd)
(ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 8 ByteString
bd)
(ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 10 ByteString
bd)
(ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 12 ByteString
bd)
0 Day
Sunday 0
"GMT" 0 Bool
False
else let dt :: ParsecT String a Identity MCalendarTime
dt = do { MCalendarTime
x <- Int -> ParsecT String a Identity MCalendarTime
forall a. Int -> CharParser a MCalendarTime
dateTime Int
tz; ParsecT String a Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof; MCalendarTime -> ParsecT String a Identity MCalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return MCalendarTime
x }
in Parsec String () MCalendarTime
-> String -> String -> Either ParseError MCalendarTime
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
dt "" String
d
where bd :: ByteString
bd = String -> ByteString
BC.pack (Int -> String -> String
forall a. Int -> [a] -> [a]
take 14 String
d)
readI :: ByteString -> Int
readI s :: ByteString
s = (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int) -> (Int, ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ (Int, ByteString) -> Maybe (Int, ByteString) -> (Int, ByteString)
forall a. a -> Maybe a -> a
fromMaybe (String -> (Int, ByteString)
forall a. HasCallStack => String -> a
error "parseDate: invalid date") (ByteString -> Maybe (Int, ByteString)
BC.readInt ByteString
s)
showIsoDateTime :: CalendarTime -> String
showIsoDateTime :: CalendarTime -> String
showIsoDateTime ct :: CalendarTime
ct = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctYear CalendarTime
ct
, String -> String
twoDigit (String -> String) -> (Month -> String) -> Month -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Month -> Int) -> Month -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Int -> Int) -> (Month -> Int) -> Month -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month -> Int
forall a. Enum a => a -> Int
fromEnum (Month -> String) -> Month -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Month
ctMonth CalendarTime
ct
, String -> String
twoDigit (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctDay CalendarTime
ct
, String -> String
twoDigit (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctHour CalendarTime
ct
, String -> String
twoDigit (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctMin CalendarTime
ct
, String -> String
twoDigit (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctSec CalendarTime
ct
]
where twoDigit :: String -> String
twoDigit [] = String
forall a. HasCallStack => a
undefined
twoDigit x :: String
x@(_:[]) = '0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
x
twoDigit x :: String
x@(_:_:[]) = String
x
twoDigit _ = String
forall a. HasCallStack => a
undefined
getIsoDateTime :: IO String
getIsoDateTime :: IO String
getIsoDateTime = (CalendarTime -> String
showIsoDateTime (CalendarTime -> String)
-> (ClockTime -> CalendarTime) -> ClockTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockTime -> CalendarTime
toUTCTime) (ClockTime -> String) -> IO ClockTime -> IO String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO ClockTime
getClockTime
caseChar :: Char -> GenParser Char a Char
caseChar :: Char -> GenParser Char a Char
caseChar c :: Char
c = (Char -> Bool) -> GenParser Char a Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\x :: Char
x -> Char -> Char
toUpper Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
c)
caseString :: String -> GenParser Char a ()
caseString :: String -> GenParser Char a ()
caseString cs :: String
cs = (Char -> ParsecT String a Identity Char)
-> String -> GenParser Char a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> ParsecT String a Identity Char
forall a. Char -> GenParser Char a Char
caseChar String
cs GenParser Char a () -> String -> GenParser Char a ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
cs
caseStrings :: [String] -> GenParser Char a ()
caseStrings :: [String] -> GenParser Char a ()
caseStrings xs :: [String]
xs = (GenParser Char a () -> GenParser Char a () -> GenParser Char a ())
-> [GenParser Char a ()] -> GenParser Char a ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 GenParser Char a () -> GenParser Char a () -> GenParser Char a ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) ([GenParser Char a ()] -> GenParser Char a ())
-> [GenParser Char a ()] -> GenParser Char a ()
forall a b. (a -> b) -> a -> b
$ (String -> GenParser Char a ())
-> [String] -> [GenParser Char a ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString [String]
xs
manyN :: Int -> GenParser a b c -> GenParser a b [c]
manyN :: Int -> GenParser a b c -> GenParser a b [c]
manyN n :: Int
n p :: GenParser a b c
p
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [c] -> GenParser a b [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = ([c] -> [c] -> [c])
-> GenParser a b [c] -> GenParser a b [c] -> GenParser a b [c]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
(++) (Int -> GenParser a b c -> GenParser a b [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n GenParser a b c
p) (GenParser a b c -> GenParser a b [c]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many GenParser a b c
p)
manyNtoM :: Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM :: Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM n :: Int
n m :: Int
m p :: GenParser a b c
p
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = [c] -> GenParser a b [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m = [c] -> GenParser a b [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m = Int -> GenParser a b c -> GenParser a b [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n GenParser a b c
p
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = (Int -> GenParser a b [c] -> GenParser a b [c])
-> GenParser a b [c] -> [Int] -> GenParser a b [c]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (GenParser a b [c] -> GenParser a b [c] -> GenParser a b [c]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) (GenParser a b [c] -> GenParser a b [c] -> GenParser a b [c])
-> (Int -> GenParser a b [c])
-> Int
-> GenParser a b [c]
-> GenParser a b [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\x :: Int
x -> GenParser a b [c] -> GenParser a b [c]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser a b [c] -> GenParser a b [c])
-> GenParser a b [c] -> GenParser a b [c]
forall a b. (a -> b) -> a -> b
$ Int -> GenParser a b c -> GenParser a b [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
x GenParser a b c
p)) ([c] -> GenParser a b [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [1..Int
m])
| Bool
otherwise = ([c] -> [c] -> [c])
-> GenParser a b [c] -> GenParser a b [c] -> GenParser a b [c]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
(++) (Int -> GenParser a b c -> GenParser a b [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n GenParser a b c
p) (Int -> Int -> GenParser a b c -> GenParser a b [c]
forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM 0 (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) GenParser a b c
p)
dateTime :: Int -> CharParser a MCalendarTime
dateTime :: Int -> CharParser a MCalendarTime
dateTime tz :: Int
tz =
[CharParser a MCalendarTime] -> CharParser a MCalendarTime
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [CharParser a MCalendarTime -> CharParser a MCalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a MCalendarTime -> CharParser a MCalendarTime)
-> CharParser a MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime -> MCalendarTime)
-> ParsecT String a Identity CalendarTime
-> CharParser a MCalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT String a Identity CalendarTime
forall a. Int -> CharParser a CalendarTime
cvsDateTime Int
tz,
CharParser a MCalendarTime -> CharParser a MCalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a MCalendarTime -> CharParser a MCalendarTime)
-> CharParser a MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ Int -> CharParser a MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime Int
tz,
CharParser a MCalendarTime -> CharParser a MCalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a MCalendarTime -> CharParser a MCalendarTime)
-> CharParser a MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime -> MCalendarTime)
-> ParsecT String a Identity CalendarTime
-> CharParser a MCalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT String a Identity CalendarTime
forall a. CharParser a CalendarTime
oldDateTime,
CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime -> MCalendarTime)
-> ParsecT String a Identity CalendarTime
-> CharParser a MCalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT String a Identity CalendarTime
forall a. CharParser a CalendarTime
rfc2822DateTime]
parseDHMS :: CharParser a (Int, Int, Int, Int)
parseDHMS :: CharParser a (Int, Int, Int, Int)
parseDHMS = do
Int
d <- CharParser a Int
forall a. CharParser a Int
day
String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
(h :: Int
h, m :: Int
m, s :: Int
s) <- CharParser a (Int, Int, Int)
forall a. CharParser a (Int, Int, Int)
parseHMS
(Int, Int, Int, Int) -> CharParser a (Int, Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
d, Int
h, Int
m, Int
s)
parseHMS :: CharParser a (Int, Int, Int)
parseHMS :: CharParser a (Int, Int, Int)
parseHMS = do
Int
h <- CharParser a Int
forall a. CharParser a Int
hour
Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'
Int
m <- CharParser a Int
forall a. CharParser a Int
minute
Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'
Int
s <- CharParser a Int
forall a. CharParser a Int
second
(Int, Int, Int) -> CharParser a (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
h, Int
m, Int
s)
parseSpacesMonthName :: CharParser a Month
parseSpacesMonthName :: CharParser a Month
parseSpacesMonthName = do
String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
Month
mon <- CharParser a Month
forall a. CharParser a Month
monthName
String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
mon
cvsDateTime :: Int -> CharParser a CalendarTime
cvsDateTime :: Int -> CharParser a CalendarTime
cvsDateTime tz :: Int
tz =
do Int
y <- CharParser a Int
forall a. CharParser a Int
year
Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'
Month
mon <- CharParser a Month
forall a. CharParser a Month
monthNum
Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'
(d :: Int
d, h :: Int
h, m :: Int
m, s :: Int
s) <- CharParser a (Int, Int, Int, Int)
forall a. CharParser a (Int, Int, Int, Int)
parseDHMS
Int
z <- Int -> CharParser a Int -> CharParser a Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
tz (CharParser a Int -> CharParser a Int)
-> CharParser a Int -> CharParser a Int
forall a b. (a -> b) -> a -> b
$ CharParser a String
forall a. CharParser a String
mySpaces CharParser a String -> CharParser a Int -> CharParser a Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser a Int
forall a. CharParser a Int
zone
CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime Int
y Month
mon Int
d Int
h Int
m Int
s 0 Day
Monday 0 "" Int
z Bool
False)
oldDateTime :: CharParser a CalendarTime
oldDateTime :: CharParser a CalendarTime
oldDateTime = do Day
wd <- CharParser a Day
forall a. CharParser a Day
dayName
Month
mon <- CharParser a Month
forall a. CharParser a Month
parseSpacesMonthName
(d :: Int
d, h :: Int
h, m :: Int
m , s :: Int
s) <- CharParser a (Int, Int, Int, Int)
forall a. CharParser a (Int, Int, Int, Int)
parseDHMS
String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
Int
z <- CharParser a Int
forall a. CharParser a Int
zone
String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
Int
y <- CharParser a Int
forall a. CharParser a Int
year
CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime Int
y Month
mon Int
d Int
h Int
m Int
s 0 Day
wd 0 "" Int
z Bool
False)
rfc2822DateTime :: CharParser a CalendarTime
rfc2822DateTime :: CharParser a CalendarTime
rfc2822DateTime = do Day
wd <- CharParser a Day
forall a. CharParser a Day
dayName
Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ','
String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
Int
d <- CharParser a Int
forall a. CharParser a Int
day
Month
mon <- CharParser a Month
forall a. CharParser a Month
parseSpacesMonthName
Int
y <- CharParser a Int
forall a. CharParser a Int
year
String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
(h :: Int
h, m :: Int
m, s :: Int
s) <- CharParser a (Int, Int, Int)
forall a. CharParser a (Int, Int, Int)
parseHMS
String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
Int
z <- CharParser a Int
forall a. CharParser a Int
zone
CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime Int
y Month
mon Int
d Int
h Int
m Int
s 0 Day
wd 0 "" Int
z Bool
False)
iso8601DateTime :: Int -> CharParser a MCalendarTime
iso8601DateTime :: Int -> CharParser a MCalendarTime
iso8601DateTime localTz :: Int
localTz = CharParser a MCalendarTime -> CharParser a MCalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a MCalendarTime -> CharParser a MCalendarTime)
-> CharParser a MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$
do MCalendarTime
d <- CharParser a MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
iso8601Date
MCalendarTime -> MCalendarTime
t <- (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option MCalendarTime -> MCalendarTime
forall a. a -> a
id (ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do ParsecT String a Identity Char -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String a Identity Char -> ParsecT String a Identity ())
-> ParsecT String a Identity Char -> ParsecT String a Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf " T"
ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time
MCalendarTime -> CharParser a MCalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (MCalendarTime -> CharParser a MCalendarTime)
-> MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> MCalendarTime
t (MCalendarTime -> MCalendarTime) -> MCalendarTime -> MCalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime
d { mctTZ :: Maybe Int
mctTZ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
localTz }
iso8601Date :: CharParser a MCalendarTime
iso8601Date :: CharParser a MCalendarTime
iso8601Date =
do [MCalendarTime -> MCalendarTime]
d <- GenParser Char a [MCalendarTime -> MCalendarTime]
forall st. GenParser Char st [MCalendarTime -> MCalendarTime]
calendar_date GenParser Char a [MCalendarTime -> MCalendarTime]
-> GenParser Char a [MCalendarTime -> MCalendarTime]
-> GenParser Char a [MCalendarTime -> MCalendarTime]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a [MCalendarTime -> MCalendarTime]
forall st. GenParser Char st [MCalendarTime -> MCalendarTime]
week_date GenParser Char a [MCalendarTime -> MCalendarTime]
-> GenParser Char a [MCalendarTime -> MCalendarTime]
-> GenParser Char a [MCalendarTime -> MCalendarTime]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a [MCalendarTime -> MCalendarTime]
forall st. GenParser Char st [MCalendarTime -> MCalendarTime]
ordinal_date
MCalendarTime -> CharParser a MCalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (MCalendarTime -> CharParser a MCalendarTime)
-> MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ ((MCalendarTime -> MCalendarTime)
-> MCalendarTime -> MCalendarTime)
-> MCalendarTime
-> [MCalendarTime -> MCalendarTime]
-> MCalendarTime
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (MCalendarTime -> MCalendarTime) -> MCalendarTime -> MCalendarTime
forall a b. (a -> b) -> a -> b
($) MCalendarTime
nullMCalendar [MCalendarTime -> MCalendarTime]
d
where
calendar_date :: GenParser Char st [MCalendarTime -> MCalendarTime]
calendar_date =
GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime])
-> GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall a b. (a -> b) -> a -> b
$ do [MCalendarTime -> MCalendarTime]
d <- CharParser st (MCalendarTime -> MCalendarTime)
-> [(CharParser st Char,
CharParser st (MCalendarTime -> MCalendarTime))]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain CharParser st (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
year_ [ (CharParser st Char
forall u. ParsecT String u Identity Char
dash, CharParser st (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
month_), (CharParser st Char
forall u. ParsecT String u Identity Char
dash, CharParser st (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
day_) ]
CharParser st Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (CharParser st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit CharParser st Char -> CharParser st Char -> CharParser st Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'W')
[MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall (m :: * -> *) a. Monad m => a -> m a
return [MCalendarTime -> MCalendarTime]
d
week_date :: GenParser Char st [MCalendarTime -> MCalendarTime]
week_date =
GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime])
-> GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall a b. (a -> b) -> a -> b
$ do MCalendarTime -> MCalendarTime
yfn <- GenParser Char st (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
year_
ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String st Identity Char
forall u. ParsecT String u Identity Char
dash
Char
_ <- Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'W'
Int
w' <- (\x :: Int
x -> Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (Int -> Int)
-> ParsecT String st Identity Int -> ParsecT String st Identity Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT String st Identity Int
forall a. CharParser a Int
twoDigits
Maybe Int
mwd <- Maybe Int
-> ParsecT String st Identity (Maybe Int)
-> ParsecT String st Identity (Maybe Int)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Int
forall a. Maybe a
Nothing (ParsecT String st Identity (Maybe Int)
-> ParsecT String st Identity (Maybe Int))
-> ParsecT String st Identity (Maybe Int)
-> ParsecT String st Identity (Maybe Int)
forall a b. (a -> b) -> a -> b
$ do { ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String st Identity Char
forall u. ParsecT String u Identity Char
dash; Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ParsecT String st Identity Int
-> ParsecT String st Identity (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT String st Identity Int
forall a. Int -> CharParser a Int
nDigits 1 }
let y :: CalendarTime
y = CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime)
-> (MCalendarTime -> CalendarTime) -> MCalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> MCalendarTime
-> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> MCalendarTime
yfn (MCalendarTime -> CalendarTime) -> MCalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime
nullMCalendar { mctDay :: Maybe Int
mctDay = Int -> Maybe Int
forall a. a -> Maybe a
Just 1 }
firstDay :: Day
firstDay = CalendarTime -> Day
ctWDay CalendarTime
y
let afterThursday :: Bool
afterThursday = Day
firstDay Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Day
Sunday Bool -> Bool -> Bool
|| Day
firstDay Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
Thursday
w :: Int
w = if Bool
afterThursday then Int
w'Int -> Int -> Int
forall a. Num a => a -> a -> a
+1 else Int
w'
yday :: Int
yday = (7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1 Maybe Int
mwd
diff :: MCalendarTime -> MCalendarTime
diff c :: MCalendarTime
c = MCalendarTime
c { mctWeek :: Bool
mctWeek = Bool
True
, mctWDay :: Maybe Day
mctWDay = Int -> Day
forall a. Enum a => Int -> a
toEnum (Int -> Day) -> Maybe Int -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Int
mwd
, mctDay :: Maybe Int
mctDay = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
yday }
[MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall (m :: * -> *) a. Monad m => a -> m a
return [MCalendarTime -> MCalendarTime
diff(MCalendarTime -> MCalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> MCalendarTime
-> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MCalendarTime -> MCalendarTime
yfn]
ordinal_date :: GenParser Char st [MCalendarTime -> MCalendarTime]
ordinal_date =
GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime])
-> GenParser Char st [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall a b. (a -> b) -> a -> b
$ CharParser st (MCalendarTime -> MCalendarTime)
-> [(CharParser st Char,
CharParser st (MCalendarTime -> MCalendarTime))]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain CharParser st (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
year_ [ (CharParser st Char
forall u. ParsecT String u Identity Char
dash, CharParser st (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
yearDay_) ]
year_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
year_ = GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime))
-> GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do Int
y <- CharParser st Int
forall a. CharParser a Int
fourDigits CharParser st Int -> String -> CharParser st Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "year (0000-9999)"
(MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctYear :: Maybe Int
mctYear = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y }
month_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
month_ = GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime))
-> GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do Int
m <- CharParser st Int
forall a. CharParser a Int
twoDigits CharParser st Int -> String -> CharParser st Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "month (1 to 12)"
(MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctMonth :: Maybe Month
mctMonth = Month -> Maybe Month
forall a. a -> Maybe a
Just (Month -> Maybe Month) -> Month -> Maybe Month
forall a b. (a -> b) -> a -> b
$ Int -> Month
intToMonth Int
m }
day_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
day_ = GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime))
-> GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do Int
d <- CharParser st Int
forall a. CharParser a Int
twoDigits CharParser st Int -> String -> CharParser st Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "day in month (1 to 31)"
(MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctDay :: Maybe Int
mctDay = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d }
yearDay_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
yearDay_ = GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime))
-> GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do Int
d <- Int -> CharParser st Int
forall a. Int -> CharParser a Int
nDigits 3 CharParser st Int -> String -> CharParser st Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "day in year (001 to 366)"
(MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctDay :: Maybe Int
mctDay = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d
, mctYDay :: Maybe Int
mctYDay = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) }
dash :: ParsecT String u Identity Char
dash = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-'
iso8601Time :: CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time :: CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time = CharParser a (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime))
-> CharParser a (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$
do [MCalendarTime -> MCalendarTime]
ts <- CharParser a (MCalendarTime -> MCalendarTime)
-> [(CharParser a Char,
CharParser a (MCalendarTime -> MCalendarTime))]
-> CharParser a [MCalendarTime -> MCalendarTime]
forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
hour_ [ (CharParser a Char
forall u. ParsecT String u Identity Char
colon , CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
min_)
, (CharParser a Char
forall u. ParsecT String u Identity Char
colon , CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
sec_)
, (String -> CharParser a Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf ",.", CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
pico_) ]
MCalendarTime -> MCalendarTime
z <- (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option MCalendarTime -> MCalendarTime
forall a. a -> a
id (CharParser a (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime))
-> CharParser a (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ [CharParser a (MCalendarTime -> MCalendarTime)]
-> CharParser a (MCalendarTime -> MCalendarTime)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
zulu , CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
offset ]
(MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ ((MCalendarTime -> MCalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> MCalendarTime
-> MCalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> [MCalendarTime -> MCalendarTime]
-> MCalendarTime
-> MCalendarTime
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (MCalendarTime -> MCalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> MCalendarTime
-> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) MCalendarTime -> MCalendarTime
forall a. a -> a
id (MCalendarTime -> MCalendarTime
z(MCalendarTime -> MCalendarTime)
-> [MCalendarTime -> MCalendarTime]
-> [MCalendarTime -> MCalendarTime]
forall a. a -> [a] -> [a]
:[MCalendarTime -> MCalendarTime]
ts)
where
hour_ :: ParsecT String a Identity (MCalendarTime -> MCalendarTime)
hour_ = do Int
h <- CharParser a Int
forall a. CharParser a Int
twoDigits
(MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctHour :: Maybe Int
mctHour = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h }
min_ :: ParsecT String a Identity (MCalendarTime -> MCalendarTime)
min_ = do Int
m <- CharParser a Int
forall a. CharParser a Int
twoDigits
(MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctMin :: Maybe Int
mctMin = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
m }
sec_ :: ParsecT String a Identity (MCalendarTime -> MCalendarTime)
sec_ = do Int
s <- CharParser a Int
forall a. CharParser a Int
twoDigits
(MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctSec :: Maybe Int
mctSec = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
s }
pico_ :: ParsecT String u Identity (MCalendarTime -> MCalendarTime)
pico_ = do String
digs <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
let picoExp :: Int
picoExp = 12
digsExp :: Int
digsExp = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
digs
let frac :: Integer
frac | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
digs = 0
| Int
digsExp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
picoExp = String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
picoExp String
digs
| Bool
otherwise = 10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
picoExp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
digsExp) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* String -> Integer
forall a. Read a => String -> a
read String
digs
(MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctPicosec :: Maybe Integer
mctPicosec = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
frac }
zulu :: ParsecT String u Identity (MCalendarTime -> MCalendarTime)
zulu = do { Char
_ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'Z'; (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (\c :: MCalendarTime
c -> MCalendarTime
c { mctTZ :: Maybe Int
mctTZ = Int -> Maybe Int
forall a. a -> Maybe a
Just 0 }) }
offset :: ParsecT String u Identity (MCalendarTime -> MCalendarTime)
offset = do Int
sign <- [ParsecT String u Identity Int] -> ParsecT String u Identity Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '+' ParsecT String u Identity Char
-> ParsecT String u Identity Int -> ParsecT String u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT String u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return 1
, Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-' ParsecT String u Identity Char
-> ParsecT String u Identity Int -> ParsecT String u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT String u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (-1) ]
Int
h <- ParsecT String u Identity Int
forall a. CharParser a Int
twoDigits
Int
m <- Int
-> ParsecT String u Identity Int -> ParsecT String u Identity Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option 0 (ParsecT String u Identity Int -> ParsecT String u Identity Int)
-> ParsecT String u Identity Int -> ParsecT String u Identity Int
forall a b. (a -> b) -> a -> b
$ do { ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
colon; ParsecT String u Identity Int
forall a. CharParser a Int
twoDigits }
(MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctTZ :: Maybe Int
mctTZ = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
sign Int -> Int -> Int
forall a. Num a => a -> a -> a
* 60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m) }
colon :: ParsecT String u Identity Char
colon = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'
iso8601Interval :: Int -> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval :: Int
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval localTz :: Int
localTz = CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a.
ParsecT
String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
leftDur CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a a.
ParsecT String a Identity (Either a (MCalendarTime, MCalendarTime))
rightDur where
leftDur :: ParsecT
String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
leftDur =
do TimeDiff
dur <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
iso8601Duration
Maybe MCalendarTime
end <- Maybe MCalendarTime
-> ParsecT String a Identity (Maybe MCalendarTime)
-> ParsecT String a Identity (Maybe MCalendarTime)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe MCalendarTime
forall a. Maybe a
Nothing (ParsecT String a Identity (Maybe MCalendarTime)
-> ParsecT String a Identity (Maybe MCalendarTime))
-> ParsecT String a Identity (Maybe MCalendarTime)
-> ParsecT String a Identity (Maybe MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do { Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'; MCalendarTime -> Maybe MCalendarTime
forall a. a -> Maybe a
Just (MCalendarTime -> Maybe MCalendarTime)
-> ParsecT String a Identity MCalendarTime
-> ParsecT String a Identity (Maybe MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT String a Identity MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
isoDt }
Either TimeDiff (MCalendarTime, MCalendarTime)
-> ParsecT
String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TimeDiff (MCalendarTime, MCalendarTime)
-> ParsecT
String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime)))
-> Either TimeDiff (MCalendarTime, MCalendarTime)
-> ParsecT
String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a b. (a -> b) -> a -> b
$ case Maybe MCalendarTime
end of
Nothing -> TimeDiff -> Either TimeDiff (MCalendarTime, MCalendarTime)
forall a b. a -> Either a b
Left TimeDiff
dur
Just e :: MCalendarTime
e -> (MCalendarTime, MCalendarTime)
-> Either TimeDiff (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`subtractFromMCal` MCalendarTime
e, MCalendarTime
e)
rightDur :: ParsecT String a Identity (Either a (MCalendarTime, MCalendarTime))
rightDur =
do MCalendarTime
start <- CharParser a MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
isoDt
Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'
Either TimeDiff MCalendarTime
durOrEnd <- TimeDiff -> Either TimeDiff MCalendarTime
forall a b. a -> Either a b
Left (TimeDiff -> Either TimeDiff MCalendarTime)
-> ParsecT String a Identity TimeDiff
-> ParsecT String a Identity (Either TimeDiff MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT String a Identity TimeDiff
forall a. CharParser a TimeDiff
iso8601Duration ParsecT String a Identity (Either TimeDiff MCalendarTime)
-> ParsecT String a Identity (Either TimeDiff MCalendarTime)
-> ParsecT String a Identity (Either TimeDiff MCalendarTime)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MCalendarTime -> Either TimeDiff MCalendarTime
forall a b. b -> Either a b
Right (MCalendarTime -> Either TimeDiff MCalendarTime)
-> CharParser a MCalendarTime
-> ParsecT String a Identity (Either TimeDiff MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` CharParser a MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
isoDt
Either a (MCalendarTime, MCalendarTime)
-> ParsecT
String a Identity (Either a (MCalendarTime, MCalendarTime))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (MCalendarTime, MCalendarTime)
-> ParsecT
String a Identity (Either a (MCalendarTime, MCalendarTime)))
-> Either a (MCalendarTime, MCalendarTime)
-> ParsecT
String a Identity (Either a (MCalendarTime, MCalendarTime))
forall a b. (a -> b) -> a -> b
$ case Either TimeDiff MCalendarTime
durOrEnd of
Left dur :: TimeDiff
dur -> (MCalendarTime, MCalendarTime)
-> Either a (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (MCalendarTime
start, TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`addToMCal` MCalendarTime
start)
Right end :: MCalendarTime
end -> (MCalendarTime, MCalendarTime)
-> Either a (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (MCalendarTime
start, MCalendarTime
end)
isoDt :: CharParser a MCalendarTime
isoDt = Int -> CharParser a MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime Int
localTz
iso8601Duration :: CharParser a TimeDiff
iso8601Duration :: CharParser a TimeDiff
iso8601Duration =
do Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'P'
Int
y <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block 0 'Y'
Int
mon <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block 0 'M'
Int
d <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block 0 'D'
(h :: Int
h,m :: Int
m,s :: Int
s) <- (Int, Int, Int)
-> ParsecT String a Identity (Int, Int, Int)
-> ParsecT String a Identity (Int, Int, Int)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (0,0,0) (ParsecT String a Identity (Int, Int, Int)
-> ParsecT String a Identity (Int, Int, Int))
-> ParsecT String a Identity (Int, Int, Int)
-> ParsecT String a Identity (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$
do Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'T'
Int
h' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-1) 'H'
Int
m' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-1) 'M'
Int
s' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-1) 'S'
let unset :: Int -> Bool
unset = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1))
if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
unset [Int
h',Int
m',Int
s']
then String -> ParsecT String a Identity (Int, Int, Int)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "T should be omitted if time is unspecified"
else let clear :: Int -> Int
clear x :: Int
x = if Int -> Bool
unset Int
x then 0 else Int
x
in (Int, Int, Int) -> ParsecT String a Identity (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int
clear Int
h', Int -> Int
clear Int
m', Int -> Int
clear Int
s')
TimeDiff -> CharParser a TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff -> CharParser a TimeDiff)
-> TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
y Int
mon Int
d Int
h Int
m Int
s 0
where block :: a -> Char -> ParsecT String u Identity a
block d :: a
d c :: Char
c = a -> ParsecT String u Identity a -> ParsecT String u Identity a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
d (ParsecT String u Identity a -> ParsecT String u Identity a)
-> ParsecT String u Identity a -> ParsecT String u Identity a
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity a -> ParsecT String u Identity a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity a -> ParsecT String u Identity a)
-> ParsecT String u Identity a -> ParsecT String u Identity a
forall a b. (a -> b) -> a -> b
$
do String
n <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
Char
_ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT String u Identity a)
-> a -> ParsecT String u Identity a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. Read a => String -> a
read String
n
optchain :: CharParser a b -> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain :: CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain p :: CharParser a b
p next :: [(CharParser a c, CharParser a b)]
next = CharParser a [b] -> CharParser a [b]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a [b] -> CharParser a [b])
-> CharParser a [b] -> CharParser a [b]
forall a b. (a -> b) -> a -> b
$
do b
r1 <- CharParser a b
p
[b]
r2 <- case [(CharParser a c, CharParser a b)]
next of
[] -> [b] -> CharParser a [b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
((sep :: CharParser a c
sep,p2 :: CharParser a b
p2):next2 :: [(CharParser a c, CharParser a b)]
next2) -> [b] -> CharParser a [b] -> CharParser a [b]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (CharParser a [b] -> CharParser a [b])
-> CharParser a [b] -> CharParser a [b]
forall a b. (a -> b) -> a -> b
$ do { CharParser a c -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional CharParser a c
sep; CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain CharParser a b
p2 [(CharParser a c, CharParser a b)]
next2 }
[b] -> CharParser a [b]
forall (m :: * -> *) a. Monad m => a -> m a
return (b
r1b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
r2)
nDigits :: Int -> CharParser a Int
nDigits :: Int -> CharParser a Int
nDigits n :: Int
n = String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT String a Identity String -> CharParser a Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int
-> ParsecT String a Identity Char
-> ParsecT String a Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
twoDigits, fourDigits :: CharParser a Int
twoDigits :: CharParser a Int
twoDigits = Int -> CharParser a Int
forall a. Int -> CharParser a Int
nDigits 2
fourDigits :: CharParser a Int
fourDigits = Int -> CharParser a Int
forall a. Int -> CharParser a Int
nDigits 4
mySpaces :: CharParser a String
mySpaces :: CharParser a String
mySpaces = Int -> GenParser Char a Char -> CharParser a String
forall a b c. Int -> GenParser a b c -> GenParser a b [c]
manyN 1 (GenParser Char a Char -> CharParser a String)
-> GenParser Char a Char -> CharParser a String
forall a b. (a -> b) -> a -> b
$ Char -> GenParser Char a Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ' '
dayName :: CharParser a Day
dayName :: CharParser a Day
dayName = [CharParser a Day] -> CharParser a Day
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Mon" GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Monday
, GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Tue") GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Tuesday
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Wed" GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Wednesday
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Thu" GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Thursday
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Fri" GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Friday
, GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Sat") GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Saturday
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Sun" GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Sunday
]
year :: CharParser a Int
year :: CharParser a Int
year = CharParser a Int
forall a. CharParser a Int
fourDigits
monthNum :: CharParser a Month
monthNum :: CharParser a Month
monthNum = do String
mn <- Int -> Int -> GenParser Char a Char -> GenParser Char a String
forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM 1 2 GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return (Month -> CharParser a Month) -> Month -> CharParser a Month
forall a b. (a -> b) -> a -> b
$ Int -> Month
intToMonth (String -> Int
forall a. Read a => String -> a
read String
mn :: Int)
intToMonth :: Int -> Month
intToMonth :: Int -> Month
intToMonth 1 = Month
January
intToMonth 2 = Month
February
intToMonth 3 = Month
March
intToMonth 4 = Month
April
intToMonth 5 = Month
May
intToMonth 6 = Month
June
intToMonth 7 = Month
July
intToMonth 8 = Month
August
intToMonth 9 = Month
September
intToMonth 10 = Month
October
intToMonth 11 = Month
November
intToMonth 12 = Month
December
intToMonth _ = String -> Month
forall a. HasCallStack => String -> a
error "invalid month!"
monthName :: CharParser a Month
monthName :: CharParser a Month
monthName = [CharParser a Month] -> CharParser a Month
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Jan") GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
January
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Feb" GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
February
, GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Mar") GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
March
, GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Apr") GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
April
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "May" GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
May
, GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Jun") GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
June
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Jul" GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
July
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Aug" GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
August
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Sep" GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
September
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Oct" GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
October
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Nov" GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
November
, String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Dec" GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
December
]
day :: CharParser a Int
day :: CharParser a Int
day = do String
d <- Int -> Int -> GenParser Char a Char -> GenParser Char a String
forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM 1 2 GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
Int -> CharParser a Int
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. Read a => String -> a
read String
d :: Int)
hour :: CharParser a Int
hour :: CharParser a Int
hour = CharParser a Int
forall a. CharParser a Int
twoDigits
minute :: CharParser a Int
minute :: CharParser a Int
minute = CharParser a Int
forall a. CharParser a Int
twoDigits
second :: CharParser a Int
second :: CharParser a Int
second = CharParser a Int
forall a. CharParser a Int
twoDigits
zone :: CharParser a Int
zone :: CharParser a Int
zone = [CharParser a Int] -> CharParser a Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ do { Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '+'; Int
h <- CharParser a Int
forall a. CharParser a Int
hour; Int
m <- CharParser a Int
forall a. CharParser a Int
minute; Int -> CharParser a Int
forall (m :: * -> *) a. Monad m => a -> m a
return (((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)Int -> Int -> Int
forall a. Num a => a -> a -> a
*60) }
, do { Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-'; Int
h <- CharParser a Int
forall a. CharParser a Int
hour; Int
m <- CharParser a Int
forall a. CharParser a Int
minute; Int -> CharParser a Int
forall (m :: * -> *) a. Monad m => a -> m a
return (-((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)Int -> Int -> Int
forall a. Num a => a -> a -> a
*60) }
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "UTC" 0
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "UT" 0
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "GMT" 0
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "WET" 0
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "WEST" 1
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "BST" 1
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "ART" (-3)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "BRT" (-3)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "BRST" (-2)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "AST" (-4)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "ADT" (-3)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CLT" (-4)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CLST" (-3)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EST" (-5)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EDT" (-4)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CST" (-6)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CDT" (-5)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MST" (-7)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MDT" (-6)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "PST" (-8)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "PDT" (-7)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "AKST" (-9)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "AKDT" (-8)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "HST" (-10)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "HAST" (-10)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "HADT" (-9)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "SST" (-12)
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "WAT" 1
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CET" 1
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CEST" 2
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MET" 1
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MEZ" 1
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MEST" 2
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MESZ" 2
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EET" 2
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EEST" 3
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CAT" 2
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "SAST" 2
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EAT" 3
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MSK" 3
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MSD" 4
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "SGT" 8
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "KST" 9
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "JST" 9
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "GST" 10
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "NZST" 12
, String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "NZDT" 13
, do { String
_ <- ParsecT String a Identity Char
-> ParsecT String a Identity Char
-> ParsecT String a Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (String -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (String -> ParsecT String a Identity Char)
-> String -> ParsecT String a Identity Char
forall a b. (a -> b) -> a -> b
$ ' ' Char -> String -> String
forall a. a -> [a] -> [a]
: ['a'..'z']String -> String -> String
forall a. [a] -> [a] -> [a]
++['A'..'Z'])
(ParsecT String a Identity Char -> ParsecT String a Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String a Identity Char
forall u. ParsecT String u Identity Char
space_digit);
Int -> CharParser a Int
forall (m :: * -> *) a. Monad m => a -> m a
return 0 }
]
where mkZone :: String -> a -> GenParser Char st a
mkZone n :: String
n o :: a
o = GenParser Char st a -> GenParser Char st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st a -> GenParser Char st a)
-> GenParser Char st a -> GenParser Char st a
forall a b. (a -> b) -> a -> b
$ do { String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString String
n; a -> GenParser Char st a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
oa -> a -> a
forall a. Num a => a -> a -> a
*60a -> a -> a
forall a. Num a => a -> a -> a
*60) }
space_digit :: GenParser Char st Char
space_digit = GenParser Char st Char -> GenParser Char st Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Char -> GenParser Char st Char)
-> GenParser Char st Char -> GenParser Char st Char
forall a b. (a -> b) -> a -> b
$ do { Char
_ <- Char -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ' '; String -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf ['0'..'9'] }
englishDateTime :: CalendarTime -> CharParser a CalendarTime
englishDateTime :: CalendarTime -> CharParser a CalendarTime
englishDateTime now :: CalendarTime
now =
CharParser a CalendarTime -> CharParser a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a CalendarTime -> CharParser a CalendarTime)
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall a b. (a -> b) -> a -> b
$ CharParser a CalendarTime
forall a. CharParser a CalendarTime
dateMaybeAtTime CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a CalendarTime
forall a. CharParser a CalendarTime
timeThenDate
where
dateMaybeAtTime :: GenParser Char st CalendarTime
dateMaybeAtTime = GenParser Char st CalendarTime -> GenParser Char st CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st CalendarTime -> GenParser Char st CalendarTime)
-> GenParser Char st CalendarTime -> GenParser Char st CalendarTime
forall a b. (a -> b) -> a -> b
$
do CalendarTime
ed <- CalendarTime -> GenParser Char st CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
Maybe (CalendarTime -> CalendarTime)
t <- Maybe (CalendarTime -> CalendarTime)
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime))
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe (CalendarTime -> CalendarTime)
forall a. Maybe a
Nothing (ParsecT String st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime)))
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime))
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime))
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime)))
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime))
forall a b. (a -> b) -> a -> b
$
do { Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space; ParsecT String st Identity () -> ParsecT String st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String st Identity () -> ParsecT String st Identity ())
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity ()
forall a. String -> GenParser Char a ()
caseString "at "; (CalendarTime -> CalendarTime)
-> Maybe (CalendarTime -> CalendarTime)
forall a. a -> Maybe a
Just ((CalendarTime -> CalendarTime)
-> Maybe (CalendarTime -> CalendarTime))
-> ParsecT String st Identity (CalendarTime -> CalendarTime)
-> ParsecT
String st Identity (Maybe (CalendarTime -> CalendarTime))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT String st Identity (CalendarTime -> CalendarTime)
forall a. CharParser a (CalendarTime -> CalendarTime)
englishTime }
CalendarTime -> GenParser Char st CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> GenParser Char st CalendarTime)
-> CalendarTime -> GenParser Char st CalendarTime
forall a b. (a -> b) -> a -> b
$ (CalendarTime -> CalendarTime)
-> Maybe (CalendarTime -> CalendarTime)
-> CalendarTime
-> CalendarTime
forall a. a -> Maybe a -> a
fromMaybe CalendarTime -> CalendarTime
forall a. a -> a
id Maybe (CalendarTime -> CalendarTime)
t CalendarTime
ed
timeThenDate :: GenParser Char st CalendarTime
timeThenDate = GenParser Char st CalendarTime -> GenParser Char st CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st CalendarTime -> GenParser Char st CalendarTime)
-> GenParser Char st CalendarTime -> GenParser Char st CalendarTime
forall a b. (a -> b) -> a -> b
$
do CalendarTime -> CalendarTime
t <- CharParser st (CalendarTime -> CalendarTime)
forall a. CharParser a (CalendarTime -> CalendarTime)
englishTime
ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String st Identity Char -> ParsecT String st Identity ())
-> ParsecT String st Identity Char -> ParsecT String st Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ','
Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
CalendarTime
ed <- CalendarTime -> GenParser Char st CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
CalendarTime -> GenParser Char st CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> GenParser Char st CalendarTime)
-> CalendarTime -> GenParser Char st CalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> CalendarTime
t (CalendarTime -> CalendarTime) -> CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> CalendarTime
unsetTime CalendarTime
ed
englishDate :: CalendarTime -> CharParser a CalendarTime
englishDate :: CalendarTime -> CharParser a CalendarTime
englishDate now :: CalendarTime
now = CharParser a CalendarTime -> CharParser a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a CalendarTime -> CharParser a CalendarTime)
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall a b. (a -> b) -> a -> b
$
(String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "today" GenParser Char a ()
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> CalendarTime
resetCalendar CalendarTime
now))
CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "yesterday" GenParser Char a ()
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff
oneDay TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now))
CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (CalendarTime, CalendarTime) -> CalendarTime
forall a b. (a, b) -> a
fst ((CalendarTime, CalendarTime) -> CalendarTime)
-> ParsecT String a Identity (CalendarTime, CalendarTime)
-> CharParser a CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CalendarTime
-> ParsecT String a Identity (CalendarTime, CalendarTime)
forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now
CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CalendarTime -> CharParser a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now
where oneDay :: TimeDiff
oneDay = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 0 1 0 0 0 0
englishAgo :: CalendarTime -> CharParser a CalendarTime
englishAgo :: CalendarTime -> CharParser a CalendarTime
englishAgo now :: CalendarTime
now =
CharParser a CalendarTime -> CharParser a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a CalendarTime -> CharParser a CalendarTime)
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall a b. (a -> b) -> a -> b
$ do TimeDiff
p <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
englishDuration
Char
_ <- GenParser Char a Char -> GenParser Char a Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
(m :: Int
m,ref :: CalendarTime
ref) <- GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "ago" GenParser Char a ()
-> GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int, CalendarTime) -> GenParser Char a (Int, CalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (-1, CalendarTime
now))
GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do Int
m <- GenParser Char a Int
forall a. CharParser a Int
beforeMod GenParser Char a Int
-> GenParser Char a Int -> GenParser Char a Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a Int
forall a. CharParser a Int
afterMod
Char
_ <- GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
CalendarTime
d <- CalendarTime -> CharParser a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (CalendarTime, CalendarTime) -> CalendarTime
forall a b. (a, b) -> a
fst ((CalendarTime, CalendarTime) -> CalendarTime)
-> ParsecT String a Identity (CalendarTime, CalendarTime)
-> CharParser a CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CalendarTime
-> ParsecT String a Identity (CalendarTime, CalendarTime)
forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now
CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> ParsecT String a Identity MCalendarTime
-> CharParser a CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT String a Identity MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime (CalendarTime -> Int
ctTZ CalendarTime
now)
(Int, CalendarTime) -> GenParser Char a (Int, CalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m,CalendarTime
d)
CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> CharParser a CalendarTime)
-> CalendarTime -> CharParser a CalendarTime
forall a b. (a -> b) -> a -> b
$ Int -> TimeDiff -> TimeDiff
multiplyDiff Int
m TimeDiff
p TimeDiff -> CalendarTime -> CalendarTime
`addToCal` CalendarTime
ref
where
beforeMod :: GenParser Char st Int
beforeMod = GenParser Char st Int -> GenParser Char st Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Int -> GenParser Char st Int)
-> GenParser Char st Int -> GenParser Char st Int
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "before" GenParser Char st ()
-> GenParser Char st Int -> GenParser Char st Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> GenParser Char st Int
forall (m :: * -> *) a. Monad m => a -> m a
return (-1)
afterMod :: GenParser Char st Int
afterMod = GenParser Char st Int -> GenParser Char st Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Int -> GenParser Char st Int)
-> GenParser Char st Int -> GenParser Char st Int
forall a b. (a -> b) -> a -> b
$ [String] -> GenParser Char st ()
forall a. [String] -> GenParser Char a ()
caseStrings ["after","since"] GenParser Char st ()
-> GenParser Char st Int -> GenParser Char st Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> GenParser Char st Int
forall (m :: * -> *) a. Monad m => a -> m a
return 1
englishInterval :: CalendarTime -> CharParser a TimeInterval
englishInterval :: CalendarTime -> CharParser a TimeInterval
englishInterval now :: CalendarTime
now = CharParser a TimeInterval
forall st. GenParser Char st TimeInterval
twixt CharParser a TimeInterval
-> CharParser a TimeInterval -> CharParser a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a TimeInterval
forall st. GenParser Char st TimeInterval
before CharParser a TimeInterval
-> CharParser a TimeInterval -> CharParser a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a TimeInterval
forall st a. GenParser Char st (Maybe CalendarTime, Maybe a)
after CharParser a TimeInterval
-> CharParser a TimeInterval -> CharParser a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a TimeInterval
forall st. GenParser Char st TimeInterval
inTheLast CharParser a TimeInterval
-> CharParser a TimeInterval -> CharParser a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a TimeInterval
forall st. GenParser Char st TimeInterval
lastetc
where
englishDT :: ParsecT String u Identity CalendarTime
englishDT = MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> ParsecT String u Identity MCalendarTime
-> ParsecT String u Identity CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT String u Identity MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime (CalendarTime -> Int
ctTZ CalendarTime
now)
ParsecT String u Identity CalendarTime
-> ParsecT String u Identity CalendarTime
-> ParsecT String u Identity CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CalendarTime -> ParsecT String u Identity CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDateTime CalendarTime
now
before :: GenParser Char st TimeInterval
before = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
do String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "before"
Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
CalendarTime
end <- ParsecT String st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
TimeInterval -> GenParser Char st TimeInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
theBeginning, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
end)
after :: GenParser Char st (Maybe CalendarTime, Maybe a)
after = GenParser Char st (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a))
-> GenParser Char st (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall a b. (a -> b) -> a -> b
$
do [String] -> GenParser Char st ()
forall a. [String] -> GenParser Char a ()
caseStrings ["after","since"]
Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
CalendarTime
start <- ParsecT String st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
(Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
start, Maybe a
forall a. Maybe a
Nothing)
twixt :: GenParser Char st TimeInterval
twixt = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
do String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "between"
Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
CalendarTime
start <- ParsecT String st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "and"
Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
CalendarTime
end <- ParsecT String st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
TimeInterval -> GenParser Char st TimeInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
start, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
end)
inTheLast :: GenParser Char st TimeInterval
inTheLast = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
do String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "in the last"
Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
TimeDiff
dur <- CharParser st TimeDiff
forall a. CharParser a TimeDiff
englishDuration
TimeInterval -> GenParser Char st TimeInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just (CalendarTime -> Maybe CalendarTime)
-> CalendarTime -> Maybe CalendarTime
forall a b. (a -> b) -> a -> b
$ TimeDiff
dur TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
now)
lastetc :: ParsecT String a Identity TimeInterval
lastetc =
do CalendarTime
l <- CalendarTime -> CharParser a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now
TimeInterval -> ParsecT String a Identity TimeInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
l, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
now)
englishLast :: CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast :: CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast now :: CalendarTime
now =
CharParser a (CalendarTime, CalendarTime)
-> CharParser a (CalendarTime, CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a (CalendarTime, CalendarTime)
-> CharParser a (CalendarTime, CalendarTime))
-> CharParser a (CalendarTime, CalendarTime)
-> CharParser a (CalendarTime, CalendarTime)
forall a b. (a -> b) -> a -> b
$ do String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "last"
Char
_ <- ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
TimeDiff
d <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
englishDuration
(CalendarTime, CalendarTime)
-> CharParser a (CalendarTime, CalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff
d TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now, CalendarTime
now)
englishTime :: CharParser a (CalendarTime->CalendarTime)
englishTime :: CharParser a (CalendarTime -> CalendarTime)
englishTime = CharParser a (CalendarTime -> CalendarTime)
-> CharParser a (CalendarTime -> CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a (CalendarTime -> CalendarTime)
-> CharParser a (CalendarTime -> CalendarTime))
-> CharParser a (CalendarTime -> CalendarTime)
-> CharParser a (CalendarTime -> CalendarTime)
forall a b. (a -> b) -> a -> b
$
[CharParser a (CalendarTime -> CalendarTime)]
-> CharParser a (CalendarTime -> CalendarTime)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ (MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
wrapM ((MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> CharParser a (CalendarTime -> CalendarTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time
, String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "noon" 12 0
, String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "midnight" 0 0
, String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "tea time" 16 30
, String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "bed time" 2 30
, String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "proper bed time" 21 30 ]
where namedTime :: String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime name :: String
name h :: Int
h m :: Int
m = GenParser Char st (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime))
-> GenParser Char st (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall a b. (a -> b) -> a -> b
$
do String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString String
name
(CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime))
-> (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: CalendarTime
c -> CalendarTime
c { ctHour :: Int
ctHour = Int
h, ctMin :: Int
ctMin = Int
m }
wrapM :: (MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
wrapM f :: MCalendarTime -> MCalendarTime
f = MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> (CalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> MCalendarTime
f (MCalendarTime -> MCalendarTime)
-> (CalendarTime -> MCalendarTime) -> CalendarTime -> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> MCalendarTime
toMCalendarTime
englishDuration :: CharParser a TimeDiff
englishDuration :: CharParser a TimeDiff
englishDuration = CharParser a TimeDiff -> CharParser a TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a TimeDiff -> CharParser a TimeDiff)
-> CharParser a TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$
do Int
n <- Int
-> ParsecT String a Identity Int -> ParsecT String a Identity Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option 1 (ParsecT String a Identity Int -> ParsecT String a Identity Int)
-> ParsecT String a Identity Int -> ParsecT String a Identity Int
forall a b. (a -> b) -> a -> b
$ do String
x <- ParsecT String a Identity Char -> ParsecT String a Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
Char
_ <- ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
Int -> ParsecT String a Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String a Identity Int)
-> Int -> ParsecT String a Identity Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
x
TimeDiff
b <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
base
ParsecT String a Identity () -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ([String] -> ParsecT String a Identity ()
forall a. [String] -> GenParser Char a ()
caseStrings ["es","s"])
let current :: TimeDiff
current = Int -> TimeDiff -> TimeDiff
multiplyDiff Int
n TimeDiff
b
TimeDiff
next <- TimeDiff -> CharParser a TimeDiff -> CharParser a TimeDiff
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option TimeDiff
noTimeDiff (CharParser a TimeDiff -> CharParser a TimeDiff)
-> CharParser a TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ CharParser a TimeDiff -> CharParser a TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a TimeDiff -> CharParser a TimeDiff)
-> CharParser a TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ do
{ ParsecT String a Identity Char -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space; Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ',' ; ParsecT String a Identity Char -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ; CharParser a TimeDiff
forall a. CharParser a TimeDiff
englishDuration }
TimeDiff -> CharParser a TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff -> CharParser a TimeDiff)
-> TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ TimeDiff -> TimeDiff -> TimeDiff
addDiff TimeDiff
current TimeDiff
next
where
base :: ParsecT String u Identity TimeDiff
base = [ParsecT String u Identity TimeDiff]
-> ParsecT String u Identity TimeDiff
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff)
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "score" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 20 0 0 0 0 0 0)
, String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "year" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 1 0 0 0 0 0 0)
, ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff)
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "month" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 1 0 0 0 0 0)
, String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "fortnight" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 0 14 0 0 0 0)
, String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "week" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 0 7 0 0 0 0)
, String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "day" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 0 1 0 0 0 0)
, String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "hour" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 0 0 1 0 0 0)
, String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "minute" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 0 0 0 1 0 0)
, String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "second" GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 0 0 0 0 1 0) ]
theBeginning :: CalendarTime
theBeginning :: CalendarTime
theBeginning = IO CalendarTime -> CalendarTime
forall a. IO a -> a
unsafePerformIO (IO CalendarTime -> CalendarTime)
-> IO CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ ClockTime -> IO CalendarTime
toCalendarTime (ClockTime -> IO CalendarTime) -> ClockTime -> IO CalendarTime
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> ClockTime
TOD 0 0
data MCalendarTime = MCalendarTime
{ MCalendarTime -> Maybe Int
mctYear :: Maybe Int
, MCalendarTime -> Maybe Month
mctMonth :: Maybe Month
, MCalendarTime -> Maybe Int
mctDay :: Maybe Int
, MCalendarTime -> Maybe Int
mctHour :: Maybe Int
, MCalendarTime -> Maybe Int
mctMin :: Maybe Int
, MCalendarTime -> Maybe Int
mctSec :: Maybe Int
, MCalendarTime -> Maybe Integer
mctPicosec :: Maybe Integer
, MCalendarTime -> Maybe Day
mctWDay :: Maybe Day
, MCalendarTime -> Maybe Int
mctYDay :: Maybe Int
, MCalendarTime -> Maybe String
mctTZName :: Maybe String
, MCalendarTime -> Maybe Int
mctTZ :: Maybe Int
, MCalendarTime -> Maybe Bool
mctIsDST :: Maybe Bool
, MCalendarTime -> Bool
mctWeek :: Bool
} deriving Int -> MCalendarTime -> String -> String
[MCalendarTime] -> String -> String
MCalendarTime -> String
(Int -> MCalendarTime -> String -> String)
-> (MCalendarTime -> String)
-> ([MCalendarTime] -> String -> String)
-> Show MCalendarTime
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MCalendarTime] -> String -> String
$cshowList :: [MCalendarTime] -> String -> String
show :: MCalendarTime -> String
$cshow :: MCalendarTime -> String
showsPrec :: Int -> MCalendarTime -> String -> String
$cshowsPrec :: Int -> MCalendarTime -> String -> String
Show
toMCalendarTime :: CalendarTime -> MCalendarTime
toMCalendarTime :: CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime a :: Int
a b :: Month
b c :: Int
c d :: Int
d e :: Int
e f :: Int
f g :: Integer
g h :: Day
h i :: Int
i j :: String
j k :: Int
k l :: Bool
l) =
Maybe Int
-> Maybe Month
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Integer
-> Maybe Day
-> Maybe Int
-> Maybe String
-> Maybe Int
-> Maybe Bool
-> Bool
-> MCalendarTime
MCalendarTime (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
a) (Month -> Maybe Month
forall a. a -> Maybe a
Just Month
b) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
c) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
e) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
f)
(Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
g) (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
h) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i) (String -> Maybe String
forall a. a -> Maybe a
Just String
j) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
l)
Bool
False
unsafeToCalendarTime :: MCalendarTime -> CalendarTime
unsafeToCalendarTime :: MCalendarTime -> CalendarTime
unsafeToCalendarTime m :: MCalendarTime
m =
CalendarTime :: Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime
{ ctYear :: Int
ctYear = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctYear MCalendarTime
m
, ctMonth :: Month
ctMonth = Month -> Maybe Month -> Month
forall a. a -> Maybe a -> a
fromMaybe Month
January (Maybe Month -> Month) -> Maybe Month -> Month
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Month
mctMonth MCalendarTime
m
, ctDay :: Int
ctDay = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctDay MCalendarTime
m
, ctHour :: Int
ctHour = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctHour MCalendarTime
m
, ctMin :: Int
ctMin = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctMin MCalendarTime
m
, ctSec :: Int
ctSec = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctSec MCalendarTime
m
, ctPicosec :: Integer
ctPicosec = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Integer
mctPicosec MCalendarTime
m
, ctWDay :: Day
ctWDay = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
Sunday (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Day
mctWDay MCalendarTime
m
, ctYDay :: Int
ctYDay = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctYDay MCalendarTime
m
, ctTZName :: String
ctTZName = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe String
mctTZName MCalendarTime
m
, ctTZ :: Int
ctTZ = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctTZ MCalendarTime
m
, ctIsDST :: Bool
ctIsDST = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Bool
mctIsDST MCalendarTime
m
}
addToCal :: TimeDiff -> CalendarTime -> CalendarTime
addToCal :: TimeDiff -> CalendarTime -> CalendarTime
addToCal td :: TimeDiff
td = ClockTime -> CalendarTime
toUTCTime (ClockTime -> CalendarTime)
-> (CalendarTime -> ClockTime) -> CalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeDiff -> ClockTime -> ClockTime
addToClockTime TimeDiff
td (ClockTime -> ClockTime)
-> (CalendarTime -> ClockTime) -> CalendarTime -> ClockTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> ClockTime
toClockTime
subtractFromCal :: TimeDiff -> CalendarTime -> CalendarTime
subtractFromCal :: TimeDiff -> CalendarTime -> CalendarTime
subtractFromCal = TimeDiff -> CalendarTime -> CalendarTime
addToCal (TimeDiff -> CalendarTime -> CalendarTime)
-> (TimeDiff -> TimeDiff)
-> TimeDiff
-> CalendarTime
-> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TimeDiff -> TimeDiff
multiplyDiff (-1)
addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal td :: TimeDiff
td mc :: MCalendarTime
mc =
CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar (TimeDiff -> CalendarTime -> CalendarTime
addToCal TimeDiff
td (CalendarTime -> CalendarTime) -> CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
mc) MCalendarTime
mc
subtractFromMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
subtractFromMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
subtractFromMCal = TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal (TimeDiff -> MCalendarTime -> MCalendarTime)
-> (TimeDiff -> TimeDiff)
-> TimeDiff
-> MCalendarTime
-> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TimeDiff -> TimeDiff
multiplyDiff (-1)
addDiff :: TimeDiff -> TimeDiff -> TimeDiff
addDiff :: TimeDiff -> TimeDiff -> TimeDiff
addDiff (TimeDiff a1 :: Int
a1 a2 :: Int
a2 a3 :: Int
a3 a4 :: Int
a4 a5 :: Int
a5 a6 :: Int
a6 a7 :: Integer
a7) (TimeDiff b1 :: Int
b1 b2 :: Int
b2 b3 :: Int
b3 b4 :: Int
b4 b5 :: Int
b5 b6 :: Int
b6 b7 :: Integer
b7) =
Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff (Int
a1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b1) (Int
a2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b2) (Int
a3Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b3) (Int
a4Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b4) (Int
a5Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b5) (Int
a6Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b6) (Integer
a7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b7)
multiplyDiff :: Int -> TimeDiff -> TimeDiff
multiplyDiff :: Int -> TimeDiff -> TimeDiff
multiplyDiff m :: Int
m (TimeDiff a1 :: Int
a1 a2 :: Int
a2 a3 :: Int
a3 a4 :: Int
a4 a5 :: Int
a5 a6 :: Int
a6 a7 :: Integer
a7) =
Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff (Int
a1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Integer
a7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m)
nullMCalendar :: MCalendarTime
nullMCalendar :: MCalendarTime
nullMCalendar = Maybe Int
-> Maybe Month
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Integer
-> Maybe Day
-> Maybe Int
-> Maybe String
-> Maybe Int
-> Maybe Bool
-> Bool
-> MCalendarTime
MCalendarTime Maybe Int
forall a. Maybe a
Nothing Maybe Month
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
Maybe Integer
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
Bool
False
resetCalendar :: CalendarTime -> CalendarTime
resetCalendar :: CalendarTime -> CalendarTime
resetCalendar = ClockTime -> CalendarTime
toUTCTime (ClockTime -> CalendarTime)
-> (CalendarTime -> ClockTime) -> CalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> ClockTime
toClockTime
copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar c :: CalendarTime
c mc :: MCalendarTime
mc = MCalendarTime
mc
{ mctYear :: Maybe Int
mctYear = MCalendarTime -> Maybe Int
mctYear MCalendarTime
mc Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctYear CalendarTime
c)
, mctMonth :: Maybe Month
mctMonth = MCalendarTime -> Maybe Month
mctMonth MCalendarTime
mc Maybe Month -> Maybe Month -> Maybe Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> Maybe Month
forall a. a -> Maybe a
Just (CalendarTime -> Month
ctMonth CalendarTime
c)
, mctDay :: Maybe Int
mctDay = MCalendarTime -> Maybe Int
mctDay MCalendarTime
mc Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctDay CalendarTime
c)
, mctHour :: Maybe Int
mctHour = MCalendarTime -> Maybe Int
mctHour MCalendarTime
mc Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctHour CalendarTime
c)
, mctMin :: Maybe Int
mctMin = MCalendarTime -> Maybe Int
mctMin MCalendarTime
mc Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctMin CalendarTime
c)
, mctSec :: Maybe Int
mctSec = MCalendarTime -> Maybe Int
mctSec MCalendarTime
mc Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctSec CalendarTime
c)
, mctPicosec :: Maybe Integer
mctPicosec = MCalendarTime -> Maybe Integer
mctPicosec MCalendarTime
mc Maybe Integer -> Maybe Integer -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (CalendarTime -> Integer
ctPicosec CalendarTime
c)
, mctWDay :: Maybe Day
mctWDay = MCalendarTime -> Maybe Day
mctWDay MCalendarTime
mc Maybe Day -> Maybe Day -> Maybe Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> Maybe Day
forall a. a -> Maybe a
Just (CalendarTime -> Day
ctWDay CalendarTime
c)
, mctYDay :: Maybe Int
mctYDay = MCalendarTime -> Maybe Int
mctYDay MCalendarTime
mc Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctYDay CalendarTime
c)
, mctTZName :: Maybe String
mctTZName = MCalendarTime -> Maybe String
mctTZName MCalendarTime
mc Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Maybe String
forall a. a -> Maybe a
Just (CalendarTime -> String
ctTZName CalendarTime
c)
, mctTZ :: Maybe Int
mctTZ = MCalendarTime -> Maybe Int
mctTZ MCalendarTime
mc Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctTZ CalendarTime
c)
, mctIsDST :: Maybe Bool
mctIsDST = MCalendarTime -> Maybe Bool
mctIsDST MCalendarTime
mc Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CalendarTime -> Bool
ctIsDST CalendarTime
c)
}
unsetTime :: CalendarTime -> CalendarTime
unsetTime :: CalendarTime -> CalendarTime
unsetTime mc :: CalendarTime
mc = CalendarTime
mc
{ ctHour :: Int
ctHour = 0
, ctMin :: Int
ctMin = 0
, ctSec :: Int
ctSec = 0
, ctPicosec :: Integer
ctPicosec = 0
}