------------------------------------------------------------------------------
-- |
-- 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
--
------------------------------------------------------------------------------

{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}

module Database.PostgreSQL.Simple.Time.Implementation where

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

data Unbounded a
   = NegInfinity
   | Finite !a
   | PosInfinity
     deriving (Unbounded a -> Unbounded a -> Bool
forall a. Eq a => Unbounded a -> Unbounded a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unbounded a -> Unbounded a -> Bool
$c/= :: forall a. Eq a => Unbounded a -> Unbounded a -> Bool
== :: Unbounded a -> Unbounded a -> Bool
$c== :: forall a. Eq a => Unbounded a -> Unbounded a -> Bool
Eq, Unbounded a -> Unbounded a -> Bool
Unbounded a -> Unbounded a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Unbounded a)
forall a. Ord a => Unbounded a -> Unbounded a -> Bool
forall a. Ord a => Unbounded a -> Unbounded a -> Ordering
forall a. Ord a => Unbounded a -> Unbounded a -> Unbounded a
min :: Unbounded a -> Unbounded a -> Unbounded a
$cmin :: forall a. Ord a => Unbounded a -> Unbounded a -> Unbounded a
max :: Unbounded a -> Unbounded a -> Unbounded a
$cmax :: forall a. Ord a => Unbounded a -> Unbounded a -> Unbounded a
>= :: Unbounded a -> Unbounded a -> Bool
$c>= :: forall a. Ord a => Unbounded a -> Unbounded a -> Bool
> :: Unbounded a -> Unbounded a -> Bool
$c> :: forall a. Ord a => Unbounded a -> Unbounded a -> Bool
<= :: Unbounded a -> Unbounded a -> Bool
$c<= :: forall a. Ord a => Unbounded a -> Unbounded a -> Bool
< :: Unbounded a -> Unbounded a -> Bool
$c< :: forall a. Ord a => Unbounded a -> Unbounded a -> Bool
compare :: Unbounded a -> Unbounded a -> Ordering
$ccompare :: forall a. Ord a => Unbounded a -> Unbounded a -> Ordering
Ord, Typeable, forall a b. a -> Unbounded b -> Unbounded a
forall a b. (a -> b) -> Unbounded a -> Unbounded b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Unbounded b -> Unbounded a
$c<$ :: forall a b. a -> Unbounded b -> Unbounded a
fmap :: forall a b. (a -> b) -> Unbounded a -> Unbounded b
$cfmap :: forall a b. (a -> b) -> Unbounded a -> Unbounded b
Functor)

instance Show a => Show (Unbounded a) where
  showsPrec :: Int -> Unbounded a -> ShowS
showsPrec Int
prec Unbounded a
x String
rest
    = case Unbounded a
x of
        Unbounded a
NegInfinity -> String
"-infinity" forall a. Semigroup a => a -> a -> a
<> String
rest
        Finite a
time -> forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec a
time String
rest
        Unbounded a
PosInfinity ->  String
"infinity" forall a. Semigroup a => a -> a -> a
<> String
rest

instance Read a => Read (Unbounded a) where
  readsPrec :: Int -> ReadS (Unbounded a)
readsPrec Int
prec = forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False forall a b. (a -> b) -> a -> b
$ \String
str -> case String
str of
    (Char
'-':Char
'i':Char
'n':Char
'f':Char
'i':Char
'n':Char
'i':Char
't':Char
'y':String
xs)  -> [(forall a. Unbounded a
NegInfinity,String
xs)]
    (    Char
'i':Char
'n':Char
'f':Char
'i':Char
'n':Char
'i':Char
't':Char
'y':String
xs)  -> [(forall a. Unbounded a
PosInfinity,String
xs)]
    String
xs -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Unbounded a
Finite forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. a -> a
id) (forall a. Read a => Int -> ReadS a
readsPrec Int
prec String
xs)

type LocalTimestamp = Unbounded LocalTime
type UTCTimestamp   = Unbounded UTCTime
type ZonedTimestamp = Unbounded ZonedTime
type Date           = Unbounded Day

parseUTCTime   :: B.ByteString -> Either String UTCTime
parseUTCTime :: ByteString -> Either String UTCTime
parseUTCTime   = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString UTCTime
getUTCTime forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseZonedTime :: B.ByteString -> Either String ZonedTime
parseZonedTime :: ByteString -> Either String ZonedTime
parseZonedTime = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString ZonedTime
getZonedTime forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseLocalTime :: B.ByteString -> Either String LocalTime
parseLocalTime :: ByteString -> Either String LocalTime
parseLocalTime = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString LocalTime
getLocalTime forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseDay :: B.ByteString -> Either String Day
parseDay :: ByteString -> Either String Day
parseDay = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString Day
getDay forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseTimeOfDay :: B.ByteString -> Either String TimeOfDay
parseTimeOfDay :: ByteString -> Either String TimeOfDay
parseTimeOfDay = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString TimeOfDay
getTimeOfDay forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseUTCTimestamp   :: B.ByteString -> Either String UTCTimestamp
parseUTCTimestamp :: ByteString -> Either String UTCTimestamp
parseUTCTimestamp   = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString UTCTimestamp
getUTCTimestamp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseZonedTimestamp :: B.ByteString -> Either String ZonedTimestamp
parseZonedTimestamp :: ByteString -> Either String ZonedTimestamp
parseZonedTimestamp = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString ZonedTimestamp
getZonedTimestamp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseLocalTimestamp :: B.ByteString -> Either String LocalTimestamp
parseLocalTimestamp :: ByteString -> Either String LocalTimestamp
parseLocalTimestamp = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString LocalTimestamp
getLocalTimestamp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseDate :: B.ByteString -> Either String Date
parseDate :: ByteString -> Either String Date
parseDate = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString Date
getDate forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime
parseCalendarDiffTime :: ByteString -> Either String CalendarDiffTime
parseCalendarDiffTime = forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser ByteString CalendarDiffTime
getCalendarDiffTime forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
getUnbounded :: forall a. Parser a -> Parser (Unbounded a)
getUnbounded Parser a
getFinite
    =     (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Unbounded a
NegInfinity forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString
A.string ByteString
"-infinity")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Unbounded a
PosInfinity forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString
A.string  ByteString
"infinity")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. a -> Unbounded a
Finite forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
getFinite)

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

