{-# LANGUAGE Safe #-}

{-# OPTIONS -fno-warn-orphans #-}

module Data.Time.Format.Parse.Instances (

) where

import Control.Applicative ((<|>))
import Data.Char
import Data.Fixed
import Data.List (elemIndex, find)
import Data.Maybe
import Data.Ratio
import Data.Time.Calendar.CalendarDiffDays
import Data.Time.Calendar.Days
import Data.Time.Calendar.Gregorian
import Data.Time.Calendar.Month
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Private (clipValid)
import Data.Time.Calendar.Quarter
import Data.Time.Calendar.Types
import Data.Time.Calendar.WeekDate
import Data.Time.Clock.Internal.DiffTime
import Data.Time.Clock.Internal.NominalDiffTime
import Data.Time.Clock.Internal.UTCTime
import Data.Time.Clock.Internal.UniversalTime
import Data.Time.Clock.POSIX
import Data.Time.Format.Locale
import Data.Time.Format.Parse.Class
import Data.Time.LocalTime.Internal.CalendarDiffTime
import Data.Time.LocalTime.Internal.LocalTime
import Data.Time.LocalTime.Internal.TimeOfDay
import Data.Time.LocalTime.Internal.TimeZone
import Data.Time.LocalTime.Internal.ZonedTime
import Data.Traversable
import Text.Read (readMaybe)

data WeekType
    = ISOWeek
    | SundayWeek
    | MondayWeek
    deriving WeekType -> WeekType -> Bool
(WeekType -> WeekType -> Bool)
-> (WeekType -> WeekType -> Bool) -> Eq WeekType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WeekType -> WeekType -> Bool
== :: WeekType -> WeekType -> Bool
$c/= :: WeekType -> WeekType -> Bool
/= :: WeekType -> WeekType -> Bool
Eq

mkDayFromWeekType :: WeekType -> Year -> WeekOfYear -> DayOfWeek -> Maybe Day
mkDayFromWeekType :: WeekType -> Integer -> Int -> DayOfWeek -> Maybe Day
mkDayFromWeekType WeekType
wt Integer
y Int
woy DayOfWeek
dow =
    case WeekType
wt of
        WeekType
ISOWeek -> Integer -> Int -> Int -> Maybe Day
fromWeekDateValid Integer
y Int
woy (Int -> Maybe Day) -> Int -> Maybe Day
forall a b. (a -> b) -> a -> b
$ DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
dow
        WeekType
SundayWeek -> Integer -> Int -> Int -> Maybe Day
fromSundayStartWeekValid Integer
y Int
woy (Int -> Maybe Day) -> Int -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
dow) Int
7
        WeekType
MondayWeek -> Integer -> Int -> Int -> Maybe Day
fromMondayStartWeekValid Integer
y Int
woy (Int -> Maybe Day) -> Int -> Maybe Day
forall a b. (a -> b) -> a -> b
$ DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
dow

data DayFact
    = CenturyDayFact Integer -- century of all years
    | YearOfCenturyDayFact Integer -- 0-99, last two digits of both real years and week years
    | QuarterOfYearDayFact QuarterOfYear
    | MonthOfYearDayFact MonthOfYear -- 1-12
    | DayOfMonthDayFact DayOfMonth -- 1-31
    | DayOfYearDayFact DayOfYear -- 1-366
    | DayOfWeekDayFact DayOfWeek
    | WeekOfYearDayFact
        WeekType
        WeekOfYear -- 1-53 or 0-53
    | UTCTimeDayFact UTCTime
    | TimeZoneDayFact TimeZone

lastMatch :: (a -> Maybe b) -> [a] -> Maybe b
lastMatch :: forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch a -> Maybe b
f [a]
aa = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> [b] -> Maybe b
forall a b. (a -> b) -> a -> b
$ [b] -> [b]
forall a. [a] -> [a]
reverse ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ [Maybe b] -> [b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe b] -> [b]) -> [Maybe b] -> [b]
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> [a] -> [Maybe b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
f [a]
aa

dayFactGetCentury :: [DayFact] -> Maybe Integer
dayFactGetCentury :: [DayFact] -> Maybe Integer
dayFactGetCentury = (DayFact -> Maybe Integer) -> [DayFact] -> Maybe Integer
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe Integer) -> [DayFact] -> Maybe Integer)
-> (DayFact -> Maybe Integer) -> [DayFact] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ \case
    CenturyDayFact Integer
x -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
x
    DayFact
_ -> Maybe Integer
forall a. Maybe a
Nothing

dayFactGetYearOfCentury :: [DayFact] -> Maybe Integer
dayFactGetYearOfCentury :: [DayFact] -> Maybe Integer
dayFactGetYearOfCentury = (DayFact -> Maybe Integer) -> [DayFact] -> Maybe Integer
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe Integer) -> [DayFact] -> Maybe Integer)
-> (DayFact -> Maybe Integer) -> [DayFact] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ \case
    YearOfCenturyDayFact Integer
x -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
x
    DayFact
_ -> Maybe Integer
forall a. Maybe a
Nothing

dayFactGetQuarterOfYear :: [DayFact] -> Maybe QuarterOfYear
dayFactGetQuarterOfYear :: [DayFact] -> Maybe QuarterOfYear
dayFactGetQuarterOfYear = (DayFact -> Maybe QuarterOfYear)
-> [DayFact] -> Maybe QuarterOfYear
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe QuarterOfYear)
 -> [DayFact] -> Maybe QuarterOfYear)
-> (DayFact -> Maybe QuarterOfYear)
-> [DayFact]
-> Maybe QuarterOfYear
forall a b. (a -> b) -> a -> b
$ \case
    QuarterOfYearDayFact QuarterOfYear
x -> QuarterOfYear -> Maybe QuarterOfYear
forall a. a -> Maybe a
Just QuarterOfYear
x
    DayFact
_ -> Maybe QuarterOfYear
forall a. Maybe a
Nothing

dayFactGetMonthOfYear :: [DayFact] -> Maybe MonthOfYear
dayFactGetMonthOfYear :: [DayFact] -> Maybe Int
dayFactGetMonthOfYear = (DayFact -> Maybe Int) -> [DayFact] -> Maybe Int
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe Int) -> [DayFact] -> Maybe Int)
-> (DayFact -> Maybe Int) -> [DayFact] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ \case
    MonthOfYearDayFact Int
x -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    DayFact
_ -> Maybe Int
forall a. Maybe a
Nothing

dayFactGetDayOfMonth :: [DayFact] -> Maybe DayOfMonth
dayFactGetDayOfMonth :: [DayFact] -> Maybe Int
dayFactGetDayOfMonth = (DayFact -> Maybe Int) -> [DayFact] -> Maybe Int
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe Int) -> [DayFact] -> Maybe Int)
-> (DayFact -> Maybe Int) -> [DayFact] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ \case
    DayOfMonthDayFact Int
