-- Copyright (C) 2003 Peter Simons
-- Copyright (C) 2003 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

-- |
-- Module      : Darcs.Util.IsoDate
-- Copyright   : 2003 Peter Simons
--               2003 David Roundy
-- License     : GPL
-- Maintainer  : darcs-devel@darcs.net
-- Stability   : experimental
-- Portability : portable

module Darcs.Util.IsoDate
    ( getIsoDateTime, readUTCDate, readUTCDateOldFashioned
    , parseDate, getLocalTz
    , englishDateTime, englishInterval, englishLast
    , iso8601Interval, iso8601Duration
    , cleanLocalDate, resetCalendar
    , MCalendarTime(..), subtractFromMCal, addToMCal
    , toMCalendarTime, unsafeToCalendarTime
    , unsetTime, TimeInterval
    , showIsoDateTime
    , theBeginning
    ) where

import Darcs.Prelude
import 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)

-- | Read/interpret a date string, assuming UTC if timezone
--   is not specified in the string (see 'readDate')
--   Warning! This errors out if we fail to interpret the
--   date
readUTCDate :: String -> CalendarTime
readUTCDate :: String -> CalendarTime
readUTCDate = Int -> String -> CalendarTime
readDate Int
0

-- | Convert a date string into ISO 8601 format (yyyymmdd variant)
--   assuming local timezone if not specified in the string
--   Warning! This errors out if we fail to interpret the date
cleanLocalDate :: String -> IO String
cleanLocalDate :: String -> IO String
cleanLocalDate 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

-- | Return the local timezone offset from UTC in seconds
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)

-- | Parse a date string with 'parseDate'
--   Warning! This errors out if we fail to interpret the date
--   Uses its first argument as the default time zone.
readDate :: Int -> String -> CalendarTime
readDate :: Int -> String -> CalendarTime
readDate Int
tz String
d =
             case Int -> String -> Either ParseError MCalendarTime
parseDate Int
tz String
d of
             Left ParseError
e -> String -> CalendarTime
forall a. HasCallStack => String -> a
error (String -> CalendarTime) -> String -> CalendarTime
forall a b. (a -> b) -> a -> b
$ String
"bad date: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" - "String -> String -> String
forall a. [a] -> [a] -> [a]
++ParseError -> String
forall a. Show a => a -> String
show ParseError
e
             Right MCalendarTime
ct -> CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime) -> CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
ct

-- | Similar to 'readUTCDate', except we /ignore/ timezone info
-- in the input string. This is incorrect and ugly. The only reason
-- it still exists is so we can generate file names for old-fashioned
-- repositories in the same way that old darcs versions expected them.
-- You should not use this function except for the above stated purpose.
readUTCDateOldFashioned :: String -> CalendarTime
readUTCDateOldFashioned :: String -> CalendarTime
readUTCDateOldFashioned String
d = 
             case Int -> String -> Either ParseError MCalendarTime
parseDate Int
0 String
d of
             Left ParseError
e -> String -> CalendarTime
forall a. HasCallStack => String -> a
error (String -> CalendarTime) -> String -> CalendarTime
forall a b. (a -> b) -> a -> b
$ String
"bad date: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" - "String -> String -> String
forall a. [a] -> [a] -> [a]
++ParseError -> String
forall a. Show a => a -> String
show ParseError
e
             Right MCalendarTime
ct -> (MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
ct) { ctTZ :: Int
ctTZ = Int
0 }

-- | Parse a date string, assuming a default timezone if
--   the date string does not specify one.  The date formats
--   understood are those of 'showIsoDateTime' and 'dateTime'
parseDate :: Int -> String -> Either ParseError MCalendarTime
parseDate :: Int -> String -> Either ParseError MCalendarTime
parseDate Int
tz 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
>= Int
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 Int
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
+ (-Int
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 Int
2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
4 ByteString
bd)
                                (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
6 ByteString
bd) -- Day
                                (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
8 ByteString
bd) -- Hour
                                (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
10 ByteString
bd) -- Minute
                                (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
12 ByteString
bd) -- Second
                                Integer
