-- This file is part of purebred-email
-- Copyright (C) 2021  Fraser Tweedale
--
-- purebred-email is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings #-}

module Data.IMF.DateTime
  ( dateTime
  ) where

import Control.Applicative ((<|>), optional)
import Control.Monad (guard)
import Data.Functor (($>))

import Data.Attoparsec.ByteString as A
import Data.Attoparsec.ByteString.Char8 (char8, isDigit_w8)
import qualified Data.ByteString as B
import qualified Data.Time
import Data.Time
  ( Day, DayOfWeek(..), LocalTime(LocalTime), TimeOfDay, TimeZone(TimeZone)
  , ZonedTime(ZonedTime), fromGregorianValid, makeTimeOfDayValid
  , minutesToTimeZone, hoursToTimeZone, utc
  )
import Data.IMF.Syntax (fws, optionalCFWS, optionalFWS)

dateTime :: Parser ZonedTime
dateTime :: Parser ZonedTime
dateTime = do
  Maybe DayOfWeek
dow <- Parser ByteString DayOfWeek -> Parser ByteString (Maybe DayOfWeek)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString DayOfWeek
dayOfWeek Parser ByteString DayOfWeek
-> Parser ByteString Word8 -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
char8 Char
',')
  Day
theDate <- Parser Day
date

  -- ensure day of week matches date
  case Maybe DayOfWeek
dow of
    Just DayOfWeek
dow' | Day -> DayOfWeek
Data.Time.dayOfWeek Day
theDate DayOfWeek -> DayOfWeek -> Bool
forall a. Eq a => a -> a -> Bool
/= DayOfWeek
dow'
      -> String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day of week inconsistent with date"
    Maybe DayOfWeek
_ -> () -> Parser ByteString ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  TimeOfDay
tod <- Parser TimeOfDay
timeOfDay
  TimeZone
z <- Parser TimeZone
zone
  ByteString
_ <- Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS

  ZonedTime -> Parser ZonedTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZonedTime -> Parser ZonedTime) -> ZonedTime -> Parser ZonedTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeZone -> ZonedTime
ZonedTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
theDate TimeOfDay
tod) TimeZone
z


dayOfWeek :: Parser DayOfWeek
dayOfWeek :: Parser ByteString DayOfWeek
dayOfWeek = Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalFWS Parser ByteString ByteString
-> Parser ByteString DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString DayOfWeek
dayName

dayName :: Parser DayOfWeek
dayName :: Parser ByteString DayOfWeek
dayName =
  ByteString -> Parser ByteString ByteString
string ByteString
"Mon" Parser ByteString ByteString
-> DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Monday
  Parser ByteString DayOfWeek
-> Parser ByteString DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Tue" Parser ByteString ByteString
-> DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Tuesday
  Parser ByteString DayOfWeek
-> Parser ByteString DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Wed" Parser ByteString ByteString
-> DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Wednesday
  Parser ByteString DayOfWeek
-> Parser ByteString DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Thu" Parser ByteString ByteString
-> DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Thursday
  Parser ByteString DayOfWeek
-> Parser ByteString DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Fri" Parser ByteString ByteString
-> DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Friday
  Parser ByteString DayOfWeek
-> Parser ByteString DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Sat" Parser ByteString ByteString
-> DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Saturday
  Parser ByteString DayOfWeek
-> Parser ByteString DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Sun" Parser ByteString ByteString
-> DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Sunday
  Parser ByteString DayOfWeek
-> Parser ByteString DayOfWeek -> Parser ByteString DayOfWeek
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ByteString DayOfWeek
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid day-of-week"

date :: Parser Day
date :: Parser Day
date = do
  Int
d <- Parser Int
day
  Int
m <- Parser Int
month
  Integer
y <- Parser Integer
year
  case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
y Int
m Int
d of
    Just Day
r -> Day -> Parser Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
r
    Maybe Day
Nothing -> String -> Parser Day
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid date"

day :: Parser Int
day :: Parser Int
day = Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalFWS Parser ByteString ByteString -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
go Parser Int -> Parser ByteString ByteString -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s s
fws
  where
  go :: Parser Int
go = (Parser Int
twoDigit Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Int
digit) Parser Int -> (Int -> Parser Int) -> Parser Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Bool) -> String -> Int -> Parser Int
forall a. (a -> Bool) -> String -> a -> Parser a
check (\Int
n -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
31) String
"day out of range"

month :: Parser Int
month :: Parser Int
month =
  ByteString -> Parser ByteString ByteString
string ByteString
"Jan" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
1
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Feb" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
2
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Mar" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
3
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Apr" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
4
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"May" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
5
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Jun" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
6
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Jul" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
7
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Aug" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
8
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Sep" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
9
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Oct" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
10
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Nov" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
11
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"Dec" Parser ByteString ByteString -> Int -> Parser Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
12
  Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid month"

