-- 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
      [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> ([Char] -> [Char]) -> [Char] -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> [Char]
showIsoDateTime (CalendarTime -> [Char])
-> ([Char] -> CalendarTime) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime)
-> ([Char] -> CalendarTime) -> [Char] -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> CalendarTime
readDate Int
tz ([Char] -> IO [Char]) -> [Char] -> IO [Char]
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 (CalendarTime -> Int) -> IO CalendarTime -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (IO ClockTime
getClockTime IO ClockTime -> (ClockTime -> IO CalendarTime) -> IO CalendarTime
forall a b. IO a -> (a -> IO b) -> IO b
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 -> [Char] -> CalendarTime
forall a. HasCallStack => [Char] -> a
error ([Char] -> CalendarTime) -> [Char] -> CalendarTime
forall a b. (a -> b) -> a -> b
$ [Char]
"bad date: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
d[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" - "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
e
             Right MCalendarTime
ct -> CalendarTime -> CalendarTime
resetCalendar (CalendarTime -> CalendarTime) -> CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
ct

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

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

-- | Case-insensitive variant of Parsec's 'string' function.
caseString      :: String -> GenParser Char a ()
caseString :: forall a. [Char] -> GenParser Char a ()
caseString [Char]
cs    = (Char -> ParsecT [Char] a Identity Char)
-> [Char] -> ParsecT [Char] a Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> ParsecT [Char] a Identity Char
forall a. Char -> GenParser Char a Char
caseChar [Char]
cs ParsecT [Char] a Identity ()
-> [Char] -> ParsecT [Char] a Identity ()
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 = (GenParser Char a () -> GenParser Char a () -> GenParser Char a ())
-> [GenParser Char a ()] -> GenParser Char a ()
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 GenParser Char a () -> GenParser Char a () -> GenParser Char a ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) ([GenParser Char a ()] -> GenParser Char a ())
-> [GenParser Char a ()] -> GenParser Char a ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> GenParser Char a ())
-> [[Char]] -> [GenParser Char a ()]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> GenParser Char a ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0     = [c] -> ParsecT [a] b Identity [c]
forall a. a -> ParsecT [a] b Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise  = ([c] -> [c] -> [c])
-> ParsecT [a] b Identity [c]
-> ParsecT [a] b Identity [c]
-> ParsecT [a] b Identity [c]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
(++) (Int -> GenParser a b c -> ParsecT [a] b Identity [c]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n GenParser a b c
p) (GenParser a b c -> ParsecT [a] b Identity [c]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many GenParser a b c
p)

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


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

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

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

