Implementation.hs

------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------

-- |
-- Module:      Database.PostgreSQL.Simple.Time.Implementation
-- Copyright:   (c) 2012-2015 Leon P Smith
-- License:     BSD3
-- Maintainer:  Leon P Smith <leon@melding-monads.com>
-- Stability:   experimental
module Database.PostgreSQL.Simple.Time.Implementation where

import Control.Applicative
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString as B
import Data.ByteString.Builder (Builder, byteString)
import Data.ByteString.Builder.Prim (primBounded)
import Data.Maybe (fromMaybe)
import Data.Time.Compat (Day, LocalTime, NominalDiffTime, TimeOfDay, TimeZone, UTCTime, ZonedTime, utc)
import Data.Time.LocalTime.Compat (CalendarDiffTime)
import qualified Database.PostgreSQL.Simple.Time.Internal.Parser as TP
import qualified Database.PostgreSQL.Simple.Time.Internal.Printer as TPP
import Hpgsql.Time (Unbounded (..))
import Prelude hiding (take)

type LocalTimestamp = Unbounded LocalTime

type UTCTimestamp = Unbounded UTCTime

type ZonedTimestamp = Unbounded ZonedTime

type Date = Unbounded Day

parseUTCTime :: B.ByteString -> Either String UTCTime
parseUTCTime = A.parseOnly (getUTCTime <* A.endOfInput)

parseZonedTime :: B.ByteString -> Either String ZonedTime
parseZonedTime = A.parseOnly (getZonedTime <* A.endOfInput)

parseLocalTime :: B.ByteString -> Either String LocalTime
parseLocalTime = A.parseOnly (getLocalTime <* A.endOfInput)

parseDay :: B.ByteString -> Either String Day
parseDay = A.parseOnly (getDay <* A.endOfInput)

parseTimeOfDay :: B.ByteString -> Either String TimeOfDay
parseTimeOfDay = A.parseOnly (getTimeOfDay <* A.endOfInput)

parseUTCTimestamp :: B.ByteString -> Either String UTCTimestamp
parseUTCTimestamp = A.parseOnly (getUTCTimestamp <* A.endOfInput)

parseZonedTimestamp :: B.ByteString -> Either String ZonedTimestamp
parseZonedTimestamp = A.parseOnly (getZonedTimestamp <* A.endOfInput)

parseLocalTimestamp :: B.ByteString -> Either String LocalTimestamp
parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)

parseDate :: B.ByteString -> Either String Date
parseDate = A.parseOnly (getDate <* A.endOfInput)

parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime
parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)

getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
getUnbounded getFinite =
  (pure NegInfinity <* A.string "-infinity")
    <|> (pure PosInfinity <* A.string "infinity")
    <|> (Finite <$> getFinite)

getDay :: A.Parser Day
getDay = TP.day

getDate :: A.Parser Date
getDate = getUnbounded getDay

getTimeOfDay :: A.Parser TimeOfDay
getTimeOfDay = TP.timeOfDay

getLocalTime :: A.Parser LocalTime
getLocalTime = TP.localTime

getLocalTimestamp :: A.Parser LocalTimestamp
getLocalTimestamp = getUnbounded getLocalTime

getTimeZone :: A.Parser TimeZone
getTimeZone = fromMaybe utc <$> TP.timeZone

type TimeZoneHMS = (Int, Int, Int)

getTimeZoneHMS :: A.Parser TimeZoneHMS
getTimeZoneHMS = munge <$> TP.timeZoneHMS
  where
    munge Nothing = (0, 0, 0)
    munge (Just (TP.UTCOffsetHMS h m s)) = (h, m, s)

localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)
localToUTCTimeOfDayHMS (dh, dm, ds) tod =
  TP.localToUTCTimeOfDayHMS (TP.UTCOffsetHMS dh dm ds) tod

getZonedTime :: A.Parser ZonedTime
getZonedTime = TP.zonedTime

getZonedTimestamp :: A.Parser ZonedTimestamp
getZonedTimestamp = getUnbounded getZonedTime

getUTCTime :: A.Parser UTCTime
getUTCTime = TP.utcTime

getUTCTimestamp :: A.Parser UTCTimestamp
getUTCTimestamp = getUnbounded getUTCTime

getCalendarDiffTime :: A.Parser CalendarDiffTime
getCalendarDiffTime = TP.calendarDiffTime

dayToBuilder :: Day -> Builder
dayToBuilder = primBounded TPP.day

timeOfDayToBuilder :: TimeOfDay -> Builder
timeOfDayToBuilder = primBounded TPP.timeOfDay

timeZoneToBuilder :: TimeZone -> Builder
timeZoneToBuilder = primBounded TPP.timeZone

utcTimeToBuilder :: UTCTime -> Builder
utcTimeToBuilder = primBounded TPP.utcTime

zonedTimeToBuilder :: ZonedTime -> Builder
zonedTimeToBuilder = primBounded TPP.zonedTime

localTimeToBuilder :: LocalTime -> Builder
localTimeToBuilder = primBounded TPP.localTime

unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)
unboundedToBuilder finiteToBuilder unbounded =
  case unbounded of
    NegInfinity -> byteString "-infinity"
    Finite a -> finiteToBuilder a
    PosInfinity -> byteString "infinity"

utcTimestampToBuilder :: UTCTimestamp -> Builder
utcTimestampToBuilder = unboundedToBuilder utcTimeToBuilder

zonedTimestampToBuilder :: ZonedTimestamp -> Builder
zonedTimestampToBuilder = unboundedToBuilder zonedTimeToBuilder

localTimestampToBuilder :: LocalTimestamp -> Builder
localTimestampToBuilder = unboundedToBuilder localTimeToBuilder

dateToBuilder :: Date -> Builder
dateToBuilder = unboundedToBuilder dayToBuilder

nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
nominalDiffTimeToBuilder = TPP.nominalDiffTime

calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder
calendarDiffTimeToBuilder = TPP.calendarDiffTime