{-# 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.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.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 DayComponent
= DCCentury Integer
| DCCenturyYear Integer
| DCYearMonth MonthOfYear
| DCMonthDay DayOfMonth
| DCYearDay DayOfYear
| DCWeekDay Int
| DCYearWeek
WeekType
WeekOfYear
data WeekType
= ISOWeek
| SundayWeek
| MondayWeek
makeDayComponent :: TimeLocale -> Char -> String -> Maybe [DayComponent]
makeDayComponent :: TimeLocale -> Char -> [Char] -> Maybe [DayComponent]
makeDayComponent 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
Int
index <- [[Char]] -> Maybe Int
zeroBasedListIndex [[Char]]
ss
Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
+ Int
index
in case Char
c of
Char
'C' -> do
Integer
a <- Maybe Integer
forall a. Read a => Maybe a
ra
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer -> DayComponent
DCCentury Integer
a]
Char
'f' -> do
Integer
a <- Maybe Integer
forall a. Read a => Maybe a
ra
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer -> DayComponent
DCCentury Integer
a]
Char
'Y' -> do
Integer
a <- Maybe Integer
forall a. Read a => Maybe a
ra
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer -> DayComponent
DCCentury (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
100), Integer -> DayComponent
DCCenturyYear (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
100)]
Char
'G' -> do
Integer
a <- Maybe Integer
forall a. Read a => Maybe a
ra
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer -> DayComponent
DCCentury (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
100), Integer -> DayComponent
DCCenturyYear (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
100)]
Char
'y' -> do
Integer
a <- Maybe Integer
forall a. Read a => Maybe a
ra
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer -> DayComponent
DCCenturyYear Integer
a]
Char
'g' -> do
Integer
a <- Maybe Integer
forall a. Read a => Maybe a
ra
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer -> DayComponent
DCCenturyYear Integer
a]
Char
'B' -> do
Int
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
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCYearMonth Int
a]
Char
'b' -> do
Int
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
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCYearMonth Int
a]
Char
'm' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
12 Int
raw
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCYearMonth Int
a]
Char
'd' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
31 Int
raw
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCMonthDay Int
a]
Char
'e' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
31 Int
raw
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCMonthDay Int
a]
Char
'V' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
53 Int
raw
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [WeekType -> Int -> DayComponent
DCYearWeek WeekType
ISOWeek Int
a]
Char
'U' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
53 Int
raw
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [WeekType -> Int -> DayComponent
DCYearWeek WeekType
SundayWeek Int
a]
Char
'W' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
53 Int
raw
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [WeekType -> Int -> DayComponent
DCYearWeek WeekType
MondayWeek Int
a]
Char
'u' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
7 Int
raw
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCWeekDay Int
a]
Char
'a' -> do
Int
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
let a :: Int
a =
if Int
a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Int
7
else Int
a'
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCWeekDay Int
a]
Char
'A' -> do
Int
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
let a :: Int
a =
if Int
a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Int
7
else Int
a'
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCWeekDay Int
a]
Char
'w' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
6 Int
raw
let a :: Int
a =
if Int
a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Int
7
else Int
a'
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCWeekDay Int
a]
Char
'j' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
366 Int
raw
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> DayComponent
DCYearDay Int
a]
Char
_ -> [DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return []
makeDayComponents :: TimeLocale -> [(Char, String)] -> Maybe [DayComponent]
makeDayComponents :: TimeLocale -> [(Char, [Char])] -> Maybe [DayComponent]
makeDayComponents TimeLocale
l [(Char, [Char])]
pairs = do
[[DayComponent]]
components <- [(Char, [Char])]
-> ((Char, [Char]) -> Maybe [DayComponent])
-> Maybe [[DayComponent]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Char, [Char])]
pairs (((Char, [Char]) -> Maybe [DayComponent])
-> Maybe [[DayComponent]])
-> ((Char, [Char]) -> Maybe [DayComponent])
-> Maybe [[DayComponent]]
forall a b. (a -> b) -> a -> b
$ \(Char
c, [Char]
x) -> TimeLocale -> Char -> [Char] -> Maybe [DayComponent]
makeDayComponent TimeLocale
l Char
c [Char]
x
[DayComponent] -> Maybe [DayComponent]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DayComponent] -> Maybe [DayComponent])
-> [DayComponent] -> Maybe [DayComponent]
forall a b. (a -> b) -> a -> b
$ [[DayComponent]] -> [DayComponent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[DayComponent]]
components
safeLast :: a -> [a] -> a
safeLast :: forall a. a -> [a] -> a
safeLast a
x [a]
xs = [a] -> a
forall a. HasCallStack => [a] -> a
last (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
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
[DayComponent]
cs <- TimeLocale -> [(Char, [Char])] -> Maybe [DayComponent]
makeDayComponents TimeLocale
l [(Char, [Char])]
pairs
let y :: Integer
y =
let d :: Integer
d = Integer -> [Integer] -> Integer
forall a. a -> [a] -> a
safeLast Integer
70 [Integer
x | DCCenturyYear Integer
x <- [DayComponent]
cs]
c :: Integer
c =
Integer -> [Integer] -> Integer
forall a. a -> [a] -> a
safeLast
( if Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
69
then Integer
19
else Integer
20
)
[Integer
x | DCCentury Integer
x <- [DayComponent]
cs]
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
rest :: [DayComponent] -> Maybe Day
rest (DCYearMonth Int
m : [DayComponent]
_) =
let d :: Int
d = Int -> [Int] -> Int
forall a. a -> [a] -> a
safeLast Int
1 [Int
x | DCMonthDay Int
x <- [DayComponent]
cs]
in Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
y Int
m Int
d
rest (DCYearDay Int
d : [DayComponent]
_) = Integer -> Int -> Maybe Day
fromOrdinalDateValid Integer
y Int
d
rest (DCYearWeek WeekType
wt Int
w : [DayComponent]
_) =
let d :: Int
d = Int -> [Int] -> Int
forall a. a -> [a] -> a
safeLast Int
4 [Int
x | DCWeekDay Int
x <- [DayComponent]
cs]
in case WeekType
wt of
WeekType
ISOWeek -> Integer -> Int -> Int -> Maybe Day
fromWeekDateValid Integer
y Int
w Int
d
WeekType
SundayWeek -> Integer -> Int -> Int -> Maybe Day
fromSundayStartWeekValid Integer
y Int
w (Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7)
WeekType
MondayWeek -> Integer -> Int -> Int -> Maybe Day
fromMondayStartWeekValid Integer
y Int
w Int
d
rest (DayComponent
_ : [DayComponent]
xs) = [DayComponent] -> Maybe Day
rest [DayComponent]
xs
rest [] = [DayComponent] -> Maybe Day
rest [Int -> DayComponent
DCYearMonth Int
1]
[DayComponent] -> Maybe Day
rest [DayComponent]
cs
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
[DayComponent]
cs <- TimeLocale -> [(Char, [Char])] -> Maybe [DayComponent]
makeDayComponents TimeLocale
l [(Char, [Char])]
pairs
let y :: Integer
y =
let d :: Integer
d = Integer -> [Integer] -> Integer
forall a. a -> [a] -> a
safeLast Integer
70 [Integer
x | DCCenturyYear Integer
x <- [DayComponent]
cs]
c :: Integer
c =
Integer -> [Integer] -> Integer
forall a. a -> [a] -> a
safeLast
( if Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
69
then Integer
19
else Integer
20
)
[Integer
x | DCCentury Integer
x <- [DayComponent]
cs]
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
rest :: [DayComponent] -> Maybe Month
rest (DCYearMonth Int
m : [DayComponent]
_) = Integer -> Int -> Maybe Month
fromYearMonthValid Integer
y Int
m
rest (DayComponent
_ : [DayComponent]
xs) = [DayComponent] -> Maybe Month
rest [DayComponent]
xs
rest [] = Integer -> Int -> Maybe Month
fromYearMonthValid Integer
y Int
1
[DayComponent] -> Maybe Month
rest [DayComponent]
cs
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
a <- m a
ma
a -> b -> m a
f a
a b
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
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 =
let f :: TimeOfDay -> (Char, [Char]) -> Maybe TimeOfDay
f t :: TimeOfDay
t@(TimeOfDay Int
h Int
m Pico
s) (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 TimeOfDay
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 TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12) Int
m Pico
s
else
if [Char]
upx [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
pmStr
then
TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$
Int -> Int -> Pico -> TimeOfDay
TimeOfDay
( 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
)
Int
m
Pico
s
else Maybe TimeOfDay
forall a. Maybe a
Nothing
in case Char
c of
Char
'P' -> Maybe TimeOfDay
getAmPm
Char
'p' -> Maybe TimeOfDay
getAmPm
Char
'H' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
23 Int
raw
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
a Int
m Pico
s
Char
'I' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
12 Int
raw
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
a Int
m Pico
s
Char
'k' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
23 Int
raw
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
a Int
m Pico
s
Char
'l' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
12 Int
raw
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
a Int
m Pico
s
Char
'M' -> do
Int
raw <- Maybe Int
forall a. Read a => Maybe a
ra
Int
a <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
59 Int
raw
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
a Pico
s
Char
'S' -> do
Integer
raw <- Maybe Integer
forall a. Read a => Maybe a
ra
Integer
a <- Integer -> Integer -> Integer -> Maybe Integer
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Integer
0 Integer
60 Integer
raw
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 (Integer -> Pico
forall a. Num a => Integer -> a
fromInteger Integer
a)
Char
'q' -> do
Integer
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
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 (Integer -> Integer -> Pico
mkPico (Pico -> Integer
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Pico
s) Integer
ps)
Char
'Q' ->
if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
x
then TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just TimeOfDay
t
else do
Integer
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
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 (Integer -> Integer -> Pico
mkPico (Pico -> Integer
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Pico
s) Integer
ps)
Char
_ -> TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just TimeOfDay
t
in (TimeOfDay -> (Char, [Char]) -> Maybe TimeOfDay)
-> Maybe TimeOfDay -> [(Char, [Char])] -> Maybe TimeOfDay
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> m a -> [b] -> m a
mfoldl TimeOfDay -> (Char, [Char]) -> Maybe TimeOfDay
f (TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just TimeOfDay
midnight)
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
Int
hours <- Char -> Maybe Int
getMilZoneHours Char
yc
TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> Maybe TimeZone) -> TimeZone -> Maybe TimeZone
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> TimeZone
TimeZone (Int
hours Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
False [Char
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)
| 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
dst [Char]
name
f Char
'z' [Char]
_ TimeZone
_ = Maybe TimeZone
forall a. Maybe a
Nothing
f Char
'Z' [Char]
str TimeZone
_
| 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]
""
f Char
'Z' [Char]
str TimeZone
_
| Just TimeZone
zone <- TimeLocale -> [Char] -> Maybe TimeZone
getKnownTimeZone TimeLocale
l [Char]
str = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
zone
f Char
'Z' [Char]
"UTC" TimeZone
_ = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
utc
f Char
'Z' [Char
c] TimeZone
_
| Just TimeZone
zone <- Char -> Maybe TimeZone
getMilZone Char
c = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
zone
f Char
'Z' [Char]
_ TimeZone
_ = Maybe TimeZone
forall a. Maybe a
Nothing
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
b
sign <- Char -> Maybe b
forall {a}. Num a => Char -> Maybe a
getSign Char
s
b
h <- [Char] -> Maybe b
forall a. Read a => [Char] -> Maybe a
readMaybe [Char
h1, Char
h2]
b
m <- [Char] -> Maybe b
forall a. Read a => [Char] -> Maybe a
readMaybe [Char
m1, Char
m2]
b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ b
sign b -> b -> b
forall a. Num a => a -> a -> a
* (b
60 b -> b -> b
forall a. Num a => a -> a -> a
* b
h b -> b -> b
forall a. Num a => a -> a -> a
+ b
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
Integer
a <- [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x
let s :: NominalDiffTime
s = Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger Integer
a
(Integer
_, Pico
ps) = Pico -> (Integer, Pico)
forall b. Integral b => Pico -> (b, Pico)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (TimeOfDay -> Pico
todSec TimeOfDay
tod) :: (Integer, Pico)
s' :: NominalDiffTime
s' = NominalDiffTime
s NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Pico -> Rational
forall a. Real a => a -> Rational
toRational Pico
ps)
ZonedTime -> Maybe ZonedTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonedTime -> Maybe ZonedTime) -> ZonedTime -> Maybe ZonedTime
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
z (NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
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
buildTimeMonths :: [(Char, String)] -> Maybe Integer
buildTimeMonths :: [(Char, [Char])] -> Maybe Integer
buildTimeMonths [(Char, [Char])]
xs = do
[Integer]
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
Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
tt
buildTimeDays :: [(Char, String)] -> Maybe Integer
buildTimeDays :: [(Char, [Char])] -> Maybe Integer
buildTimeDays [(Char, [Char])]
xs = do
[Integer]
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
Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
tt
buildTimeSeconds :: [(Char, String)] -> Maybe Pico
buildTimeSeconds :: [(Char, [Char])] -> Maybe Pico
buildTimeSeconds [(Char, [Char])]
xs = do
[Pico]
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
Integer
i <- [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
Pico -> Maybe Pico
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pico -> Maybe Pico) -> Pico -> Maybe Pico
forall a b. (a -> b) -> a -> b
$ Integer -> Pico
forall a. Num a => Integer -> a
fromInteger (Integer -> Pico) -> Integer -> Pico
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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
Pico -> Maybe Pico
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pico -> Maybe Pico) -> Pico -> Maybe Pico
forall a b. (a -> b) -> a -> b
$ [Pico] -> Pico
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Pico]
tt
instance ParseTime NominalDiffTime where
parseTimeSpecifier :: Proxy NominalDiffTime
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
parseTimeSpecifier Proxy NominalDiffTime
_ = TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP [Char]
durationParseTimeSpecifier
buildTime :: TimeLocale -> [(Char, [Char])] -> Maybe NominalDiffTime
buildTime TimeLocale
_ [(Char, [Char])]
xs = do
Integer
dd <- [(Char, [Char])] -> Maybe Integer
buildTimeDays [(Char, [Char])]
xs
Pico
tt <- [(Char, [Char])] -> Maybe Pico
buildTimeSeconds [(Char, [Char])]
xs
NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime -> Maybe NominalDiffTime)
-> NominalDiffTime -> Maybe NominalDiffTime
forall a b. (a -> b) -> a -> b
$ (Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger Integer
dd NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
86400) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ Pico -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
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
Integer
dd <- [(Char, [Char])] -> Maybe Integer
buildTimeDays [(Char, [Char])]
xs
Pico
tt <- [(Char, [Char])] -> Maybe Pico
buildTimeSeconds [(Char, [Char])]
xs
DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffTime -> Maybe DiffTime) -> DiffTime -> Maybe DiffTime
forall a b. (a -> b) -> a -> b
$ (Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger Integer
dd DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
86400) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ Pico -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
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
Integer
mm <- [(Char, [Char])] -> Maybe Integer
buildTimeMonths [(Char, [Char])]
xs
Integer
dd <- [(Char, [Char])] -> Maybe Integer
buildTimeDays [(Char, [Char])]
xs
CalendarDiffDays -> Maybe CalendarDiffDays
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarDiffDays -> Maybe CalendarDiffDays)
-> CalendarDiffDays -> Maybe CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
mm Integer
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
Integer
mm <- [(Char, [Char])] -> Maybe Integer
buildTimeMonths [(Char, [Char])]
xs
NominalDiffTime
tt <- TimeLocale -> [(Char, [Char])] -> Maybe NominalDiffTime
forall t. ParseTime t => TimeLocale -> [(Char, [Char])] -> Maybe t
buildTime TimeLocale
locale [(Char, [Char])]
xs
CalendarDiffTime -> Maybe CalendarDiffTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarDiffTime -> Maybe CalendarDiffTime)
-> CalendarDiffTime -> Maybe CalendarDiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> NominalDiffTime -> CalendarDiffTime
CalendarDiffTime Integer
mm NominalDiffTime
tt