DateTime.hs

module Bookhound.Parsers.DateTime (date, time, timeZoneOffset, localDateTime, offsetDateTime, dateTime, year, day, month, hour, minute, second) where

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

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


date :: Parser Day
date = withErrorN (-1) "Date" $
  fromGregorian <$> year <*> within dash month <*> day


time :: Parser TimeOfDay
time = withErrorN (-1) "Time" $
  do h <- hour
     m <- colon *> minute
     s <- colon *> second
     decimals <- fromMaybe 0 <$> ((colon *> secondDecimals) |?)
     pure $ TimeOfDay h m $ read (show s <> "." <> show decimals)


timeZoneOffset :: Parser TimeZone
timeZoneOffset = withErrorN (-1) "Timezone Offset" $
  do pos <- (True <$ plus) <|> (False <$ dash)
     h <- hour
     m <- fromMaybe 0 <$> ((colon *> minute) |?)
     pure $ minutesToTimeZone $ (if pos then 1 else (-1)) * (h * 60 + m)


localDateTime :: Parser LocalTime
localDateTime = withErrorN (-1) "Local DateTime" $
  LocalTime <$> (date <* oneOf ['T', 't']) <*> time


offsetDateTime :: Parser ZonedTime
offsetDateTime = withErrorN (-1) "Offset DateTime" $
  ZonedTime <$> localDateTime <*> timeZoneOffset


dateTime :: Parser ZonedTime
dateTime = withErrorN (-1) "DateTime" $
  ((`ZonedTime` minutesToTimeZone 0) <$> localDateTime <* is 'Z')
  <|> offsetDateTime



year :: Parser Integer
year = read <$> digit <#> 4

day :: Parser Int
day = check "Day" (range 1 31) $ read <$> digit <#> 2

month :: Parser Int
month = check "Month" (range 1 12) $ read <$> digit <#> 2

hour :: Parser Int
hour = check "Hour" (range 0 23) $ read <$> digit <#> 2

minute :: Parser Int
minute = check "Minute" (range 0 59) $ read <$> digit <#> 2

second :: Parser Int
second = check "Second" (range 0 59) $ read <$> digit <#> 2

secondDecimals :: Parser Integer
secondDecimals = read <$> check "Pico Seconds" ((<= 12) . length) (digit |+)




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