x -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    DayFact
_ -> Maybe Int
forall a. Maybe a
Nothing

dayFactGetDayOfYear :: [DayFact] -> Maybe DayOfYear
dayFactGetDayOfYear :: [DayFact] -> Maybe Int
dayFactGetDayOfYear = (DayFact -> Maybe Int) -> [DayFact] -> Maybe Int
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe Int) -> [DayFact] -> Maybe Int)
-> (DayFact -> Maybe Int) -> [DayFact] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ \case
    DayOfYearDayFact Int
x -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    DayFact
_ -> Maybe Int
forall a. Maybe a
Nothing

dayFactGetDayOfWeek :: [DayFact] -> Maybe DayOfWeek
dayFactGetDayOfWeek :: [DayFact] -> Maybe DayOfWeek
dayFactGetDayOfWeek = (DayFact -> Maybe DayOfWeek) -> [DayFact] -> Maybe DayOfWeek
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe DayOfWeek) -> [DayFact] -> Maybe DayOfWeek)
-> (DayFact -> Maybe DayOfWeek) -> [DayFact] -> Maybe DayOfWeek
forall a b. (a -> b) -> a -> b
$ \case
    DayOfWeekDayFact DayOfWeek
x -> DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just DayOfWeek
x
    DayFact
_ -> Maybe DayOfWeek
forall a. Maybe a
Nothing

dayFactGetWeekOfYear :: [DayFact] -> Maybe (WeekType, WeekOfYear)
dayFactGetWeekOfYear :: [DayFact] -> Maybe (WeekType, Int)
dayFactGetWeekOfYear = (DayFact -> Maybe (WeekType, Int))
-> [DayFact] -> Maybe (WeekType, Int)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe (WeekType, Int))
 -> [DayFact] -> Maybe (WeekType, Int))
-> (DayFact -> Maybe (WeekType, Int))
-> [DayFact]
-> Maybe (WeekType, Int)
forall a b. (a -> b) -> a -> b
$ \case
    WeekOfYearDayFact WeekType
wt Int
x -> (WeekType, Int) -> Maybe (WeekType, Int)
forall a. a -> Maybe a
Just (WeekType
wt, Int
x)
    DayFact
_ -> Maybe (WeekType, Int)
forall a. Maybe a
Nothing

dayFactGetUTCTime :: [DayFact] -> Maybe UTCTime
dayFactGetUTCTime :: [DayFact] -> Maybe UTCTime
dayFactGetUTCTime = (DayFact -> Maybe UTCTime) -> [DayFact] -> Maybe UTCTime
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe UTCTime) -> [DayFact] -> Maybe UTCTime)
-> (DayFact -> Maybe UTCTime) -> [DayFact] -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ \case
    UTCTimeDayFact UTCTime
x -> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
x
    DayFact
_ -> Maybe UTCTime
forall a. Maybe a
Nothing

dayFactGetTimeZone :: [DayFact] -> Maybe TimeZone
dayFactGetTimeZone :: [DayFact] -> Maybe TimeZone
dayFactGetTimeZone = (DayFact -> Maybe TimeZone) -> [DayFact] -> Maybe TimeZone
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((DayFact -> Maybe TimeZone) -> [DayFact] -> Maybe TimeZone)
-> (DayFact -> Maybe TimeZone) -> [DayFact] -> Maybe TimeZone
forall a b. (a -> b) -> a -> b
$ \case
    TimeZoneDayFact TimeZone
x -> TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
x
    DayFact
_ -> Maybe TimeZone
forall a. Maybe a
Nothing

readSpec_z :: String -> Maybe Int
readSpec_z :: [Char] -> Maybe Int
readSpec_z = [Char] -> Maybe Int
readTzOffset

readSpec_Z :: TimeLocale -> String -> Maybe TimeZone
readSpec_Z :: TimeLocale -> [Char] -> Maybe TimeZone
readSpec_Z TimeLocale
_ [Char]
str | Just Int
offset <- [Char] -> Maybe Int
readTzOffset [Char]
str = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just (TimeZone -> Maybe TimeZone) -> TimeZone -> Maybe TimeZone
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> TimeZone
TimeZone Int
offset Bool
False [Char]
""
readSpec_Z TimeLocale
l [Char]
str | Just TimeZone
zone <- TimeLocale -> [Char] -> Maybe TimeZone
getKnownTimeZone TimeLocale
l [Char]
str = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
zone
readSpec_Z TimeLocale
_ [Char]
"UTC" = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
utc
readSpec_Z TimeLocale
_ [Char
c] | Just TimeZone
zone <- Char -> Maybe TimeZone
getMilZone Char
c = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
zone
readSpec_Z TimeLocale
_ [Char]
_ = Maybe TimeZone
forall a. Maybe a
Nothing

makeDayFact :: TimeLocale -> Char -> String -> Maybe [DayFact]
makeDayFact :: TimeLocale -> Char -> [Char] -> Maybe [DayFact]
makeDayFact TimeLocale
l Char
c [Char]
x =
    let
        ra :: Read a => Maybe a
        ra :: forall a. Read a => Maybe a
ra = [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x
        zeroBasedListIndex :: [String] -> Maybe Int
        zeroBasedListIndex :: [[Char]] -> Maybe Int
zeroBasedListIndex [[Char]]
ss = [Char] -> [[Char]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
x) ([[Char]] -> Maybe Int) -> [[Char]] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper) [[Char]]
ss
        oneBasedListIndex :: [String] -> Maybe Int
        oneBasedListIndex :: [[Char]] -> Maybe Int
oneBasedListIndex [[Char]]
ss = do
            index <- [[Char]] -> Maybe Int
zeroBasedListIndex [[Char]]
ss
            return $ 1 + index
    in
        case Char
c of
            -- %C: century (all but the last two digits of the year), 00 - 99
            Char
'C' -> do
                a <- Maybe Integer
forall a. Read a => Maybe a
ra
                return [CenturyDayFact a]
            -- %f century (all but the last two digits of the year), 00 - 99
            Char
'f' -> do
                a <- Maybe Integer
forall a. Read a => Maybe a
ra
                return [CenturyDayFact a]
            -- %Y: year
            Char
'Y' -> do
                a <- Maybe Integer
forall a. Read a => Maybe a
ra
                return [CenturyDayFact (a `div` 100), YearOfCenturyDayFact (a `mod` 100)]
            -- %G: year for Week Date format
            Char
'G' -> do
                a <- Maybe Integer
forall a. Read a => Maybe a
ra
                return [CenturyDayFact (a `div` 100), YearOfCenturyDayFact (a `mod` 100)]
            -- %y: last two digits of year, 00 - 99
            Char