0 Day
Sunday Int
0 -- Picosecond, weekday and day of year unknown
                                String
"GMT" Int
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
"" String
d
  where bd :: ByteString
bd = String -> ByteString
BC.pack (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
14 String
d)
        readI :: ByteString -> Int
readI 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 String
"parseDate: invalid date") (ByteString -> Maybe (Int, ByteString)
BC.readInt ByteString
s)

-- | Display a 'CalendarTime' in the ISO 8601 format without any
--   separators, e.g. 20080825142503
showIsoDateTime :: CalendarTime -> String
showIsoDateTime :: CalendarTime -> String
showIsoDateTime 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
+Int
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@(Char
_:[])    = Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
x
          twoDigit x :: String
x@(Char
_:Char
_:[])  = String
x
          twoDigit String
_           = String
forall a. HasCallStack => a
undefined

-- | The current time in the format returned by 'showIsoDateTime'
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

----- Parser Combinators ---------------------------------------------

-- | Case-insensitive variant of Parsec's 'char' function.
caseChar        :: Char -> GenParser Char a Char
caseChar :: Char -> GenParser Char a Char
caseChar Char
c       = (Char -> Bool) -> GenParser Char a Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
x -> Char -> Char
toUpper Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
c)

-- | Case-insensitive variant of Parsec's 'string' function.
caseString      :: String -> GenParser Char a ()
caseString :: String -> GenParser Char a ()
caseString 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

-- [x,y] => x <|> y
caseStrings :: [String] -> GenParser Char a ()
caseStrings :: [String] -> GenParser Char a ()
caseStrings [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

-- | Match a parser at least @n@ times.
manyN           :: Int -> GenParser a b c -> GenParser a b [c]
manyN :: Int -> GenParser a b c -> GenParser a b [c]
manyN Int
n GenParser a b c
p
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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)

-- | Match a parser at least @n@ times, but no more than @m@ times.
manyNtoM        :: Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM :: Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM Int
n Int
m GenParser a b c
p
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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
== Int
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
. (\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 [Int
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 Int
0 (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) GenParser a b c
p)


----- Date/Time Parser -----------------------------------------------

-- | Try each of these date parsers in the following order
--
--    (1) 'cvsDateTime'
--
--    (2) 'iso8601DateTime'
--
--    (3) 'oldDateTime'
--
--    (4) 'rfc2822DateTime'
dateTime :: Int -> CharParser a MCalendarTime
dateTime :: Int -> CharParser a MCalendarTime
dateTime 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
    (Int
h, Int
m, 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 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 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

-- | CVS-style date/times, e.g.
--   2007/08/25 14:25:39 GMT
--   Note that time-zones are optional here.
cvsDateTime :: Int -> CharParser a CalendarTime
cvsDateTime :: Int -> CharParser a CalendarTime
cvsDateTime 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 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 Char
'/'
                   (Int
d, Int
h, Int
m, 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 Integer
0 Day
Monday Int
0 String
"" Int
z Bool
False)

-- | \"Old\"-style dates, e.g.
--   Tue Jan 3 14:08:07 EST 1999
-- darcs-doc: Question (what does the "old" stand for really?)
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
                      (Int
d, Int
h, Int
m , 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 Integer
0 Day
wd Int
0 String
"" 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 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
                        (Int
h, Int
m, 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 Integer
0 Day
wd Int
0 String
"" Int
z Bool
False)

-- | ISO 8601 dates and times.  Please note the following flaws:
--
--   I am reluctant to implement:
--
--      * years > 9999
--
--      * truncated representations with implied century (89 for 1989)
--
--   I have not implemented:
--
--      * repeated durations (not relevant)
--
--      * lowest order component fractions in intervals
--
--      * negative dates (BC)
--
--   I have not verified or have left too relaxed:
--
--      * the difference between 24h and 0h
--
--      * allows stuff like 2005-1212; either you use the hyphen all the way
--        (2005-12-12) or you don't use it at all (20051212), but you don't use
--        it halfway, likewise with time
--
--      * No bounds checking whatsoever on intervals!
--        (next action: read iso doc to see if bounds-checking required?) -}
iso8601DateTime   :: Int -> CharParser a MCalendarTime
iso8601DateTime :: Int -> CharParser a MCalendarTime
iso8601DateTime 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 String
" 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 }

-- | Three types of ISO 8601 date:
--
--     * calendar date, e.g., 1997-07-17, 1997-07, 199707, 1997
--
--     * week+day in year, e.g.,  1997-W32-4
--
--     * day in year, e.g, 1997-273
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 = -- yyyy-mm-dd
      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_) ]
               -- allow other variants to be parsed correctly
               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 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 = --yyyy-Www-d
      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 Char
