{-# LANGUAGE PostfixOperators #-}

module Parsers.DateTime where

import Parser(Parser(..), check)
import ParserCombinators (IsMatch(..), (<|>), (<#>), (|?), (|*), (|+), within)
import Parsers.Char (digit, dash, colon, plus)

import Data.Time (Day, LocalTime(..), TimeOfDay(..), TimeZone, ZonedTime(..),
                  fromGregorian, minutesToTimeZone)
import Data.Maybe (fromMaybe)


year :: Parser Integer
year :: Parser Integer
year = String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> Parser String -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
digit Parser Char -> Integer -> Parser String
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
4

day :: Parser Int
day :: Parser Int
day = String -> (Int -> Bool) -> Parser Int -> Parser Int
forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"day" (Int -> Int -> Int -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Int
1 Int
31) (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
digit Parser Char -> Integer -> Parser String
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
2

month :: Parser Int
month :: Parser Int
month = String -> (Int -> Bool) -> Parser Int -> Parser Int
forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"month" (Int -> Int -> Int -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Int
1 Int
12) (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
digit Parser Char -> Integer -> Parser String
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
2

hour :: Parser Int
hour :: Parser Int
hour = String -> (Int -> Bool) -> Parser Int -> Parser Int
forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"hour" (Int -> Int -> Int -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Int
0 Int
23) (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
digit Parser Char -> Integer -> Parser String
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
2

minute :: Parser Int
minute :: Parser Int
minute = String -> (Int -> Bool) -> Parser Int -> Parser Int
forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"minute" (Int -> Int -> Int -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Int
0 Int
59) (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
digit Parser Char -> Integer -> Parser String
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
2

second :: Parser Int
second :: Parser Int
second = String -> (Int -> Bool) -> Parser Int -> Parser Int
forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"second" (Int -> Int -> Int -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Int
0 Int
59) (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
digit Parser Char -> Integer -> Parser String
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
2

secondDecimals :: Parser Integer
secondDecimals :: Parser Integer
secondDecimals = String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> Parser String -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (String -> Bool) -> Parser String -> Parser String
forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"pico seconds" ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
12) (Int -> Bool) -> (String -> Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (Parser Char
digit Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|+)



date :: Parser Day
date :: Parser Day
date = do Integer
y <- Parser Integer
year
          Int
m <- Parser Char -> Parser Int -> Parser Int
forall a b. Parser a -> Parser b -> Parser b
within Parser Char
dash Parser Int
month
          Int
d <- Parser Int
day
          Day -> Parser Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> Parser Day) -> Day -> Parser Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d


time :: Parser TimeOfDay
time :: Parser TimeOfDay
time = do Int
h <- Parser Int
hour
          Int
min <- Parser Char
colon Parser Char -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
minute
          Int
s <- Parser Char
colon Parser Char -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
second
          Integer
decimals <- Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
0) (Maybe Integer -> Integer)
-> Parser (Maybe Integer) -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser Char
colon Parser Char -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
secondDecimals) Parser Integer -> Parser (Maybe Integer)
forall a. Parser a -> Parser (Maybe a)
|?)
          TimeOfDay -> Parser TimeOfDay
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeOfDay -> Parser TimeOfDay) -> TimeOfDay -> Parser TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
min (Pico -> TimeOfDay) -> Pico -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ String -> Pico
forall a. Read a => String -> a
read (Int -> String
forall a. Show a => a -> String
show Int
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
decimals)


timeZoneOffset :: Parser TimeZone
timeZoneOffset :: Parser TimeZone
timeZoneOffset = do Bool
pos <- (Bool
True Bool -> Parser Char -> Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Char
plus) Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
<|> (Bool
False Bool -> Parser Char -> Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Char
dash)
                    Int
h <- Parser Int
hour
                    Int
min <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Parser (Maybe Int) -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser Char
colon Parser Char -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
minute) Parser Int -> Parser (Maybe Int)
forall a. Parser a -> Parser (Maybe a)
|?)
                    TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeZone -> Parser TimeZone) -> TimeZone -> Parser TimeZone
forall a b. (a -> b) -> a -> b
$ Int -> TimeZone
minutesToTimeZone (Int -> TimeZone) -> Int -> TimeZone
forall a b. (a -> b) -> a -> b
$ (if Bool
pos then Int
1 else (-Int
1)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
min)

localDateTime :: Parser LocalTime
localDateTime :: Parser LocalTime
localDateTime = do Day
d <- Parser Day
date
                   String -> Parser Char
forall a. IsMatch a => [a] -> Parser a
oneOf [Char
'T', Char
't']
                   TimeOfDay
t <- Parser TimeOfDay
time
                   LocalTime -> Parser LocalTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalTime -> Parser LocalTime) -> LocalTime -> Parser LocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
t

offsetDateTime :: Parser ZonedTime
offsetDateTime :: Parser ZonedTime
offsetDateTime = do LocalTime
localTime <- Parser LocalTime
localDateTime
                    TimeZone
offset    <- Parser TimeZone
timeZoneOffset
                    ZonedTime -> Parser ZonedTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZonedTime -> Parser ZonedTime) -> ZonedTime -> Parser ZonedTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
localTime TimeZone
offset

dateTime :: Parser ZonedTime
dateTime :: Parser ZonedTime
dateTime = ((LocalTime -> TimeZone -> ZonedTime
`ZonedTime` Int -> TimeZone
minutesToTimeZone Int
0) (LocalTime -> ZonedTime) -> Parser LocalTime -> Parser ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LocalTime
localDateTime Parser ZonedTime -> Parser Char -> Parser ZonedTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
forall a. IsMatch a => a -> Parser a
is Char
'Z') Parser ZonedTime -> Parser ZonedTime -> Parser ZonedTime
forall a. Parser a -> Parser a -> Parser a
<|>
            Parser ZonedTime
offsetDateTime


range :: Ord a => a -> a -> a -> Bool
range :: a -> a -> a -> Bool
range a
min a
max a
x = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
min Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
max