'y' -> do
                a <- Maybe Integer
forall a. Read a => Maybe a
ra
                return [YearOfCenturyDayFact a]
            -- %g: last two digits of year for Week Date format, 00 - 99
            Char
'g' -> do
                a <- Maybe Integer
forall a. Read a => Maybe a
ra
                return [YearOfCenturyDayFact a]
            -- %v: quarter of year, 1 - 4
            Char
'v' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 4 raw
                return [QuarterOfYearDayFact $ toEnum a]
            -- %B: month name, long form (fst from months locale), January - December
            Char
'B' -> do
                a <- [[Char]] -> Maybe Int
oneBasedListIndex ([[Char]] -> Maybe Int) -> [[Char]] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst ([([Char], [Char])] -> [[Char]]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [([Char], [Char])]
months TimeLocale
l
                return [MonthOfYearDayFact a]
            -- %b: month name, short form (snd from months locale), Jan - Dec
            Char
'b' -> do
                a <- [[Char]] -> Maybe Int
oneBasedListIndex ([[Char]] -> Maybe Int) -> [[Char]] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd ([([Char], [Char])] -> [[Char]]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [([Char], [Char])]
months TimeLocale
l
                return [MonthOfYearDayFact a]
            -- %m: month of year, leading 0 as needed, 01 - 12
            Char
'm' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 12 raw
                return [MonthOfYearDayFact a]
            -- %d: day of month, leading 0 as needed, 01 - 31
            Char
'd' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 31 raw
                return [DayOfMonthDayFact a]
            -- %e: day of month, leading space as needed, 1 - 31
            Char
'e' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 31 raw
                return [DayOfMonthDayFact a]
            -- %V: week for Week Date format, 01 - 53
            Char
'V' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 53 raw
                return [WeekOfYearDayFact ISOWeek a]
            -- %U: week number of year, where weeks start on Sunday (as sundayStartWeek), 00 - 53
            Char
'U' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 0 53 raw
                return [WeekOfYearDayFact SundayWeek a]
            -- %W: week number of year, where weeks start on Monday (as mondayStartWeek), 00 - 53
            Char
'W' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 0 53 raw
                return [WeekOfYearDayFact MondayWeek a]
            -- %u: day for Week Date format, 1 - 7
            Char
'u' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 7 raw
                return [DayOfWeekDayFact $ toEnum a]
            -- %a: day of week, short form (snd from wDays locale), Sun - Sat
            Char
'a' -> do
                a <- [[Char]] -> Maybe Int
zeroBasedListIndex ([[Char]] -> Maybe Int) -> [[Char]] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd ([([Char], [Char])] -> [[Char]]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [([Char], [Char])]
wDays TimeLocale
l
                return [DayOfWeekDayFact $ toEnum a]
            -- %A: day of week, long form (fst from wDays locale), Sunday - Saturday
            Char
'A' -> do
                a <- [[Char]] -> Maybe Int
zeroBasedListIndex ([[Char]] -> Maybe Int) -> [[Char]] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst ([([Char], [Char])] -> [[Char]]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [([Char], [Char])]
wDays TimeLocale
l
                return [DayOfWeekDayFact $ toEnum a]
            -- %w: day of week number, 0 (= Sunday) - 6 (= Saturday)
            Char
'w' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 0 6 raw
                return [DayOfWeekDayFact $ toEnum a]
            -- %j: day of year for Ordinal Date format, 001 - 366
            Char
'j' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 366 raw
                return [DayOfYearDayFact a]
            -- %s: number of whole seconds since the Unix epoch.
            Char
's' -> do
                raw <- Maybe Integer
forall a. Read a => Maybe a
ra
                return [UTCTimeDayFact $ posixSecondsToUTCTime $ fromInteger raw]
            Char
'z' -> do
                a <- [Char] -> Maybe Int
readSpec_z [Char]
x
                return [TimeZoneDayFact $ TimeZone a False ""]
            Char
'Z' -> do
                a <- TimeLocale -> [Char] -> Maybe TimeZone
readSpec_Z TimeLocale
l [Char]
x
                return [TimeZoneDayFact a]
            -- unrecognised, pass on to other parsers
            Char
_ -> [DayFact] -> Maybe [DayFact]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return []

makeDayFacts :: TimeLocale -> [(Char, String)] -> Maybe [DayFact]
makeDayFacts :: TimeLocale -> [(Char, [Char])] -> Maybe [DayFact]
makeDayFacts TimeLocale
l [(Char, [Char])]
pairs = do
    factss <- [(Char, [Char])]
-> ((Char, [Char]) -> Maybe [DayFact]) -> Maybe [[DayFact]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Char, [Char])]
pairs (((Char, [Char]) -> Maybe [DayFact]) -> Maybe [[DayFact]])
-> ((Char, [Char]) -> Maybe [DayFact]) -> Maybe [[DayFact]]
forall a b. (a -> b) -> a -> b
$ \(Char
c, [Char]
x) -> TimeLocale -> Char -> [Char] -> Maybe [DayFact]
makeDayFact TimeLocale
l Char
c [Char]
x
    return $ mconcat factss

dayFactYear :: [DayFact] -> Integer
dayFactYear :: [DayFact] -> Integer
dayFactYear [DayFact]
facts =
    let
        d :: Integer
d = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
70 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ [DayFact] -> Maybe Integer
dayFactGetYearOfCentury [DayFact]
facts
        c :: Integer
c =
            Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe
                ( if Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
69
                    then Integer
19
                    else Integer
20
                )
                (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ [DayFact] -> Maybe Integer
dayFactGetCentury [DayFact]
facts
    in
        Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d

dayFactDay :: [DayFact] -> Maybe Day
dayFactDay :: [DayFact] -> Maybe Day
dayFactDay [DayFact]
facts =
    case [DayFact] -> Integer
dayFactYear [DayFact]
facts of
        Integer
y | Just Int
doy <- [DayFact] -> Maybe Int
dayFactGetDayOfYear [DayFact]
facts -> Integer -> Int -> Maybe Day
fromOrdinalDateValid Integer
y Int
doy
        Integer
y
            | Just Int
moy <- [DayFact] -> Maybe Int
dayFactGetMonthOfYear [DayFact]
facts ->
                let
                    dom :: Int
dom = 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
$ [DayFact] -> Maybe Int
dayFactGetDayOfMonth [DayFact]
facts
                in
                    Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
y Int
moy Int
dom
        Integer
y
            | Just (WeekType
wt, Int
woy) <- [DayFact] -> Maybe (WeekType, Int)
dayFactGetWeekOfYear [DayFact]
facts ->
                let
                    dow :: DayOfWeek
dow = DayOfWeek -> Maybe DayOfWeek -> DayOfWeek
forall a. a -> Maybe a -> a
fromMaybe DayOfWeek
Thursday (Maybe DayOfWeek -> DayOfWeek) -> Maybe DayOfWeek -> DayOfWeek
forall a b. (a -> b) -> a -> b
$ [DayFact] -> Maybe DayOfWeek
dayFactGetDayOfWeek [DayFact]
facts
                in
                    WeekType -> Integer -> Int -> DayOfWeek -> Maybe Day
mkDayFromWeekType WeekType
wt Integer
y Int
woy DayOfWeek
dow
        Integer
y
            | Just QuarterOfYear
qoy <- [DayFact] -> Maybe QuarterOfYear
dayFactGetQuarterOfYear [DayFact]
facts ->
                let
                    moy :: Int
moy = case QuarterOfYear
qoy of
                        QuarterOfYear
Q1 -> Int
1
                        QuarterOfYear
Q2 -> Int
4
                        QuarterOfYear
Q3 -> Int
7
                        QuarterOfYear
Q4 -> Int
10
                    dom :: Int
dom = 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
$ [DayFact] -> Maybe Int
dayFactGetDayOfMonth [DayFact]
facts
                in
                    Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
y Int
moy Int
dom
        Integer
_
            | Just UTCTime
ut <- [DayFact] -> Maybe UTCTime
dayFactGetUTCTime [DayFact]
facts ->
                let
                    tz :: TimeZone
tz = TimeZone -> Maybe TimeZone -> TimeZone
forall a. a -> Maybe a -> a
fromMaybe TimeZone
utc (Maybe TimeZone -> TimeZone) -> Maybe TimeZone -> TimeZone
forall a b. (a -> b) -> a -> b
$ [DayFact] -> Maybe TimeZone
dayFactGetTimeZone [DayFact]
facts
                in
                    Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay (LocalTime -> Day) -> LocalTime -> Day
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz UTCTime
ut
        Integer
y | Just Int
dom <- [DayFact] -> Maybe Int
dayFactGetDayOfMonth [DayFact]
facts -> Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
y Int
1 Int
dom
        Integer
y | Just DayOfWeek
dow <- [DayFact] -> Maybe DayOfWeek
dayFactGetDayOfWeek [DayFact]
facts -> Integer -> Int -> Int -> Maybe Day
fromWeekDateValid Integer
y Int
1 (Int -> Maybe Day) -> Int -> Maybe Day
forall a b. (a -> b) -> a -> b
$ DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
dow
        Integer
y -> Integer -> Int -> Maybe Day
fromOrdinalDateValid Integer
y Int
1

instance ParseTime Day where
    substituteTimeSpecifier :: Proxy Day -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy Day
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy Day
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy Day
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe Day
buildTime TimeLocale
l [(Char, [Char])]
pairs = do
        facts <- TimeLocale -> [(Char, [Char])] -> Maybe [DayFact]
makeDayFacts TimeLocale
l [(Char, [Char])]
pairs
        dayFactDay facts

instance ParseTime DayOfWeek where
    substituteTimeSpecifier :: Proxy DayOfWeek -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy DayOfWeek
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy DayOfWeek
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy DayOfWeek
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe DayOfWeek
buildTime TimeLocale
l [(Char, [Char])]
pairs = do
        facts <- TimeLocale -> [(Char, [Char])] -> Maybe [DayFact]
makeDayFacts TimeLocale
l [(Char, [Char])]
pairs
        dayFactGetDayOfWeek facts
            <|> (fmap dayOfWeek $ dayFactDay facts)

instance ParseTime Month where
    substituteTimeSpecifier :: Proxy Month -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy Month
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy Month
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy Month
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe Month
buildTime TimeLocale
l [(Char, [Char])]
pairs = do
        facts <- TimeLocale -> [(Char, [Char])] -> Maybe [DayFact]
makeDayFacts TimeLocale
l [(Char, [Char])]
pairs
        case dayFactGetMonthOfYear facts of
            Just Int
moy ->
                let
                    y :: Integer
y = [DayFact] -> Integer
dayFactYear [DayFact]
facts
                in
                    Month -> Maybe Month
forall a. a -> Maybe a
Just (Month -> Maybe Month) -> Month -> Maybe Month
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Month
YearMonth Integer
y Int
moy
            Maybe Int
Nothing -> (Day -> Month) -> Maybe Day -> Maybe Month
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> Month
forall p. DayPeriod p => Day -> p
dayPeriod (Maybe Day -> Maybe Month) -> Maybe Day -> Maybe Month
forall a b. (a -> b) -> a -> b
$ [DayFact] -> Maybe Day
dayFactDay [DayFact]
facts

instance ParseTime QuarterOfYear where
    substituteTimeSpecifier :: Proxy QuarterOfYear -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy QuarterOfYear
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy QuarterOfYear
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy QuarterOfYear
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe QuarterOfYear
buildTime TimeLocale
l [(Char, [Char])]
pairs = do
        facts <- TimeLocale -> [(Char, [Char])] -> Maybe [DayFact]
makeDayFacts TimeLocale
l [(Char, [Char])]
pairs
        case dayFactGetQuarterOfYear facts of
            Just QuarterOfYear
qoy -> QuarterOfYear -> Maybe QuarterOfYear
forall a. a -> Maybe a
Just QuarterOfYear
qoy
            Maybe QuarterOfYear
Nothing -> do
                QuarterDay (YearQuarter _ qoy) _ <- [DayFact] -> Maybe Day
dayFactDay [DayFact]
facts
                return qoy

instance ParseTime Quarter where
    substituteTimeSpecifier :: Proxy Quarter -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy Quarter
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy Quarter
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy Quarter
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe Quarter
buildTime TimeLocale
l [(Char, [Char])]
pairs = do
        facts <- TimeLocale -> [(Char, [Char])] -> Maybe [DayFact]
makeDayFacts TimeLocale
l [(Char, [Char])]
pairs
        case dayFactGetQuarterOfYear facts of
            Just QuarterOfYear
qoy ->
                let
                    y :: Integer
y = [DayFact] -> Integer
dayFactYear [DayFact]
facts
                in
                    Quarter -> Maybe Quarter
forall a. a -> Maybe a
Just (Quarter -> Maybe Quarter) -> Quarter -> Maybe Quarter
forall a b. (a -> b) -> a -> b
$ Integer -> QuarterOfYear -> Quarter
YearQuarter Integer
y QuarterOfYear
qoy
            Maybe QuarterOfYear
Nothing -> (Day -> Quarter) -> Maybe Day -> Maybe Quarter
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> Quarter
forall p. DayPeriod p => Day -> p
dayPeriod (Maybe Day -> Maybe Quarter) -> Maybe Day -> Maybe Quarter
forall a b. (a -> b) -> a -> b
$ [DayFact] -> Maybe Day
dayFactDay [DayFact]
facts

mfoldl :: Monad m => (a -> b -> m a) -> m a -> [b] -> m a
mfoldl :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> m a -> [b] -> m a
mfoldl a -> b -> m a
f =
    let
        mf :: m a -> b -> m a
mf m a
ma b
b = do
            a <- m a
ma
            f a b
    in
        (m a -> b -> m a) -> m a -> [b] -> m a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl m a -> b -> m a
mf

data AMPM = AM | PM

data TimeFact
    = AMAPMTimeFact AMPM
    | HourTimeFact Int
    | MinuteTimeFact Int
    | WholeSecondTimeFact Int
    | FractSecondTimeFact Pico
    | UTCTimeFact UTCTime
    | ZoneTimeFact TimeZone

timeFactGetAMPM :: [TimeFact] -> Maybe AMPM
timeFactGetAMPM :: [TimeFact] -> Maybe AMPM
timeFactGetAMPM = (TimeFact -> Maybe AMPM) -> [TimeFact] -> Maybe AMPM
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((TimeFact -> Maybe AMPM) -> [TimeFact] -> Maybe AMPM)
-> (TimeFact -> Maybe AMPM) -> [TimeFact] -> Maybe AMPM
forall a b. (a -> b) -> a -> b
$ \case
    AMAPMTimeFact AMPM
x -> AMPM -> Maybe AMPM
forall a. a -> Maybe a
Just AMPM
x
    TimeFact
_ -> Maybe AMPM
forall a. Maybe a
Nothing

timeFactGetHour :: [TimeFact] -> Maybe Int
timeFactGetHour :: [TimeFact] -> Maybe Int
timeFactGetHour = (TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int)
-> (TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ \case
    HourTimeFact Int
x -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    TimeFact
_ -> Maybe Int
forall a. Maybe a
Nothing

timeFactGetMinute :: [TimeFact] -> Maybe Int
timeFactGetMinute :: [TimeFact] -> Maybe Int
timeFactGetMinute = (TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int)
-> (TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ \case
    MinuteTimeFact Int
x -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    TimeFact
_ -> Maybe Int
forall a. Maybe a
Nothing

timeFactGetWholeSecond :: [TimeFact] -> Maybe Int
timeFactGetWholeSecond :: [TimeFact] -> Maybe Int
timeFactGetWholeSecond = (TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int)
-> (TimeFact -> Maybe Int) -> [TimeFact] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ \case
    WholeSecondTimeFact Int
x -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    TimeFact
_ -> Maybe Int
forall a. Maybe a
Nothing

timeFactGetFractSecond :: [TimeFact] -> Maybe Pico
timeFactGetFractSecond :: [TimeFact] -> Maybe Pico
timeFactGetFractSecond = (TimeFact -> Maybe Pico) -> [TimeFact] -> Maybe Pico
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((TimeFact -> Maybe Pico) -> [TimeFact] -> Maybe Pico)
-> (TimeFact -> Maybe Pico) -> [TimeFact] -> Maybe Pico
forall a b. (a -> b) -> a -> b
$ \case
    FractSecondTimeFact Pico
x -> Pico -> Maybe Pico
forall a. a -> Maybe a
Just Pico
x
    TimeFact
_ -> Maybe Pico
forall a. Maybe a
Nothing

timeFactGetUTC :: [TimeFact] -> Maybe UTCTime
timeFactGetUTC :: [TimeFact] -> Maybe UTCTime
timeFactGetUTC = (TimeFact -> Maybe UTCTime) -> [TimeFact] -> Maybe UTCTime
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((TimeFact -> Maybe UTCTime) -> [TimeFact] -> Maybe UTCTime)
-> (TimeFact -> Maybe UTCTime) -> [TimeFact] -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ \case
    UTCTimeFact UTCTime
x -> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
x
    TimeFact
_ -> Maybe UTCTime
forall a. Maybe a
Nothing

timeFactGetZone :: [TimeFact] -> Maybe TimeZone
timeFactGetZone :: [TimeFact] -> Maybe TimeZone
timeFactGetZone = (TimeFact -> Maybe TimeZone) -> [TimeFact] -> Maybe TimeZone
forall a b. (a -> Maybe b) -> [a] -> Maybe b
lastMatch ((TimeFact -> Maybe TimeZone) -> [TimeFact] -> Maybe TimeZone)
-> (TimeFact -> Maybe TimeZone) -> [TimeFact] -> Maybe TimeZone
forall a b. (a -> b) -> a -> b
$ \case
    ZoneTimeFact TimeZone
x -> TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
x
    TimeFact
_ -> Maybe TimeZone
forall a. Maybe a
Nothing

makeTimeFact :: TimeLocale -> Char -> String -> Maybe [TimeFact]
makeTimeFact :: TimeLocale -> Char -> [Char] -> Maybe [TimeFact]
makeTimeFact TimeLocale
l Char
c [Char]
x =
    let
        ra :: Read a => Maybe a
        ra :: forall a. Read a => Maybe a
ra = [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x
        getAmPm :: Maybe [TimeFact]
getAmPm =
            let
                upx :: [Char]
upx = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
x
                ([Char]
amStr, [Char]
pmStr) = TimeLocale -> ([Char], [Char])
amPm TimeLocale
l
            in
                if [Char]
upx [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
amStr
                    then [TimeFact] -> Maybe [TimeFact]
forall a. a -> Maybe a
Just [AMPM -> TimeFact
AMAPMTimeFact AMPM
AM]
                    else
                        if [Char]
upx [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
pmStr
                            then [TimeFact] -> Maybe [TimeFact]
forall a. a -> Maybe a
Just [AMPM -> TimeFact
AMAPMTimeFact AMPM
PM]
                            else Maybe [TimeFact]
forall a. Maybe a
Nothing
    in
        case Char
c of
            Char
'P' -> Maybe [TimeFact]
getAmPm
            Char
'p' -> Maybe [TimeFact]
getAmPm
            Char
'H' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 0 23 raw
                return [HourTimeFact a]
            Char
'I' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 12 raw
                return [HourTimeFact a]
            Char
'k' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 0 23 raw
                return [HourTimeFact a]
            Char
'l' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 1 12 raw
                return [HourTimeFact a]
            Char
'M' -> do
                raw <- Maybe Int
forall a. Read a => Maybe a
ra
                a <- clipValid 0 59 raw
                return [MinuteTimeFact a]
            Char
'S' -> do
                raw <- Maybe Integer
forall a. Read a => Maybe a
ra
                a <- clipValid 0 60 raw
                return [WholeSecondTimeFact $ fromInteger a]
            Char
'q' -> do
                ps <- ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Integer) -> [Char] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
12 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char] -> [Char]
forall a. Int -> a -> [a] -> [a]
rpad Int
12 Char
'0' [Char]
x) Maybe Integer -> Maybe Integer -> Maybe Integer
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
                return [FractSecondTimeFact $ mkPico 0 ps]
            Char
'Q' ->
                if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
x
                    then [TimeFact] -> Maybe [TimeFact]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                    else do
                        ps <- ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Integer) -> [Char] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
12 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char] -> [Char]
forall a. Int -> a -> [a] -> [a]
rpad Int
12 Char
'0' [Char]
x) Maybe Integer -> Maybe Integer -> Maybe Integer
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
                        return [FractSecondTimeFact $ mkPico 0 ps]
            Char
's' -> do
                raw <- Maybe Integer
forall a. Read a => Maybe a
ra
                return [UTCTimeFact $ posixSecondsToUTCTime $ fromInteger raw]
            Char
'z' -> do
                a <- [Char] -> Maybe Int
readSpec_z [Char]
x
                return [ZoneTimeFact $ TimeZone a False ""]
            Char
'Z' -> do
                a <- TimeLocale -> [Char] -> Maybe TimeZone
readSpec_Z TimeLocale
l [Char]
x
                return [ZoneTimeFact a]
            Char
_ -> [TimeFact] -> Maybe [TimeFact]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return []

makeTimeFacts :: TimeLocale -> [(Char, String)] -> Maybe [TimeFact]
makeTimeFacts :: TimeLocale -> [(Char, [Char])] -> Maybe [TimeFact]
makeTimeFacts TimeLocale
l [(Char, [Char])]
pairs = do
    factss <- [(Char, [Char])]
-> ((Char, [Char]) -> Maybe [TimeFact]) -> Maybe [[TimeFact]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Char, [Char])]
pairs (((Char, [Char]) -> Maybe [TimeFact]) -> Maybe [[TimeFact]])
-> ((Char, [Char]) -> Maybe [TimeFact]) -> Maybe [[TimeFact]]
forall a b. (a -> b) -> a -> b
$ \(Char
c, [Char]
x) -> TimeLocale -> Char -> [Char] -> Maybe [TimeFact]
makeTimeFact TimeLocale
l Char
c [Char]
x
    return $ mconcat factss

instance ParseTime TimeOfDay where
    substituteTimeSpecifier :: Proxy TimeOfDay -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy TimeOfDay
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy TimeOfDay
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy TimeOfDay
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe TimeOfDay
buildTime TimeLocale
l [(Char, [Char])]
pairs = do
        facts <- TimeLocale -> [(Char, [Char])] -> Maybe [TimeFact]
makeTimeFacts TimeLocale
l [(Char, [Char])]
pairs
        -- 'Nothing' indicates a parse failure,
        -- while 'Just []' means no information
        case timeFactGetUTC facts of
            Just UTCTime
t ->
                let
                    zone :: TimeZone
zone = TimeZone -> Maybe TimeZone -> TimeZone
forall a. a -> Maybe a -> a
fromMaybe TimeZone
utc (Maybe TimeZone -> TimeZone) -> Maybe TimeZone -> TimeZone
forall a b. (a -> b) -> a -> b
$ [TimeFact] -> Maybe TimeZone
timeFactGetZone [TimeFact]
facts
                    sf :: Pico
sf = Pico -> Maybe Pico -> Pico
forall a. a -> Maybe a -> a
fromMaybe Pico
0 (Maybe Pico -> Pico) -> Maybe Pico -> Pico
forall a b. (a -> b) -> a -> b
$ [TimeFact] -> Maybe Pico
timeFactGetFractSecond [TimeFact]
facts
                    TimeOfDay Int
h Int
m Pico
s = LocalTime -> TimeOfDay
localTimeOfDay (LocalTime -> TimeOfDay) -> LocalTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
zone UTCTime
t
                in
                    TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m (Pico -> TimeOfDay) -> Pico -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ Pico
s Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Pico
sf
            Maybe UTCTime
Nothing ->
                let
                    h :: Int
h = 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
$ [TimeFact] -> Maybe Int
timeFactGetHour [TimeFact]
facts
                    m :: Int
m = 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
$ [TimeFact] -> Maybe Int
timeFactGetMinute [TimeFact]
facts
                    si :: Int
si = 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
$ [TimeFact] -> Maybe Int
timeFactGetWholeSecond [TimeFact]
facts
                    sf :: Pico
sf = Pico -> Maybe Pico -> Pico
forall a. a -> Maybe a -> a
fromMaybe Pico
0 (Maybe Pico -> Pico) -> Maybe Pico -> Pico
forall a b. (a -> b) -> a -> b
$ [TimeFact] -> Maybe Pico
timeFactGetFractSecond [TimeFact]
facts
                    s :: Pico
                    s :: Pico
s = Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
si Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Pico
sf
                    h' :: Int
h' = case [TimeFact] -> Maybe AMPM
timeFactGetAMPM [TimeFact]
facts of
                        Maybe AMPM
Nothing -> Int
h
                        Just AMPM
AM -> Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
h Int
12
                        Just AMPM
PM -> if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12 then Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12 else Int
h
                in
                    TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h' Int
m Pico
s

rpad :: Int -> a -> [a] -> [a]
rpad :: forall a. Int -> a -> [a] -> [a]
rpad Int
n a
c [a]
xs = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) a
c

mkPico :: Integer -> Integer -> Pico
mkPico :: Integer -> Integer -> Pico
mkPico Integer
i Integer
f = Integer -> Pico
forall a. Num a => Integer -> a
fromInteger Integer
i Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Integer
f Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000000000)

