-- 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
    ) where

import Prelude ( (^) )
import Darcs.Prelude

import Text.ParserCombinators.Parsec
import System.Time
import System.IO.Unsafe ( unsafePerformIO )
import Data.Char ( toUpper, isDigit )
import Data.Maybe ( fromMaybe )
import Control.Monad ( liftM, liftM2 )
import qualified Data.ByteString.Char8 as BC

type TimeInterval = (Maybe CalendarTime, Maybe CalendarTime)

-- | 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 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 str :: String
str =
   do Int
tz <- IO Int
getLocalTz
      String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> (String -> String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> String
showIsoDateTime (CalendarTime -> String)
-> (String -> CalendarTime) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime)
-> (String -> CalendarTime) -> String -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> CalendarTime
readDate Int
tz (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
str

-- | 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 tz :: Int
tz d :: String
d =
             case Int -> String -> Either ParseError MCalendarTime
parseDate Int
tz String
d of
             Left e :: ParseError
e -> String -> CalendarTime
forall a. HasCallStack => String -> a
error (String -> CalendarTime) -> String -> CalendarTime
forall a b. (a -> b) -> a -> b
$ "bad date: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
dString -> String -> String
forall a. [a] -> [a] -> [a]
++" - "String -> String -> String
forall a. [a] -> [a] -> [a]
++ParseError -> String
forall a. Show a => a -> String
show ParseError
e
             Right ct :: MCalendarTime
ct -> CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime) -> CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
ct

-- | 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 d :: String
d = 
             case Int -> String -> Either ParseError MCalendarTime
parseDate 0 String
d of
             Left e :: ParseError
e -> String -> CalendarTime
forall a. HasCallStack => String -> a
error (String -> CalendarTime) -> String -> CalendarTime
forall a b. (a -> b) -> a -> b
$ "bad date: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
dString -> String -> String
forall a. [a] -> [a] -> [a]
++" - "String -> String -> String
forall a. [a] -> [a] -> [a]
++ParseError -> String
forall a. Show a => a -> String
show ParseError
e
             Right ct :: MCalendarTime
ct -> (MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
ct) { ctTZ :: Int
ctTZ = 0 }

-- | 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 tz :: Int
tz d :: String
d =
              if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 14 Bool -> Bool -> Bool
&& (Char -> Bool) -> ByteString -> Bool
BC.all Char -> Bool
isDigit ByteString
bd
              then MCalendarTime -> Either ParseError MCalendarTime
forall a b. b -> Either a b
Right (MCalendarTime -> Either ParseError MCalendarTime)
-> MCalendarTime -> Either ParseError MCalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime -> MCalendarTime) -> CalendarTime -> MCalendarTime
forall a b. (a -> b) -> a -> b
$
                   Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 4 ByteString
bd)
                                (Int -> Month
forall a. Enum a => Int -> a
toEnum (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (-1)) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 4 ByteString
bd)
                                (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 6 ByteString
bd) -- Day
                                (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 8 ByteString
bd) -- Hour
                                (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 10 ByteString
bd) -- Minute
                                (ByteString -> Int
readI (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop 12 ByteString
bd) -- Second
                                0 Day
Sunday 0 -- Picosecond, weekday and day of year unknown
                                "GMT" 0 Bool
False
              else let dt :: ParsecT String a Identity MCalendarTime
dt = do { MCalendarTime
x <- Int -> ParsecT String a Identity MCalendarTime
forall a. Int -> CharParser a MCalendarTime
dateTime Int
tz; ParsecT String a Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof; MCalendarTime -> ParsecT String a Identity MCalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return MCalendarTime
x }
                   in Parsec String () MCalendarTime
-> String -> String -> Either ParseError MCalendarTime
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
dt "" String
d
  where bd :: ByteString
bd = String -> ByteString
BC.pack (Int -> String -> String
forall a. Int -> [a] -> [a]
take 14 String
d)
        readI :: ByteString -> Int
readI s :: ByteString
s = (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int) -> (Int, ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ (Int, ByteString) -> Maybe (Int, ByteString) -> (Int, ByteString)
forall a. a -> Maybe a -> a
fromMaybe (String -> (Int, ByteString)
forall a. HasCallStack => String -> a
error "parseDate: invalid date") (ByteString -> Maybe (Int, ByteString)
BC.readInt ByteString
s)

-- | Display a 'CalendarTime' in the ISO 8601 format without any
--   separators, e.g. 20080825142503
showIsoDateTime :: CalendarTime -> String
showIsoDateTime :: CalendarTime -> String
showIsoDateTime ct :: CalendarTime
ct = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctYear CalendarTime
ct
                            , String -> String
twoDigit (String -> String) -> (Month -> String) -> Month -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Month -> Int) -> Month -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Int -> Int) -> (Month -> Int) -> Month -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month -> Int
forall a. Enum a => a -> Int
fromEnum (Month -> String) -> Month -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Month
ctMonth CalendarTime
ct
                            , String -> String