-- | Intervals in ISO 8601, e.g.,
--
--    * 2008-09/2012-08-17T16:30
--
--    * 2008-09/P2Y11MT16H30M
--
--    * P2Y11MT16H30M/2012-08-17T16:30
--
--   See 'iso8601Duration'
iso8601Interval :: Int -> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval :: forall a.
Int
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval Int
localTz = ParsecT
  [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall {a}.
ParsecT
  [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
leftDur ParsecT
  [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
-> ParsecT
     [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
-> ParsecT
     [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT
  [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
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 <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
iso8601Duration
       Maybe MCalendarTime
end <- Maybe MCalendarTime
-> ParsecT [Char] a Identity (Maybe MCalendarTime)
-> ParsecT [Char] a Identity (Maybe MCalendarTime)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe MCalendarTime
forall a. Maybe a
Nothing (ParsecT [Char] a Identity (Maybe MCalendarTime)
 -> ParsecT [Char] a Identity (Maybe MCalendarTime))
-> ParsecT [Char] a Identity (Maybe MCalendarTime)
-> ParsecT [Char] a Identity (Maybe MCalendarTime)
forall a b. (a -> b) -> a -> b
$ do { Char
_ <- Char -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'; MCalendarTime -> Maybe MCalendarTime
forall a. a -> Maybe a
Just (MCalendarTime -> Maybe MCalendarTime)
-> ParsecT [Char] a Identity MCalendarTime
-> ParsecT [Char] a Identity (Maybe MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT [Char] a Identity MCalendarTime
forall {a}. ParsecT [Char] a Identity MCalendarTime
isoDt }
       Either TimeDiff (MCalendarTime, MCalendarTime)
-> ParsecT
     [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TimeDiff (MCalendarTime, MCalendarTime)
 -> ParsecT
      [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime)))
-> Either TimeDiff (MCalendarTime, MCalendarTime)
-> ParsecT
     [Char] a Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a b. (a -> b) -> a -> b
$ case Maybe MCalendarTime
end of
                Maybe MCalendarTime
Nothing -> TimeDiff -> Either TimeDiff (MCalendarTime, MCalendarTime)
forall a b. a -> Either a b
Left TimeDiff
dur
                Just MCalendarTime
e  -> (MCalendarTime, MCalendarTime)
-> Either TimeDiff (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`subtractFromMCal` MCalendarTime
e, MCalendarTime
e)
  rightDur :: ParsecT [Char] a Identity (Either a (MCalendarTime, MCalendarTime))
rightDur =
    do MCalendarTime
start <- CharParser a MCalendarTime
forall {a}. ParsecT [Char] a Identity MCalendarTime
isoDt
       Char
_ <- Char -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
       Either TimeDiff MCalendarTime
durOrEnd <- TimeDiff -> Either TimeDiff MCalendarTime
forall a b. a -> Either a b
Left (TimeDiff -> Either TimeDiff MCalendarTime)
-> ParsecT [Char] a Identity TimeDiff
-> ParsecT [Char] a Identity (Either TimeDiff MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT [Char] a Identity TimeDiff
forall a. CharParser a TimeDiff
iso8601Duration ParsecT [Char] a Identity (Either TimeDiff MCalendarTime)
-> ParsecT [Char] a Identity (Either TimeDiff MCalendarTime)
-> ParsecT [Char] a Identity (Either TimeDiff MCalendarTime)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MCalendarTime -> Either TimeDiff MCalendarTime
forall a b. b -> Either a b
Right (MCalendarTime -> Either TimeDiff MCalendarTime)
-> CharParser a MCalendarTime
-> ParsecT [Char] a Identity (Either TimeDiff MCalendarTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` CharParser a MCalendarTime
forall {a}. ParsecT [Char] a Identity MCalendarTime
isoDt
       Either a (MCalendarTime, MCalendarTime)
-> ParsecT
     [Char] a Identity (Either a (MCalendarTime, MCalendarTime))
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (MCalendarTime, MCalendarTime)
 -> ParsecT
      [Char] a Identity (Either a (MCalendarTime, MCalendarTime)))
-> Either a (MCalendarTime, MCalendarTime)
-> ParsecT
     [Char] a Identity (Either a (MCalendarTime, MCalendarTime))
forall a b. (a -> b) -> a -> b
$ case Either TimeDiff MCalendarTime
durOrEnd of
                Left TimeDiff
dur  -> (MCalendarTime, MCalendarTime)
-> Either a (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (MCalendarTime
start, TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`addToMCal` MCalendarTime
start)
                Right MCalendarTime
end -> (MCalendarTime, MCalendarTime)
-> Either a (MCalendarTime, MCalendarTime)
forall a b. b -> Either a b
Right (MCalendarTime
start, MCalendarTime
end)
  isoDt :: CharParser a MCalendarTime
isoDt   = Int -> CharParser a MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime Int
localTz

-- | Durations in ISO 8601, e.g.,
--
--    * P4Y (four years)
--
--    * P5M (five months)
--
--    * P4Y5M (four years and five months)
--
--    * P4YT3H6S (four years, three hours and six seconds)
iso8601Duration :: CharParser a TimeDiff
iso8601Duration :: forall a. CharParser a TimeDiff
iso8601Duration =
  do Char
_ <- Char -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'P'
     Int
y   <- Int -> Char -> ParsecT [Char] a Identity Int
forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block Int
0 Char
'Y'
     Int
mon <- Int -> Char -> ParsecT [Char] a Identity Int
forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block Int
0 Char
'M'
     Int
d   <- Int -> Char -> ParsecT [Char] a Identity Int
forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block Int
0 Char
'D'
     (Int
h,Int
m,Int
s) <- (Int, Int, Int)
-> ParsecT [Char] a Identity (Int, Int, Int)
-> ParsecT [Char] a Identity (Int, Int, Int)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Int
0,Int
0,Int
0) (ParsecT [Char] a Identity (Int, Int, Int)
 -> ParsecT [Char] a Identity (Int, Int, Int))
-> ParsecT [Char] a Identity (Int, Int, Int)
-> ParsecT [Char] a Identity (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$
       do Char
_ <- Char -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'T'
          Int
h' <- Int -> Char -> ParsecT [Char] a Identity Int
forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block (-Int
1) Char
'H'
          Int
m' <- Int -> Char -> ParsecT [Char] a Identity Int
forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block (-Int
1) Char
'M'
          Int
s' <- Int -> Char -> ParsecT [Char] a Identity Int
forall {a} {u}. Read a => a -> Char -> ParsecT [Char] u Identity a
block (-Int
1) Char
'S'
          let unset :: Int -> Bool
unset = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1))
          if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
unset [Int
h',Int
m',Int
s']
             then [Char] -> ParsecT [Char] a Identity (Int, Int, Int)
forall a. [Char] -> ParsecT [Char] a Identity a
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 (Int, Int, Int) -> ParsecT [Char] a Identity (Int, Int, Int)
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int
clear Int
h', Int -> Int
clear Int
m', Int -> Int
clear Int
s')
     --
     TimeDiff -> CharParser a TimeDiff
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff -> CharParser a TimeDiff)
-> TimeDiff -> CharParser a TimeDiff
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
y Int
mon Int
d Int
h Int
m Int
s Integer
0
  where block :: a -> Char -> ParsecT [Char] u Identity a
block a
d Char
c = a -> ParsecT [Char] u Identity a -> ParsecT [Char] u Identity a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
d (ParsecT [Char] u Identity a -> ParsecT [Char] u Identity a)
-> ParsecT [Char] u Identity a -> ParsecT [Char] u Identity a
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] u Identity a -> ParsecT [Char] u Identity a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] u Identity a -> ParsecT [Char] u Identity a)
-> ParsecT [Char] u Identity a -> ParsecT [Char] u Identity a
forall a b. (a -> b) -> a -> b
$
          do [Char]
n <- ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
             Char
_ <- Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
             a -> ParsecT [Char] u Identity a
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Char] u Identity a)
-> a -> ParsecT [Char] u Identity a
forall a b. (a -> b) -> a -> b
$ [Char] -> a
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 = GenParser Char a [b] -> GenParser Char a [b]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a [b] -> GenParser Char a [b])
-> GenParser Char a [b] -> GenParser Char a [b]
forall a b. (a -> b) -> a -> b
$
  do b
r1 <- CharParser a b
p
     [b]
r2 <- case [(CharParser a c, CharParser a b)]
next of
           [] -> [b] -> GenParser Char a [b]
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
           ((CharParser a c
sep,CharParser a b
p2):[(CharParser a c, CharParser a b)]
next2) -> [b] -> GenParser Char a [b] -> GenParser Char a [b]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (GenParser Char a [b] -> GenParser Char a [b])
-> GenParser Char a [b] -> GenParser Char a [b]
forall a b. (a -> b) -> a -> b
$ do { CharParser a c -> ParsecT [Char] a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional CharParser a c
sep; CharParser a b
-> [(CharParser a c, CharParser a b)] -> GenParser Char a [b]
forall a b c.
CharParser a b
-> [(CharParser a c, CharParser a b)] -> CharParser a [b]
optchain CharParser a b
p2 [(CharParser a c, CharParser a b)]
next2 }
     [b] -> GenParser Char a [b]
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
r1b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
r2)

nDigits :: Int -> CharParser a Int
nDigits :: forall a. Int -> CharParser a Int
nDigits Int
n = [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int)
-> ParsecT [Char] a Identity [Char]
-> ParsecT [Char] a Identity Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int
-> ParsecT [Char] a Identity Char
-> ParsecT [Char] a Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n ParsecT [Char] a Identity Char
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 = Int -> CharParser a Int
forall a. Int -> CharParser a Int
nDigits Int
2
fourDigits :: forall a. CharParser a Int
fourDigits = Int -> CharParser a Int
forall a. Int -> CharParser a Int
nDigits Int
4

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

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

-- | One or two digit month (e.g. 3 for March, 11 for November)
monthNum       :: CharParser a Month
monthNum :: forall a. CharParser a Month
monthNum =  do [Char]
mn <- Int -> Int -> GenParser Char a Char -> GenParser Char a [Char]
forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM Int
1 Int
2 GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
               Month -> CharParser a Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Month -> CharParser a Month) -> Month -> CharParser a Month
forall a b. (a -> b) -> a -> b
$ Int -> Month
intToMonth ([Char] -> Int
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
_  = [Char] -> Month
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       = [ParsecT [Char] a Identity Month]
-> ParsecT [Char] a Identity Month
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
                       [ GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Jan") GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
January
                       , [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Feb"       GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
February
                       , GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Mar") GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
March
                       , GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Apr") GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
April
                       , [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"May"       GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
May
                       , GenParser Char a () -> GenParser Char a ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Jun") GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
June
                       , [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Jul"       GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
July
                       , [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Aug"       GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
August
                       , [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Sep"       GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
September
                       , [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Oct"       GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
October
                       , [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Nov"       GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Month
November
                       , [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"Dec"       GenParser Char a ()
-> ParsecT [Char] a Identity Month
-> ParsecT [Char] a Identity Month
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Month -> ParsecT [Char] a Identity Month
forall a. a -> ParsecT [Char] a Identity a
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 <- Int -> Int -> GenParser Char a Char -> GenParser Char a [Char]
forall a b c. Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM Int
1 Int
2 GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                      Int -> CharParser a Int
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Int
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             = CharParser a Int
forall a. CharParser a Int
twoDigits

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

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

-- | limited timezone support
--
--   * +HHMM or -HHMM
--
--   * Universal timezones: UTC, UT
--
--   * Zones from GNU coreutils/lib/getdate.y, less half-hour ones --
--     sorry Newfies.
--
--   * any sequence of alphabetic characters (WARNING! treated as 0!)
zone            :: CharParser a Int
zone :: forall a. CharParser a Int
zone             = [ParsecT [Char] a Identity Int] -> ParsecT [Char] a Identity Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
                       [ do { Char
_ <- Char -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'; Int
h <- ParsecT [Char] a Identity Int
forall a. CharParser a Int
hour; Int
m <- ParsecT [Char] a Identity Int
forall a. CharParser a Int
minute; Int -> ParsecT [Char] a Identity Int
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60) }
                       , do { Char
_ <- Char -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'; Int
h <- ParsecT [Char] a Identity Int
forall a. CharParser a Int
hour; Int
m <- ParsecT [Char] a Identity Int
forall a. CharParser a Int
minute; Int -> ParsecT [Char] a Identity Int
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (-((Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60) }
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"UTC"  Int
0
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"UT"  Int
0
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"GMT" Int
0
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"WET" Int
0
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"WEST" Int
1
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"BST" Int
1
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"ART" (-Int
3)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"BRT" (-Int
3)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"BRST" (-Int
2)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"AST" (-Int
4)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"ADT" (-Int
3)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"CLT" (-Int
4)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"CLST" (-Int
3)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"EST" (-Int
5)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"EDT" (-Int
4)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"CST" (-Int
6)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"CDT" (-Int
5)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"MST" (-Int
7)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"MDT" (-Int
6)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"PST" (-Int
8)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"PDT" (-Int
7)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"AKST" (-Int
9)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"AKDT" (-Int
8)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"HST" (-Int
10)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"HAST" (-Int
10)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"HADT" (-Int
9)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"SST" (-Int
12)
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"WAT" Int
1
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"CET" Int
1
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"CEST" Int
2
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"MET" Int
1
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"MEZ" Int
1
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"MEST" Int
2
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"MESZ" Int
2
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"EET" Int
2
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"EEST" Int
3
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"CAT" Int
2
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"SAST" Int
2
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"EAT" Int
3
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"MSK" Int
3
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"MSD" Int
4
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"SGT" Int
8
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"KST" Int
9
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"JST" Int
9
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"GST" Int
10
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
forall {a} {st}. Num a => [Char] -> a -> GenParser Char st a
mkZone [Char]
"NZST" Int
12
                       , [Char] -> Int -> ParsecT [Char] a Identity Int
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]
_ <- ParsecT [Char] a Identity Char
-> ParsecT [Char] a Identity Char
-> ParsecT [Char] a Identity [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 ([Char] -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf ([Char] -> ParsecT [Char] a Identity Char)
-> [Char] -> ParsecT [Char] a Identity Char
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char
'a'..Char
'z'][Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char
'A'..Char
'Z'])
                                       (ParsecT [Char] a Identity Char -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Char] a Identity Char
forall {u}. ParsecT [Char] u Identity Char
space_digit);
                              Int -> ParsecT [Char] a Identity Int
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0 }
                       ]
     where mkZone :: [Char] -> a -> GenParser Char st a
mkZone [Char]
n a
o  = GenParser Char st a -> GenParser Char st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st a -> GenParser Char st a)
-> GenParser Char st a -> GenParser Char st a
forall a b. (a -> b) -> a -> b
$ do { [Char] -> GenParser Char st ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
n; a -> GenParser Char st a
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
oa -> a -> a
forall a. Num a => a -> a -> a
*a
60a -> a -> a
forall a. Num a => a -> a -> a
*a
60) }
           space_digit :: GenParser Char st Char
space_digit = GenParser Char st Char -> GenParser Char st Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Char -> GenParser Char st Char)
-> GenParser Char st Char -> GenParser Char st Char
forall a b. (a -> b) -> a -> b
$ do { Char
_ <- Char -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '; [Char] -> GenParser Char st 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 =
  GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a CalendarTime -> GenParser Char a CalendarTime)
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall a b. (a -> b) -> a -> b
$ GenParser Char a CalendarTime
forall a. CharParser a CalendarTime
dateMaybeAtTime GenParser Char a CalendarTime
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a CalendarTime
forall a. CharParser a CalendarTime
timeThenDate
  where
   -- yesterday (at) noon
   dateMaybeAtTime :: GenParser Char st CalendarTime
dateMaybeAtTime = GenParser Char st CalendarTime -> GenParser Char st CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st CalendarTime -> GenParser Char st CalendarTime)
-> GenParser Char st CalendarTime -> GenParser Char st CalendarTime
forall a b. (a -> b) -> a -> b
$
     do CalendarTime
ed <- CalendarTime -> GenParser Char st CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
        Maybe (CalendarTime -> CalendarTime)
t  <- Maybe (CalendarTime -> CalendarTime)
-> ParsecT
     [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
     [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe (CalendarTime -> CalendarTime)
forall a. Maybe a
Nothing (ParsecT [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
 -> ParsecT
      [Char] st Identity (Maybe (CalendarTime -> CalendarTime)))
-> ParsecT
     [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
     [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
     [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
 -> ParsecT
      [Char] st Identity (Maybe (CalendarTime -> CalendarTime)))
-> ParsecT
     [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
-> ParsecT
     [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
forall a b. (a -> b) -> a -> b
$
                do { Char
_ <- ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space; ParsecT [Char] st Identity () -> ParsecT [Char] st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT [Char] st Identity () -> ParsecT [Char] st Identity ())
-> ParsecT [Char] st Identity () -> ParsecT [Char] st Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] st Identity ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"at "; (CalendarTime -> CalendarTime)
-> Maybe (CalendarTime -> CalendarTime)
forall a. a -> Maybe a
Just ((CalendarTime -> CalendarTime)
 -> Maybe (CalendarTime -> CalendarTime))
-> ParsecT [Char] st Identity (CalendarTime -> CalendarTime)
-> ParsecT
     [Char] st Identity (Maybe (CalendarTime -> CalendarTime))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT [Char] st Identity (CalendarTime -> CalendarTime)
forall a. CharParser a (CalendarTime -> CalendarTime)
englishTime }
        CalendarTime -> GenParser Char st CalendarTime
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> GenParser Char st CalendarTime)
-> CalendarTime -> GenParser Char st CalendarTime
forall a b. (a -> b) -> a -> b
$ (CalendarTime -> CalendarTime)
-> Maybe (CalendarTime -> CalendarTime)
-> CalendarTime
-> CalendarTime
forall a. a -> Maybe a -> a
fromMaybe CalendarTime -> CalendarTime
forall a. a -> a
id Maybe (CalendarTime -> CalendarTime)
t CalendarTime
ed
   -- tea time 2005-12-04
   timeThenDate :: GenParser Char st CalendarTime
timeThenDate = GenParser Char st CalendarTime -> GenParser Char st CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st CalendarTime -> GenParser Char st CalendarTime)
-> GenParser Char st CalendarTime -> GenParser Char st CalendarTime
forall a b. (a -> b) -> a -> b
$
     do CalendarTime -> CalendarTime
t  <- CharParser st (CalendarTime -> CalendarTime)
forall a. CharParser a (CalendarTime -> CalendarTime)
englishTime
        ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ())
-> ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
        Char
_ <- ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
ed <- CalendarTime -> GenParser Char st CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
        CalendarTime -> GenParser Char st CalendarTime
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> GenParser Char st CalendarTime)
-> CalendarTime -> GenParser Char st CalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> CalendarTime
t (CalendarTime -> CalendarTime) -> CalendarTime -> CalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> CalendarTime
unsetTime CalendarTime
ed

-- | Specific dates in English as specific points of time, e.g,
--
--    * today
--
--    * yesterday
--
--    * last week (i.e. the beginning of that interval)
--
--    * 4 months ago (via 'englishAgo')
--
--   The first argument is "now".
englishDate :: CalendarTime -> CharParser a CalendarTime
englishDate :: forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now = GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a CalendarTime -> GenParser Char a CalendarTime)
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall a b. (a -> b) -> a -> b
$
      ([Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"today"     GenParser Char a ()
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CalendarTime -> GenParser Char a CalendarTime
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> CalendarTime
resetCalendar CalendarTime
now))
  GenParser Char a CalendarTime
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"yesterday" GenParser Char a ()
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CalendarTime -> GenParser Char a CalendarTime
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff
oneDay TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now))
  GenParser Char a CalendarTime
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (CalendarTime, CalendarTime) -> CalendarTime
forall a b. (a, b) -> a
fst ((CalendarTime, CalendarTime) -> CalendarTime)
-> ParsecT [Char] a Identity (CalendarTime, CalendarTime)
-> GenParser Char a CalendarTime
forall a b.
(a -> b)
-> ParsecT [Char] a Identity a -> ParsecT [Char] a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CalendarTime
-> ParsecT [Char] a Identity (CalendarTime, CalendarTime)
forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now
  GenParser Char a CalendarTime
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CalendarTime -> GenParser Char a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now
  where oneDay :: TimeDiff
oneDay    = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
1 Int
0 Int
0 Int
0 Integer
0

-- | English expressions for points in the past, e.g.
--
--    * 4 months ago
--
--    * 1 day ago
--
--    * day before yesterday
--
--   See 'englishDuration'
englishAgo :: CalendarTime -> CharParser a CalendarTime
englishAgo :: forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now =
  GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a CalendarTime -> GenParser Char a CalendarTime)
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall a b. (a -> b) -> a -> b
$ do TimeDiff
p <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
englishDuration
           Char
_ <- GenParser Char a Char -> GenParser Char a Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
           (Int
m,CalendarTime
ref) <- GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"ago" GenParser Char a ()
-> GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall a b.
ParsecT [Char] a Identity a
-> ParsecT [Char] a Identity b -> ParsecT [Char] a Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int, CalendarTime) -> GenParser Char a (Int, CalendarTime)
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1, CalendarTime
now))
                   GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
-> GenParser Char a (Int, CalendarTime)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do Int
m <- GenParser Char a Int
forall a. CharParser a Int
beforeMod GenParser Char a Int
-> GenParser Char a Int -> GenParser Char a Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a Int
forall a. CharParser a Int
afterMod
                          Char
_ <- GenParser Char a Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                          CalendarTime
d <- CalendarTime -> GenParser Char a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDate CalendarTime
now
                               GenParser Char a CalendarTime
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (CalendarTime, CalendarTime) -> CalendarTime
forall a b. (a, b) -> a
fst ((CalendarTime, CalendarTime) -> CalendarTime)
-> ParsecT [Char] a Identity (CalendarTime, CalendarTime)
-> GenParser Char a CalendarTime
forall a b.
(a -> b)
-> ParsecT [Char] a Identity a -> ParsecT [Char] a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CalendarTime
-> ParsecT [Char] a Identity (CalendarTime, CalendarTime)
forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now
                               GenParser Char a CalendarTime
-> GenParser Char a CalendarTime -> GenParser Char a CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> ParsecT [Char] a Identity MCalendarTime
-> GenParser Char a CalendarTime
forall a b.
(a -> b)
-> ParsecT [Char] a Identity a -> ParsecT [Char] a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT [Char] a Identity MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime (CalendarTime -> Int
ctTZ CalendarTime
now)
                          (Int, CalendarTime) -> GenParser Char a (Int, CalendarTime)
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m,CalendarTime
d)
           CalendarTime -> GenParser Char a CalendarTime
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> GenParser Char a CalendarTime)
-> CalendarTime -> GenParser Char a CalendarTime
forall a b. (a -> b) -> a -> b
$ Int -> TimeDiff -> TimeDiff
multiplyDiff Int
m TimeDiff
p TimeDiff -> CalendarTime -> CalendarTime
`addToCal` CalendarTime
ref
  where
    beforeMod :: GenParser Char st Int
beforeMod = GenParser Char st Int -> GenParser Char st Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Int -> GenParser Char st Int)
-> GenParser Char st Int -> GenParser Char st Int
forall a b. (a -> b) -> a -> b
$ [Char] -> GenParser Char st ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"before" GenParser Char st ()
-> GenParser Char st Int -> GenParser Char st Int
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> GenParser Char st Int
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
    afterMod :: GenParser Char st Int
afterMod  = GenParser Char st Int -> GenParser Char st Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Int -> GenParser Char st Int)
-> GenParser Char st Int -> GenParser Char st Int
forall a b. (a -> b) -> a -> b
$ [[Char]] -> GenParser Char st ()
forall a. [[Char]] -> GenParser Char a ()
caseStrings [[Char]
"after",[Char]
"since"] GenParser Char st ()
-> GenParser Char st Int -> GenParser Char st Int
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> GenParser Char st Int
forall a. a -> ParsecT [Char] st Identity a
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 = GenParser Char a TimeInterval
forall {st}. GenParser Char st TimeInterval
twixt GenParser Char a TimeInterval
-> GenParser Char a TimeInterval -> GenParser Char a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a TimeInterval
forall {st}. GenParser Char st TimeInterval
before GenParser Char a TimeInterval
-> GenParser Char a TimeInterval -> GenParser Char a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a TimeInterval
forall {st} {a}. GenParser Char st (Maybe CalendarTime, Maybe a)
after GenParser Char a TimeInterval
-> GenParser Char a TimeInterval -> GenParser Char a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a TimeInterval
forall {st}. GenParser Char st TimeInterval
inTheLast GenParser Char a TimeInterval
-> GenParser Char a TimeInterval -> GenParser Char a TimeInterval
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char a TimeInterval
forall {st}. GenParser Char st TimeInterval
lastetc
  where
   englishDT :: ParsecT [Char] u Identity CalendarTime
englishDT = MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> ParsecT [Char] u Identity MCalendarTime
-> ParsecT [Char] u Identity CalendarTime
forall a b.
(a -> b)
-> ParsecT [Char] u Identity a -> ParsecT [Char] u Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> ParsecT [Char] u Identity MCalendarTime
forall a. Int -> CharParser a MCalendarTime
iso8601DateTime (CalendarTime -> Int
ctTZ CalendarTime
now)
                ParsecT [Char] u Identity CalendarTime
-> ParsecT [Char] u Identity CalendarTime
-> ParsecT [Char] u Identity CalendarTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CalendarTime -> ParsecT [Char] u Identity CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDateTime CalendarTime
now
   before :: GenParser Char st TimeInterval
before = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
     do [Char] -> GenParser Char st ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"before"
        Char
_ <- ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
end <- ParsecT [Char] st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
        TimeInterval -> GenParser Char st TimeInterval
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
theBeginning, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
end)
   after :: GenParser Char st (Maybe CalendarTime, Maybe a)
after = GenParser Char st (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (Maybe CalendarTime, Maybe a)
 -> GenParser Char st (Maybe CalendarTime, Maybe a))
-> GenParser Char st (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall a b. (a -> b) -> a -> b
$
     do [[Char]] -> GenParser Char st ()
forall a. [[Char]] -> GenParser Char a ()
caseStrings [[Char]
"after",[Char]
"since"]
        Char
_ <- ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
start <- ParsecT [Char] st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
        (Maybe CalendarTime, Maybe a)
-> GenParser Char st (Maybe CalendarTime, Maybe a)
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
start, Maybe a
forall a. Maybe a
Nothing)
   twixt :: GenParser Char st TimeInterval
twixt = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
     do [Char] -> GenParser Char st ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"between"
        Char
_ <- ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
start <- ParsecT [Char] st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
        Char
_ <- ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        [Char] -> GenParser Char st ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"and"
        Char
_ <- ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        CalendarTime
end <- ParsecT [Char] st Identity CalendarTime
forall a. CharParser a CalendarTime
englishDT
        TimeInterval -> GenParser Char st TimeInterval
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
start, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
end)
   inTheLast :: GenParser Char st TimeInterval
inTheLast = GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st TimeInterval -> GenParser Char st TimeInterval)
-> GenParser Char st TimeInterval -> GenParser Char st TimeInterval
forall a b. (a -> b) -> a -> b
$
     do [Char] -> GenParser Char st ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"in the last"
        Char
_ <- ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        TimeDiff
dur <- CharParser st TimeDiff
forall a. CharParser a TimeDiff
englishDuration
        TimeInterval -> GenParser Char st TimeInterval
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just (CalendarTime -> Maybe CalendarTime)
-> CalendarTime -> Maybe CalendarTime
forall a b. (a -> b) -> a -> b
$ TimeDiff
dur TimeDiff -> CalendarTime -> CalendarTime
`subtractFromCal` CalendarTime
now, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
now)
   lastetc :: ParsecT [Char] a Identity TimeInterval
lastetc =
     do CalendarTime
l <- CalendarTime -> CharParser a CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishAgo CalendarTime
now
        TimeInterval -> ParsecT [Char] a Identity TimeInterval
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
l, CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
now)

-- | Durations in English that begin with the word \"last\",
--   E.g. \"last 4 months\" is treated as the duration between
--   4 months ago and now
englishLast :: CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast :: forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
now =
    -- last year, last week, last 3 years, etc
    GenParser Char a (CalendarTime, CalendarTime)
-> GenParser Char a (CalendarTime, CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a (CalendarTime, CalendarTime)
 -> GenParser Char a (CalendarTime, CalendarTime))
-> GenParser Char a (CalendarTime, CalendarTime)
-> GenParser Char a (CalendarTime, CalendarTime)
forall a b. (a -> b) -> a -> b
$ do [Char] -> GenParser Char a ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"last"
             Char
_ <- ParsecT [Char] a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
             TimeDiff
d <- CharParser a TimeDiff
forall a. CharParser a TimeDiff
englishDuration
             (CalendarTime, CalendarTime)
-> GenParser Char a (CalendarTime, CalendarTime)
forall a. a -> ParsecT [Char] a Identity a
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 = GenParser Char a (CalendarTime -> CalendarTime)
-> GenParser Char a (CalendarTime -> CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a (CalendarTime -> CalendarTime)
 -> GenParser Char a (CalendarTime -> CalendarTime))
-> GenParser Char a (CalendarTime -> CalendarTime)
-> GenParser Char a (CalendarTime -> CalendarTime)
forall a b. (a -> b) -> a -> b
$
  [GenParser Char a (CalendarTime -> CalendarTime)]
-> GenParser Char a (CalendarTime -> CalendarTime)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ (MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
wrapM ((MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime)
-> ParsecT [Char] a Identity (MCalendarTime -> MCalendarTime)
-> GenParser Char a (CalendarTime -> CalendarTime)
forall a b.
(a -> b)
-> ParsecT [Char] a Identity a -> ParsecT [Char] a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT [Char] a Identity (MCalendarTime -> MCalendarTime)
forall a. CharParser a (MCalendarTime -> MCalendarTime)
iso8601Time
         , [Char]
-> Int -> Int -> GenParser Char a (CalendarTime -> CalendarTime)
forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"noon"            Int
12  Int
0
         , [Char]
-> Int -> Int -> GenParser Char a (CalendarTime -> CalendarTime)
forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"midnight"         Int
0  Int
0
         , [Char]
-> Int -> Int -> GenParser Char a (CalendarTime -> CalendarTime)
forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"tea time"        Int
16 Int
30
         , [Char]
-> Int -> Int -> GenParser Char a (CalendarTime -> CalendarTime)
forall {st}.
[Char]
-> Int -> Int -> GenParser Char st (CalendarTime -> CalendarTime)
namedTime [Char]
"bed time"         Int
2 Int
30
         , [Char]
-> Int -> Int -> GenParser Char a (CalendarTime -> CalendarTime)
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 = GenParser Char st (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st (CalendarTime -> CalendarTime)
 -> GenParser Char st (CalendarTime -> CalendarTime))
-> GenParser Char st (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall a b. (a -> b) -> a -> b
$
          do [Char] -> GenParser Char st ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
name
             (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CalendarTime -> CalendarTime)
 -> GenParser Char st (CalendarTime -> CalendarTime))
-> (CalendarTime -> CalendarTime)
-> GenParser Char st (CalendarTime -> CalendarTime)
forall a b. (a -> b) -> a -> b
$ \CalendarTime
c -> CalendarTime
c { ctHour = h, ctMin = m }
        wrapM :: (MCalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
wrapM MCalendarTime -> MCalendarTime
f = MCalendarTime -> CalendarTime
unsafeToCalendarTime (MCalendarTime -> CalendarTime)
-> (CalendarTime -> MCalendarTime) -> CalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCalendarTime -> MCalendarTime
f (MCalendarTime -> MCalendarTime)
-> (CalendarTime -> MCalendarTime) -> CalendarTime -> MCalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> MCalendarTime
toMCalendarTime

-- | Some English durations, e.g.
--
--    * day
--
--    * 4 score
--
--    * 7 years
--
--    * 12 months
--
-- This is not particularly strict about what it accepts.
-- For example, "7 yeares", "4 scores" or "1 days" are
-- just fine.
englishDuration :: CharParser a TimeDiff
englishDuration :: forall a. CharParser a TimeDiff
englishDuration = GenParser Char a TimeDiff -> GenParser Char a TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a TimeDiff -> GenParser Char a TimeDiff)
-> GenParser Char a TimeDiff -> GenParser Char a TimeDiff
forall a b. (a -> b) -> a -> b
$
  do Int
n <- Int
-> ParsecT [Char] a Identity Int -> ParsecT [Char] a Identity Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
1 (ParsecT [Char] a Identity Int -> ParsecT [Char] a Identity Int)
-> ParsecT [Char] a Identity Int -> ParsecT [Char] a Identity Int
forall a b. (a -> b) -> a -> b
$ do [Char]
x <- ParsecT [Char] a Identity Char -> ParsecT [Char] a Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                        Char
_ <- ParsecT [Char] a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                        Int -> ParsecT [Char] a Identity Int
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT [Char] a Identity Int)
-> Int -> ParsecT [Char] a Identity Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
x
     TimeDiff
b <- GenParser Char a TimeDiff
forall a. CharParser a TimeDiff
base
     ParsecT [Char] a Identity () -> ParsecT [Char] a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ([[Char]] -> ParsecT [Char] a Identity ()
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 <- TimeDiff -> GenParser Char a TimeDiff -> GenParser Char a TimeDiff
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option TimeDiff
noTimeDiff (GenParser Char a TimeDiff -> GenParser Char a TimeDiff)
-> GenParser Char a TimeDiff -> GenParser Char a TimeDiff
forall a b. (a -> b) -> a -> b
$ GenParser Char a TimeDiff -> GenParser Char a TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a TimeDiff -> GenParser Char a TimeDiff)
-> GenParser Char a TimeDiff -> GenParser Char a TimeDiff
forall a b. (a -> b) -> a -> b
$ do
              { ParsecT [Char] a Identity Char -> ParsecT [Char] a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Char] a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space; Char
_ <- Char -> ParsecT [Char] a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ; ParsecT [Char] a Identity Char -> ParsecT [Char] a Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Char] a Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ; GenParser Char a TimeDiff
forall a. CharParser a TimeDiff
englishDuration }
     TimeDiff -> GenParser Char a TimeDiff
forall a. a -> ParsecT [Char] a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff -> GenParser Char a TimeDiff)
-> TimeDiff -> GenParser Char a TimeDiff
forall a b. (a -> b) -> a -> b
$ TimeDiff -> TimeDiff -> TimeDiff
addDiff TimeDiff
current TimeDiff
next
  where
  base :: ParsecT [Char] u Identity TimeDiff
base = [ParsecT [Char] u Identity TimeDiff]
-> ParsecT [Char] u Identity TimeDiff
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
         [ ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] u Identity TimeDiff
 -> ParsecT [Char] u Identity TimeDiff)
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b. (a -> b) -> a -> b
$ [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"score"      GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
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?
         ,       [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"year"       GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
1 Int
0  Int
0 Int
0 Int
0 Int
0 Integer
0)
         , ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] u Identity TimeDiff
 -> ParsecT [Char] u Identity TimeDiff)
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b. (a -> b) -> a -> b
$ [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"month"      GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
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)
         ,       [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"fortnight"  GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
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)
         ,       [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"week"       GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
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)
         ,       [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"day"        GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
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)
         ,       [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"hour"       GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
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)
         ,       [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"minute"     GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
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)
         ,       [Char] -> GenParser Char u ()
forall a. [Char] -> GenParser Char a ()
caseString [Char]
"second"     GenParser Char u ()
-> ParsecT [Char] u Identity TimeDiff
-> ParsecT [Char] u Identity TimeDiff
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeDiff -> ParsecT [Char] u Identity TimeDiff
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff  Int
0 Int
0  Int
0 Int
0 Int
0 Int
1 Integer
0) ]

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

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

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

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

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

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

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

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

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

-- | 'multiplyDiff' @i d@ multiplies every field in @d@ with @i@
--
-- FIXME; this seems like a terrible idea! it seems like
-- we should get rid of it if at all possible, maybe adding an
-- invertDiff function
multiplyDiff :: Int -> TimeDiff -> TimeDiff
multiplyDiff :: Int -> TimeDiff -> TimeDiff
multiplyDiff Int
m (TimeDiff Int
a1 Int
a2 Int
a3 Int
a4 Int
a5 Int
a6 Integer
a7) =
  Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff (Int
a1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Int
a6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) (Integer
a7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m)

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

-- | Set a calendar to UTC time any eliminate any inconsistencies within
--   (for example, where the weekday is given as @Thursday@, but this does not
--   match what the numerical date would lead one to expect)
resetCalendar :: CalendarTime -> CalendarTime
resetCalendar :: CalendarTime -> CalendarTime
resetCalendar = ClockTime -> CalendarTime
toUTCTime (ClockTime -> CalendarTime)
-> (CalendarTime -> ClockTime) -> CalendarTime -> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> ClockTime
toClockTime

-- | 'copyCalendar' @c mc@ replaces any field which is
--   specified in @mc@ with the equivalent field in @c@
--   @copyCalendar c nullMCalendar == nullMCalendar@
copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar :: CalendarTime -> MCalendarTime -> MCalendarTime
copyCalendar CalendarTime
c MCalendarTime
mc = MCalendarTime
mc
  { mctYear  = mctYear mc  >> Just (ctYear c)
  , mctMonth = mctMonth mc >> Just (ctMonth c)
  , mctDay   = mctDay mc   >> Just (ctDay c)
  , mctHour  = mctHour mc  >> Just (ctHour c)
  , mctMin   = mctMin mc   >> Just (ctMin c)
  , mctSec   = mctSec mc   >> Just (ctSec c)
  , mctPicosec = mctPicosec mc >> Just (ctPicosec c)
  , mctWDay = mctWDay mc   >> Just (ctWDay c)
  , mctYDay = mctYDay mc   >> Just (ctYDay c)
  , mctTZName = mctTZName mc >> Just (ctTZName c)
  , mctTZ     = mctTZ mc    >> Just (ctTZ c)
  , mctIsDST  = mctIsDST mc >> Just (ctIsDST c)
  }

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