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

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

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

import Darcs.Prelude
import Prelude ( (^) )

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

type TimeInterval = (Maybe CalendarTime, Maybe CalendarTime)

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

-- | Convert a date string into ISO 8601 format (yyyymmdd variant)
--   assuming local timezone if not specified in the string
--   Warning! This errors out if we fail to interpret the date
cleanLocalDate :: String -> IO String
cleanLocalDate :: [Char] -> IO [Char]
cleanLocalDate [Char]
str =
   do Int
tz <- IO Int
getLocalTz
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> [Char]
showIsoDateTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> CalendarTime
resetCalendar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> CalendarTime
readDate Int
tz forall a b. (a -> b) -> a -> b
$ [Char]
str

-- | Return the local timezone offset from UTC in seconds
getLocalTz :: IO Int
getLocalTz :: IO Int
getLocalTz = CalendarTime -> Int
ctTZ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (IO ClockTime
getClockTime 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 -> [Char] -> CalendarTime
readDate Int
tz [Char]
d =
             case Int -> [Char] -> Either ParseError MCalendarTime
parseDate Int
tz [Char]
d of
             Left ParseError
e -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"bad date: "forall a. [a] -> [a] -> [a]
++[Char]
dforall a. [a] -> [a] -> [a]
++[Char]
" - "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show ParseError
e
             Right MCalendarTime
ct -> CalendarTime -> CalendarTime
resetCalendar 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 :: [Char] -> CalendarTime
readUTCDateOldFashioned [Char]
d = 
             case Int -> [Char] -> Either ParseError MCalendarTime
parseDate Int
0 [Char]
d of
             Left ParseError
e -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"bad date: "forall a. [a] -> [a] -> [a]
++[Char]
dforall a. [a] -> [a] -> [a]
++[Char]
" - "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show ParseError
e
             Right MCalendarTime
ct -> (MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
ct) { ctTZ :: Int
ctTZ = Int
0 }

-- | Parse a date string, assuming a default timezone if
--   the date string does not specify one.  The date formats
--   understood are those of 'showIsoDateTime' and 'dateTime'
parseDate :: Int -> String -> Either ParseError MCalendarTime
parseDate :: Int -> [Char] -> Either ParseError MCalendarTime
parseDate Int
tz [Char]
d =
              if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
d forall a. Ord a => a -> a -> Bool
>= Int
14 Bool -> Bool -> Bool
&& (Char -> Bool) -> ByteString -> Bool
BC.all Char -> Bool
isDigit ByteString
bd
              then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime forall a b. (a -> b) -> a -> b
$
                   Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> [Char]
-> Int
-> Bool
-> CalendarTime
CalendarTime (ByteString -> Int
readI forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
4 ByteString
bd)
                                (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ (forall a. Num a => a -> a -> a
+ (-Int
1)) forall a b. (a -> b) -> a -> b
$ ByteString -> Int
readI forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
4 ByteString
bd)
                                (ByteString -> Int
readI forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
6 ByteString
bd) -- Day
                                (ByteString -> Int
readI forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
8 ByteString
bd) -- Hour
                                (ByteString -> Int
readI forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
10 ByteString
bd) -- Minute
                                (ByteString -> Int
readI forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.take Int
2 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BC.drop Int
12 ByteString
bd) -- Second
                                Integer
0 Day
Sunday Int
0 -- Picosecond, weekday and day of year unknown
                                [Char]
"GMT" Int
0 Bool
False
              else let dt :: ParsecT [Char] a Identity MCalendarTime
dt = do { MCalendarTime
x <- forall a. Int -> CharParser a MCalendarTime
dateTime Int
tz; forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof; forall (m :: * -> *) a. Monad m => a -> m a
return MCalendarTime
x }
                   in forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse forall {a}. ParsecT [Char] a Identity MCalendarTime
dt [Char]
"" [Char]
d
  where bd :: ByteString
bd = [Char] -> ByteString
BC.pack (forall a. Int -> [a] -> [a]
take Int
14 [Char]
d)
        readI :: ByteString -> Int
readI ByteString
s = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"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 -> [Char]
showIsoDateTime CalendarTime
ct = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctYear CalendarTime
ct
                            , [Char] -> [Char]
twoDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ CalendarTime -> Month
ctMonth CalendarTime
ct
                            , [Char] -> [Char]
twoDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctDay CalendarTime
ct
                            , [Char] -> [Char]
twoDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctHour CalendarTime
ct
                            , [Char] -> [Char]
twoDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctMin CalendarTime
ct
                            , [Char] -> [Char]
twoDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctSec CalendarTime
ct
                            ]
    where twoDigit :: [Char] -> [Char]
twoDigit []          = forall a. HasCallStack => a
undefined
          twoDigit x :: [Char]
x@(Char
_:[])    = Char
'0' forall a. a -> [a] -> [a]
: [Char]
x
          twoDigit x :: [Char]
x@(Char
_:Char
_:[])  = [Char]
x
          twoDigit [Char]
_           = forall a. HasCallStack => a
undefined

-- | The current time in the format returned by 'showIsoDateTime'
getIsoDateTime          :: IO String
getIsoDateTime :: IO [Char]
getIsoDateTime = (CalendarTime -> [Char]
showIsoDateTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockTime -> CalendarTime
toUTCTime) 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 :: forall a. Char -> GenParser Char a Char
caseChar Char
c       = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
x -> Char -> Char
toUpper Char
x 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 :: forall a. [Char] -> GenParser Char a ()
caseString [Char]
cs    = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Char -> GenParser Char a Char
caseChar [Char]
cs forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
cs

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