twoDigit (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctDay CalendarTime
ct
                            , String -> String
twoDigit (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctHour CalendarTime
ct
                            , String -> String
twoDigit (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctMin CalendarTime
ct
                            , String -> String
twoDigit (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctSec CalendarTime
ct
                            ]
    where twoDigit :: String -> String
twoDigit []          = String
forall a. HasCallStack => a
undefined
          twoDigit x :: String
x@(_:[])    = '0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
x
          twoDigit x :: String
x@(_:_:[])  = String
x
          twoDigit _           = String
forall a. HasCallStack => a
undefined

-- | 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 c :: Char
c       = (Char -> Bool) -> GenParser Char a Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\x :: Char
x -> Char -> Char
toUpper Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
c)

-- | Case-insensitive variant of Parsec's 'string' function.
caseString      :: String -> GenParser Char a ()
caseString :: String -> GenParser Char a ()
caseString cs :: String
cs    = (Char -> ParsecT String a Identity Char)
-> String -> GenParser Char a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> ParsecT String a Identity Char
forall a. Char -> GenParser Char a Char
caseChar String
cs GenParser Char a () -> String -> GenParser Char a ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
cs

-- [x,y] => x <|> y
caseStrings :: [String] -> GenParser Char a ()
caseStrings :: [String] -> GenParser Char a ()
caseStrings xs :: [String]
xs = (GenParser Char a () -> GenParser Char a () -> GenParser Char a ())
-> [GenParser Char a ()] -> GenParser Char a ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 GenParser Char a () -> GenParser Char a () -> GenParser Char a ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) ([GenParser Char a ()] -> GenParser Char a ())
-> [GenParser Char a ()] -> GenParser Char a ()
forall a b. (a -> b) -> a -> b
$ (String -> GenParser Char a ())
-> [String] -> [GenParser Char a ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString [String]
xs

-- | 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 n :: Int
n p :: GenParser a b c
p
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0     = [c] -> GenParser a b [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise  = ([c] -> [c] -> [c])
-> GenParser a b [c] -> GenParser a b [c] -> GenParser a b [c]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
(++) (Int -> GenParser a b c -> GenParser a b [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n GenParser a b c
p) (GenParser a b c -> GenParser a b [c]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many GenParser a b c
p)

-- | 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 n :: Int
n m :: Int
m p :: GenParser a b c
p
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0      = [c] -> GenParser a b [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m      = [c] -> GenParser a b [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m     = Int -> GenParser a b c -> GenParser a b [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n GenParser a b c
p
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0     = (Int -> GenParser a b [c] -> GenParser a b [c])
-> GenParser a b [c] -> [Int] -> GenParser a b [c]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (GenParser a b [c] -> GenParser a b [c] -> GenParser a b [c]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) (GenParser a b [c] -> GenParser a b [c] -> GenParser a b [c])
-> (Int -> GenParser a b [c])
-> Int
-> GenParser a b [c]
-> GenParser a b [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\x :: Int
x -> GenParser a b [c] -> GenParser a b [c]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser a b [c] -> GenParser a b [c])
-> GenParser a b [c] -> GenParser a b [c]
forall a b. (a -> b) -> a -> b
$ Int -> GenParser a b c -> GenParser a b [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
x GenParser a b c
p)) ([c] -> GenParser a b [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [1..Int
m])
    | Bool
otherwise  = ([c] -> [c] -> [c])
-> GenParser a b [c] -> GenParser a b [c] -> GenParser a b [c]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
(++) (Int -> GenParser a b c -> GenParser a b [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n GenParser a b c
p) (Int -> Int -> GenParser a b c -> GenParser a b [c]
forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM 0 (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) GenParser a b c
p)


----- 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 tz :: Int
tz =
            [CharParser a MCalendarTime] -> CharParser a MCalendarTime
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [CharParser a MCalendarTime -> CharParser a MCalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a MCalendarTime -> CharParser a MCalendarTime)
-> CharParser a MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime -> MCalendarTime)
-> ParsecT String a Identity CalendarTime
-> CharParser a MCalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT String a Identity CalendarTime
forall a. Int -> CharParser a CalendarTime
cvsDateTime Int
tz,
                    CharParser a MCalendarTime -> CharParser a MCalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a MCalendarTime -> CharParser a MCalendarTime)
-> CharParser a MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ Int -> CharParser a MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime Int
tz,
                    CharParser a MCalendarTime -> CharParser a MCalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a MCalendarTime -> CharParser a MCalendarTime)
-> CharParser a MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime -> MCalendarTime)
-> ParsecT String a Identity CalendarTime
-> CharParser a MCalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT String a Identity CalendarTime
forall a. CharParser a CalendarTime
oldDateTime,
                    CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime -> MCalendarTime)
-> ParsecT String a Identity CalendarTime
-> CharParser a MCalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT String a Identity CalendarTime
forall a. CharParser a CalendarTime
rfc2822DateTime]

parseDHMS :: CharParser a (Int, Int, Int, Int)
parseDHMS :: CharParser a (Int, Int, Int, Int)
parseDHMS = do
    Int
d <- CharParser a Int
forall a. CharParser a Int
day
    String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
    (h :: Int
h, m :: Int
m, s :: Int
s) <- CharParser a (Int, Int, Int)
forall a. CharParser a (Int, Int, Int)
parseHMS
    (Int, Int, Int, Int) -> CharParser a (Int, Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
d, Int
h, Int
m, Int
s)

parseHMS :: CharParser a (Int, Int, Int)
parseHMS :: CharParser a (Int, Int, Int)
parseHMS = do
    Int
h <- CharParser a Int
forall a. CharParser a Int
hour
    Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'
    Int
m <- CharParser a Int
forall a. CharParser a Int
minute
    Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'
    Int
s <- CharParser a Int
forall a. CharParser a Int
second
    (Int, Int, Int) -> CharParser a (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
h, Int
m, Int
s)

parseSpacesMonthName :: CharParser a Month
parseSpacesMonthName :: CharParser a Month
parseSpacesMonthName = do
    String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
    Month
mon <- CharParser a Month
forall a. CharParser a Month
monthName
    String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
    Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
mon

-- | 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 tz :: Int
tz =
                do Int
y <- CharParser a Int
forall a. CharParser a Int
year
                   Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'
                   Month
mon <- CharParser a Month
forall a. CharParser a Month
monthNum
                   Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'
                   (d :: Int
d, h :: Int
h, m :: Int
m, s :: Int
s) <- CharParser a (Int, Int, Int, Int)
forall a. CharParser a (Int, Int, Int, Int)
parseDHMS
                   Int
z <- Int -> CharParser a Int -> CharParser a Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
tz (CharParser a Int -> CharParser a Int)
-> CharParser a Int -> CharParser a Int
forall a b. (a -> b) -> a -> b
$ CharParser a String
forall a. CharParser a String
mySpaces CharParser a String -> CharParser a Int -> CharParser a Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser a Int
forall a. CharParser a Int
zone
                   CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime Int
y Month
mon Int
d Int
h Int
m Int
s 0 Day
Monday 0 "" Int
z Bool
False)

-- | \"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
                      (d :: Int
d, h :: Int
h, m :: Int
m , s :: Int
s) <- CharParser a (Int, Int, Int, Int)
forall a. CharParser a (Int, Int, Int, Int)
parseDHMS
                      String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
                      Int
z <- CharParser a Int
forall a. CharParser a Int
zone
                      String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
                      Int
y <- CharParser a Int
forall a. CharParser a Int
year
                      CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime Int
y Month
mon Int
d Int
h Int
m Int
s 0 Day
wd 0 "" Int
z Bool
False)

rfc2822DateTime :: CharParser a CalendarTime
rfc2822DateTime :: CharParser a CalendarTime
rfc2822DateTime    = do Day
wd <- CharParser a Day
forall a. CharParser a Day
dayName
                        Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ','
                        String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
                        Int
d <- CharParser a Int
forall a. CharParser a Int
day
                        Month
mon <- CharParser a Month
forall a. CharParser a Month
parseSpacesMonthName
                        Int
y <- CharParser a Int
forall a. CharParser a Int
year
                        String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
                        (h :: Int
h, m :: Int
m, s :: Int
s) <- CharParser a (Int, Int, Int)
forall a. CharParser a (Int, Int, Int)
parseHMS
                        String
_ <- CharParser a String
forall a. CharParser a String
mySpaces
                        Int
z <- CharParser a Int
forall a. CharParser a Int
zone
                        CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime Int
y Month
mon Int
d Int
h Int
m Int
s 0 Day
wd 0 "" Int
z Bool
False)

-- | 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 localTz :: Int
localTz = CharParser a MCalendarTime -> CharParser a MCalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a MCalendarTime -> CharParser a MCalendarTime)
-> CharParser a MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$
  do MCalendarTime