'W'
               -- offset human 'week 1' -> computer 'week 0'
               Int
w'  <- (\Int
x -> Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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 Int
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 Int
1 }
                   firstDay :: Day
firstDay = CalendarTime -> Day
ctWDay CalendarTime
y
               -- things that make this complicated
               -- 1. iso8601 weeks start from Monday; Haskell weeks start from Sunday
               -- 2. the first week is the one that contains at least Thursday
               --    if the year starts after Thursday, then some days of the year
               --    will have already passed before the first week
               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
+Int
1 else Int
w'
                   yday :: Int
yday = (Int
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 Int
1 Maybe Int
mwd
                   diff :: MCalendarTime -> MCalendarTime
diff 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 = -- yyyy-ddd
      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
<?> String
"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
$ \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
<?> String
"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
$ \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
<?> String
"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
$ \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 Int
3 CharParser st Int -> String -> CharParser st Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"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
$ \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
- Int
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 Char
'-'

-- | Note that this returns a function which sets the time on
--   another calendar (see 'iso8601DateTime' for a list of
--   flaws
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 String
",.", 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
$ \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
$ \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
$ \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 = Int
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 = Integer
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 = Integer
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
$ \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 Char
'Z'; (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (\MCalendarTime
c -> MCalendarTime
c { mctTZ :: Maybe Int
mctTZ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
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 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   Int
1
                               , Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
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 (-Int
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 Int
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
$ \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
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
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 Char
':'

-- | Intervals in ISO 8601, e.g.,
--
--    * 2008-09/2012-08-17T16:30
--
--    * 2008-09/P2Y11MT16H30M
--
--    * P2Y11MT16H30M/2012-08-17T16:30
--
--   See 'iso8601Duration'
iso8601Interval :: Int -> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval :: Int
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval 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 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
                Maybe MCalendarTime
Nothing -> TimeDiff -> Either TimeDiff (MCalendarTime, MCalendarTime)
forall a b. a -> Either a b
Left TimeDiff
dur
                Just 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 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 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 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

-- | Durations in ISO 8601, e.g.,
--
--    * P4Y (four years)
--
--    * P5M (five months)
--
--    * P4Y5M (four years and five months)
--
--    * P4YT3H6S (four years, three hours and six seconds)
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 Char
'P'
     Int
y   <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block Int
0 Char
'Y'
     Int
mon <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block Int
0 Char
'M'
     Int
d   <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block Int
0 Char
'D'
     (Int
h,Int
m,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 (Int
0,Int
0,Int
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 Char
'T'
          Int
h' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-Int
1) Char
'H'
          Int
m' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-Int
1) Char
'M'
          Int
s' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-Int
1) Char
'S'
          let unset :: Int -> Bool
unset = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
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 String
"T should be omitted if time is unspecified"
             else let clear :: Int -> Int
clear Int
x = if Int -> Bool
unset Int
x then Int
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 Integer
0
  where block :: a -> Char -> ParsecT String u Identity a
block a
d 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' @p xs@ parses a string with the obligatory
--   parser @p@.  If this suceeds, it continues on to the
--   rest of the input using the next parsers down the
--   chain.  Each part of the chain consists of a parser
--   for a separator and for the content itself.  The
--   separator is optional.
--
--   A good use of this function is to help in parsing ISO
--   ISO 8601 dates and times.  For example, the parser
--   @optchain year [(dash, month), (dash, day)]@ accepts
--   dates like 2007 (only the year is used), 2007-07 (only
--   the year and month), 200707 (only the year and month
--   with no separator), 2007-07-19 (year, month and day).
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 CharParser a b
p [(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 []
           ((CharParser a c
sep,CharParser a b
p2):[(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 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 Int
2
fourDigits :: CharParser a Int
fourDigits = Int -> CharParser a Int
forall a. Int -> CharParser a Int
nDigits Int
4

-- | One or more space.
--   WARNING! This only matches on the space character, not on
--   whitespace in general
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 Int
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 Char
' '

-- | English three-letter day abbreviations (e.g. Mon, Tue, Wed)
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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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
                       ]

-- | Four-digit year
year            :: CharParser a Int
year :: CharParser a Int
year             = CharParser a Int
forall a. CharParser a Int
fourDigits

-- | One or two digit month (e.g. 3 for March, 11 for November)
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 Int
1 Int
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)

-- | January is 1, February is 2, etc
intToMonth :: Int -> Month
intToMonth :: Int -> Month
intToMonth Int
1 = Month
January
intToMonth Int
2 = Month
February
intToMonth Int
3 = Month
March
intToMonth Int
4 = Month
April
intToMonth Int
5 = Month
May
intToMonth Int
6 = Month
June
intToMonth Int
7 = Month
July
intToMonth Int
8 = Month
August
intToMonth Int
9 = Month
September
intToMonth Int
10 = Month
October
intToMonth Int
11 = Month
November
intToMonth Int
12 = Month
December
intToMonth Int
_  = String -> Month
forall a. HasCallStack => String -> a
error String
"invalid month!"

-- | English three-letter month abbreviations (e.g. Jan, Feb, Mar)
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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 in one or two digit notation
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 Int
1 Int
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 in two-digit notation
hour            :: CharParser a Int
hour :: CharParser a Int
hour             = CharParser a Int
forall a. CharParser a Int
twoDigits

-- | minute in two-digit notation
minute          :: CharParser a Int
minute :: CharParser a Int
minute           = CharParser a Int
forall a. CharParser a Int
twoDigits

-- | second in two-digit notation
second          :: CharParser a Int
second :: CharParser a Int
second           = CharParser a Int
forall a. CharParser a Int
twoDigits

-- | limited timezone support
--
--   * +HHMM or -HHMM
--
--   * Universal timezones: UTC, UT
--
--   * Zones from GNU coreutils/lib/getdate.y, less half-hour ones --
--     sorry Newfies.
--
--   * any sequence of alphabetic characters (WARNING! treated as 0!)
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 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
*Int
60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60) }
                       , do { Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
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
*Int
60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60) }
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"UTC"  Int
0
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"UT"  Int
0
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"GMT" Int
0
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"WET" Int
0
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"WEST" Int
1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"BST" Int
1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"ART" (-Int
3)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"BRT" (-Int
3)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"BRST" (-Int
2)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"AST" (-Int
4)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"ADT" (-Int
3)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"CLT" (-Int
4)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"CLST" (-Int
3)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"EST" (-Int
5)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"EDT" (-Int
4)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"CST" (-Int
6)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"CDT" (-Int
5)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"MST" (-Int
7)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"MDT" (-Int
6)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"PST" (-Int
8)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"PDT" (-Int
7)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"AKST" (-Int
9)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"AKDT" (-Int
8)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"HST" (-Int
10)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"HAST" (-Int
10)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"HADT" (-Int
9)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"SST" (-Int
12)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"WAT" Int
1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"CET" Int
1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"CEST" Int
2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"MET" Int
1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"MEZ" Int
1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"MEST" Int
2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"MESZ" Int
2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"EET" Int
2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"EEST" Int
3
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"CAT" Int
2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"SAST" Int
2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"EAT" Int
3
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"MSK" Int
3
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"MSD" Int
4
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"SGT" Int
8
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"KST" Int
9
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"JST" Int
9
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"GST" Int
10
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"NZST" Int
12
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone String
"NZDT" Int
13
                         -- if we don't understand it, just give a GMT answer...
                       , 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
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
'a'..Char
'z']String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
'A'..Char
'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 Int
0 }
                       ]
     where mkZone :: String -> a -> GenParser Char st a
mkZone String
n 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
*a
60a -> a -> a
forall a. Num a => 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 Char
' '; String -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'0'..Char
'9'] }