-- | Match a parser at least @n@ times.
manyN           :: Int -> GenParser a b c -> GenParser a b [c]
manyN :: forall a b c. Int -> GenParser a b c -> GenParser a b [c]
manyN Int
n GenParser a b c
p
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0     = forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise  = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) (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) (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 :: forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM Int
n Int
m GenParser a b c
p
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
0      = forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Int
n forall a. Ord a => a -> a -> Bool
> Int
m      = forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
m     = 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 forall a. Eq a => a -> a -> Bool
== Int
0     = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ 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)) (forall (m :: * -> *) a. Monad m => a -> m a
return []) (forall a. [a] -> [a]
reverse [Int
1..Int
m])
    | Bool
otherwise  = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) (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) (forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM Int
0 (Int
mforall 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 :: forall a. Int -> CharParser a MCalendarTime
dateTime Int
tz =
            forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Int -> CharParser a CalendarTime
cvsDateTime Int
tz,
                    forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. Int -> CharParser a MCalendarTime
iso8601DateTime Int
tz,
                    forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ CalendarTime -> MCalendarTime
toMCalendarTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. CharParser a CalendarTime
oldDateTime,
                    CalendarTime -> MCalendarTime
toMCalendarTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. CharParser a CalendarTime
rfc2822DateTime]

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

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

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

rfc2822DateTime :: CharParser a CalendarTime
rfc2822DateTime :: forall a. CharParser a CalendarTime
rfc2822DateTime    = do Day
wd <- forall a. CharParser a Day
dayName
                        Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
                        [Char]
_ <- forall a. CharParser a [Char]
mySpaces
                        Int
d <- forall a. CharParser a Int
day
                        Month
mon <- forall a. CharParser a Month
parseSpacesMonthName
                        Int
y <- forall a. CharParser a Int
year
                        [Char]
_ <- forall a. CharParser a [Char]
mySpaces
                        (Int
h, Int
m, Int
s) <- forall a. CharParser a (Int, Int, Int)
parseHMS
                        [Char]
_ <- forall a. CharParser a [Char]
mySpaces
                        Int
z <- forall a. CharParser a Int
zone
                        forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> [Char]
-> Int
-> Bool
-> CalendarTime
CalendarTime Int
y Month
mon Int
d Int
h Int
m Int
s Integer
0 Day
wd Int
0 [Char]
"" 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 :: forall a. Int -> CharParser a MCalendarTime
iso8601DateTime Int
localTz = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
  do MCalendarTime
d <- forall {a}. ParsecT [Char] a Identity MCalendarTime
iso8601Date
     MCalendarTime -> MCalendarTime
t <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" T"
                               forall a. CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MCalendarTime -> MCalendarTime
t forall a b. (a -> b) -> a -> b
$ MCalendarTime
d { mctTZ :: Maybe Int
mctTZ = 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 :: forall {a}. ParsecT [Char] a Identity MCalendarTime
iso8601Date =
  do [MCalendarTime -> MCalendarTime]
d <- forall {st}. GenParser Char st [MCalendarTime -> MCalendarTime]
calendar_date forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {st}. GenParser Char st [MCalendarTime -> MCalendarTime]
week_date forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {st}. GenParser Char st [MCalendarTime -> MCalendarTime]
ordinal_date
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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
      forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do [MCalendarTime -> MCalendarTime]
d <- forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain forall a. CharParser a (MCalendarTime -> MCalendarTime)
year_ [ (forall {u}. ParsecT [Char] u Identity Char
dash, forall a. CharParser a (MCalendarTime -> MCalendarTime)
month_), (forall {u}. ParsecT [Char] u Identity Char
dash, forall a. CharParser a (MCalendarTime -> MCalendarTime)
day_) ]
               -- allow other variants to be parsed correctly
               forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'W')
               forall (m :: * -> *) a. Monad m => a -> m a
return [MCalendarTime -> MCalendarTime]
d
    week_date :: GenParser Char st [MCalendarTime -> MCalendarTime]
week_date = --yyyy-Www-d
      forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do MCalendarTime -> MCalendarTime
yfn <- forall a. CharParser a (MCalendarTime -> MCalendarTime)
year_
               forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall {u}. ParsecT [Char] u Identity Char
dash
               Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'W'
               -- offset human 'week 1' -> computer 'week 0'
               Int
w'  <- (\Int
x -> Int
xforall a. Num a => a -> a -> a
-Int
1) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. CharParser a Int
twoDigits
               Maybe Int
mwd  <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do { forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall {u}. ParsecT [Char] u Identity Char
dash; forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Int -> CharParser a Int
nDigits Int
1 }
               let y :: CalendarTime
y = CalendarTime -> CalendarTime
resetCalendar forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> CalendarTime
unsafeToCalendarTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> MCalendarTime
yfn forall a b. (a -> b) -> a -> b
$ MCalendarTime
nullMCalendar { mctDay :: Maybe Int
mctDay = forall a. a -> Maybe a
Just Int
1 }
                   firstDay :: Day
firstDay = CalendarTime -> Day
ctWDay CalendarTime
y
               -- things that make this complicated
               -- 1. iso8601 weeks start from Monday; Haskell weeks start from Sunday
               -- 2. the first week is the one that contains at least Thursday
               --    if the year starts after Thursday, then some days of the year
               --    will have already passed before the first week
               let afterThursday :: Bool