instance ParseTime LocalTime where
    substituteTimeSpecifier :: Proxy LocalTime -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy LocalTime
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy LocalTime
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy LocalTime
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe LocalTime
buildTime TimeLocale
l [(Char, [Char])]
xs = Day -> TimeOfDay -> LocalTime
LocalTime (Day -> TimeOfDay -> LocalTime)
-> Maybe Day -> Maybe (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TimeLocale -> [(Char, [Char])] -> Maybe Day
forall t. ParseTime t => TimeLocale -> [(Char, [Char])] -> Maybe t
buildTime TimeLocale
l [(Char, [Char])]
xs) Maybe (TimeOfDay -> LocalTime)
-> Maybe TimeOfDay -> Maybe LocalTime
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TimeLocale -> [(Char, [Char])] -> Maybe TimeOfDay
forall t. ParseTime t => TimeLocale -> [(Char, [Char])] -> Maybe t
buildTime TimeLocale
l [(Char, [Char])]
xs)

enumDiff :: Enum a => a -> a -> Int
enumDiff :: forall a. Enum a => a -> a -> Int
enumDiff a
a a
b = (a -> Int
forall a. Enum a => a -> Int
fromEnum a
a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (a -> Int
forall a. Enum a => a -> Int
fromEnum a
b)

getMilZoneHours :: Char -> Maybe Int
getMilZoneHours :: Char -> Maybe Int
getMilZoneHours Char
c
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'A' = Maybe Int
forall a. Maybe a
Nothing
getMilZoneHours Char
c
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'I' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Char -> Int
forall a. Enum a => a -> a -> Int
enumDiff Char
c Char
'A'
getMilZoneHours Char
'J' = Maybe Int
forall a. Maybe a
Nothing
getMilZoneHours Char
c
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'M' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Char -> Int
forall a. Enum a => a -> a -> Int
enumDiff Char
c Char
'K'
getMilZoneHours Char
c
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Y' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Int
forall a. Enum a => a -> a -> Int
enumDiff Char
'N' Char
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
getMilZoneHours Char
'Z' = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
getMilZoneHours Char
_ = Maybe Int
forall a. Maybe a
Nothing

getMilZone :: Char -> Maybe TimeZone
getMilZone :: Char -> Maybe TimeZone
getMilZone Char
c =
    let
        yc :: Char
yc = Char -> Char
toUpper Char
c
    in
        do
            hours <- Char -> Maybe Int
getMilZoneHours Char
yc
            return $ TimeZone (hours * 60) False [yc]

getKnownTimeZone :: TimeLocale -> String -> Maybe TimeZone
getKnownTimeZone :: TimeLocale -> [Char] -> Maybe TimeZone
getKnownTimeZone TimeLocale
locale [Char]
x = (TimeZone -> Bool) -> [TimeZone] -> Maybe TimeZone
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TimeZone
tz -> (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== TimeZone -> [Char]
timeZoneName TimeZone
tz) (TimeLocale -> [TimeZone]
knownTimeZones TimeLocale
locale)

instance ParseTime TimeZone where
    substituteTimeSpecifier :: Proxy TimeZone -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy TimeZone
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy TimeZone
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy TimeZone
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe TimeZone
buildTime TimeLocale
l =
        let
            f :: Char -> String -> TimeZone -> Maybe TimeZone
            f :: Char -> [Char] -> TimeZone -> Maybe TimeZone
f Char
'z' [Char]
str (TimeZone Int
_ Bool
dst [Char]
name) = do
                offset <- [Char] -> Maybe Int
readSpec_z [Char]
str
                return $ TimeZone offset dst name
            f Char
'Z' [Char]
str TimeZone
_ = TimeLocale -> [Char] -> Maybe TimeZone
readSpec_Z TimeLocale
l [Char]
str
            f Char
_ [Char]
_ TimeZone
tz = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
tz
        in
            (Maybe TimeZone -> (Char, [Char]) -> Maybe TimeZone)
-> Maybe TimeZone -> [(Char, [Char])] -> Maybe TimeZone
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Maybe TimeZone
mt (Char
c, [Char]
s) -> Maybe TimeZone
mt Maybe TimeZone -> (TimeZone -> Maybe TimeZone) -> Maybe TimeZone
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> [Char] -> TimeZone -> Maybe TimeZone
f Char
c [Char]
s) (TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just (TimeZone -> Maybe TimeZone) -> TimeZone -> Maybe TimeZone
forall a b. (a -> b) -> a -> b
$ Int -> TimeZone
minutesToTimeZone Int
0)

