{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.Raw.PgTime
  ( dayToPostgreSQL
  , day
  , utcTimeToPostgreSQL
  , utcTime
  , localTimeToPostgreSQL
  , localTime
  )
where

import qualified Data.Attoparsec.ByteString as AttoBS
import qualified Data.Attoparsec.ByteString.Char8 as AttoB8
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.Char as Char
import qualified Data.Fixed as Fixed
import qualified Data.Time as Time
import qualified Data.Word as Word

{- |
  Renders a 'Time.Day' value to a textual representation for PostgreSQL.

@since 1.0.0.0
-}
dayToPostgreSQL :: Time.Day -> B8.ByteString
dayToPostgreSQL :: Day -> ByteString
dayToPostgreSQL =
  String -> ByteString
B8.pack (String -> ByteString) -> (Day -> String) -> Day -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
Time.showGregorian

{- |
  An Attoparsec parser for parsing 'Time.Day' from YYYY-MM-DD format. Parsing
  fails if given an invalid 'Time.Day'.

@since 1.0.0.0
-}
day :: AttoB8.Parser Time.Day
day :: Parser Day
day = do
  (Integer
y, Integer
yearCount) <- Parser (Integer, Integer)
forall a. Integral a => Parser (a, a)
decimalWithCount Parser (Integer, Integer)
-> Parser ByteString Char -> Parser (Integer, Integer)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
AttoB8.char Char
'-'
  if Integer
yearCount Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
4
    then String -> Parser Day
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid date format"
    else do
      Int
m <- Parser Int
forall a. Integral a => Parser a
twoDigits Parser Int -> Parser ByteString Char -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
AttoB8.char Char
'-'
      Int
d <- Parser Int
forall a. Integral a => Parser a
twoDigits
      Parser Day -> (Day -> Parser Day) -> Maybe Day -> Parser Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Day
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid date format") Day -> Parser Day
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Day -> Parser Day) -> Maybe Day -> Parser Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Maybe Day
Time.fromGregorianValid Integer
y Int
m Int
d

{- |
  An Attoparsec parser for parsing 2-digit integral numbers.

@since 1.0.0.0
-}
twoDigits :: Integral a => AttoB8.Parser a
twoDigits :: forall a. Integral a => Parser a
twoDigits = do
  Char
tens <- Parser ByteString Char
AttoB8.digit
  Char
ones <- Parser ByteString Char
AttoB8.digit
  a -> Parser a
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ Char -> a
forall a. Integral a => Char -> a
fromChar Char
tens a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Char -> a
forall a. Integral a => Char -> a
fromChar Char
ones

fromChar :: Integral a => Char -> a
fromChar :: forall a. Integral a => Char -> a
fromChar Char
c = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Char -> Int
Char.ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'0'

{- |
  Renders a 'Time.UTCTime' value to a textual representation for PostgreSQL.

@since 1.0.0.0
-}
utcTimeToPostgreSQL :: Time.UTCTime -> B8.ByteString
utcTimeToPostgreSQL :: UTCTime -> ByteString
utcTimeToPostgreSQL =
  String -> ByteString
B8.pack (String -> ByteString)
-> (UTCTime -> String) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
Time.defaultTimeLocale String
"%0Y-%m-%d %H:%M:%S%Q+00"

{- |
  An Attoparsec parser for parsing 'Time.UTCTime' from an ISO-8601 style
  datetime and timezone with a few PostgreSQL-specific exceptions. See
  'localTime' for more details.

@since 1.0.0.0
-}
utcTime :: AttoB8.Parser Time.UTCTime
utcTime :: Parser UTCTime
utcTime = do
  LocalTime
lt <- Parser LocalTime
localTime
  Char
sign <- (Char -> Bool) -> Parser ByteString Char
AttoB8.satisfy (\Char
char -> Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z')
  if Char
sign Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z'
    then UTCTime -> Parser UTCTime
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Parser UTCTime) -> UTCTime -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$ TimeZone -> LocalTime -> UTCTime
Time.localTimeToUTC TimeZone
Time.utc LocalTime
lt
    else do
      Int
hour <- Parser Int
forall a. Integral a => Parser a
twoDigits
      Int
minute <- Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AttoB8.option Int
0 (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ [Parser Int] -> Parser Int
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AttoB8.choice [Char -> Parser ByteString Char
AttoB8.char Char
':' Parser ByteString Char -> Parser Int -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
forall a. Integral a => Parser a
twoDigits, Parser Int
forall a. Integral a => Parser a
twoDigits]
      Int
second <- Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AttoB8.option Int
0 (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
AttoB8.char Char
':' Parser ByteString Char -> Parser Int -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
forall a. Integral a => Parser a
twoDigits
      let
        offsetSeconds :: Int
        offsetSeconds :: Int
offsetSeconds = (Int
second Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minute Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hour Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3600) Int -> Int -> Int
forall a. Num a => a -> a -> a
* if Char
sign Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' then (-Int
1) else Int
1
        offsetNominalDiffTime :: NominalDiffTime
offsetNominalDiffTime = Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetSeconds
        diffTime :: DiffTime
diffTime = TimeOfDay -> DiffTime
Time.timeOfDayToTime (LocalTime -> TimeOfDay
Time.localTimeOfDay LocalTime
lt)
        utcTimeWithoutOffset :: UTCTime
utcTimeWithoutOffset = Day -> DiffTime -> UTCTime
Time.UTCTime (LocalTime -> Day
Time.localDay LocalTime
lt) DiffTime
diffTime
      UTCTime -> Parser UTCTime
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Parser UTCTime) -> UTCTime -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> UTCTime
Time.addUTCTime NominalDiffTime
offsetNominalDiffTime UTCTime
utcTimeWithoutOffset