afterThursday = Day
firstDay forall a. Eq a => a -> a -> Bool
== Day
Sunday Bool -> Bool -> Bool
|| Day
firstDay forall a. Ord a => a -> a -> Bool
> Day
Thursday
                   w :: Int
w  = if Bool
afterThursday then Int
w'forall a. Num a => a -> a -> a
+Int
1 else Int
w'
                   yday :: Int
yday = (Int
7 forall a. Num a => a -> a -> a
* Int
w) forall a. Num a => a -> a -> a
+ forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
mwd
                   diff :: MCalendarTime -> MCalendarTime
diff MCalendarTime
c = MCalendarTime
c { mctWeek :: Bool
mctWeek = Bool
True
                              , mctWDay :: Maybe Day
mctWDay = forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Int
mwd
                              , mctDay :: Maybe Int
mctDay  = forall a. a -> Maybe a
Just Int
yday }
               forall (m :: * -> *) a. Monad m => a -> m a
return [MCalendarTime -> MCalendarTime
diffforall b c a. (b -> c) -> (a -> b) -> a -> c
.MCalendarTime -> MCalendarTime
yfn]
    ordinal_date :: GenParser Char st [MCalendarTime -> MCalendarTime]
ordinal_date = -- yyyy-ddd
      forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain forall a. CharParser a (MCalendarTime -> MCalendarTime)
year_ [ (forall {u}. ParsecT [Char] u Identity Char
dash, forall a. CharParser a (MCalendarTime -> MCalendarTime)
yearDay_) ]
    --
    year_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
year_  = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do Int
y <- forall a. CharParser a Int
fourDigits forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"year (0000-9999)"
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctYear :: Maybe Int
mctYear = forall a. a -> Maybe a
Just Int
y }
    month_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
month_ = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do Int
m <- forall a. CharParser a Int
twoDigits forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"month (1 to 12)"
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctMonth :: Maybe Month
mctMonth = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Month
intToMonth Int
m }
    day_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
day_   = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do Int
d <- forall a. CharParser a Int
twoDigits forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"day in month (1 to 31)"
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctDay :: Maybe Int
mctDay = forall a. a -> Maybe a
Just Int
d }
    yearDay_ :: GenParser Char st (MCalendarTime -> MCalendarTime)
yearDay_ = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do Int
d <- forall a. Int -> CharParser a Int
nDigits Int
3 forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"day in year (001 to 366)"
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctDay :: Maybe Int
mctDay = forall a. a -> Maybe a
Just Int
d
                                         , mctYDay :: Maybe Int
mctYDay = forall a. a -> Maybe a
Just (Int
d forall a. Num a => a -> a -> a
- Int
1) }
    dash :: ParsecT [Char] u Identity Char
dash = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'

-- | Note that this returns a function which sets the time on
--   another calendar (see 'iso8601DateTime' for a list of
--   flaws
iso8601Time :: CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time :: forall a. CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
  do [MCalendarTime -> MCalendarTime]
ts <- forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain forall a. CharParser a (MCalendarTime -> MCalendarTime)
hour_ [ (forall {u}. ParsecT [Char] u Identity Char
colon     , forall a. CharParser a (MCalendarTime -> MCalendarTime)
min_)
                          , (forall {u}. ParsecT [Char] u Identity Char
colon     , forall a. CharParser a (MCalendarTime -> MCalendarTime)
sec_)
                          , (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
",.", forall a. CharParser a (MCalendarTime -> MCalendarTime)
pico_) ]
     MCalendarTime -> MCalendarTime
z  <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall a. CharParser a (MCalendarTime -> MCalendarTime)
zulu , forall a. CharParser a (MCalendarTime -> MCalendarTime)
offset ]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (MCalendarTime -> MCalendarTime
zforall a. a -> [a] -> [a]
:[MCalendarTime -> MCalendarTime]
ts)
  where
    hour_ :: ParsecT [Char] a Identity (MCalendarTime -> MCalendarTime)
hour_ = do Int
h <- forall a. CharParser a Int
twoDigits
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctHour :: Maybe Int
mctHour = forall a. a -> Maybe a
Just Int
h }
    min_ :: ParsecT [Char] a Identity (MCalendarTime -> MCalendarTime)
min_  = do Int
m <- forall a. CharParser a Int
twoDigits
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctMin :: Maybe Int
mctMin = forall a. a -> Maybe a
Just Int
m }
    sec_ :: ParsecT [Char] a Identity (MCalendarTime -> MCalendarTime)
sec_  = do Int
s <- forall a. CharParser a Int
twoDigits
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctSec :: Maybe Int
mctSec = forall a. a -> Maybe a
Just Int
s }
    pico_ :: ParsecT [Char] u Identity (MCalendarTime -> MCalendarTime)
pico_ = do [Char]
digs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
               let picoExp :: Int
picoExp = Int
12
                   digsExp :: Int
digsExp = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
digs
               let frac :: Integer
frac | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
digs = Integer
0
                        | Int
digsExp forall a. Ord a => a -> a -> Bool
> Int
picoExp = forall a. Read a => [Char] -> a
read forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
picoExp [Char]
digs
                        | Bool