readTzOffset :: String -> Maybe Int
readTzOffset :: [Char] -> Maybe Int
readTzOffset [Char]
str =
    let
        getSign :: Char -> Maybe a
getSign Char
'+' = a -> Maybe a
forall a. a -> Maybe a
Just a
1
        getSign Char
'-' = a -> Maybe a
forall a. a -> Maybe a
Just (-a
1)
        getSign Char
_ = Maybe a
forall a. Maybe a
Nothing
        calc :: Char -> Char -> Char -> Char -> Char -> Maybe b
calc Char
s Char
h1 Char
h2 Char
m1 Char
m2 = do
            sign <- Char -> Maybe b
forall {a}. Num a => Char -> Maybe a
getSign Char
s
            h <- readMaybe [h1, h2]
            m <- readMaybe [m1, m2]
            return $ sign * (60 * h + m)
    in
        case [Char]
str of
            (Char
s : Char
h1 : Char
h2 : Char
':' : Char
m1 : Char
m2 : []) -> Char -> Char -> Char -> Char -> Char -> Maybe Int
forall {b}.
(Num b, Read b) =>
Char -> Char -> Char -> Char -> Char -> Maybe b
calc Char
s Char
h1 Char
h2 Char
m1 Char
m2
            (Char
s : Char
h1 : Char
h2 : Char
m1 : Char
m2 : []) -> Char -> Char -> Char -> Char -> Char -> Maybe Int
forall {b}.
(Num b, Read b) =>
Char -> Char -> Char -> Char -> Char -> Maybe b
calc Char
s Char
h1 Char
h2 Char
m1 Char
m2
            [Char]
