{-# 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)