otherwise = Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
picoExp forall a. Num a => a -> a -> a
- Int
digsExp) forall a. Num a => a -> a -> a
* forall a. Read a => [Char] -> a
read [Char]
digs
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctPicosec :: Maybe Integer
mctPicosec = forall a. a -> Maybe a
Just Integer
frac }
    zulu :: ParsecT [Char] u Identity (MCalendarTime -> MCalendarTime)
zulu   = do { Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'Z'; forall (m :: * -> *) a. Monad m => a -> m a
return (\MCalendarTime
c -> MCalendarTime
c { mctTZ :: Maybe Int
mctTZ = forall a. a -> Maybe a
Just Int
0 }) }
    offset :: ParsecT [Char] u Identity (MCalendarTime -> MCalendarTime)
offset = do Int
sign <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return   Int
1
                               , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1) ]
                Int
h <- forall a. CharParser a Int
twoDigits
                Int
m <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ do { forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall {u}. ParsecT [Char] u Identity Char
colon; forall a. CharParser a Int
twoDigits }
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MCalendarTime
c -> MCalendarTime
c { mctTZ :: Maybe Int
mctTZ = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
sign forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
* ((Int
hforall a. Num a => a -> a -> a
*Int
60)forall a. Num a => a -> a -> a
+Int
m) }
    colon :: ParsecT [Char] u Identity Char
colon = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'

-- | Intervals in ISO 8601, e.g.,
--
--    * 2008-09/2012-08-17T16:30
--
--    * 2008-09/P2Y11MT16H30M
--
--    * P2Y11MT16H30M/2012-08-17T16:30
--
--   See 'iso8601Duration'
iso8601Interval :: Int -> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval :: forall a.
Int
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval Int
localTz = forall {a}.
ParsecT
  [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
leftDur forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a} {a}.
ParsecT [Char] a Identity (Either a (MCalendarTime, MCalendarTime))
rightDur where
  leftDur :: ParsecT
  [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
leftDur  =
    do TimeDiff
dur <- forall a. CharParser a TimeDiff
iso8601Duration
       Maybe MCalendarTime
end <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do { Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'; forall a. a -> Maybe a
Just forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall {a}. ParsecT [Char] a Identity MCalendarTime
isoDt }
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe MCalendarTime
end of
                Maybe MCalendarTime
Nothing -> forall a b. a -> Either a b
Left TimeDiff
dur
                Just MCalendarTime
e  -> forall a b. b -> Either a b
Right (TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`subtractFromMCal` MCalendarTime
e, MCalendarTime
e)
  rightDur :: ParsecT [Char] a Identity (Either a (MCalendarTime, MCalendarTime))
rightDur =
    do MCalendarTime
start <- forall {a}. ParsecT [Char] a Identity MCalendarTime
isoDt
       Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
       Either TimeDiff MCalendarTime
durOrEnd <- forall a b. a -> Either a b
Left forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. CharParser a TimeDiff
iso8601Duration forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a b. b -> Either a b
Right forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall {a}. ParsecT [Char] a Identity MCalendarTime
isoDt
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either TimeDiff MCalendarTime
durOrEnd of
                Left TimeDiff
dur  -> forall a b. b -> Either a b
Right (MCalendarTime
start, TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`addToMCal` MCalendarTime
start)
                Right MCalendarTime
end -> forall a b. b -> Either a b
Right (MCalendarTime
start, MCalendarTime
end)
  isoDt :: CharParser a MCalendarTime
isoDt   = 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 :: forall a. CharParser a TimeDiff
iso8601Duration =
  do Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'P'
     Int
y   <- forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block Int
0 Char
'Y'
     Int
mon <- forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block Int
0 Char
'M'
     Int
d   <- forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block Int
0 Char
'D'
     (Int
h,Int
m,Int
s) <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Int
0,Int
0,Int
0) forall a b. (a -> b) -> a -> b
$
       do Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'T'
          Int
h' <- forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block (-Int
1) Char
'H'
          Int
m' <- forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block (-Int
1) Char
'M'
          Int
s' <- forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block (-Int
1) Char
'S'
          let unset :: Int -> Bool
unset = (forall a. Eq a => a -> a -> Bool
== (-Int
1))
          if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