_ -> Maybe Int
forall a. Maybe a
Nothing

instance ParseTime ZonedTime where
    substituteTimeSpecifier :: Proxy ZonedTime -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy ZonedTime
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy ZonedTime
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy ZonedTime
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe ZonedTime
buildTime TimeLocale
l [(Char, [Char])]
xs =
        let
            f :: ZonedTime -> (Char, [Char]) -> Maybe ZonedTime
f (ZonedTime (LocalTime Day
_ TimeOfDay
tod) TimeZone
z) (Char
's', [Char]
x) = do
                a <- [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x
                let
                    s = Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger Integer
a
                    (_, ps) = properFraction (todSec tod) :: (Integer, Pico)
                    s' = POSIXTime
s POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Pico -> Rational
forall a. Real a => a -> Rational
toRational Pico
ps)
                return $ utcToZonedTime z (posixSecondsToUTCTime s')
            f ZonedTime
t (Char, [Char])
_ = ZonedTime -> Maybe ZonedTime
forall a. a -> Maybe a
Just ZonedTime
t
        in
            (ZonedTime -> (Char, [Char]) -> Maybe ZonedTime)
-> Maybe ZonedTime -> [(Char, [Char])] -> Maybe ZonedTime
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> m a -> [b] -> m a
mfoldl ZonedTime -> (Char, [Char]) -> Maybe ZonedTime
f (LocalTime -> TimeZone -> ZonedTime
ZonedTime (LocalTime -> TimeZone -> ZonedTime)
-> Maybe LocalTime -> Maybe (TimeZone -> ZonedTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TimeLocale -> [(Char, [Char])] -> Maybe LocalTime
forall t. ParseTime t => TimeLocale -> [(Char, [Char])] -> Maybe t
buildTime TimeLocale
l [(Char, [Char])]
xs) Maybe (TimeZone -> ZonedTime) -> Maybe TimeZone -> Maybe ZonedTime
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TimeLocale -> [(Char, [Char])] -> Maybe TimeZone
forall t. ParseTime t => TimeLocale -> [(Char, [Char])] -> Maybe t
buildTime TimeLocale
l [(Char, [Char])]
xs)) [(Char, [Char])]
xs