getDate :: A.Parser Date
getDate :: Parser ByteString Date
getDate = forall a. Parser a -> Parser (Unbounded a)
getUnbounded Parser ByteString Day
getDay

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

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

getLocalTimestamp :: A.Parser LocalTimestamp
getLocalTimestamp :: Parser ByteString LocalTimestamp
getLocalTimestamp = forall a. Parser a -> Parser (Unbounded a)
getUnbounded Parser ByteString LocalTime
getLocalTime

getTimeZone :: A.Parser TimeZone
getTimeZone :: Parser TimeZone
getTimeZone = forall a. a -> Maybe a -> a
fromMaybe TimeZone
utc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe TimeZone)
TP.timeZone

type TimeZoneHMS = (Int,Int,Int)

getTimeZoneHMS :: A.Parser TimeZoneHMS
getTimeZoneHMS :: Parser TimeZoneHMS
getTimeZoneHMS = Maybe UTCOffsetHMS -> TimeZoneHMS
munge forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe UTCOffsetHMS)
TP.timeZoneHMS
  where
    munge :: Maybe UTCOffsetHMS -> TimeZoneHMS
munge Maybe UTCOffsetHMS
Nothing = (Int
0,Int
0,Int
0)
    munge (Just (TP.UTCOffsetHMS Int
h Int
m Int
s)) = (Int
h,Int
m,Int
s)

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

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

getZonedTimestamp :: A.Parser ZonedTimestamp
getZonedTimestamp :: Parser ByteString ZonedTimestamp
getZonedTimestamp = forall a. Parser a -> Parser (Unbounded a)
getUnbounded Parser ByteString ZonedTime
getZonedTime

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

getUTCTimestamp :: A.Parser UTCTimestamp
getUTCTimestamp :: Parser ByteString UTCTimestamp
getUTCTimestamp = forall a. Parser a -> Parser (Unbounded a)
getUnbounded Parser ByteString UTCTime
getUTCTime

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

dayToBuilder :: Day -> Builder
dayToBuilder :: Day -> Builder
dayToBuilder = forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim Day
TPP.day

timeOfDayToBuilder :: TimeOfDay -> Builder
timeOfDayToBuilder :: TimeOfDay -> Builder
timeOfDayToBuilder = forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim TimeOfDay
TPP.timeOfDay

timeZoneToBuilder :: TimeZone -> Builder
timeZoneToBuilder :: TimeZone -> Builder
timeZoneToBuilder = forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim TimeZone
TPP.timeZone

utcTimeToBuilder :: UTCTime -> Builder
utcTimeToBuilder :: UTCTime -> Builder
utcTimeToBuilder = forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim UTCTime
TPP.utcTime

zonedTimeToBuilder :: ZonedTime -> Builder
zonedTimeToBuilder :: ZonedTime -> Builder
zonedTimeToBuilder = forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim ZonedTime
TPP.zonedTime

localTimeToBuilder :: LocalTime -> Builder
localTimeToBuilder :: LocalTime -> Builder
localTimeToBuilder = forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim LocalTime
TPP.localTime

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

utcTimestampToBuilder :: UTCTimestamp -> Builder
utcTimestampToBuilder :: UTCTimestamp -> Builder
utcTimestampToBuilder = forall a. (a -> Builder) -> Unbounded a -> Builder
unboundedToBuilder UTCTime -> Builder
utcTimeToBuilder

zonedTimestampToBuilder :: ZonedTimestamp -> Builder
zonedTimestampToBuilder :: ZonedTimestamp -> Builder
zonedTimestampToBuilder = forall a. (a -> Builder) -> Unbounded a -> Builder
unboundedToBuilder ZonedTime -> Builder
zonedTimeToBuilder

localTimestampToBuilder :: LocalTimestamp -> Builder
localTimestampToBuilder :: LocalTimestamp -> Builder
localTimestampToBuilder = forall a. (a -> Builder) -> Unbounded a -> Builder
unboundedToBuilder LocalTime -> Builder
localTimeToBuilder

dateToBuilder  :: Date -> Builder
dateToBuilder :: Date -> Builder
dateToBuilder  = forall a. (a -> Builder) -> Unbounded a -> Builder
unboundedToBuilder Day -> Builder
dayToBuilder

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

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