unset [Int
h',Int
m',Int
s']
             then forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"T should be omitted if time is unspecified"
             else let clear :: Int -> Int
clear Int
x = if Int -> Bool
unset Int
x then Int
0 else Int
x
                  in forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int
clear Int
h', Int -> Int
clear Int
m', Int -> Int
clear Int
s')
     --
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
y Int
mon Int
d Int
h Int
m Int
s Integer
0
  where block :: a -> Char -> ParsecT [Char] u Identity a
block a
d Char
c = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
d forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
          do [Char]
n <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
             Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Read a => [Char] -> a
read [Char]
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 :: forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain CharParser a b
p [(CharParser a c, CharParser a b)]
next = forall tok st a. GenParser tok st a -> GenParser tok st a
try 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
           [] -> forall (m :: * -> *) a. Monad m => a -> m a
return []
           ((CharParser a c
sep,CharParser a b
p2):[(CharParser a c, CharParser a b)]
next2) -> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ do { forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional CharParser a c
sep; 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 }
     forall (m :: * -> *) a. Monad m => a -> m a
return (b
r1forall a. a -> [a] -> [a]
:[b]
r2)

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

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

-- | One or more space.
--   WARNING! This only matches on the space character, not on
--   whitespace in general
mySpaces :: CharParser a String
mySpaces :: forall a. CharParser a [Char]
mySpaces = forall a b c. Int -> GenParser a b c -> GenParser a b [c]
manyN Int
1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '

-- | English three-letter day abbreviations (e.g. Mon, Tue, Wed)
dayName        :: CharParser a Day
dayName :: forall a. CharParser a Day
dayName         = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
                       [ forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Mon"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Day
Monday
                       , forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Tue") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Day
Tuesday
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Wed"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Day
Wednesday
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Thu"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Day
Thursday
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Fri"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Day
Friday
                       , forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Sat") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Day
Saturday
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Sun"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Day
Sunday
                       ]

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

-- | One or two digit month (e.g. 3 for March, 11 for November)
monthNum       :: CharParser a Month
monthNum :: forall a. CharParser a Month
monthNum =  do [Char]
mn <- forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM Int
1 Int
2 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Month
intToMonth (forall a. Read a => [Char] -> a
read [Char]
mn :: Int)

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

-- | English three-letter month abbreviations (e.g. Jan, Feb, Mar)
monthName      :: CharParser a Month
monthName :: forall a. CharParser a Month
monthName       = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
                       [ forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Jan") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
January
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Feb"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
February
                       , forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Mar") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
March
                       , forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Apr") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
April
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"May"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
May
                       , forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Jun") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
June
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Jul"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
July
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Aug"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
August
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Sep"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
September
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Oct"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
October
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Nov"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
November
                       , forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Dec"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Month
December
                       ]

-- | day in one or two digit notation
day             :: CharParser a Int
day :: forall a. CharParser a Int
day              = do [Char]
d <- forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM Int
1 Int
2 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Read a => [Char] -> a
read [Char]
d :: Int)

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

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

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

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

-- | In English, either a date followed by a time, or vice-versa, e.g,
--
--    * yesterday at noon
--
--    * yesterday tea time
--
--    * 12:00 yesterday
--
--   See 'englishDate' and 'englishTime'
--   Uses its first argument as "now", i.e. the time relative to which
--   "yesterday", "today" etc are to be interpreted
englishDateTime :: CalendarTime -> CharParser a CalendarTime
englishDateTime :: forall a. CalendarTime -> CharParser a CalendarTime
englishDateTime CalendarTime
now =
  forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. CharParser a CalendarTime
dateMaybeAtTime forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. CharParser a CalendarTime
timeThenDate
  where
   -- yesterday (at) noon
   dateMaybeAtTime :: GenParser Char st CalendarTime
dateMaybeAtTime = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
     do CalendarTime
ed <- forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
        Maybe (CalendarTime -> CalendarTime)
t  <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
                do { Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space; forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> GenParser Char a ()
caseString [Char]
"at "; forall a. a -> Maybe a
Just forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. CharParser a (CalendarTime -> CalendarTime)
englishTime }
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. a -> a
id Maybe (CalendarTime -> CalendarTime)
t CalendarTime
ed
   -- tea time 2005-12-04
   timeThenDate :: GenParser Char st CalendarTime
timeThenDate = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
     do CalendarTime -> CalendarTime
t  <- forall a. CharParser a (CalendarTime -> CalendarTime)
englishTime
        forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
        Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
ed <- forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CalendarTime -> CalendarTime
t 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 :: forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
      (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"today"     forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> CalendarTime
resetCalendar CalendarTime
now))
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"yesterday" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff
oneDay TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now))
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now
  where oneDay :: TimeDiff
oneDay    = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
1 Int
0 Int
0 Int
0 Integer
0

-- | English expressions for points in the past, e.g.
--
--    * 4 months ago
--
--    * 1 day ago
--
--    * day before yesterday
--
--   See 'englishDuration'
englishAgo :: CalendarTime -> CharParser a CalendarTime
englishAgo :: forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now =
  forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do TimeDiff
p <- forall a. CharParser a TimeDiff
englishDuration
           Char
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
           (Int
m,CalendarTime
ref) <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. [Char] -> GenParser Char a ()
caseString [Char]
"ago" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1, CalendarTime
now))
                   forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do Int
m <- forall a. CharParser a Int
beforeMod forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. CharParser a Int
afterMod
                          Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                          CalendarTime
d <- forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now
                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MCalendarTime -> CalendarTime
unsafeToCalendarTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Int -> CharParser a MCalendarTime
iso8601DateTime (CalendarTime -> Int
ctTZ CalendarTime
now)
                          forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m,CalendarTime
d)
           forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> GenParser Char a ()
caseString [Char]
"before" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
    afterMod :: GenParser Char st Int
afterMod  = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. [[Char]] -> GenParser Char a ()
caseStrings [[Char]
"after",[Char]
"since"] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
1

-- | English expressions for intervals of time,
--
--    * before tea time (i.e. from the beginning of time)
--
--    * after 14:00 last month (i.e. till now)
--
--    * between last year and last month
--
--    * in the last three months (i.e. from then till now)
--
--    * 4 months ago (i.e. till now; see 'englishAgo')
englishInterval :: CalendarTime -> CharParser a TimeInterval
englishInterval :: forall a. CalendarTime -> CharParser a TimeInterval
englishInterval CalendarTime
now = forall {st}. GenParser Char st TimeInterval
twixt forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {st}. GenParser Char st TimeInterval
before forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {st} {a}. GenParser Char st (Maybe CalendarTime, Maybe a)
after forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {st}. GenParser Char st TimeInterval
inTheLast forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {st}. GenParser Char st TimeInterval
lastetc
  where
   englishDT :: ParsecT [Char] u Identity CalendarTime