instance ParseTime UTCTime where
    substituteTimeSpecifier :: Proxy UTCTime -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy UTCTime
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy UTCTime
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy UTCTime
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe UTCTime
buildTime TimeLocale
l [(Char, [Char])]
xs = ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime) -> Maybe ZonedTime -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeLocale -> [(Char, [Char])] -> Maybe ZonedTime
forall t. ParseTime t => TimeLocale -> [(Char, [Char])] -> Maybe t
buildTime TimeLocale
l [(Char, [Char])]
xs

instance ParseTime UniversalTime where
    substituteTimeSpecifier :: Proxy UniversalTime -> TimeLocale -> Char -> Maybe [Char]
substituteTimeSpecifier Proxy UniversalTime
_ = TimeLocale -> Char -> Maybe [Char]
timeSubstituteTimeSpecifier
    parseTimeSpecifier :: Proxy UniversalTime
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy UniversalTime
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
timeParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe UniversalTime
buildTime TimeLocale
l [(Char, [Char])]
xs = Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
0 (LocalTime -> UniversalTime)
-> Maybe LocalTime -> Maybe UniversalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeLocale -> [(Char, [Char])] -> Maybe LocalTime
forall t. ParseTime t => TimeLocale -> [(Char, [Char])] -> Maybe t
buildTime TimeLocale
l [(Char, [Char])]
xs