----- English dates and intervals -----------------------------------------------

-- | In English, either a date followed by a time, or vice-versa, e.g,
--
--    * yesterday at noon
--
--    * yesterday tea time
--
--    * 12:00 yesterday
--
--   See 'englishDate' and 'englishTime'
--   Uses its first argument as "now", i.e. the time relative to which
--   "yesterday", "today" etc are to be interpreted
englishDateTime :: CalendarTime -> CharParser a CalendarTime
englishDateTime :: CalendarTime -> CharParser a CalendarTime
englishDateTime 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
   -- yesterday (at) noon
   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 String
"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
   -- tea time 2005-12-04
   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
','
        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

-- | Specific dates in English as specific points of time, e.g,
--
--    * today
--
--    * yesterday
--
--    * last week (i.e. the beginning of that interval)
--
--    * 4 months ago (via 'englishAgo')
--
--   The first argument is "now".
englishDate :: CalendarTime -> CharParser a CalendarTime
englishDate :: CalendarTime -> CharParser a CalendarTime
englishDate 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 String
"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 String
"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 Int
0 Int
0 Int
1 Int
0 Int
0 Int
0 Integer
0

-- | English expressions for points in the past, e.g.
--
--    * 4 months ago
--
--    * 1 day ago
--
--    * day before yesterday
--
--   See 'englishDuration'
englishAgo :: CalendarTime -> CharParser a CalendarTime
englishAgo :: CalendarTime -> CharParser a CalendarTime
englishAgo 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
           (Int
m,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 String
"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 (-Int
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 String
"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 (-Int
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 [String
"after",String
"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 Int
1

-- | English expressions for intervals of time,
--
--    * before tea time (i.e. from the beginning of time)
--
--    * after 14:00 last month (i.e. till now)
--
--    * between last year and last month
--
--    * in the last three months (i.e. from then till now)
--
--    * 4 months ago (i.e. till now; see 'englishAgo')
englishInterval :: CalendarTime -> CharParser a TimeInterval
englishInterval :: CalendarTime -> CharParser a TimeInterval
englishInterval 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 String
"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 [String
"after",String
"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 String
"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 String
"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 String
"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)

-- | Durations in English that begin with the word \"last\",
--   E.g. \"last 4 months\" is treated as the duration between
--   4 months ago and now
englishLast :: CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast :: CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now =
    -- last year, last week, last 3 years, etc
    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 String
"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)

-- | Either an 'iso8601Time' or one of several common
--   English time expressions like 'noon' or 'tea time'
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 String
"noon"            Int
12  Int
0
         , String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime String
"midnight"         Int
0  Int
0
         , String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime String
"tea time"        Int
16 Int
30
         , String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime String
"bed time"         Int
2 Int
30
         , String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime String
"proper bed time" Int
21 Int
30 ]
  where namedTime :: String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime String
name Int
h 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
$ \CalendarTime
c -> CalendarTime
c { ctHour :: Int
ctHour = Int
h, ctMin :: Int
ctMin = Int
m }
        wrapM :: (MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
wrapM 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

-- | Some English durations, e.g.
--
--    * day
--
--    * 4 score
--
--    * 7 years
--
--    * 12 months
--
-- This is not particularly strict about what it accepts.
-- For example, "7 yeares", "4 scores" or "1 days" are
-- just fine.
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 Int
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 [String
"es",String
"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 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 String
"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 Int
20 Int
0  Int
0 Int
0 Int
0 Int
0 Integer
0) -- why not?
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString String
"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  Int
1 Int
0  Int
0 Int
0 Int
0 Int
0 Integer
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 String
"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  Int
0 Int
1  Int
0 Int
0 Int
0 Int
0 Integer
0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString String
"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  Int
0 Int
0 Int
14 Int
0 Int
0 Int
0 Integer
0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString String
"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  Int
0 Int
0  Int
7 Int
0 Int
0 Int
0 Integer
0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString String
"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  Int
0 Int
0  Int
1 Int
0 Int
0 Int
0 Integer
0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString String
"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  Int
0 Int
0  Int
0 Int
1 Int
0 Int
0 Integer
0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString String
"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  Int
0 Int
0  Int
0 Int
0 Int
1 Int
0 Integer
0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString String
"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  Int
0 Int
0  Int
0 Int
0 Int
0 Int
1 Integer
0) ]