englishDT = MCalendarTime -> CalendarTime
unsafeToCalendarTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Int -> CharParser a MCalendarTime
iso8601DateTime (CalendarTime -> Int
ctTZ CalendarTime
now)
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. CalendarTime -> CharParser a CalendarTime
englishDateTime CalendarTime
now
   before :: GenParser Char st TimeInterval
before = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
     do forall a. [Char] -> GenParser Char a ()
caseString [Char]
"before"
        Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
end <- forall a. CharParser a CalendarTime
englishDT
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just CalendarTime
theBeginning, forall a. a -> Maybe a
Just CalendarTime
end)
   after :: GenParser Char st (Maybe CalendarTime, Maybe a)
after = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
     do forall a. [[Char]] -> GenParser Char a ()
caseStrings [[Char]
"after",[Char]
"since"]
        Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
start <- forall a. CharParser a CalendarTime
englishDT
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just CalendarTime
start, forall a. Maybe a
Nothing)
   twixt :: GenParser Char st TimeInterval
twixt = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
     do forall a. [Char] -> GenParser Char a ()
caseString [Char]
"between"
        Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
start <- forall a. CharParser a CalendarTime
englishDT
        Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        forall a. [Char] -> GenParser Char a ()
caseString [Char]
"and"
        Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
end <- forall a. CharParser a CalendarTime
englishDT
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just CalendarTime
start, forall a. a -> Maybe a
Just CalendarTime
end)
   inTheLast :: GenParser Char st TimeInterval
inTheLast = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
     do forall a. [Char] -> GenParser Char a ()
caseString [Char]
"in the last"
        Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        TimeDiff
dur <- forall a. CharParser a TimeDiff
englishDuration
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TimeDiff
dur TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now, forall a. a -> Maybe a
Just CalendarTime
now)
   lastetc :: ParsecT [Char] a Identity TimeInterval
lastetc =
     do CalendarTime
l <- forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just CalendarTime
l, 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 :: forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now =
    -- last year, last week, last 3 years, etc
    forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do forall a. [Char] -> GenParser Char a ()
caseString [Char]
"last"
             Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
             TimeDiff
d <- forall a. CharParser a TimeDiff
englishDuration
             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 :: forall a. CharParser a (CalendarTime -> CalendarTime)
englishTime = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
  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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time
         , forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"noon"            Int
12  Int
0
         , forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"midnight"         Int
0  Int
0
         , forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"tea time"        Int
16 Int
30
         , forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"bed time"         Int
2 Int
30
         , forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"proper bed time" Int
21 Int
30 ]
  where namedTime :: [Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
name Int
h Int
m = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
          do forall a. [Char] -> GenParser Char a ()
caseString [Char]
name
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \CalendarTime
c -> CalendarTime
c { ctHour :: Int
ctHour = Int
h, ctMin :: Int
ctMin = Int
m }
        wrapM :: (MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
wrapM MCalendarTime -> MCalendarTime
f = MCalendarTime -> CalendarTime
unsafeToCalendarTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> MCalendarTime
f 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 :: forall a. CharParser a TimeDiff
englishDuration = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
  do Int
n <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
1 forall a b. (a -> b) -> a -> b
$ do [Char]
x <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                        Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Read a => [Char] -> a
read [Char]
x
     TimeDiff
b <- forall a. CharParser a TimeDiff
base
     forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall a. [[Char]] -> GenParser Char a ()
caseStrings [[Char]
"es",[Char]
"s"])
     let current :: TimeDiff
current = Int -> TimeDiff -> TimeDiff
multiplyDiff Int
n TimeDiff
b
     TimeDiff
next <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option TimeDiff
noTimeDiff forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
              { forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space; Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ; forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ; forall a. CharParser a TimeDiff
englishDuration }
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TimeDiff -> TimeDiff -> TimeDiff
addDiff TimeDiff
current TimeDiff
next
  where
  base :: ParsecT [Char] u Identity TimeDiff
base = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
         [ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> GenParser Char a ()
caseString [Char]
"score"      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
20 Int
0  Int
0 Int
0 Int
0 Int
0 Integer
0) -- why not?
         ,       forall a. [Char] -> GenParser Char a ()
caseString [Char]
"year"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
1 Int
0  Int
0 Int
0 Int
0 Int
0 Integer
0)
         , forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> GenParser Char a ()
caseString [Char]
"month"      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
0 Int
1  Int
0 Int
0 Int
0 Int
0 Integer
0)
         ,       forall a. [Char] -> GenParser Char a ()
caseString [Char]
"fortnight"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
0 Int
0 Int
14 Int
0 Int
0 Int
0 Integer
0)
         ,       forall a. [Char] -> GenParser Char a ()
caseString [Char]
"week"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
0 Int
0  Int
7 Int
0 Int
0 Int
0 Integer
0)
         ,       forall a. [Char] -> GenParser Char a ()
caseString [Char]
"day"        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
0 Int
0  Int
1 Int
0 Int
0 Int
0 Integer
0)
         ,       forall a. [Char] -> GenParser Char a ()
caseString [Char]
"hour"       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
0 Int
0  Int
0 Int
1 Int
0 Int
0 Integer
0)
         ,       forall a. [Char] -> GenParser Char a ()
