content: {-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes, RecordWildCards #-}
  module IHP.Postgres.TimeParser where
  
  import BasicPrelude hiding (takeWhile)
  import Data.Attoparsec.ByteString.Char8
  import Data.Bits ((.&.))
  import Data.Char (ord)
  
  import Data.Fixed (Pico, Fixed(MkFixed))
  import Data.Time.Clock.Compat (NominalDiffTime)
  import qualified Data.ByteString.Char8 as B8
  import qualified Data.Time.LocalTime.Compat as Local
  
  --Simple newtype wrapper around a postgres interval bytestring.
  newtype PGInterval = PGInterval ByteString deriving (Eq, Show)
  
  -- The mapping of the "interval" bytestring into application
  -- logic depends on the Interval Output Style of the postgres database
  -- and the semantics of the interval quantity in the application code (if they differ from the postgres
  -- interpretation for some reason).
  -- This module provides the PGInterval wrapper type and a parser for the default
  -- `postgres` output style into a a PGTimeInterval data struct of years, months, days, and NominalDiffTime.
  --  These can be combined with the standard Calendar/Time library to perform Calendar Arithmetic
  --  Days and Years are big Integers and can be added to the Gregorian year and Julian Day respectively
  --  Months are small Int (up to 1-11) denoting a month of the year, and the pgClock is a Nominal DiffTime
  --  representing the time as measured by a clock without leap seconds.
  
  data PGTimeInterval = PGTimeInterval { pgYears :: !Integer
                                       , pgMonths :: !Int
                                       , pgDays :: !Integer
                                       , pgClock :: !NominalDiffTime } deriving (Eq, Show)
  
  -- To support the default postgres output style PGInterval -> PGTimeInterval
  -- in Application Code we provide the parser combinators for the `postgres` output style.
  -- for parsing (optional combination of): Y year[s] M mon[s] D day[s] [-]HH:MM:SS.[SSSs].
  -- This corresponds to the default interval `postgres` format.
  -- (https://www.postgresql.org/docs/current/datatype-datetime.html).
  -- alternative parsers would need to be provided for the `sql_standard`, `postgres_verbose`, and `iso_8601`
  -- styles/
  
  unpackInterval :: PGInterval -> PGTimeInterval
  unpackInterval (PGInterval bs) = case parseOnly pPGInterval bs of
      Left err -> error ("Couldn't parse PGInterval. " <> err)
      Right val -> val
  
  
  pPGInterval :: Parser PGTimeInterval
  pPGInterval = do
      year <- option 0 ((signed decimal <* space <* (string "years" <|>  string "year")))
      skipSpace
      mons <-  option 0 ((signed decimal <* space <* (string "mons" <|>  string "mon")))
      skipSpace
      days <- option 0 ((signed decimal <* space <* (string "days" <|>  "day")))
      skipSpace
      timeOfDay <- option 0 nominalDiffTime
      pure (PGTimeInterval year mons days timeOfDay)
  
  
  -- | Parse a two-digit integer (e.g. day of month, hour).
  twoDigits :: Parser Int
  twoDigits = do
    a <- digit
    b <- digit
    let c2d c = ord c .&. 15
    pure $! c2d a * 10 + c2d b
  
  
  -- Take from Postgresql Internal to facilitate a definition of a NominalDiffTime FromField
  -- | See https://stackoverflow.com/questions/32398878/converting-postgres-interval-to-haskell-nominaltimediff-with-postgresql-simple
  -- |
  -- Module:      Database.PostgreSQL.Simple.Time.Internal.Parser
  -- Copyright:   (c) 2012-2015 Leon P Smith
  --              (c) 2015 Bryan O'Sullivan
  -- License:     BSD3
  -- Maintainer:  Leon P Smith <leon@melding-monads.com>
  -- Stability:   experimental
  --
  -- Parsers for parsing dates and times.
  
  toPico :: Integer -> Pico
  toPico = MkFixed
  -- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
  
  pClockInterval :: Parser Local.TimeOfDay
  pClockInterval = do
    h <- twoDigits <* char ':'
    m <- twoDigits
    mc <- peekChar
    s <- case mc of
           Just ':' -> anyChar *> seconds
           _   -> return 0
    if h < 24 && m < 60 && s <= 60
      then return (Local.TimeOfDay h m s)
      else fail "invalid time"
  
  -- | Parse a count of seconds, with the integer part being two digits
  -- long.
  seconds :: Parser Pico
  seconds = do
    real <- twoDigits
    mc <- peekChar
    case mc of
      Just '.' -> do
        t <- anyChar *> takeWhile1 isDigit
        pure $! parsePicos (fromIntegral real) t
      _ -> pure $! fromIntegral real
   where
    parsePicos :: Int64 -> B8.ByteString -> Pico
    parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
      where n  = max 0 (12 - B8.length t)
            t' = B8.foldl' (\a c -> 10 * a + fromIntegral (ord c .&. 15)) a0
                           (B8.take 12 t)
  
  nominalDiffTime :: Parser NominalDiffTime
  nominalDiffTime = do
      (h, m, s) <- pClockTime
      pure . fromRational . toRational $ s + 60*(fromIntegral m) + 60*60*(fromIntegral h)
  
  
  -- | Parse a limited postgres interval of the form [-]HHH:MM:SS.[SSSS] (no larger units than hours).
  pClockTime :: Parser (Int, Int, Pico)
  pClockTime = do
      h <- try $ signed decimal <* char ':'
      m <- try $ twoDigits <* char ':'
      s <- try seconds
      pure (h,m,s)
  