--- Duration

buildTimeMonths :: [(Char, String)] -> Maybe Integer
buildTimeMonths :: [(Char, [Char])] -> Maybe Integer
buildTimeMonths [(Char, [Char])]
xs = do
    tt <-
        [(Char, [Char])]
-> ((Char, [Char]) -> Maybe Integer) -> Maybe [Integer]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Char, [Char])]
xs (((Char, [Char]) -> Maybe Integer) -> Maybe [Integer])
-> ((Char, [Char]) -> Maybe Integer) -> Maybe [Integer]
forall a b. (a -> b) -> a -> b
$ \(Char
c, [Char]
s) ->
            case Char
c of
                Char
'y' -> (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) Integer
12) (Maybe Integer -> Maybe Integer) -> Maybe Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                Char
'b' -> [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                Char
'B' -> [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                Char
_ -> Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
    return $ sum tt

buildTimeDays :: [(Char, String)] -> Maybe Integer
buildTimeDays :: [(Char, [Char])] -> Maybe Integer
buildTimeDays [(Char, [Char])]
xs = do
    tt <-
        [(Char, [Char])]
-> ((Char, [Char]) -> Maybe Integer) -> Maybe [Integer]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Char, [Char])]
xs (((Char, [Char]) -> Maybe Integer) -> Maybe [Integer])
-> ((Char, [Char]) -> Maybe Integer) -> Maybe [Integer]
forall a b. (a -> b) -> a -> b
$ \(Char
c, [Char]
s) ->
            case Char
c of
                Char
'w' -> (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) Integer
7) (Maybe Integer -> Maybe Integer) -> Maybe Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                Char
'd' -> [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                Char
'D' -> [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                Char
_ -> Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
    return $ sum tt

buildTimeSeconds :: [(Char, String)] -> Maybe Pico
buildTimeSeconds :: [(Char, [Char])] -> Maybe Pico
buildTimeSeconds [(Char, [Char])]
xs = do
    tt <- [(Char, [Char])] -> ((Char, [Char]) -> Maybe Pico) -> Maybe [Pico]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Char, [Char])]
xs (((Char, [Char]) -> Maybe Pico) -> Maybe [Pico])
-> ((Char, [Char]) -> Maybe Pico) -> Maybe [Pico]
forall a b. (a -> b) -> a -> b
$ \(Char
c, [Char]
s) ->
        let
            readInt :: Integer -> Maybe Pico
            readInt :: Integer -> Maybe Pico
readInt Integer
t = do
                i <- [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                return $ fromInteger $ i * t
        in
            case Char
c of
                Char
'h' -> Integer -> Maybe Pico
readInt Integer
3600
                Char
'H' -> Integer -> Maybe Pico
readInt Integer
3600
                Char
'm' -> Integer -> Maybe Pico
readInt Integer
60
                Char
'M' -> Integer -> Maybe Pico
readInt Integer
60
                Char
's' -> [Char] -> Maybe Pico
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                Char
'S' -> [Char] -> Maybe Pico
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
                Char
_ -> Pico -> Maybe Pico
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Pico
0
    return $ sum tt

instance ParseTime NominalDiffTime where
    parseTimeSpecifier :: Proxy POSIXTime
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy POSIXTime
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
durationParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe POSIXTime
buildTime TimeLocale
_ [(Char, [Char])]
xs = do
        dd <- [(Char, [Char])] -> Maybe Integer
buildTimeDays [(Char, [Char])]
xs
        tt <- buildTimeSeconds xs
        return $ (fromInteger dd * 86400) + realToFrac tt

instance ParseTime DiffTime where
    parseTimeSpecifier :: Proxy DiffTime
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy DiffTime
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
durationParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe DiffTime
buildTime TimeLocale
_ [(Char, [Char])]
xs = do
        dd <- [(Char, [Char])] -> Maybe Integer
buildTimeDays [(Char, [Char])]
xs
        tt <- buildTimeSeconds xs
        return $ (fromInteger dd * 86400) + realToFrac tt

instance ParseTime CalendarDiffDays where
    parseTimeSpecifier :: Proxy CalendarDiffDays
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy CalendarDiffDays
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
durationParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe CalendarDiffDays
buildTime TimeLocale
_ [(Char, [Char])]
xs = do
        mm <- [(Char, [Char])] -> Maybe Integer
buildTimeMonths [(Char, [Char])]
xs
        dd <- buildTimeDays xs
        return $ CalendarDiffDays mm dd

instance ParseTime CalendarDiffTime where
    parseTimeSpecifier :: Proxy CalendarDiffTime
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy CalendarDiffTime
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
durationParseTimeSpecifier
    buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe CalendarDiffTime
buildTime TimeLocale
locale [(Char, [Char])]
xs = do
        mm <- [(Char, [Char])] -> Maybe Integer
buildTimeMonths [(Char, [Char])]
xs
        tt <- buildTime locale xs
        return $ CalendarDiffTime mm tt