caseString [Char]
"minute"     forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
0 Int
0  Int
0 Int
0 Int
1 Int
0 Integer
0)
         ,       forall a. [Char] -> GenParser Char a ()
caseString [Char]
"second"     forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
0 Int
0  Int
0 Int
0 Int
0 Int
1 Integer
0) ]

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

-- | The very beginning of time, i.e. 1970-01-01
theBeginning :: CalendarTime
theBeginning :: CalendarTime
theBeginning = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ ClockTime -> IO CalendarTime
toCalendarTime forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> ClockTime
TOD Integer
0 Integer
0

-- | An 'MCalenderTime' is an underspecified 'CalendarTime'
--   It is used for parsing dates.  For example, if you want to parse
--   the date '4 January', it may be useful to underspecify the year
--   by setting it to 'Nothing'.  This uses almost the same fields as
--   'System.Time.CalendarTime', a notable exception being that we
--   introduce 'mctWeek' to indicate if a weekday was specified or not
data MCalendarTime = MCalendarTime
 { MCalendarTime -> Maybe Int
mctYear  :: Maybe Int
 , MCalendarTime -> Maybe Month
mctMonth :: Maybe Month
 , MCalendarTime -> Maybe Int
mctDay   :: Maybe Int
 , MCalendarTime -> Maybe Int
mctHour  :: Maybe Int
 , MCalendarTime -> Maybe Int
mctMin   :: Maybe Int
 , MCalendarTime -> Maybe Int
mctSec   :: Maybe Int
 , MCalendarTime -> Maybe Integer
mctPicosec :: Maybe Integer
 , MCalendarTime -> Maybe Day
mctWDay     :: Maybe Day
 , MCalendarTime -> Maybe Int
mctYDay     :: Maybe Int
 , MCalendarTime -> Maybe [Char]
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 -> [Char] -> [Char]
[MCalendarTime] -> [Char] -> [Char]
MCalendarTime -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [MCalendarTime] -> [Char] -> [Char]
$cshowList :: [MCalendarTime] -> [Char] -> [Char]
show :: MCalendarTime -> [Char]
$cshow :: MCalendarTime -> [Char]
showsPrec :: Int -> MCalendarTime -> [Char] -> [Char]
$cshowsPrec :: Int -> MCalendarTime -> [Char] -> [Char]
Show

-- | Trivially convert a 'CalendarTime' to a fully specified
--   'MCalendarTime' (note that this sets the 'mctWeek' flag to
--   @False@
toMCalendarTime :: CalendarTime -> MCalendarTime
toMCalendarTime :: CalendarTime -> MCalendarTime
toMCalendarTime (CalendarTime Int
a Month
b Int
c Int
d Int
e Int
f Integer
g Day
h Int
i [Char]
j Int
k Bool
l) =
  Maybe Int
-> Maybe Month
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Integer
-> Maybe Day
-> Maybe Int
-> Maybe [Char]
-> Maybe Int
-> Maybe Bool
-> Bool
-> MCalendarTime
MCalendarTime (forall a. a -> Maybe a
Just Int
a) (forall a. a -> Maybe a
Just Month
b) (forall a. a -> Maybe a
Just Int
c) (forall a. a -> Maybe a
Just Int
d) (forall a. a -> Maybe a
Just Int
e) (forall a. a -> Maybe a
Just Int
f)
                (forall a. a -> Maybe a
Just Integer
g) (forall a. a -> Maybe a
Just Day
h) (forall a. a -> Maybe a
Just Int
i) (forall a. a -> Maybe a
Just [Char]
j) (forall a. a -> Maybe a
Just Int
k) (forall a. a -> Maybe a
Just Bool
l)
                Bool
False

-- | Returns the first 'CalendarTime' that falls within a 'MCalendarTime'
--   This is only unsafe in the sense that it plugs in default values
--   for fields that have not been set, e.g. @January@ for the month
--   or @0@ for the seconds field.
--   Maybe we should rename it something happier.
--   See also 'resetCalendar'
unsafeToCalendarTime :: MCalendarTime -> CalendarTime
unsafeToCalendarTime :: MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
m =
 CalendarTime
  { ctYear :: Int
ctYear = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctYear MCalendarTime
m
  , ctMonth :: Month
ctMonth = forall a. a -> Maybe a -> a
fromMaybe Month
January forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Month
mctMonth MCalendarTime
m
  , ctDay :: Int
ctDay = forall a. a -> Maybe a -> a
fromMaybe Int
1 forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctDay MCalendarTime
m
  , ctHour :: Int
ctHour = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctHour MCalendarTime
m
  , ctMin :: Int
ctMin = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctMin MCalendarTime
m
  , ctSec :: Int
ctSec = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctSec MCalendarTime
m
  , ctPicosec :: Integer
ctPicosec = forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Integer
mctPicosec MCalendarTime
m
  , ctWDay :: Day
ctWDay = forall a. a -> Maybe a -> a
fromMaybe Day
Sunday forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Day
mctWDay MCalendarTime
m
  , ctYDay :: Int
ctYDay = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctYDay MCalendarTime
m
  , ctTZName :: [Char]
ctTZName = forall a. a -> Maybe a -> a
fromMaybe [Char]
"" forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe [Char]
mctTZName MCalendarTime
m
  , ctTZ :: Int
ctTZ = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Int
mctTZ MCalendarTime
m
  , ctIsDST :: Bool
ctIsDST = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ MCalendarTime -> Maybe Bool
mctIsDST MCalendarTime
m
 }

addToCal :: TimeDiff -> CalendarTime -> CalendarTime
addToCal :: TimeDiff -> CalendarTime -> CalendarTime
addToCal TimeDiff
td = ClockTime -> CalendarTime
toUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeDiff -> ClockTime -> ClockTime
addToClockTime TimeDiff
td 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TimeDiff -> TimeDiff
multiplyDiff (-Int
1)

addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal :: TimeDiff -> MCalendarTime -> MCalendarTime
addToMCal TimeDiff
td MCalendarTime
mc =
 CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar (TimeDiff -> CalendarTime -> CalendarTime
addToCal TimeDiff
td 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TimeDiff -> TimeDiff
multiplyDiff (-Int
1)

-- surely there is a more concise way to express these
addDiff :: TimeDiff -> TimeDiff -> TimeDiff
addDiff :: TimeDiff -> TimeDiff -> TimeDiff
addDiff (TimeDiff Int
a1 Int
a2 Int
a3 Int
a4 Int
a5 Int
a6 Integer
a7) (TimeDiff Int
b1 Int
b2 Int
b3 Int
b4 Int
b5 Int
b6 Integer
b7) =
  Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff (Int
a1forall a. Num a => a -> a -> a
+Int
b1) (Int
a2forall a. Num a => a -> a -> a
+Int
b2) (Int
a3forall a. Num a => a -> a -> a
+Int
b3) (Int
a4forall a. Num a => a -> a -> a
+Int
b4) (Int
a5forall a. Num a => a -> a -> a
+Int
b5) (Int
a6forall a. Num a => a -> a -> a
+Int
b6) (Integer
a7 forall a. Num a => a -> a -> a
+ Integer
b7)

-- | 'multiplyDiff' @i d@ multiplies every field in @d@ with @i@
--
-- FIXME; this seems like a terrible idea! it seems like
-- we should get rid of it if at all possible, maybe adding an
-- invertDiff function
multiplyDiff :: Int -> TimeDiff -> TimeDiff
multiplyDiff :: Int -> TimeDiff -> TimeDiff
multiplyDiff Int
m (TimeDiff Int
a1 Int
a2 Int
a3 Int
a4 Int
a5 Int
a6 Integer
a7) =
  Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff (Int
a1forall a. Num a => a -> a -> a
*Int
m) (Int
a2forall a. Num a => a -> a -> a
*Int
m) (Int
a3forall a. Num a => a -> a -> a
*Int
m) (Int
a4forall a. Num a => a -> a -> a
*Int
m) (Int
a5forall a. Num a => a -> a -> a
*Int
m) (Int
a6forall a. Num a => a -> a -> a
*Int
m) (Integer
a7 forall a. Num a => a -> a -> a
* 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 [Char]
-> Maybe Int
-> Maybe Bool
-> Bool
-> MCalendarTime
MCalendarTime forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                              forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> ClockTime
toClockTime

-- | 'copyCalendar' @c mc@ replaces any field which is
--   specified in @mc@ with the equivalent field in @c@
--   @copyCalendar c nullMCalendar == nullMCalendar@
copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar CalendarTime
c MCalendarTime
mc = MCalendarTime
mc
  { mctYear :: Maybe Int
mctYear  = MCalendarTime -> Maybe Int
mctYear MCalendarTime
mc  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Int
ctYear CalendarTime
c)
  , mctMonth :: Maybe Month
mctMonth = MCalendarTime -> Maybe Month
mctMonth MCalendarTime
mc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Month
ctMonth CalendarTime
c)
  , mctDay :: Maybe Int
mctDay   = MCalendarTime -> Maybe Int
mctDay MCalendarTime
mc   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Int
ctDay CalendarTime
c)
  , mctHour :: Maybe Int
mctHour  = MCalendarTime -> Maybe Int
mctHour MCalendarTime
mc  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Int
ctHour CalendarTime
c)
  , mctMin :: Maybe Int
mctMin   = MCalendarTime -> Maybe Int
mctMin MCalendarTime
mc   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Int
ctMin CalendarTime
c)
  , mctSec :: Maybe Int