d <- CharParser a MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
iso8601Date
     MCalendarTime -> MCalendarTime
t <- (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option MCalendarTime -> MCalendarTime
forall a. a -> a
id (ParsecT String a Identity (MCalendarTime -> MCalendarTime)
 -> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String a Identity (MCalendarTime -> MCalendarTime)
 -> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do ParsecT String a Identity Char -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String a Identity Char -> ParsecT String a Identity ())
-> ParsecT String a Identity Char -> ParsecT String a Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf " T"
                               ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time
     MCalendarTime -> CharParser a MCalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (MCalendarTime -> CharParser a MCalendarTime)
-> MCalendarTime -> CharParser a MCalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> MCalendarTime
t (MCalendarTime -> MCalendarTime) -> MCalendarTime -> MCalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime
d { mctTZ :: Maybe Int
mctTZ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
localTz }

-- | 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 '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 'W'
               -- offset human 'week 1' -> computer 'week 0'
               Int
w'  <- (\x :: Int
x -> Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (Int -> Int)
-> ParsecT String st Identity Int -> ParsecT String st Identity Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT String st Identity Int
forall a. CharParser a Int
twoDigits
               Maybe Int
mwd  <- Maybe Int
-> ParsecT String st Identity (Maybe Int)
-> ParsecT String st Identity (Maybe Int)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Int
forall a. Maybe a
Nothing (ParsecT String st Identity (Maybe Int)
 -> ParsecT String st Identity (Maybe Int))
-> ParsecT String st Identity (Maybe Int)
-> ParsecT String st Identity (Maybe Int)
forall a b. (a -> b) -> a -> b
$ do { ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String st Identity Char
forall u. ParsecT String u Identity Char
dash; Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ParsecT String st Identity Int
-> ParsecT String st Identity (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT String st Identity Int
forall a. Int -> CharParser a Int
nDigits 1 }
               let y :: CalendarTime
y = CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime)
-> (MCalendarTime -> CalendarTime) -> MCalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> MCalendarTime
-> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> MCalendarTime
yfn (MCalendarTime -> CalendarTime) -> MCalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime
nullMCalendar { mctDay :: Maybe Int
mctDay = Int -> Maybe Int
forall a. a -> Maybe a
Just 1 }
                   firstDay :: Day
firstDay = CalendarTime -> Day
ctWDay CalendarTime
y
               -- 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
+1 else Int
w'
                   yday :: Int
yday = (7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1 Maybe Int
mwd
                   diff :: MCalendarTime -> MCalendarTime
diff c :: MCalendarTime
c = MCalendarTime
c { mctWeek :: Bool
mctWeek = Bool
True
                              , mctWDay :: Maybe Day
mctWDay = Int -> Day
forall a. Enum a => Int -> a
toEnum (Int -> Day) -> Maybe Int -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Int
mwd
                              , mctDay :: Maybe Int
mctDay  = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
yday }
               [MCalendarTime -> MCalendarTime]
-> GenParser Char st [MCalendarTime -> MCalendarTime]
forall (m :: * -> *) a. Monad m => a -> m a
return [MCalendarTime -> MCalendarTime
diff(MCalendarTime -> MCalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> MCalendarTime
-> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MCalendarTime -> MCalendarTime
yfn]
    ordinal_date :: GenParser Char st [MCalendarTime -> MCalendarTime]
ordinal_date = -- 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
<?> "year (0000-9999)"
                      (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> GenParser Char st (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctYear :: Maybe Int
mctYear = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y }
    month_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
month_ = GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (MCalendarTime -> MCalendarTime)
 -> GenParser Char st (MCalendarTime -> MCalendarTime))
-> GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do Int
m <- CharParser st Int
forall a. CharParser a Int
twoDigits CharParser st Int -> String -> CharParser st Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "month (1 to 12)"
                      (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> GenParser Char st (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctMonth :: Maybe Month
mctMonth = Month -> Maybe Month
forall a. a -> Maybe a
Just (Month -> Maybe Month) -> Month -> Maybe Month
forall a b. (a -> b) -> a -> b
$ Int -> Month
intToMonth Int
m }
    day_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
day_   = GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (MCalendarTime -> MCalendarTime)
 -> GenParser Char st (MCalendarTime -> MCalendarTime))
-> GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do Int
d <- CharParser st Int
forall a. CharParser a Int
twoDigits CharParser st Int -> String -> CharParser st Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "day in month (1 to 31)"
                      (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> GenParser Char st (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctDay :: Maybe Int
mctDay = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d }
    yearDay_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
yearDay_ = GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (MCalendarTime -> MCalendarTime)
 -> GenParser Char st (MCalendarTime -> MCalendarTime))
-> GenParser Char st (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do Int
d <- Int -> CharParser st Int
forall a. Int -> CharParser a Int
nDigits 3 CharParser st Int -> String -> CharParser st Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "day in year (001 to 366)"
                        (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> GenParser Char st (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> GenParser Char st (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctDay :: Maybe Int
mctDay = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d
                                         , mctYDay :: Maybe Int
mctYDay = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) }
    dash :: ParsecT String u Identity Char
dash = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-'

-- | 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 ",.", CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
pico_) ]
     MCalendarTime -> MCalendarTime
z  <- (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option MCalendarTime -> MCalendarTime
forall a. a -> a
id (CharParser a (MCalendarTime -> MCalendarTime)
 -> CharParser a (MCalendarTime -> MCalendarTime))
-> CharParser a (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ [CharParser a (MCalendarTime -> MCalendarTime)]
-> CharParser a (MCalendarTime -> MCalendarTime)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
zulu , CharParser a (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
offset ]
     (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> CharParser a (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> CharParser a (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ ((MCalendarTime -> MCalendarTime)
 -> (MCalendarTime -> MCalendarTime)
 -> MCalendarTime
 -> MCalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> [MCalendarTime -> MCalendarTime]
-> MCalendarTime
-> MCalendarTime
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (MCalendarTime -> MCalendarTime)
-> (MCalendarTime -> MCalendarTime)
-> MCalendarTime
-> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) MCalendarTime -> MCalendarTime
forall a. a -> a
id (MCalendarTime -> MCalendarTime
z(MCalendarTime -> MCalendarTime)
-> [MCalendarTime -> MCalendarTime]
-> [MCalendarTime -> MCalendarTime]
forall a. a -> [a] -> [a]
:[MCalendarTime -> MCalendarTime]
ts)
  where
    hour_ :: ParsecT String a Identity (MCalendarTime -> MCalendarTime)
hour_ = do Int
h <- CharParser a Int
forall a. CharParser a Int
twoDigits
               (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctHour :: Maybe Int
mctHour = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h }
    min_ :: ParsecT String a Identity (MCalendarTime -> MCalendarTime)
min_  = do Int
m <- CharParser a Int
forall a. CharParser a Int
twoDigits
               (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctMin :: Maybe Int
mctMin = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
m }
    sec_ :: ParsecT String a Identity (MCalendarTime -> MCalendarTime)
sec_  = do Int
s <- CharParser a Int
forall a. CharParser a Int
twoDigits
               (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> ParsecT String a Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String a Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctSec :: Maybe Int
mctSec = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
s }
    pico_ :: ParsecT String u Identity (MCalendarTime -> MCalendarTime)
pico_ = do String
digs <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
               let picoExp :: Int
picoExp = 12
                   digsExp :: Int
digsExp = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
digs
               let frac :: Integer
frac | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
digs = 0
                        | Int
digsExp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
picoExp = String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
picoExp String
digs
                        | Bool
otherwise = 10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
picoExp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
digsExp) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* String -> Integer
forall a. Read a => String -> a
read String
digs
               (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> ParsecT String u Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctPicosec :: Maybe Integer
mctPicosec = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
frac }
    zulu :: ParsecT String u Identity (MCalendarTime -> MCalendarTime)
zulu   = do { Char
_ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'Z'; (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (\c :: MCalendarTime
c -> MCalendarTime
c { mctTZ :: Maybe Int
mctTZ = Int -> Maybe Int
forall a. a -> Maybe a
Just 0 }) }
    offset :: ParsecT String u Identity (MCalendarTime -> MCalendarTime)
offset = do Int
sign <- [ParsecT String u Identity Int] -> ParsecT String u Identity Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '+' ParsecT String u Identity Char
-> ParsecT String u Identity Int -> ParsecT String u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT String u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return   1
                               , Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-' ParsecT String u Identity Char
-> ParsecT String u Identity Int -> ParsecT String u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT String u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (-1) ]
                Int
h <- ParsecT String u Identity Int
forall a. CharParser a Int
twoDigits
                Int
m <- Int
-> ParsecT String u Identity Int -> ParsecT String u Identity Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option 0 (ParsecT String u Identity Int -> ParsecT String u Identity Int)
-> ParsecT String u Identity Int -> ParsecT String u Identity Int
forall a b. (a -> b) -> a -> b
$ do { ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
colon; ParsecT String u Identity Int
forall a. CharParser a Int
twoDigits }
                (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MCalendarTime -> MCalendarTime)
 -> ParsecT String u Identity (MCalendarTime -> MCalendarTime))
-> (MCalendarTime -> MCalendarTime)
-> ParsecT String u Identity (MCalendarTime -> MCalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: MCalendarTime
c -> MCalendarTime
c { mctTZ :: Maybe Int
mctTZ = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
sign Int -> Int -> Int
forall a. Num a => a -> a -> a
* 60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m) }
    colon :: ParsecT String u Identity Char
colon = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'

-- | 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 localTz :: Int
localTz = CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a.
ParsecT
  String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
leftDur CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a a.
ParsecT String a Identity (Either a (MCalendarTime, MCalendarTime))
rightDur where
  leftDur :: ParsecT
  String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
leftDur  =
    do TimeDiff
dur <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
iso8601Duration
       Maybe MCalendarTime
end <- Maybe MCalendarTime
-> ParsecT String a Identity (Maybe MCalendarTime)
-> ParsecT String a Identity (Maybe MCalendarTime)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe MCalendarTime
forall a. Maybe a
Nothing (ParsecT String a Identity (Maybe MCalendarTime)
 -> ParsecT String a Identity (Maybe MCalendarTime))
-> ParsecT String a Identity (Maybe MCalendarTime)
-> ParsecT String a Identity (Maybe MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do { Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'; MCalendarTime -> Maybe MCalendarTime
forall a. a -> Maybe a
Just (MCalendarTime -> Maybe MCalendarTime)
-> ParsecT String a Identity MCalendarTime
-> ParsecT String a Identity (Maybe MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT String a Identity MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
isoDt }
       Either TimeDiff (MCalendarTime, MCalendarTime)
-> ParsecT
     String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TimeDiff (MCalendarTime, MCalendarTime)
 -> ParsecT
      String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime)))
-> Either TimeDiff (MCalendarTime, MCalendarTime)
-> ParsecT
     String a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a b. (a -> b) -> a -> b
$ case Maybe MCalendarTime
end of
                Nothing -> TimeDiff -> Either TimeDiff (MCalendarTime, MCalendarTime)
forall a b. a -> Either a b
Left TimeDiff
dur
                Just e :: MCalendarTime
e  -> (MCalendarTime, MCalendarTime)
-> Either TimeDiff (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`subtractFromMCal` MCalendarTime
e, MCalendarTime
e)
  rightDur :: ParsecT String a Identity (Either a (MCalendarTime, MCalendarTime))
rightDur =
    do MCalendarTime
start <- CharParser a MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
isoDt
       Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'
       Either TimeDiff MCalendarTime
durOrEnd <- TimeDiff -> Either TimeDiff MCalendarTime
forall a b. a -> Either a b
Left (TimeDiff -> Either TimeDiff MCalendarTime)
-> ParsecT String a Identity TimeDiff
-> ParsecT String a Identity (Either TimeDiff MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT String a Identity TimeDiff
forall a. CharParser a TimeDiff
iso8601Duration ParsecT String a Identity (Either TimeDiff MCalendarTime)
-> ParsecT String a Identity (Either TimeDiff MCalendarTime)
-> ParsecT String a Identity (Either TimeDiff MCalendarTime)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MCalendarTime -> Either TimeDiff MCalendarTime
forall a b. b -> Either a b
Right (MCalendarTime -> Either TimeDiff MCalendarTime)
-> CharParser a MCalendarTime
-> ParsecT String a Identity (Either TimeDiff MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` CharParser a MCalendarTime
forall a. ParsecT String a Identity MCalendarTime
isoDt
       Either a (MCalendarTime, MCalendarTime)
-> ParsecT
     String a Identity (Either a (MCalendarTime, MCalendarTime))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (MCalendarTime, MCalendarTime)
 -> ParsecT
      String a Identity (Either a (MCalendarTime, MCalendarTime)))
-> Either a (MCalendarTime, MCalendarTime)
-> ParsecT
     String a Identity (Either a (MCalendarTime, MCalendarTime))
forall a b. (a -> b) -> a -> b
$ case Either TimeDiff MCalendarTime
durOrEnd of
                Left dur :: TimeDiff
dur  -> (MCalendarTime, MCalendarTime)
-> Either a (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (MCalendarTime
start, TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`addToMCal` MCalendarTime
start)
                Right end :: MCalendarTime
end -> (MCalendarTime, MCalendarTime)
-> Either a (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (MCalendarTime
start, MCalendarTime
end)
  isoDt :: CharParser a MCalendarTime
isoDt   = Int -> CharParser a MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime Int
localTz

-- | 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 'P'
     Int
y   <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block 0 'Y'
     Int
mon <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block 0 'M'
     Int
d   <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block 0 'D'
     (h :: Int
h,m :: Int
m,s :: Int
s) <- (Int, Int, Int)
-> ParsecT String a Identity (Int, Int, Int)
-> ParsecT String a Identity (Int, Int, Int)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (0,0,0) (ParsecT String a Identity (Int, Int, Int)
 -> ParsecT String a Identity (Int, Int, Int))
-> ParsecT String a Identity (Int, Int, Int)
-> ParsecT String a Identity (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$
       do Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'T'
          Int
h' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-1) 'H'
          Int
m' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-1) 'M'
          Int
s' <- Int -> Char -> ParsecT String a Identity Int
forall a u. Read a => a -> Char -> ParsecT String u Identity a
block (-1) 'S'
          let unset :: Int -> Bool
unset = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1))
          if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
unset [Int
h',Int
m',Int
s']
             then String -> ParsecT String a Identity (Int, Int, Int)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "T should be omitted if time is unspecified"
             else let clear :: Int -> Int
clear x :: Int
x = if Int -> Bool
unset Int
x then 0 else Int
x
                  in (Int, Int, Int) -> ParsecT String a Identity (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int
clear Int
h', Int -> Int
clear Int
m', Int -> Int
clear Int
s')
     --
     TimeDiff -> CharParser a TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff -> CharParser a TimeDiff)
-> TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
y Int
mon Int
d Int
h Int
m Int
s 0
  where block :: a -> Char -> ParsecT String u Identity a
block d :: a
d c :: Char
c = a -> ParsecT String u Identity a -> ParsecT String u Identity a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
d (ParsecT String u Identity a -> ParsecT String u Identity a)
-> ParsecT String u Identity a -> ParsecT String u Identity a
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity a -> ParsecT String u Identity a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity a -> ParsecT String u Identity a)
-> ParsecT String u Identity a -> ParsecT String u Identity a
forall a b. (a -> b) -> a -> b
$
          do String
n <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
             Char
_ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
             a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT String u Identity a)
-> a -> ParsecT String u Identity a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. Read a => String -> a
read String
n

-- | 'optchain' @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 p :: CharParser a b
p next :: [(CharParser a c, CharParser a b)]
next = CharParser a [b] -> CharParser a [b]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a [b] -> CharParser a [b])
-> CharParser a [b] -> CharParser a [b]
forall a b. (a -> b) -> a -> b
$
  do b
r1 <- CharParser a b
p
     [b]
r2 <- case [(CharParser a c, CharParser a b)]
next of
           [] -> [b] -> CharParser a [b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
           ((sep :: CharParser a c
sep,p2 :: CharParser a b
p2):next2 :: [(CharParser a c, CharParser a b)]
next2) -> [b] -> CharParser a [b] -> CharParser a [b]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (CharParser a [b] -> CharParser a [b])
-> CharParser a [b] -> CharParser a [b]
forall a b. (a -> b) -> a -> b
$ do { CharParser a c -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional CharParser a c
sep; CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain CharParser a b
p2 [(CharParser a c, CharParser a b)]
next2 }
     [b] -> CharParser a [b]
forall (m :: * -> *) a. Monad m => a -> m a
return (b
r1b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
r2)

nDigits :: Int -> CharParser a Int
nDigits :: Int -> CharParser a Int
nDigits n :: Int
n = String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT String a Identity String -> CharParser a Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int
-> ParsecT String a Identity Char
-> ParsecT String a Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

twoDigits, fourDigits :: CharParser a Int
twoDigits :: CharParser a Int
twoDigits = Int -> CharParser a Int
forall a. Int -> CharParser a Int
nDigits 2
fourDigits :: CharParser a Int
fourDigits = Int -> CharParser a Int
forall a. Int -> CharParser a Int
nDigits 4

-- | 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 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 ' '

-- | 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 "Mon"       GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Monday
                       , GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Tue") GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Tuesday
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Wed"       GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Wednesday
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Thu"       GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Thursday
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Fri"       GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Friday
                       , GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Sat") GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Saturday
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Sun"       GenParser Char a () -> CharParser a Day -> CharParser a Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> CharParser a Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
Sunday
                       ]

-- | 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 1 2 GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
               Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return (Month -> CharParser a Month) -> Month -> CharParser a Month
forall a b. (a -> b) -> a -> b
$ Int -> Month
intToMonth (String -> Int
forall a. Read a => String -> a
read String
mn :: Int)

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

-- | 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 "Jan") GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
January
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Feb"       GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
February
                       , GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Mar") GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
March
                       , GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Apr") GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
April
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "May"       GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
May
                       , GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Jun") GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
June
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Jul"       GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
July
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Aug"       GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
August
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Sep"       GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
September
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Oct"       GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
October
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Nov"       GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
November
                       , String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "Dec"       GenParser Char a () -> CharParser a Month -> CharParser a Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> CharParser a Month
forall (m :: * -> *) a. Monad m => a -> m a
return Month
December
                       ]

-- | day 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 1 2 GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                      Int -> CharParser a Int
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. Read a => String -> a
read String
d :: Int)

-- | hour 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 '+'; Int
h <- CharParser a Int
forall a. CharParser a Int
hour; Int
m <- CharParser a Int
forall a. CharParser a Int
minute; Int -> CharParser a Int
forall (m :: * -> *) a. Monad m => a -> m a
return (((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)Int -> Int -> Int
forall a. Num a => a -> a -> a
*60) }
                       , do { Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-'; Int
h <- CharParser a Int
forall a. CharParser a Int
hour; Int
m <- CharParser a Int
forall a. CharParser a Int
minute; Int -> CharParser a Int
forall (m :: * -> *) a. Monad m => a -> m a
return (-((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)Int -> Int -> Int
forall a. Num a => a -> a -> a
*60) }
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "UTC"  0
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "UT"  0
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "GMT" 0
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "WET" 0
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "WEST" 1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "BST" 1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "ART" (-3)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "BRT" (-3)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "BRST" (-2)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "AST" (-4)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "ADT" (-3)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CLT" (-4)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CLST" (-3)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EST" (-5)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EDT" (-4)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CST" (-6)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CDT" (-5)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MST" (-7)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MDT" (-6)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "PST" (-8)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "PDT" (-7)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "AKST" (-9)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "AKDT" (-8)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "HST" (-10)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "HAST" (-10)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "HADT" (-9)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "SST" (-12)
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "WAT" 1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CET" 1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CEST" 2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MET" 1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MEZ" 1
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MEST" 2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MESZ" 2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EET" 2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EEST" 3
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "CAT" 2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "SAST" 2
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "EAT" 3
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MSK" 3
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "MSD" 4
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "SGT" 8
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "KST" 9
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "JST" 9
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "GST" 10
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "NZST" 12
                       , String -> Int -> CharParser a Int
forall a st. Num a => String -> a -> GenParser Char st a
mkZone "NZDT" 13
                         -- 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 -> String -> String
forall a. a -> [a] -> [a]
: ['a'..'z']String -> String -> String
forall a. [a] -> [a] -> [a]
++['A'..'Z'])
                                       (ParsecT String a Identity Char -> ParsecT String a Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String a Identity Char
forall u. ParsecT String u Identity Char
space_digit);
                              Int -> CharParser a Int
forall (m :: * -> *) a. Monad m => a -> m a
return 0 }
                       ]
     where mkZone :: String -> a -> GenParser Char st a
mkZone n :: String
n o :: a
o  = GenParser Char st a -> GenParser Char st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st a -> GenParser Char st a)
-> GenParser Char st a -> GenParser Char st a
forall a b. (a -> b) -> a -> b
$ do { String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString String
n; a -> GenParser Char st a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
oa -> a -> a
forall a. Num a => a -> a -> a
*60a -> a -> a
forall a. Num a => a -> a -> a
*60) }
           space_digit :: GenParser Char st Char
space_digit = GenParser Char st Char -> GenParser Char st Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Char -> GenParser Char st Char)
-> GenParser Char st Char -> GenParser Char st Char
forall a b. (a -> b) -> a -> b
$ do { Char
_ <- Char -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ' '; String -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf ['0'..'9'] }

----- 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 now :: CalendarTime
now =
  CharParser a CalendarTime -> CharParser a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a CalendarTime -> CharParser a CalendarTime)
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall a b. (a -> b) -> a -> b
$ CharParser a CalendarTime
forall a. CharParser a CalendarTime
dateMaybeAtTime CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a CalendarTime
forall a. CharParser a CalendarTime
timeThenDate
  where
   -- 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 "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
_ <- 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 now :: CalendarTime
now = CharParser a CalendarTime -> CharParser a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a CalendarTime -> CharParser a CalendarTime)
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall a b. (a -> b) -> a -> b
$
      (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "today"     GenParser Char a ()
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> CalendarTime
resetCalendar CalendarTime
now))
  CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "yesterday" GenParser Char a ()
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff
oneDay TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now))
  CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (CalendarTime, CalendarTime) -> CalendarTime
forall a b. (a, b) -> a
fst ((CalendarTime, CalendarTime) -> CalendarTime)
-> ParsecT String a Identity (CalendarTime, CalendarTime)
-> CharParser a CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CalendarTime
-> ParsecT String a Identity (CalendarTime, CalendarTime)
forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now
  CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CalendarTime -> CharParser a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now
  where oneDay :: TimeDiff
oneDay    = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 0 0 1 0 0 0 0

-- | 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 now :: CalendarTime
now =
  CharParser a CalendarTime -> CharParser a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a CalendarTime -> CharParser a CalendarTime)
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall a b. (a -> b) -> a -> b
$ do TimeDiff
p <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
englishDuration
           Char
_ <- GenParser Char a Char -> GenParser Char a Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
           (m :: Int
m,ref :: CalendarTime
ref) <- GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char a ()
forall a. String -> GenParser Char a ()
caseString "ago" GenParser Char a ()
-> GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int, CalendarTime) -> GenParser Char a (Int, CalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (-1, CalendarTime
now))
                   GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do Int
m <- GenParser Char a Int
forall a. CharParser a Int
beforeMod GenParser Char a Int
-> GenParser Char a Int -> GenParser Char a Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a Int
forall a. CharParser a Int
afterMod
                          Char
_ <- GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                          CalendarTime
d <- CalendarTime -> CharParser a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
                               CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (CalendarTime, CalendarTime) -> CalendarTime
forall a b. (a, b) -> a
fst ((CalendarTime, CalendarTime) -> CalendarTime)
-> ParsecT String a Identity (CalendarTime, CalendarTime)
-> CharParser a CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CalendarTime
-> ParsecT String a Identity (CalendarTime, CalendarTime)
forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now
                               CharParser a CalendarTime
-> CharParser a CalendarTime -> CharParser a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> ParsecT String a Identity MCalendarTime
-> CharParser a CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT String a Identity MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime (CalendarTime -> Int
ctTZ CalendarTime
now)
                          (Int, CalendarTime) -> GenParser Char a (Int, CalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m,CalendarTime
d)
           CalendarTime -> CharParser a CalendarTime
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> CharParser a CalendarTime)
-> CalendarTime -> CharParser a CalendarTime
forall a b. (a -> b) -> a -> b
$ Int -> TimeDiff -> TimeDiff
multiplyDiff Int
m TimeDiff
p TimeDiff -> CalendarTime -> CalendarTime
`addToCal` CalendarTime
ref
  where
    beforeMod :: GenParser Char st Int
beforeMod = GenParser Char st Int -> GenParser Char st Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Int -> GenParser Char st Int)
-> GenParser Char st Int -> GenParser Char st Int
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "before" GenParser Char st ()
-> GenParser Char st Int -> GenParser Char st Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> GenParser Char st Int
forall (m :: * -> *) a. Monad m => a -> m a
return (-1)
    afterMod :: GenParser Char st Int
afterMod  = GenParser Char st Int -> GenParser Char st Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Int -> GenParser Char st Int)
-> GenParser Char st Int -> GenParser Char st Int
forall a b. (a -> b) -> a -> b
$ [String] -> GenParser Char st ()
forall a. [String] -> GenParser Char a ()
caseStrings ["after","since"] GenParser Char st ()
-> GenParser Char st Int -> GenParser Char st Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> GenParser Char st Int
forall (m :: * -> *) a. Monad m => a -> m a
return 1

-- | 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 now :: CalendarTime
now = CharParser a TimeInterval
forall st. GenParser Char st TimeInterval
twixt CharParser a TimeInterval
-> CharParser a TimeInterval -> CharParser a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a TimeInterval
forall st. GenParser Char st TimeInterval
before CharParser a TimeInterval
-> CharParser a TimeInterval -> CharParser a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a TimeInterval
forall st a. GenParser Char st (Maybe CalendarTime, Maybe a)
after CharParser a TimeInterval
-> CharParser a TimeInterval -> CharParser a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a TimeInterval
forall st. GenParser Char st TimeInterval
inTheLast CharParser a TimeInterval
-> CharParser a TimeInterval -> CharParser a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser a TimeInterval
forall st. GenParser Char st TimeInterval
lastetc
  where
   englishDT :: ParsecT String u Identity CalendarTime
englishDT = MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> ParsecT String u Identity MCalendarTime
-> ParsecT String u Identity CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT String u Identity MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime (CalendarTime -> Int
ctTZ CalendarTime
now)
                ParsecT String u Identity CalendarTime
-> ParsecT String u Identity CalendarTime
-> ParsecT String u Identity CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CalendarTime -> ParsecT String u Identity CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDateTime CalendarTime
now
   before :: GenParser Char st TimeInterval
before = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
     do String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "before"
        Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
end <- ParsecT String st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
        TimeInterval -> GenParser Char st TimeInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
theBeginning, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
end)
   after :: GenParser Char st (Maybe CalendarTime, Maybe a)
after = GenParser Char st (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (Maybe CalendarTime, Maybe a)
 -> GenParser Char st (Maybe CalendarTime, Maybe a))
-> GenParser Char st (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall a b. (a -> b) -> a -> b
$
     do [String] -> GenParser Char st ()
forall a. [String] -> GenParser Char a ()
caseStrings ["after","since"]
        Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
start <- ParsecT String st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
        (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
start, Maybe a
forall a. Maybe a
Nothing)
   twixt :: GenParser Char st TimeInterval
twixt = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
     do String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "between"
        Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
start <- ParsecT String st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
        Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "and"
        Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
end <- ParsecT String st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
        TimeInterval -> GenParser Char st TimeInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
start, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
end)
   inTheLast :: GenParser Char st TimeInterval
inTheLast = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
     do String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString "in the last"
        Char
_ <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        TimeDiff
dur <- CharParser st TimeDiff
forall a. CharParser a TimeDiff
englishDuration
        TimeInterval -> GenParser Char st TimeInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just (CalendarTime -> Maybe CalendarTime)
-> CalendarTime -> Maybe CalendarTime
forall a b. (a -> b) -> a -> b
$ TimeDiff
dur TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
now)
   lastetc :: ParsecT String a Identity TimeInterval
lastetc =
     do CalendarTime
l <- CalendarTime -> CharParser a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now
        TimeInterval -> ParsecT String a Identity TimeInterval
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
l, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
now)

-- | 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 now :: 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 "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 "noon"            12  0
         , String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "midnight"         0  0
         , String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "tea time"        16 30
         , String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "bed time"         2 30
         , String -> Int -> Int -> CharParser a (CalendarTime -> CalendarTime)
forall st.
String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime "proper bed time" 21 30 ]
  where namedTime :: String
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime name :: String
name h :: Int
h m :: Int
m = GenParser Char st (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (CalendarTime -> CalendarTime)
 -> GenParser Char st (CalendarTime -> CalendarTime))
-> GenParser Char st (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall a b. (a -> b) -> a -> b
$
          do String -> GenParser Char st ()
forall a. String -> GenParser Char a ()
caseString String
name
             (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall (m :: * -> *) a. Monad m => a -> m a
return ((CalendarTime -> CalendarTime)
 -> GenParser Char st (CalendarTime -> CalendarTime))
-> (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall a b. (a -> b) -> a -> b
$ \c :: CalendarTime
c -> CalendarTime
c { ctHour :: Int
ctHour = Int
h, ctMin :: Int
ctMin = Int
m }
        wrapM :: (MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
wrapM f :: MCalendarTime -> MCalendarTime
f = MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> (CalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> MCalendarTime
f (MCalendarTime -> MCalendarTime)
-> (CalendarTime -> MCalendarTime) -> CalendarTime -> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> MCalendarTime
toMCalendarTime

-- | 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 1 (ParsecT String a Identity Int -> ParsecT String a Identity Int)
-> ParsecT String a Identity Int -> ParsecT String a Identity Int
forall a b. (a -> b) -> a -> b
$ do String
x <- ParsecT String a Identity Char -> ParsecT String a Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                        Char
_ <- ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                        Int -> ParsecT String a Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String a Identity Int)
-> Int -> ParsecT String a Identity Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
x
     TimeDiff
b <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
base
     ParsecT String a Identity () -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ([String] -> ParsecT String a Identity ()
forall a. [String] -> GenParser Char a ()
caseStrings ["es","s"])
     let current :: TimeDiff
current = Int -> TimeDiff -> TimeDiff
multiplyDiff Int
n TimeDiff
b
     TimeDiff
next <- TimeDiff -> CharParser a TimeDiff -> CharParser a TimeDiff
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option TimeDiff
noTimeDiff (CharParser a TimeDiff -> CharParser a TimeDiff)
-> CharParser a TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ CharParser a TimeDiff -> CharParser a TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser a TimeDiff -> CharParser a TimeDiff)
-> CharParser a TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ do
              { ParsecT String a Identity Char -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space; Char
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ',' ; ParsecT String a Identity Char -> ParsecT String a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ; CharParser a TimeDiff
forall a. CharParser a TimeDiff
englishDuration }
     TimeDiff -> CharParser a TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff -> CharParser a TimeDiff)
-> TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ TimeDiff -> TimeDiff -> TimeDiff
addDiff TimeDiff
current TimeDiff
next
  where
  base :: ParsecT String u Identity TimeDiff
base = [ParsecT String u Identity TimeDiff]
-> ParsecT String u Identity TimeDiff
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
         [ ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity TimeDiff
 -> ParsecT String u Identity TimeDiff)
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "score"      GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff 20 0  0 0 0 0 0) -- why not?
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "year"       GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  1 0  0 0 0 0 0)
         , ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity TimeDiff
 -> ParsecT String u Identity TimeDiff)
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "month"      GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  0 1  0 0 0 0 0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "fortnight"  GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  0 0 14 0 0 0 0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "week"       GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  0 0  7 0 0 0 0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "day"        GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  0 0  1 0 0 0 0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "hour"       GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  0 0  0 1 0 0 0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "minute"     GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  0 0  0 0 1 0 0)
         ,       String -> GenParser Char u ()
forall a. String -> GenParser Char a ()
caseString "second"     GenParser Char u ()
-> ParsecT String u Identity TimeDiff
-> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT String u Identity TimeDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  0 0  0 0 0 1 0) ]

----- 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 0 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 a :: Int
a b :: Month
b c :: Int
c d :: Int
d e :: Int
e f :: Int
f g :: Integer
g h :: Day
h i :: Int
i j :: String
j k :: Int
k l :: Bool
l) =
  Maybe Int
-> Maybe Month
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Integer
-> Maybe Day
-> Maybe Int
-> Maybe String
-> Maybe Int
-> Maybe Bool
-> Bool
-> MCalendarTime
MCalendarTime (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
a) (Month -> Maybe Month
forall a. a -> Maybe a
Just Month
b) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
c) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
e) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
f)
                (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
g) (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
h) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i) (String -> Maybe String
forall a. a -> Maybe a
Just String
j) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
l)
                Bool
False

-- | 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 m :: MCalendarTime
m =
 CalendarTime :: Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime
  { ctYear :: Int
ctYear = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctYear MCalendarTime
m
  , ctMonth :: Month
ctMonth = Month -> Maybe Month -> Month
forall a. a -> Maybe a -> a
fromMaybe Month
January (Maybe Month -> Month) -> Maybe Month -> Month
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Month
mctMonth MCalendarTime
m
  , ctDay :: Int
ctDay = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctDay MCalendarTime
m
  , ctHour :: Int
ctHour = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctHour MCalendarTime
m
  , ctMin :: Int
ctMin = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctMin MCalendarTime
m
  , ctSec :: Int
ctSec = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctSec MCalendarTime
m
  , ctPicosec :: Integer
ctPicosec = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Integer
mctPicosec MCalendarTime
m
  , ctWDay :: Day
ctWDay = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
Sunday (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Day
mctWDay MCalendarTime
m
  , ctYDay :: Int
ctYDay = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctYDay MCalendarTime
m
  , ctTZName :: String
ctTZName = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe String
mctTZName MCalendarTime
m
  , ctTZ :: Int
ctTZ = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctTZ MCalendarTime
m
  , ctIsDST :: Bool
ctIsDST = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Bool
mctIsDST MCalendarTime
m
 }

addToCal :: TimeDiff -> CalendarTime -> CalendarTime
addToCal :: TimeDiff -> CalendarTime -> CalendarTime
addToCal td :: TimeDiff
td = ClockTime -> CalendarTime
toUTCTime (ClockTime -> CalendarTime)
-> (CalendarTime -> ClockTime) -> CalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeDiff -> ClockTime -> ClockTime
addToClockTime TimeDiff
td (ClockTime -> ClockTime)
-> (CalendarTime -> ClockTime) -> CalendarTime -> ClockTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> ClockTime
toClockTime

subtractFromCal :: TimeDiff -> CalendarTime -> CalendarTime
subtractFromCal :: TimeDiff -> CalendarTime -> CalendarTime
subtractFromCal = TimeDiff -> CalendarTime -> CalendarTime
addToCal (TimeDiff -> CalendarTime -> CalendarTime)
-> (TimeDiff -> TimeDiff)
-> TimeDiff
-> CalendarTime
-> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TimeDiff -> TimeDiff
multiplyDiff (-1)

addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal td :: TimeDiff
td mc :: MCalendarTime
mc =
 CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar (TimeDiff -> CalendarTime -> CalendarTime
addToCal TimeDiff
td (CalendarTime -> CalendarTime) -> CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
mc) MCalendarTime
mc

subtractFromMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
subtractFromMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
subtractFromMCal = TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal (TimeDiff -> MCalendarTime -> MCalendarTime)
-> (TimeDiff -> TimeDiff)
-> TimeDiff
-> MCalendarTime
-> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TimeDiff -> TimeDiff
multiplyDiff (-1)

-- surely there is a more concise way to express these
addDiff :: TimeDiff -> TimeDiff -> TimeDiff
addDiff :: TimeDiff -> TimeDiff -> TimeDiff
addDiff (TimeDiff a1 :: Int
a1 a2 :: Int
a2 a3 :: Int
a3 a4 :: Int
a4 a5 :: Int
a5 a6 :: Int
a6 a7 :: Integer
a7) (TimeDiff b1 :: Int
b1 b2 :: Int
b2 b3 :: Int
b3 b4 :: Int
b4 b5 :: Int
b5 b6 :: Int
b6 b7 :: Integer
b7) =
  Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff (Int
a1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b1) (Int
a2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b2) (Int
a3Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b3) (Int
a4Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b4) (Int
a5Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b5) (Int
a6Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b6) (Integer
a7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b7)

-- | 'multiplyDiff' @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 m :: Int
m (TimeDiff a1 :: Int
a1 a2 :: Int
a2 a3 :: Int
a3 a4 :: Int
a4 a5 :: Int
a5 a6 :: Int
a6 a7 :: Integer
a7) =
  Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff (Int
a1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Integer
a7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m)

nullMCalendar :: MCalendarTime
nullMCalendar :: MCalendarTime
nullMCalendar = Maybe Int
-> Maybe Month
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Integer
-> Maybe Day
-> Maybe Int
-> Maybe String
-> Maybe Int
-> Maybe Bool
-> Bool
-> MCalendarTime
MCalendarTime Maybe Int
forall a. Maybe a
Nothing Maybe Month
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
                              Maybe Integer
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
                              Bool
False

-- | 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 c :: CalendarTime
c mc :: MCalendarTime
mc = MCalendarTime
mc
  { mctYear :: Maybe Int
mctYear  = MCalendarTime -> Maybe Int
mctYear MCalendarTime
mc  Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctYear CalendarTime
c)
  , mctMonth :: Maybe Month
mctMonth = MCalendarTime -> Maybe Month
mctMonth MCalendarTime
mc Maybe Month -> Maybe Month -> Maybe Month
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> Maybe Month
forall a. a -> Maybe a
Just (CalendarTime -> Month
ctMonth CalendarTime
c)
  , mctDay :: Maybe Int
mctDay   = MCalendarTime -> Maybe Int
mctDay MCalendarTime
mc   Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctDay CalendarTime
c)
  , mctHour :: Maybe Int
mctHour  = MCalendarTime -> Maybe Int
mctHour MCalendarTime
mc  Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctHour CalendarTime
c)
  , mctMin :: Maybe Int
mctMin   = MCalendarTime -> Maybe Int
mctMin MCalendarTime
mc   Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctMin CalendarTime
c)
  , mctSec :: Maybe Int
mctSec   = MCalendarTime -> Maybe Int
mctSec MCalendarTime
mc   Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctSec CalendarTime
c)
  , mctPicosec :: Maybe Integer
mctPicosec = MCalendarTime -> Maybe Integer
mctPicosec MCalendarTime
mc Maybe Integer -> Maybe Integer -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (CalendarTime -> Integer
ctPicosec CalendarTime
c)
  , mctWDay :: Maybe Day
mctWDay = MCalendarTime -> Maybe Day
mctWDay MCalendarTime
mc   Maybe Day -> Maybe Day -> Maybe Day
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Day -> Maybe Day
forall a. a -> Maybe a
Just (CalendarTime -> Day
ctWDay CalendarTime
c)
  , mctYDay :: Maybe Int
mctYDay = MCalendarTime -> Maybe Int
mctYDay MCalendarTime
mc   Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctYDay CalendarTime
c)
  , mctTZName :: Maybe String
mctTZName = MCalendarTime -> Maybe String
mctTZName MCalendarTime
mc Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Maybe String
forall a. a -> Maybe a
Just (CalendarTime -> String
ctTZName CalendarTime
c)
  , mctTZ :: Maybe Int
mctTZ     = MCalendarTime -> Maybe Int
mctTZ MCalendarTime
mc    Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Maybe Int
forall a. a -> Maybe a
Just (CalendarTime -> Int
ctTZ CalendarTime
c)
  , mctIsDST :: Maybe Bool
mctIsDST  = MCalendarTime -> Maybe Bool
mctIsDST MCalendarTime
mc Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CalendarTime -> Bool
ctIsDST CalendarTime
c)
  }

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