module Parsers.DateTime (date, time, timeZoneOffset, localDateTime, offsetDateTime,
                         dateTime, year, day, month, hour, minute, second) 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)


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


time :: Parser TimeOfDay
time :: Parser TimeOfDay
time = do Int
h <- Parser Int
hour
          Int
m <- 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
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)
|?)
          pure $ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m (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
m <- 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)
|?)
                    pure $ 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
m)

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

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

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



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]
|+)





range :: Ord a => a -> a -> a -> Bool
range :: a -> a -> a -> Bool
range a
mn a
mx a
x = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
mn Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
mx