----- Calendar and TimeDiff manipulation ---------------------------------------------

-- | The very beginning of time, i.e. 1970-01-01
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 Integer
0 Integer
0

-- | An 'MCalenderTime' is an underspecified 'CalendarTime'
--   It is used for parsing dates.  For example, if you want to parse
--   the date '4 January', it may be useful to underspecify the year
--   by setting it to 'Nothing'.  This uses almost the same fields as
--   'System.Time.CalendarTime', a notable exception being that we
--   introduce 'mctWeek' to indicate if a weekday was specified or not
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 -- is set or not
} 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

-- | Trivially convert a 'CalendarTime' to a fully specified
--   'MCalendarTime' (note that this sets the 'mctWeek' flag to
--   @False@
toMCalendarTime :: CalendarTime -> MCalendarTime
toMCalendarTime :: CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime Int
a Month
b Int
c Int
d Int
e Int
f Integer
g Day
h Int
i String
j Int
k 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

-- | Returns the first 'CalendarTime' that falls within a 'MCalendarTime'
--   This is only unsafe in the sense that it plugs in default values
--   for fields that have not been set, e.g. @January@ for the month
--   or @0@ for the seconds field.
--   Maybe we should rename it something happier.
--   See also 'resetCalendar'
unsafeToCalendarTime :: MCalendarTime -> CalendarTime
unsafeToCalendarTime :: MCalendarTime -> CalendarTime
unsafeToCalendarTime 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 Int
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 Int
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 Int
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 Int
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 Int
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 Integer
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 Int
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 String
"" (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 Int
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 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 (-Int
1)

addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal TimeDiff
td 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 (-Int
1)

-- surely there is a more concise way to express these
addDiff :: TimeDiff -> TimeDiff -> TimeDiff
addDiff :: TimeDiff -> TimeDiff -> TimeDiff
addDiff (TimeDiff Int
a1 Int
a2 Int
a3 Int
a4 Int
a5 Int
a6 Integer
a7) (TimeDiff Int
b1 Int
b2 Int
b3 Int
b4 Int
b5 Int
b6 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' @i d@ multiplies every field in @d@ with @i@
--
-- FIXME; this seems like a terrible idea! it seems like
-- we should get rid of it if at all possible, maybe adding an
-- invertDiff function
multiplyDiff :: Int -> TimeDiff -> TimeDiff
multiplyDiff :: Int -> TimeDiff -> TimeDiff
multiplyDiff Int
m (TimeDiff Int
a1 Int
a2 Int
a3 Int
a4 Int
a5 Int
a6 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

-- | Set a calendar to UTC time any eliminate any inconsistencies within
--   (for example, where the weekday is given as @Thursday@, but this does not
--   match what the numerical date would lead one to expect)
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' @c mc@ replaces any field which is
--   specified in @mc@ with the equivalent field in @c@
--   @copyCalendar c nullMCalendar == nullMCalendar@
copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar CalendarTime
c 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)
  }

-- | Zero the time fields of a 'CalendarTime'
unsetTime :: CalendarTime -> CalendarTime
unsetTime :: CalendarTime -> CalendarTime
unsetTime CalendarTime
mc = CalendarTime
mc
  { ctHour :: Int
ctHour  = Int
0
  , ctMin :: Int
ctMin   = Int
0
  , ctSec :: Int
ctSec   = Int
0
  , ctPicosec :: Integer
ctPicosec = Integer
0
  }