mctSec   = MCalendarTime -> Maybe Int
mctSec MCalendarTime
mc   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Int
ctSec CalendarTime
c)
  , mctPicosec :: Maybe Integer
mctPicosec = MCalendarTime -> Maybe Integer
mctPicosec MCalendarTime
mc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Integer
ctPicosec CalendarTime
c)
  , mctWDay :: Maybe Day
mctWDay = MCalendarTime -> Maybe Day
mctWDay MCalendarTime
mc   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Day
ctWDay CalendarTime
c)
  , mctYDay :: Maybe Int
mctYDay = MCalendarTime -> Maybe Int
mctYDay MCalendarTime
mc   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Int
ctYDay CalendarTime
c)
  , mctTZName :: Maybe [Char]
mctTZName = MCalendarTime -> Maybe [Char]
mctTZName MCalendarTime
mc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> [Char]
ctTZName CalendarTime
c)
  , mctTZ :: Maybe Int
mctTZ     = MCalendarTime -> Maybe Int
mctTZ MCalendarTime
mc    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Int
ctTZ CalendarTime
c)
  , mctIsDST :: Maybe Bool
mctIsDST  = MCalendarTime -> Maybe Bool
mctIsDST MCalendarTime
mc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (CalendarTime -> Bool
ctIsDST CalendarTime
c)
  }

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