year :: Parser Integer
year :: Parser Integer
year = Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s s
fws Parser ByteString ByteString -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Integer
go Parser Integer -> (Integer -> Parser Integer) -> Parser Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Integer -> Bool) -> String -> Integer -> Parser Integer
forall a. (a -> Bool) -> String -> a -> Parser a
check (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1900) String
"year cannot be < 1900") Parser Integer -> Parser ByteString ByteString -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s s
fws
  where
  go :: Parser Integer
go = Parser Integer
fourOrMoreDigit Parser Integer -> Parser Integer -> Parser Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
obsYear Parser Integer -> Parser Integer -> Parser Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too few digits in year"
  fourOrMoreDigit :: Parser Integer
fourOrMoreDigit = do
    ByteString
digits <- (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
isDigit_w8
    Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
B.length ByteString
digits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4)
    Integer -> Parser Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Integer -> Word8 -> Integer
forall a a. (Integral a, Num a) => a -> a -> a
step Integer
0 ByteString
digits)
  step :: a -> a -> a
step a
r a
a = a
r a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
  obsYear :: Parser Integer
obsYear = do
    Int
yy <- Parser Int
twoDigit
    Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      (Int -> Integer) -> (Maybe Int -> Int) -> Maybe Int -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
yy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
yy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
49 then Int
2000 else Int
1900) (Int
1900 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yy Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)
      (Maybe Int -> Integer)
-> Parser ByteString (Maybe Int) -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
digit

timeOfDay :: Parser TimeOfDay
timeOfDay :: Parser TimeOfDay
timeOfDay = do
  Int
hour <- Parser Int
twoDigit
  Word8
_ <- Char -> Parser ByteString Word8
char8 Char
':'
  Int
minute <- Parser Int
twoDigit
  Int
second <- Char -> Parser ByteString Word8
char8 Char
':' Parser ByteString Word8 -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
twoDigit Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
  case Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
hour Int
minute (Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
second) of
    Maybe TimeOfDay
Nothing -> String -> Parser TimeOfDay
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid time-of-day"
    Just TimeOfDay
tod -> TimeOfDay -> Parser TimeOfDay
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
tod

zone :: Parser TimeZone
zone :: Parser TimeZone
zone = Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s s
fws Parser ByteString ByteString -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser TimeZone
go Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TimeZone
obsZone)
  where
  go :: Parser TimeZone
go = do
    Int -> Int
posNeg <- Char -> Parser ByteString Word8
char8 Char
'+' Parser ByteString Word8
-> (Int -> Int) -> Parser ByteString (Int -> Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> Int
forall a. a -> a
id Parser ByteString (Int -> Int)
-> Parser ByteString (Int -> Int) -> Parser ByteString (Int -> Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Word8
char8 Char
'-' Parser ByteString Word8
-> (Int -> Int) -> Parser ByteString (Int -> Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> Int
forall a. Num a => a -> a
negate
    Int
h <- Parser Int
twoDigit
    Int
m <- Parser Int
twoDigit
    Bool -> String -> Parser ByteString ()
guardFail (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
59) String
"zone minutes must be in range 0..59"
    TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeZone -> Parser TimeZone) -> TimeZone -> Parser TimeZone
forall a b. (a -> b) -> a -> b
$ Int -> TimeZone
minutesToTimeZone (Int -> Int
posNeg (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m))

obsZone :: Parser TimeZone
obsZone :: Parser TimeZone
obsZone =
  TimeZone
utc TimeZone -> Parser ByteString ByteString -> Parser TimeZone
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ByteString -> Parser ByteString ByteString
string ByteString
"GMT" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"UT")
  Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TimeZone
usZone
  Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TimeZone
milZone
  where
  usZone :: Parser TimeZone
usZone = do
    (Int
off, Char
c1) <-
      Int -> Char -> Parser ByteString (Int, Char)
forall a. a -> Char -> Parser ByteString (a, Char)
charVal (-Int
5) Char
'E'      -- eastern
      Parser ByteString (Int, Char)
-> Parser ByteString (Int, Char) -> Parser ByteString (Int, Char)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Char -> Parser ByteString (Int, Char)
forall a. a -> Char -> Parser ByteString (a, Char)
charVal (-Int
6) Char
'C'  -- central
      Parser ByteString (Int, Char)
-> Parser ByteString (Int, Char) -> Parser ByteString (Int, Char)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Char -> Parser ByteString (Int, Char)
forall a. a -> Char -> Parser ByteString (a, Char)
charVal (-Int
7) Char
'M'  -- mountain
      Parser ByteString (Int, Char)
-> Parser ByteString (Int, Char) -> Parser ByteString (Int, Char)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Char -> Parser ByteString (Int, Char)
forall a. a -> Char -> Parser ByteString (a, Char)
charVal (-Int
8) Char
'P'  -- pacific
    (Int
dst, Char
c2) <- Int -> Char -> Parser ByteString (Int, Char)
forall a. a -> Char -> Parser ByteString (a, Char)
charVal Int
0 Char
'S' Parser ByteString (Int, Char)
-> Parser ByteString (Int, Char) -> Parser ByteString (Int, Char)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Char -> Parser ByteString (Int, Char)
forall a. a -> Char -> Parser ByteString (a, Char)
charVal Int
1 Char
'D'  -- standard / dst
    Word8
_ <- Char -> Parser ByteString Word8
char8 Char
'T'
    TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeZone -> Parser TimeZone) -> TimeZone -> Parser TimeZone
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> String -> TimeZone
TimeZone ((Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dst) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) (Int
dst Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Char
c1Char -> String -> String
forall a. a -> [a] -> [a]
:Char
c2Char -> String -> String
forall a. a -> [a] -> [a]
:String
"T")
  charVal :: a -> Char -> Parser ByteString (a, Char)