{- |
  Renders a 'Time.LocalTime' value to a textual representation for PostgreSQL.

@since 1.0.0.0
-}
localTimeToPostgreSQL :: Time.LocalTime -> B8.ByteString
localTimeToPostgreSQL :: LocalTime -> ByteString
localTimeToPostgreSQL =
  String -> ByteString
B8.pack (String -> ByteString)
-> (LocalTime -> String) -> LocalTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
Time.defaultTimeLocale String
"%0Y-%m-%d %H:%M:%S%Q"

{- |
  An Attoparsec parser for parsing 'Time.LocalTime' from an ISO-8601 style
  datetime with a few exceptions. The separator between the date and time
  is always @\' \'@ and never @\'T\'@.

@since 1.0.0.0
-}
localTime :: AttoB8.Parser Time.LocalTime
localTime :: Parser LocalTime
localTime = do
  Day -> TimeOfDay -> LocalTime
Time.LocalTime (Day -> TimeOfDay -> LocalTime)
-> Parser Day -> Parser ByteString (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
day Parser ByteString (TimeOfDay -> LocalTime)
-> Parser ByteString Char
-> Parser ByteString (TimeOfDay -> LocalTime)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
AttoB8.char Char
' ' Parser ByteString (TimeOfDay -> LocalTime)
-> Parser ByteString TimeOfDay -> Parser LocalTime
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString TimeOfDay
timeOfDay

{- |
  An Attoparsec parser for parsing 'Time.TimeOfDay' from an ISO-8601 style time.

@since 1.0.0.0
-}
timeOfDay :: AttoB8.Parser Time.TimeOfDay
timeOfDay :: Parser ByteString TimeOfDay
timeOfDay = do
  Int
h <- Parser Int
forall a. Integral a => Parser a
twoDigits Parser Int -> Parser ByteString Char -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
AttoB8.char Char
':'
  Int
m <- Parser Int
forall a. Integral a => Parser a
twoDigits
  Pico
s <- Pico -> Parser ByteString Pico -> Parser ByteString Pico
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AttoB8.option Pico
0 (Char -> Parser ByteString Char
AttoB8.char Char
':' Parser ByteString Char
-> Parser ByteString Pico -> Parser ByteString Pico
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Pico
seconds)
  Parser ByteString TimeOfDay
-> (TimeOfDay -> Parser ByteString TimeOfDay)
-> Maybe TimeOfDay
-> Parser ByteString TimeOfDay
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser ByteString TimeOfDay
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid time format") TimeOfDay -> Parser ByteString TimeOfDay
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TimeOfDay -> Parser ByteString TimeOfDay)
-> Maybe TimeOfDay -> Parser ByteString TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> Maybe TimeOfDay
Time.makeTimeOfDayValid Int
h Int
m Pico
s

{- |
  An Attoparsec parser for parsing a base-10 number. Returns the number of
  digits consumed. Based off of 'AttoB8.decimal'.

@since 1.0.0.0
-}
decimalWithCount :: Integral a => AttoB8.Parser (a, a)
decimalWithCount :: forall a. Integral a => Parser (a, a)
decimalWithCount = do
  ByteString
wrds <- (Word8 -> Bool) -> Parser ByteString
AttoBS.takeWhile1 Word8 -> Bool
AttoB8.isDigit_w8
  (a, a) -> Parser (a, a)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' a -> Word8 -> a
forall a. Integral a => a -> Word8 -> a
appendDigit a
0 ByteString
wrds, Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
wrds)

appendDigit :: Integral a => a -> Word.Word8 -> a
appendDigit :: forall a. Integral a => a -> Word8 -> a
appendDigit a
a Word8
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48)

{- |
  An Attoparsec parser for parsing 'Fixed.Pico' from SS[.sss] format. This can
  handle more resolution than PostgreSQL uses, and will truncate the seconds
  fraction if more than 12 digits are present.

@since 1.0.0.0
-}
seconds :: AttoB8.Parser Fixed.Pico
seconds :: Parser ByteString Pico
seconds = do
  Integer
s <- Parser Integer
forall a. Integral a => Parser a
twoDigits
  (Integer
dec, Integer
charCount) <- (Integer, Integer)
-> Parser (Integer, Integer) -> Parser (Integer, Integer)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AttoB8.option (Integer
0, Integer
0) (Char -> Parser ByteString Char
AttoB8.char Char
'.' Parser ByteString Char
-> Parser (Integer, Integer) -> Parser (Integer, Integer)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Integer, Integer)
forall a. Integral a => Parser (a, a)
decimalWithCount)
  if Integer
charCount Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
12
    then Pico -> Parser ByteString Pico
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pico -> Parser ByteString Pico) -> Pico -> Parser ByteString Pico
forall a b. (a -> b) -> a -> b
$ Integer -> Pico
forall k (a :: k). Integer -> Fixed a
Fixed.MkFixed (Integer -> Pico) -> Integer -> Pico
forall a b. (a -> b) -> a -> b
$ (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
12 :: Int)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
dec Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
charCount Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
12))
    else Pico -> Parser ByteString Pico
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pico -> Parser ByteString Pico) -> Pico -> Parser ByteString Pico
forall a b. (a -> b) -> a -> b
$ Integer -> Pico
forall k (a :: k). Integer -> Fixed a
Fixed.MkFixed (Integer -> Pico) -> Integer -> Pico
forall a b. (a -> b) -> a -> b
$ (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
12 :: Int)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
dec Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
charCount))