{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# OPTIONS_GHC -ddump-simpl -dsuppress-all -ddump-to-file #-}
-- |
--
-- The [RFC3339 grammar](https://datatracker.ietf.org/doc/html/rfc3339#section-5.6) is below
--
-- @
-- date-fullyear   = 4DIGIT
-- date-month      = 2DIGIT  ; 01-12
-- date-mday       = 2DIGIT  ; 01-28, 01-29, 01-30, 01-31 based on month/year
-- time-hour       = 2DIGIT  ; 00-23
-- time-minute     = 2DIGIT  ; 00-59
-- time-second     = 2DIGIT  ; 00-58, 00-59, 00-60 based on leap second rules
-- time-secfrac    = "." 1*DIGIT
-- time-numoffset  = ("+" / "-") time-hour ":" time-minute
-- time-offset     = \"Z" / time-numoffset
--
-- partial-time    = time-hour ":" time-minute ":" time-second [time-secfrac]
-- full-date       = date-fullyear "-" date-month "-" date-mday
-- full-time       = partial-time time-offset
--
-- date-time       = full-date \"T" full-time
-- @
--
-- The parsers are a bit more lenient:
--
-- * We also accept space instead of @T@ date-time separator. (Allowed by RFC3339, forbidden by ISO8601)
--
-- * Seconds are optional (allowed by ISO8601)
--
-- * numerical timezone offset can be just @("+" / "-") time-hour@ or without a colon: @("+" / "-") time-hour time-minute@ (allowed by ISO8601).
--   However we require colons in between hours, minutes and seconds in the time (@partial-time@) production, and dashes in @full-date@ production.
--
-- * We allow over 4 digits in the year part (and that is a reason to require dashes).
--
-- * We allow @-00:00@ time offset. (Allowed by RFC3339, forbidden by ISO8601)
--
-- * We always allow time with 60 seconds, we don't consult any leap second database.
--
module Data.Time.FromText (
    parseDay,
    parseLocalTime,
    parseTimeOfDay,
    parseTimeZone,
    parseUTCTime,
    parseZonedTime,
    parseYear,
    parseMonth,
    parseQuarter,
    parseQuarterOfYear,
) where

import           Data.Bits                         ((.&.))
import           Data.Char                         (ord, chr)
import           Data.Fixed                        (Fixed (..), Pico)
import           Data.Integer.Conversion           (textToInteger)
import           Data.Text.Array                   (Array)
import           Data.Text.Internal                (Text (..))
import           GHC.Exts                          (inline)

import           Data.Time.Calendar                (Day, fromGregorianValid)
import           Data.Time.Calendar.Compat         (Year)
import           Data.Time.Calendar.Month.Compat   (Month, fromYearMonthValid)
import           Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
                                                    fromYearQuarter)
import           Data.Time.Clock                   (UTCTime (..))

import qualified Data.Text                         as T
import qualified Data.Text.Array                   as A
import qualified Data.Time.LocalTime               as Local

-- The parsing functions here are written in continuation passing style
-- with everything marked INLINE and continuation called with GHC.Exts.inline
-- to try to enforce that whole CPS-business goes away (with slight code-duplication).
--
-- Using staging would be a nicer way to enforce what we want here,
-- but that would require TemplateHaskell.

-------------------------------------------------------------------------------
-- Public functions
-------------------------------------------------------------------------------

-- | Parse a date of the form @[+-]YYYY-MM-DD@.
--
-- The year must contain at least 4 digits, to avoid the Y2K problem:
-- a two-digit year @YY@ may mean @YY@, @19YY@, or @20YY@, and we make it
-- an error to prevent the ambiguity.
-- Years from @0000@ to @0999@ must thus be zero-padded.
-- The year may have more than 4 digits.
--
parseDay :: Text -> Either String Day
parseDay :: Text -> Either String Day
parseDay = (Day -> Text -> Either String Day) -> Text -> Either String Day
forall r.
(Day -> Text -> Either String r) -> Text -> Either String r
parseDay_ Day -> Text -> Either String Day
forall r. r -> Text -> Either String r
expectingEOF

-- | Parse a month of the form @[+-]YYYY-MM@.
--
-- See also 'parseDay' for details about the year format.
parseMonth :: Text -> Either String Month
parseMonth :: Text -> Either String Month
parseMonth = (Year -> Int -> Text -> Either String Month)
-> Text -> Either String Month
forall r.
(Year -> Int -> Text -> Either String r) -> Text -> Either String r
parseMonth_ ((Year -> Int -> Text -> Either String Month)
 -> Text -> Either String Month)
-> (Year -> Int -> Text -> Either String Month)
-> Text
-> Either String Month
forall a b. (a -> b) -> a -> b
$ \Year
y Int
m Text
t ->
    case Year -> Int -> Maybe Month
fromYearMonthValid Year
y Int
m of
        Maybe Month
Nothing     -> String -> Either String Month
forall a b. a -> Either a b
Left (String -> Either String Month) -> String -> Either String Month
forall a b. (a -> b) -> a -> b
$ String
"invalid month:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Year, Int) -> String
forall a. Show a => a -> String
show (Year
y, Int
m)
        Just !Month
month -> Month -> Text -> Either String Month
forall r. r -> Text -> Either String r
expectingEOF Month
month Text
t

-- | Parse a year @[+-]YYYY@, with at least 4 digits. Can include a sign.
--
-- See also 'parseDay' for details about the year format.
--
-- Note: 'Year' is a type synonym for 'Integer'.
parseYear :: Text -> Either String Year
parseYear :: Text -> Either String Year
parseYear = (Year -> Either String Year)
-> (Year -> Char -> Text -> Either String Year)
-> Text
-> Either String Year
forall r.
(Year -> Either String r)
-> (Year -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseYear_ Year -> Either String Year
forall a b. b -> Either a b
Right ((Year -> Char -> Text -> Either String Year)
 -> Text -> Either String Year)
-> (Year -> Char -> Text -> Either String Year)
-> Text
-> Either String Year
forall a b. (a -> b) -> a -> b
$ \Year
_ Char
c Text
_ -> Char -> String -> Either String Year
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"end-of-input"

-- | Parse a quarter of the form @[+-]YYYY-QN@.
--
-- See also 'parseDay' for details about the year format.
--
parseQuarter :: Text -> Either String Quarter
parseQuarter :: Text -> Either String Quarter
parseQuarter = (Year -> QuarterOfYear -> Text -> Either String Quarter)
-> Text -> Either String Quarter
forall r.
(Year -> QuarterOfYear -> Text -> Either String r)
-> Text -> Either String r
parseQuarter_ ((Year -> QuarterOfYear -> Text -> Either String Quarter)
 -> Text -> Either String Quarter)
-> (Year -> QuarterOfYear -> Text -> Either String Quarter)
-> Text
-> Either String Quarter
forall a b. (a -> b) -> a -> b
$ \Year
y QuarterOfYear
q Text
t ->
    let !quarter :: Quarter
quarter = Year -> QuarterOfYear -> Quarter
fromYearQuarter Year
y QuarterOfYear
q in Quarter -> Text -> Either String Quarter
forall r. r -> Text -> Either String r
expectingEOF Quarter
quarter Text
t

-- | Parse a quarter of year of the form @QN@ or @qN@.
parseQuarterOfYear :: Text -> Either String QuarterOfYear
parseQuarterOfYear :: Text -> Either String QuarterOfYear
parseQuarterOfYear = (QuarterOfYear -> Text -> Either String QuarterOfYear)
-> Text -> Either String QuarterOfYear
forall r.
(QuarterOfYear -> Text -> Either String r)
-> Text -> Either String r
parseQuarterOfYear_ QuarterOfYear -> Text -> Either String QuarterOfYear
forall r. r -> Text -> Either String r
expectingEOF

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
parseTimeOfDay :: Text -> Either String Local.TimeOfDay
parseTimeOfDay :: Text -> Either String TimeOfDay
parseTimeOfDay = (Int -> Int -> Pico -> Either String TimeOfDay)
-> (Int -> Int -> Pico -> Char -> Text -> Either String TimeOfDay)
-> Text
-> Either String TimeOfDay
forall r.
(Int -> Int -> Pico -> Either String r)
-> (Int -> Int -> Pico -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseTimeOfDay_ Int -> Int -> Pico -> Either String TimeOfDay
kontEOF ((Int -> Int -> Pico -> Char -> Text -> Either String TimeOfDay)
 -> Text -> Either String TimeOfDay)
-> (Int -> Int -> Pico -> Char -> Text -> Either String TimeOfDay)
-> Text
-> Either String TimeOfDay
forall a b. (a -> b) -> a -> b
$ \Int
_ Int
_ Pico
_ Char
c Text
_ -> Char -> String -> Either String TimeOfDay
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"end-of-input" where
    kontEOF :: Int -> Int -> Pico -> Either String TimeOfDay
kontEOF Int
h Int
m Pico
s = Int
-> Int
-> Pico
-> (TimeOfDay -> Either String TimeOfDay)
-> Either String TimeOfDay
forall r.
Int
-> Int -> Pico -> (TimeOfDay -> Either String r) -> Either String r
makeTimeOfDay Int
h Int
m Pico
s TimeOfDay -> Either String TimeOfDay
forall a b. b -> Either a b
Right

-- | Parse a time zone.
--
-- The accepted formats are @Z@, @+HH@, @+HHMM@, or @+HH:MM@. (@+@ can be @-@).
--
-- Accepts @-23:59..23:59@ range, i.e. @HH < 24@ and @MM < 59@.
-- (This is consistent with grammar, and with what Python, Clojure, joda-time do).
--
parseTimeZone :: Text -> Either String Local.TimeZone
parseTimeZone :: Text -> Either String TimeZone
parseTimeZone = (TimeZone -> Either String TimeZone)
-> Text -> Either String TimeZone
forall r. (TimeZone -> Either String r) -> Text -> Either String r
parseTimeZone_ TimeZone -> Either String TimeZone
forall a b. b -> Either a b
Right

-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
-- The space may be replaced with a @T@.  The number of seconds is optional
-- and may be followed by a fractional component.
parseLocalTime :: Text -> Either String Local.LocalTime
parseLocalTime :: Text -> Either String LocalTime
parseLocalTime = (LocalTime -> Either String LocalTime)
-> (LocalTime -> Char -> Text -> Either String LocalTime)
-> Text
-> Either String LocalTime
forall r.
(LocalTime -> Either String r)
-> (LocalTime -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseLocalTime_ LocalTime -> Either String LocalTime
forall a b. b -> Either a b
Right ((LocalTime -> Char -> Text -> Either String LocalTime)
 -> Text -> Either String LocalTime)
-> (LocalTime -> Char -> Text -> Either String LocalTime)
-> Text
-> Either String LocalTime
forall a b. (a -> b) -> a -> b
$ \LocalTime
_ Char
c Text
_ -> Char -> String -> Either String LocalTime
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"end-of-input"

-- | Behaves as 'zonedTime', but converts any time zone offset into a
-- UTC time.
parseUTCTime :: Text -> Either String UTCTime
parseUTCTime :: Text -> Either String UTCTime
parseUTCTime = (UTCTime -> Either String UTCTime) -> Text -> Either String UTCTime
forall r. (UTCTime -> Either String r) -> Text -> Either String r
parseUTCTime_ UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right

-- | Parse a date with time zone info. Acceptable formats:
--
-- @
-- YYYY-MM-DD HH:MMZ
-- YYYY-MM-DD HH:MM:SSZ
-- YYYY-MM-DD HH:MM:SS.SSSZ
-- @
--
-- The first space may instead be a @T@, and the second space is
-- optional.  The @Z@ represents UTC.  The @Z@ may be replaced with a
-- time zone offset of the form @+0000@ or @-08:00@, where the first
-- two digits are hours, the @:@ is optional and the second two digits
-- (also optional) are minutes.
parseZonedTime :: Text -> Either String Local.ZonedTime
parseZonedTime :: Text -> Either String ZonedTime
parseZonedTime = (ZonedTime -> Either String ZonedTime)
-> Text -> Either String ZonedTime
forall r. (ZonedTime -> Either String r) -> Text -> Either String r
parseZonedTime_ ZonedTime -> Either String ZonedTime
forall a b. b -> Either a b
Right

-------------------------------------------------------------------------------
-- Uncons
-------------------------------------------------------------------------------

-- As all characters in the time format are ASCII
-- we can use slightly more efficient (or at least smaller) uncons.

{-# INLINE unconsAscii_ #-}
unconsAscii_
    :: Array -> Int -> Int
    -> Either String r                         -- ^ EOF continuation
    -> (Char -> Int -> Int -> Either String r) -- ^ character continuation
    -> Either String r
unconsAscii_ :: forall r.
Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
unconsAscii_ Array
arr Int
off Int
len Either String r
kontEOF Char -> Int -> Int -> Either String r
kontC
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = Either String r -> Either String r
forall a. a -> a
inline Either String r
kontEOF
    | Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80  = (Char -> Int -> Int -> Either String r)
-> Char -> Int -> Int -> Either String r
forall a. a -> a
inline Char -> Int -> Int -> Either String r
kontC (Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c)) (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    | Bool
otherwise = String -> Either String r
forall a b. a -> Either a b
Left String
"Non-ASCII character"
  where
    c :: Word8
c = Array -> Int -> Word8
A.unsafeIndex Array
arr Int
off

{-# INLINE unconsAscii #-}
unconsAscii :: Either String r -> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii :: forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii Either String r
kontEOF Char -> Text -> Either String r
kontC (Text Array
arr Int
off Int
len) =
    Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
forall r.
Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
unconsAscii_ Array
arr Int
off Int
len Either String r
kontEOF ((Char -> Int -> Int -> Either String r) -> Either String r)
-> (Char -> Int -> Int -> Either String r) -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c Int
off' Int
len' ->
    (Char -> Text -> Either String r)
-> Char -> Text -> Either String r
forall a. a -> a
inline Char -> Text -> Either String r
kontC Char
c (Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
len')

-------------------------------------------------------------------------------
-- Expecting errors
-------------------------------------------------------------------------------

expectingEOF :: r -> Text -> Either String r
expectingEOF :: forall r. r -> Text -> Either String r
expectingEOF = (r -> Either String r) -> r -> Text -> Either String r
forall a r. (a -> Either String r) -> a -> Text -> Either String r
expectingEOF_ r -> Either String r
forall a b. b -> Either a b
Right
{-# INLINE expectingEOF #-}

expectingEOF_ :: (a -> Either String r) -> a -> Text -> Either String r
expectingEOF_ :: forall a r. (a -> Either String r) -> a -> Text -> Either String r
expectingEOF_ a -> Either String r
kont a
a Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
    Maybe (Char, Text)
Nothing     -> (a -> Either String r) -> a -> Either String r
forall a. a -> a
inline a -> Either String r
kont a
a
    Just (Char
c, Text
_) -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"end-of-input"
{-# INLINE expectingEOF_ #-}

unexpectedEOF :: String -> Either String r
unexpectedEOF :: forall r. String -> Either String r
unexpectedEOF String
expected = String -> Either String r
forall a b. a -> Either a b
Left (String -> Either String r) -> String -> Either String r
forall a b. (a -> b) -> a -> b
$ String
"Unexpected end-of-input, expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected

unexpectedChar :: Char -> String -> Either String r
unexpectedChar :: forall r. Char -> String -> Either String r
unexpectedChar Char
c String
expected = String -> Either String r
forall a b. a -> Either a b
Left (String -> Either String r) -> String -> Either String r
forall a b. (a -> b) -> a -> b
$ String
"Unexpected '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
"', expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected

-------------------------------------------------------------------------------
-- Helpers
-------------------------------------------------------------------------------

{-# INLINE fromChar #-}
fromChar :: Char -> Int
fromChar :: Char -> Int
fromChar Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf

{-# INLINE twoDigits #-}
twoDigits
    :: (Int -> Text -> Either String r)
    -> Text
    -> Either String r
twoDigits :: forall r.
(Int -> Text -> Either String r) -> Text -> Either String r
twoDigits Int -> Text -> Either String r
kont =
    Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"a digit") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c1 -> if
        | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c1, Char
c1 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' -> Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"a digit") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c2 -> if
            | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c2, Char
c2 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' -> (Int -> Text -> Either String r) -> Int -> Text -> Either String r
forall a. a -> a
inline Int -> Text -> Either String r
kont (Char -> Int
fromChar Char
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
fromChar Char
c2)
            | Bool
otherwise -> \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c2 String
"a digit"
        | Bool
otherwise -> \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c1 String
"a digit"

{-# INLINE munchDigits #-}
munchDigits
    :: (Text -> Either String r)
    -> (Text -> Char -> Text -> Either String r)
    -> Text
    -> Either String r
munchDigits :: forall r.
(Text -> Either String r)
-> (Text -> Char -> Text -> Either String r)
-> Text
-> Either String r
munchDigits Text -> Either String r
kontEOF Text -> Char -> Text -> Either String r
kontC (Text Array
arr Int
off Int
len) =
    (Text -> Either String r)
-> (Text -> Char -> Text -> Either String r)
-> Array
-> Int
-> Int
-> Int
-> Either String r
forall r.
(Text -> Either String r)
-> (Text -> Char -> Text -> Either String r)
-> Array
-> Int
-> Int
-> Int
-> Either String r
munchDigits_ Text -> Either String r
kontEOF Text -> Char -> Text -> Either String r
kontC Array
arr Int
off Int
off Int
len

{-# INLINE munchDigits_ #-}
munchDigits_
    :: (Text -> Either String r)
    -> (Text -> Char -> Text -> Either String r)
    -> Array
    -> Int
    -> Int
    -> Int
    -> Either String r
munchDigits_ :: forall r.
(Text -> Either String r)
-> (Text -> Char -> Text -> Either String r)
-> Array
-> Int
-> Int
-> Int
-> Either String r
munchDigits_ Text -> Either String r
kontEOF Text -> Char -> Text -> Either String r
kontC Array
arr = Int -> Int -> Int -> Either String r
loop where
    loop :: Int -> Int -> Int -> Either String r
loop Int
off0 Int
off Int
len = Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
forall r.
Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
unconsAscii_ Array
arr Int
off Int
len ((Text -> Either String r) -> Text -> Either String r
forall a. a -> a
inline Text -> Either String r
kontEOF (Array -> Int -> Int -> Text
Text Array
arr Int
off0 (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off0))) ((Char -> Int -> Int -> Either String r) -> Either String r)
-> (Char -> Int -> Int -> Either String r) -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c Int
off' Int
len' -> if
        | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' -> Int -> Int -> Int -> Either String r
loop Int
off0 Int
off' Int
len'
        | Bool
otherwise          -> (Text -> Char -> Text -> Either String r)
-> Text -> Char -> Text -> Either String r
forall a. a -> a
inline Text -> Char -> Text -> Either String r
kontC (Array -> Int -> Int -> Text
Text Array
arr Int
off0 (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off0)) Char
c (Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
len')

utcTimeZone :: Local.TimeZone
utcTimeZone :: TimeZone
utcTimeZone = Int -> Bool -> String -> TimeZone
Local.TimeZone Int
0 Bool
False String
""

-------------------------------------------------------------------------------
-- Implementation: Dates
-------------------------------------------------------------------------------

-- parse year: @[+-]YYYY@.
-- Two continuations as we look at the following character.
{-# INLINE parseYear_ #-}
parseYear_
    :: forall r. (Year -> Either String r)
    -> (Year -> Char -> Text -> Either String r)
    -> Text
    -> Either String r
parseYear_ :: forall r.
(Year -> Either String r)
-> (Year -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseYear_ Year -> Either String r
kontEOF Year -> Char -> Text -> Either String r
kontC (Text Array
arr Int
offS Int
lenS) = Int -> Int -> Either String r
start Int
offS Int
lenS where
    start :: Int -> Int -> Either String r
    start :: Int -> Int -> Either String r
start !Int
off !Int
len = Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
forall r.
Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
unconsAscii_ Array
arr Int
off Int
len
        (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"-, +, or a digit") ((Char -> Int -> Int -> Either String r) -> Either String r)
-> (Char -> Int -> Int -> Either String r) -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c Int
off' Int
len' -> case Char
c of
            Char
'-' -> (Year -> Year) -> Int -> Int -> Int -> Either String r
loop Year -> Year
forall a. Num a => a -> a
negate Int
off' Int
off' Int
len'
            Char
'+' -> (Year -> Year) -> Int -> Int -> Int -> Either String r
loop Year -> Year
forall a. a -> a
id     Int
off' Int
off' Int
len'
            Char
_
                | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' -> (Year -> Year) -> Int -> Int -> Int -> Either String r
loop Year -> Year
forall a. a -> a
id    Int
off  Int
off' Int
len'
                | Bool
otherwise          -> String -> Either String r
forall a b. a -> Either a b
Left (String -> Either String r) -> String -> Either String r
forall a b. (a -> b) -> a -> b
$ String
"Unexpected '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", expecting -, +, or a digit"

    loop :: (Integer -> Integer) -> Int -> Int -> Int -> Either String r
    loop :: (Year -> Year) -> Int -> Int -> Int -> Either String r
loop !Year -> Year
posNeg !Int
off0 !Int
off !Int
len = Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
forall r.
Array
-> Int
-> Int
-> Either String r
-> (Char -> Int -> Int -> Either String r)
-> Either String r
unconsAscii_ Array
arr Int
off Int
len ((Year -> Year) -> Int -> Int -> Either String r
finishEOF Year -> Year
posNeg Int
off0 Int
off) ((Char -> Int -> Int -> Either String r) -> Either String r)
-> (Char -> Int -> Int -> Either String r) -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c Int
off' Int
len' -> if
        | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' -> (Year -> Year) -> Int -> Int -> Int -> Either String r
loop Year -> Year
posNeg Int
off0 Int
off' Int
len'
        | Bool
otherwise          -> (Year -> Year)
-> Char -> Int -> Int -> Int -> Int -> Either String r
finishC Year -> Year
posNeg Char
c Int
off0 Int
off Int
off' Int
len'

    finishEOF :: (Integer -> Integer) -> Int -> Int -> Either String r
    finishEOF :: (Year -> Year) -> Int -> Int -> Either String r
finishEOF !Year -> Year
posNeg !Int
off0 !Int
off
        | Int
len0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4
        = Year
year Year -> Either String r -> Either String r
forall a b. a -> b -> b
`seq` Year -> Either String r
kontEOF Year
year

        | Bool
otherwise
        = String -> Either String r
forall a b. a -> Either a b
Left String
"expected year with at least 4 digits"
      where
        len0 :: Int
len0 = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off0
        year :: Year
year = Year -> Year
posNeg (Text -> Year
textToInteger (Array -> Int -> Int -> Text
Text Array
arr Int
off0 Int
len0))
    {-# INLINE finishEOF #-}

    finishC :: (Integer -> Integer) -> Char -> Int -> Int -> Int -> Int-> Either String r
    finishC :: (Year -> Year)
-> Char -> Int -> Int -> Int -> Int -> Either String r
finishC !Year -> Year
posNeg Char
c !Int
off0 !Int
off !Int
off' !Int
len'
        | Int
len0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4
        = Year
year Year -> Either String r -> Either String r
forall a b. a -> b -> b
`seq` Year -> Char -> Text -> Either String r
kontC Year
year Char
c (Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
len')

        | Bool
otherwise
        = String -> Either String r
forall a b. a -> Either a b
Left String
"expected year with at least 4 digits"
      where
        len0 :: Int
len0 = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off0
        year :: Year
year = Year -> Year
posNeg (Text -> Year
textToInteger (Array -> Int -> Int -> Text
Text Array
arr Int
off0 Int
len0))
    {-# INLINE finishC #-}

{-# INLINE parseYear__ #-}
-- parse year and the following dash: @[+-]YYYY-@
parseYear__
    :: forall r. (Year -> Text -> Either String r)
    -> Text
    -> Either String r
parseYear__ :: forall r.
(Year -> Text -> Either String r) -> Text -> Either String r
parseYear__ Year -> Text -> Either String r
kont =
    (Year -> Either String r)
-> (Year -> Char -> Text -> Either String r)
-> Text
-> Either String r
forall r.
(Year -> Either String r)
-> (Year -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseYear_ (\Year
_ -> String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"a dash after a year part") ((Year -> Char -> Text -> Either String r)
 -> Text -> Either String r)
-> (Year -> Char -> Text -> Either String r)
-> Text
-> Either String r
forall a b. (a -> b) -> a -> b
$ \ !Year
y Char
c Text
t ->
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
    then Year -> Text -> Either String r
kont Year
y Text
t
    else Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"a dash after a year part"

-- parse month: @[-+]YYYY-MM@
{-# INLINE parseMonth_ #-}
parseMonth_
    :: forall r. (Year -> Int -> Text -> Either String r)
    -> Text
    -> Either String r
parseMonth_ :: forall r.
(Year -> Int -> Text -> Either String r) -> Text -> Either String r
parseMonth_ Year -> Int -> Text -> Either String r
kont =
    (Year -> Text -> Either String r) -> Text -> Either String r
forall r.
(Year -> Text -> Either String r) -> Text -> Either String r
parseYear__ ((Year -> Text -> Either String r) -> Text -> Either String r)
-> (Year -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \ !Year
y ->
    (Int -> Text -> Either String r) -> Text -> Either String r
forall r.
(Int -> Text -> Either String r) -> Text -> Either String r
twoDigits ((Int -> Text -> Either String r) -> Text -> Either String r)
-> (Int -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \ !Int
m ->
    Year -> Int -> Text -> Either String r
kont Year
y Int
m

-- parse day: @[-+]YYYY-MM-DD@
{-# INLINE parseDay_ #-}
parseDay_
    :: forall r. (Day -> Text -> Either String r)
    -> Text
    -> Either String r
parseDay_ :: forall r.
(Day -> Text -> Either String r) -> Text -> Either String r
parseDay_ Day -> Text -> Either String r
kont =
    (Year -> Int -> Text -> Either String r) -> Text -> Either String r
forall r.
(Year -> Int -> Text -> Either String r) -> Text -> Either String r
parseMonth_ ((Year -> Int -> Text -> Either String r)
 -> Text -> Either String r)
-> (Year -> Int -> Text -> Either String r)
-> Text
-> Either String r
forall a b. (a -> b) -> a -> b
$ \Year
y Int
m ->
    (Text -> Either String r) -> Text -> Either String r
forall r. (Text -> Either String r) -> Text -> Either String r
skipDash ((Text -> Either String r) -> Text -> Either String r)
-> (Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$
    (Int -> Text -> Either String r) -> Text -> Either String r
forall r.
(Int -> Text -> Either String r) -> Text -> Either String r
twoDigits ((Int -> Text -> Either String r) -> Text -> Either String r)
-> (Int -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Int
d ->
    case Year -> Int -> Int -> Maybe Day
fromGregorianValid Year
y Int
m Int
d of
        Maybe Day
Nothing   -> \Text
_ -> String -> Either String r
forall a b. a -> Either a b
Left (String -> Either String r) -> String -> Either String r
forall a b. (a -> b) -> a -> b
$ String
"invalid day:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Year, Int, Int) -> String
forall a. Show a => a -> String
show (Year
y, Int
m, Int
d)
        Just !Day
day -> (Day -> Text -> Either String r) -> Day -> Text -> Either String r
forall a. a -> a
inline Day -> Text -> Either String r
kont Day
day

-- parse quarter: @[+-]YYYY-QN@
{-# INLINE parseQuarter_ #-}
parseQuarter_
    :: forall r. (Year -> QuarterOfYear -> Text -> Either String r)
    -> Text
    -> Either String r
parseQuarter_ :: forall r.
(Year -> QuarterOfYear -> Text -> Either String r)
-> Text -> Either String r
parseQuarter_ Year -> QuarterOfYear -> Text -> Either String r
kont =
    (Year -> Text -> Either String r) -> Text -> Either String r
forall r.
(Year -> Text -> Either String r) -> Text -> Either String r
parseYear__ ((Year -> Text -> Either String r) -> Text -> Either String r)
-> (Year -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Year
y ->
    (QuarterOfYear -> Text -> Either String r)
-> Text -> Either String r
forall r.
(QuarterOfYear -> Text -> Either String r)
-> Text -> Either String r
parseQuarterOfYear_ ((QuarterOfYear -> Text -> Either String r)
 -> Text -> Either String r)
-> (QuarterOfYear -> Text -> Either String r)
-> Text
-> Either String r
forall a b. (a -> b) -> a -> b
$ \QuarterOfYear
q ->
    (Year -> QuarterOfYear -> Text -> Either String r)
-> Year -> QuarterOfYear -> Text -> Either String r
forall a. a -> a
inline Year -> QuarterOfYear -> Text -> Either String r
kont Year
y QuarterOfYear
q

{-# INLINE parseQuarterOfYear_ #-}
parseQuarterOfYear_
    :: forall r. (QuarterOfYear -> Text -> Either String r)
    -> Text
    -> Either String r
parseQuarterOfYear_ :: forall r.
(QuarterOfYear -> Text -> Either String r)
-> Text -> Either String r
parseQuarterOfYear_ QuarterOfYear -> Text -> Either String r
kont =
    Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"QuarterOfYear") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c -> if
        | Char
'Q' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
|| Char
'q' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c -> Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"Quarter digit") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c' -> case Char
c' of
            Char
'1' -> (QuarterOfYear -> Text -> Either String r)
-> QuarterOfYear -> Text -> Either String r
forall a. a -> a
inline QuarterOfYear -> Text -> Either String r
kont QuarterOfYear
Q1
            Char
'2' -> (QuarterOfYear -> Text -> Either String r)
-> QuarterOfYear -> Text -> Either String r
forall a. a -> a
inline QuarterOfYear -> Text -> Either String r
kont QuarterOfYear
Q2
            Char
'3' -> (QuarterOfYear -> Text -> Either String r)
-> QuarterOfYear -> Text -> Either String r
forall a. a -> a
inline QuarterOfYear -> Text -> Either String r
kont QuarterOfYear
Q3
            Char
'4' -> (QuarterOfYear -> Text -> Either String r)
-> QuarterOfYear -> Text -> Either String r
forall a. a -> a
inline QuarterOfYear -> Text -> Either String r
kont QuarterOfYear
Q4
            Char
_   -> \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c' String
"QuarterOfYear digit"

        | Bool
otherwise -> \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"QuarterOfYear"

{-# INLINE skipDash #-}
skipDash
    :: forall r. (Text -> Either String r)
    -> Text
    -> Either String r
skipDash :: forall r. (Text -> Either String r) -> Text -> Either String r
skipDash Text -> Either String r
kont = Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"a dash, -") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c ->
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
    then (Text -> Either String r) -> Text -> Either String r
forall a. a -> a
inline Text -> Either String r
kont
    else \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"a dash, -"

-------------------------------------------------------------------------------
-- Implementation: Time
-------------------------------------------------------------------------------

-- Parse time of day : @HH:MM[:SS[.SSS]]@
{-# INLINE parseTimeOfDay_ #-}
parseTimeOfDay_
    :: (Int -> Int -> Pico -> Either String r)
    -> (Int -> Int -> Pico -> Char -> Text -> Either String r)
    -> Text
    -> Either String r
parseTimeOfDay_ :: forall r.
(Int -> Int -> Pico -> Either String r)
-> (Int -> Int -> Pico -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseTimeOfDay_ Int -> Int -> Pico -> Either String r
kontEOF Int -> Int -> Pico -> Char -> Text -> Either String r
kontC =
    (Int -> Text -> Either String r) -> Text -> Either String r
forall r.
(Int -> Text -> Either String r) -> Text -> Either String r
twoDigits ((Int -> Text -> Either String r) -> Text -> Either String r)
-> (Int -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Int
h ->
    (Text -> Either String r) -> Text -> Either String r
forall r. (Text -> Either String r) -> Text -> Either String r
skipColon ((Text -> Either String r) -> Text -> Either String r)
-> (Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$
    (Int -> Text -> Either String r) -> Text -> Either String r
forall r.
(Int -> Text -> Either String r) -> Text -> Either String r
twoDigits ((Int -> Text -> Either String r) -> Text -> Either String r)
-> (Int -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Int
m -> Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii ((Int -> Int -> Pico -> Either String r)
-> Int -> Int -> Pico -> Either String r
forall a. a -> a
inline Int -> Int -> Pico -> Either String r
kontEOF Int
h Int
m Pico
0) ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \ Char
c ->
        if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'
        then (Pico -> Either String r)
-> (Pico -> Char -> Text -> Either String r)
-> Text
-> Either String r
forall r.
(Pico -> Either String r)
-> (Pico -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseSeconds_ ((Int -> Int -> Pico -> Either String r)
-> Int -> Int -> Pico -> Either String r
forall a. a -> a
inline Int -> Int -> Pico -> Either String r
kontEOF Int
h Int
m) ((Int -> Int -> Pico -> Char -> Text -> Either String r)
-> Int -> Int -> Pico -> Char -> Text -> Either String r
forall a. a -> a
inline Int -> Int -> Pico -> Char -> Text -> Either String r
kontC Int
h Int
m)
        else (Int -> Int -> Pico -> Char -> Text -> Either String r)
-> Int -> Int -> Pico -> Char -> Text -> Either String r
forall a. a -> a
inline Int -> Int -> Pico -> Char -> Text -> Either String r
kontC Int
h Int
m Pico
0 Char
c

{-# INLINE parseTimeOfDay__ #-}
parseTimeOfDay__
    :: (Local.TimeOfDay -> Either String r)
    -> (Local.TimeOfDay -> Char -> Text -> Either String r)
    -> Text
    -> Either String r
parseTimeOfDay__ :: forall r.
(TimeOfDay -> Either String r)
-> (TimeOfDay -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseTimeOfDay__ TimeOfDay -> Either String r
kontEOF TimeOfDay -> Char -> Text -> Either String r
kontC = (Int -> Int -> Pico -> Either String r)
-> (Int -> Int -> Pico -> Char -> Text -> Either String r)
-> Text
-> Either String r
forall r.
(Int -> Int -> Pico -> Either String r)
-> (Int -> Int -> Pico -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseTimeOfDay_
    (\Int
h Int
m Pico
s -> Int
-> Int -> Pico -> (TimeOfDay -> Either String r) -> Either String r
forall r.
Int
-> Int -> Pico -> (TimeOfDay -> Either String r) -> Either String r
makeTimeOfDay Int
h Int
m Pico
s TimeOfDay -> Either String r
kontEOF)
    (\Int
h Int
m Pico
s Char
c Text
t -> Int
-> Int -> Pico -> (TimeOfDay -> Either String r) -> Either String r
forall r.
Int
-> Int -> Pico -> (TimeOfDay -> Either String r) -> Either String r
makeTimeOfDay Int
h Int
m Pico
s ((TimeOfDay -> Either String r) -> Either String r)
-> (TimeOfDay -> Either String r) -> Either String r
forall a b. (a -> b) -> a -> b
$ \TimeOfDay
l -> (TimeOfDay -> Char -> Text -> Either String r)
-> TimeOfDay -> Char -> Text -> Either String r
forall a. a -> a
inline TimeOfDay -> Char -> Text -> Either String r
kontC TimeOfDay
l Char
c Text
t)

{-# INLINE makeTimeOfDay #-}
makeTimeOfDay :: Int -> Int -> Pico -> (Local.TimeOfDay -> Either String r) -> Either String r
makeTimeOfDay :: forall r.
Int
-> Int -> Pico -> (TimeOfDay -> Either String r) -> Either String r
makeTimeOfDay Int
h Int
m Pico
s TimeOfDay -> Either String r
kont =
    if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
60 Bool -> Bool -> Bool
&& Pico
s Pico -> Pico -> Bool
forall a. Ord a => a -> a -> Bool
< Pico
61
    then (TimeOfDay -> Either String r) -> TimeOfDay -> Either String r
forall a. a -> a
inline TimeOfDay -> Either String r
kont (Int -> Int -> Pico -> TimeOfDay
Local.TimeOfDay Int
h Int
m Pico
s)
    else String -> Either String r
forall a b. a -> Either a b
Left (String -> Either String r) -> String -> Either String r
forall a b. (a -> b) -> a -> b
$ String
"Invalid time of day:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Pico) -> String
forall a. Show a => a -> String
show (Int
h,Int
m,Pico
s)

-- Parse seconds: @SS.SSS@.
--
{-# INLINE parseSeconds_ #-}
parseSeconds_
    :: (Pico -> Either String r)
    -> (Pico -> Char -> Text -> Either String r)
    -> Text
    -> Either String r
parseSeconds_ :: forall r.
(Pico -> Either String r)
-> (Pico -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseSeconds_ Pico -> Either String r
kontEOF Pico -> Char -> Text -> Either String r
kontC =
    (Int -> Text -> Either String r) -> Text -> Either String r
forall r.
(Int -> Text -> Either String r) -> Text -> Either String r
twoDigits ((Int -> Text -> Either String r) -> Text -> Either String r)
-> (Int -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Int
real ->
    Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii ((Pico -> Either String r) -> Pico -> Either String r
forall a. a -> a
inline Pico -> Either String r
kontEOF (Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
real)) ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c ->
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
    then (Text -> Either String r)
-> (Text -> Char -> Text -> Either String r)
-> Text
-> Either String r
forall r.
(Text -> Either String r)
-> (Text -> Char -> Text -> Either String r)
-> Text
-> Either String r
munchDigits (\Text
i -> Int -> (Pico -> Either String r) -> Text -> Either String r
forall r.
Int -> (Pico -> Either String r) -> Text -> Either String r
makeSeconds Int
real Pico -> Either String r
kontEOF Text
i) (\Text
i Char
c' Text
t -> Int -> (Pico -> Either String r) -> Text -> Either String r
forall r.
Int -> (Pico -> Either String r) -> Text -> Either String r
makeSeconds Int
real (\Pico
j -> (Pico -> Char -> Text -> Either String r)
-> Pico -> Char -> Text -> Either String r
forall a. a -> a
inline Pico -> Char -> Text -> Either String r
kontC Pico
j Char
c' Text
t) Text
i)
    else Pico -> Char -> Text -> Either String r
kontC (Year -> Pico
forall k (a :: k). Year -> Fixed a
MkFixed (Year -> Pico) -> Year -> Pico
forall a b. (a -> b) -> a -> b
$ Int -> Year
forall a. Integral a => a -> Year
toInteger Int
real Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
pico) Char
c

{-# INLINE makeSeconds #-}
makeSeconds :: Int -> (Pico -> Either String r) -> Text -> Either String r
makeSeconds :: forall r.
Int -> (Pico -> Either String r) -> Text -> Either String r
makeSeconds Int
real Pico -> Either String r
kont t :: Text
t@(Text Array
_arr Int
_off Int
len)
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    = String -> Either String r
forall a b. a -> Either a b
Left String
"Expecting at least one decimal after a dot"

    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12
    = String -> Either String r
forall a b. a -> Either a b
Left String
"Unexpectedly over twelve decimals"

    | Bool
otherwise
    = (Pico -> Either String r) -> Pico -> Either String r
forall a. a -> a
inline Pico -> Either String r
kont (Year -> Pico
forall k (a :: k). Year -> Fixed a
MkFixed (Int -> Year
forall a. Integral a => a -> Year
toInteger Int
real Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
pico Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Text -> Year
textToInteger Text
t Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
10 Year -> Int -> Year
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
expo))
  where
    expo :: Int
expo = Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len

{-# INLINE parseTimeZone_ #-}
parseTimeZone_
    :: (Local.TimeZone -> Either String r)
    -> Text
    -> Either String r
parseTimeZone_ :: forall r. (TimeZone -> Either String r) -> Text -> Either String r
parseTimeZone_ TimeZone -> Either String r
kont =
    (Either String r
 -> (Char -> Text -> Either String r) -> Text -> Either String r)
-> Either String r
-> (Char -> Text -> Either String r)
-> Text
-> Either String r
forall a. a -> a
inline Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"timezone: Z, +HH:MM or -HH:MM") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c Text
t ->
    ()
-> (() -> TimeZone -> Either String r)
-> Char
-> Text
-> Either String r
forall a r.
a
-> (a -> TimeZone -> Either String r)
-> Char
-> Text
-> Either String r
parseTimeZone__ () (\()
_ -> (TimeZone -> Either String r) -> TimeZone -> Either String r
forall a. a -> a
inline TimeZone -> Either String r
kont) Char
c Text
t

pico :: Integer
pico :: Year
pico = Year
1000000000000 -- 12 zeros

{-# INLINE parseTimeZone__ #-}
parseTimeZone__
    :: a -- "extra bit of state"
    -> (a -> Local.TimeZone -> Either String r)
    -> Char
    -> Text
    -> Either String r
parseTimeZone__ :: forall a r.
a
-> (a -> TimeZone -> Either String r)
-> Char
-> Text
-> Either String r
parseTimeZone__ a
x a -> TimeZone -> Either String r
kont Char
c Text
t0 = case Char
c of
    Char
'-' -> a -> (Int -> Int) -> Text -> Either String r
hhmm a
x Int -> Int
forall a. Num a => a -> a
negate Text
t0
    Char
'+' -> a -> (Int -> Int) -> Text -> Either String r
hhmm a
x Int -> Int
forall a. a -> a
id     Text
t0
    Char
'Z' -> (TimeZone -> Either String r)
-> TimeZone -> Text -> Either String r
forall a r. (a -> Either String r) -> a -> Text -> Either String r
expectingEOF_ ((a -> TimeZone -> Either String r)
-> a -> TimeZone -> Either String r
forall a. a -> a
inline a -> TimeZone -> Either String r
kont a
x) TimeZone
utcTimeZone Text
t0
    Char
_   -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"timezone: Z, +HH:MM or -HH:MM"
  where
    hhmm :: a -> (Int -> Int) -> Text -> Either String r
hhmm a
y Int -> Int
posNeg =
        (Int -> Text -> Either String r) -> Text -> Either String r
forall r.
(Int -> Text -> Either String r) -> Text -> Either String r
twoDigits ((Int -> Text -> Either String r) -> Text -> Either String r)
-> (Int -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Int
hh ->
        Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii ((Int -> Int)
-> Int -> Int -> (TimeZone -> Either String r) -> Either String r
forall b.
(Int -> Int)
-> Int -> Int -> (TimeZone -> Either String b) -> Either String b
withResult Int -> Int
posNeg Int
hh Int
0 (a -> TimeZone -> Either String r
kont a
y)) ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c1 -> case Char
c1 of
            Char
':' ->
                (Int -> Text -> Either String r) -> Text -> Either String r
forall r.
(Int -> Text -> Either String r) -> Text -> Either String r
twoDigits ((Int -> Text -> Either String r) -> Text -> Either String r)
-> (Int -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Int
mm ->
                (Int -> Either String r) -> Int -> Text -> Either String r
forall a r. (a -> Either String r) -> a -> Text -> Either String r
expectingEOF_ (\Int
mm' -> (Int -> Int)
-> Int -> Int -> (TimeZone -> Either String r) -> Either String r
forall b.
(Int -> Int)
-> Int -> Int -> (TimeZone -> Either String b) -> Either String b
withResult Int -> Int
posNeg Int
hh Int
mm' (a -> TimeZone -> Either String r
kont a
y)) Int
mm

            Char
_ | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c1, Char
c1 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' ->
                Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"a digit") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c2 ->
                    if Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c2 Bool -> Bool -> Bool
&& Char
c2 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
                    then (Int -> Either String r) -> Int -> Text -> Either String r
forall a r. (a -> Either String r) -> a -> Text -> Either String r
expectingEOF_ (\Int
mm' -> (Int -> Int)
-> Int -> Int -> (TimeZone -> Either String r) -> Either String r
forall b.
(Int -> Int)
-> Int -> Int -> (TimeZone -> Either String b) -> Either String b
withResult Int -> Int
posNeg Int
hh Int
mm' (a -> TimeZone -> Either String r
kont a
y)) (Char -> Int
fromChar Char
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
fromChar Char
c2)
                    else \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c2 String
"a digit"

            Char
_   -> \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c1 String
"colon or a digit"

    withResult :: (Int -> Int) -> Int -> Int -> (Local.TimeZone -> Either String b) -> Either String b
    withResult :: forall b.
(Int -> Int)
-> Int -> Int -> (TimeZone -> Either String b) -> Either String b
withResult Int -> Int
posNeg Int
hh Int
mm TimeZone -> Either String b
kontR =
        -- we accept hours <24 and minutes <60
        -- this is how grammar implies, and also how python, joda-time
        -- and clojure #inst literals seem to work.
        -- Java's java.time seems to restrict to -18..18: https://docs.oracle.com/javase/8/docs/api/java/time/ZoneOffset.html
        -- but that seems more arbitrary.
        if Int
hh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24 Bool -> Bool -> Bool
&& Int
mm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
60
        then TimeZone -> Either String b
kontR (Int -> TimeZone
Local.minutesToTimeZone (Int -> Int
posNeg (Int
hh Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mm)))
        else String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"Invalid TimeZone:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
hh, Int
mm)

{-# INLINE parseLocalTime_ #-}
parseLocalTime_
    :: (Local.LocalTime -> Either String r)
    -> (Local.LocalTime -> Char -> Text -> Either String r)
    -> Text
    -> Either String r
parseLocalTime_ :: forall r.
(LocalTime -> Either String r)
-> (LocalTime -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseLocalTime_ LocalTime -> Either String r
kontEOF LocalTime -> Char -> Text -> Either String r
kontC =
    (Day -> Text -> Either String r) -> Text -> Either String r
forall r.
(Day -> Text -> Either String r) -> Text -> Either String r
parseDay_ ((Day -> Text -> Either String r) -> Text -> Either String r)
-> (Day -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Day
d ->
    (Text -> Either String r) -> Text -> Either String r
forall r. (Text -> Either String r) -> Text -> Either String r
skipDaySeparator ((Text -> Either String r) -> Text -> Either String r)
-> (Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$
    (TimeOfDay -> Either String r)
-> (TimeOfDay -> Char -> Text -> Either String r)
-> Text
-> Either String r
forall r.
(TimeOfDay -> Either String r)
-> (TimeOfDay -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseTimeOfDay__
        (\TimeOfDay
l -> (LocalTime -> Either String r) -> LocalTime -> Either String r
forall a. a -> a
inline LocalTime -> Either String r
kontEOF (Day -> TimeOfDay -> LocalTime
Local.LocalTime Day
d TimeOfDay
l))
        (\TimeOfDay
l Char
c Text
t -> (LocalTime -> Char -> Text -> Either String r)
-> LocalTime -> Char -> Text -> Either String r
forall a. a -> a
inline LocalTime -> Char -> Text -> Either String r
kontC (Day -> TimeOfDay -> LocalTime
Local.LocalTime Day
d TimeOfDay
l) Char
c Text
t)

{-# INLINE parseUTCTime_ #-}
parseUTCTime_
    :: (UTCTime -> Either String r)
    -> Text
    -> Either String r
parseUTCTime_ :: forall r. (UTCTime -> Either String r) -> Text -> Either String r
parseUTCTime_ UTCTime -> Either String r
kont = (ZonedTime -> Either String r) -> Text -> Either String r
forall r. (ZonedTime -> Either String r) -> Text -> Either String r
parseZonedTime_ ((ZonedTime -> Either String r) -> Text -> Either String r)
-> (ZonedTime -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \ZonedTime
zt -> (UTCTime -> Either String r) -> UTCTime -> Either String r
forall a. a -> a
inline UTCTime -> Either String r
kont (ZonedTime -> UTCTime
Local.zonedTimeToUTC ZonedTime
zt)

{-# INLINE parseZonedTime_ #-}
parseZonedTime_
    :: (Local.ZonedTime -> Either String r)
    -> Text
    -> Either String r
parseZonedTime_ :: forall r. (ZonedTime -> Either String r) -> Text -> Either String r
parseZonedTime_ ZonedTime -> Either String r
kont =
    (LocalTime -> Either String r)
-> (LocalTime -> Char -> Text -> Either String r)
-> Text
-> Either String r
forall r.
(LocalTime -> Either String r)
-> (LocalTime -> Char -> Text -> Either String r)
-> Text
-> Either String r
parseLocalTime_ (\LocalTime
_ -> String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"timezone") ((LocalTime -> Char -> Text -> Either String r)
 -> Text -> Either String r)
-> (LocalTime -> Char -> Text -> Either String r)
-> Text
-> Either String r
forall a b. (a -> b) -> a -> b
$ \LocalTime
lt Char
c ->
    (ZonedTime -> Either String r)
-> LocalTime -> Char -> Text -> Either String r
forall r.
(ZonedTime -> Either String r)
-> LocalTime -> Char -> Text -> Either String r
parseZT ZonedTime -> Either String r
kont LocalTime
lt Char
c

{-# INLINE parseZT #-}
parseZT
    :: (Local.ZonedTime -> Either String r)
    -> Local.LocalTime
    -> Char -> Text -> Either String r
parseZT :: forall r.
(ZonedTime -> Either String r)
-> LocalTime -> Char -> Text -> Either String r
parseZT ZonedTime -> Either String r
kont LocalTime
lt = LocalTime
-> (LocalTime -> TimeZone -> Either String r)
-> Char
-> Text
-> Either String r
forall a r.
a
-> (a -> TimeZone -> Either String r)
-> Char
-> Text
-> Either String r
parseTimeZone__ LocalTime
lt ((LocalTime -> TimeZone -> Either String r)
 -> Char -> Text -> Either String r)
-> (LocalTime -> TimeZone -> Either String r)
-> Char
-> Text
-> Either String r
forall a b. (a -> b) -> a -> b
$ \LocalTime
lt' TimeZone
tz -> (ZonedTime -> Either String r) -> ZonedTime -> Either String r
forall a. a -> a
inline ZonedTime -> Either String r
kont (LocalTime -> TimeZone -> ZonedTime
Local.ZonedTime LocalTime
lt' TimeZone
tz)

{-# INLINE skipColon #-}
skipColon
    :: (Text -> Either String r)
    -> Text
    -> Either String r
skipColon :: forall r. (Text -> Either String r) -> Text -> Either String r
skipColon Text -> Either String r
kont = Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"a colon, :") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c ->
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'
    then (Text -> Either String r) -> Text -> Either String r
forall a. a -> a
inline Text -> Either String r
kont
    else \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"a colon, :"

{-# INLINE skipDaySeparator #-}
skipDaySeparator
    :: (Text -> Either String r)
    -> Text
    -> Either String r
skipDaySeparator :: forall r. (Text -> Either String r) -> Text -> Either String r
skipDaySeparator Text -> Either String r
kont = Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall r.
Either String r
-> (Char -> Text -> Either String r) -> Text -> Either String r
unconsAscii (String -> Either String r
forall r. String -> Either String r
unexpectedEOF String
"a day separator, T or space") ((Char -> Text -> Either String r) -> Text -> Either String r)
-> (Char -> Text -> Either String r) -> Text -> Either String r
forall a b. (a -> b) -> a -> b
$ \Char
c ->
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'T' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
    then (Text -> Either String r) -> Text -> Either String r
forall a. a -> a
inline Text -> Either String r
kont
    else \Text
_ -> Char -> String -> Either String r
forall r. Char -> String -> Either String r
unexpectedChar Char
c String
"a day separator, T or space"