charVal a
a Char
c = (a
a, Char
c) (a, Char) -> Parser ByteString Word8 -> Parser ByteString (a, Char)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Word8
char8 Char
c
  milZone :: Parser TimeZone
milZone =
    TimeZone
utc TimeZone -> Parser ByteString Word8 -> Parser TimeZone
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Parser ByteString Word8
char8 Char
'Z' Parser ByteString Word8
-> Parser ByteString Word8 -> Parser ByteString Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Word8
char8 Char
'z')
    Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Int) -> Int -> Word8 -> Word8 -> Parser TimeZone
forall b.
Num b =>
(b -> Int) -> b -> Word8 -> Word8 -> Parser TimeZone
go     Int -> Int
forall a. a -> a
id Int
0x40 Word8
0x41 Word8
0x49  -- A..I
    Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Int) -> Int -> Word8 -> Word8 -> Parser TimeZone
forall b.
Num b =>
(b -> Int) -> b -> Word8 -> Word8 -> Parser TimeZone
go     Int -> Int
forall a. a -> a
id Int
0x41 Word8
0x4b Word8
0x4d  -- K..M
    Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Int) -> Int -> Word8 -> Word8 -> Parser TimeZone
forall b.
Num b =>
(b -> Int) -> b -> Word8 -> Word8 -> Parser TimeZone
go Int -> Int
forall a. Num a => a -> a
negate Int
0x4d Word8
0x4c Word8
0x59  -- N..Y
    Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Int) -> Int -> Word8 -> Word8 -> Parser TimeZone
forall b.
Num b =>
(b -> Int) -> b -> Word8 -> Word8 -> Parser TimeZone
go     Int -> Int
forall a. a -> a
id Int
0x60 Word8
0x61 Word8
0x69  -- a..i
    Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Int) -> Int -> Word8 -> Word8 -> Parser TimeZone
forall b.
Num b =>
(b -> Int) -> b -> Word8 -> Word8 -> Parser TimeZone
go     Int -> Int
forall a. a -> a
id Int
0x61 Word8
0x6b Word8
0x6d  -- k..m
    Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Int) -> Int -> Word8 -> Word8 -> Parser TimeZone
forall b.
Num b =>
(b -> Int) -> b -> Word8 -> Word8 -> Parser TimeZone
go Int -> Int
forall a. Num a => a -> a
negate Int
0x6d Word8
0x6e Word8
0x79  -- n..y
  go :: (b -> Int) -> b -> Word8 -> Word8 -> Parser TimeZone
go b -> Int
f b
off Word8
lo Word8
hi =
    Int -> TimeZone
hoursToTimeZone (Int -> TimeZone) -> (Word8 -> Int) -> Word8 -> TimeZone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
f (b -> Int) -> (Word8 -> b) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> b
forall a. Num a => a -> a -> a
subtract b
off (b -> b) -> (Word8 -> b) -> Word8 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Word8 -> TimeZone) -> Parser ByteString Word8 -> Parser TimeZone
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString Word8
satisfy (\Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
lo Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
hi)


guardFail :: Bool -> String -> Parser ()
guardFail :: Bool -> String -> Parser ByteString ()
guardFail Bool
True String
_ = () -> Parser ByteString ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
guardFail Bool
False String
s = String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s

check :: (a -> Bool) -> String -> a -> Parser a
check :: (a -> Bool) -> String -> a -> Parser a
check a -> Bool
f String
s a
a = Bool -> String -> Parser ByteString ()
guardFail (a -> Bool
f a
a) String
s Parser ByteString () -> a -> Parser a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
a

digit :: Parser Int
digit :: Parser Int
digit = (\Word8
c -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48)) (Word8 -> Int) -> Parser ByteString Word8 -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString Word8
satisfy Word8 -> Bool
isDigit_w8

twoDigit :: Parser Int
twoDigit :: Parser Int
twoDigit = (\Int
hi Int
lo -> Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lo) (Int -> Int -> Int) -> Parser Int -> Parser ByteString (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
digit Parser ByteString (Int -> Int) -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
digit