module PostgresqlTypes.Timetz
  ( Timetz,

    -- * Accessors
    toTimeInMicroseconds,
    toTimeZoneInSeconds,
    toTimeOfDay,
    normalizeToTimeZone,
    refineToTimeZone,

    -- * Constructors
    normalizeFromTimeInMicrosecondsAndOffsetInSeconds,
    normalizeFromTimeOfDayAndTimeZone,
    refineFromTimeInMicrosecondsAndOffsetInSeconds,
    refineFromTimeOfDayAndTimeZone,
  )
where

import qualified Data.Attoparsec.Text as Attoparsec
import qualified Data.Text as Text
import qualified Data.Time as TimeLib
import PostgresqlTypes.Algebra
import PostgresqlTypes.Prelude
import qualified PostgresqlTypes.Timetz.Offset as Offset
import qualified PostgresqlTypes.Timetz.Time as Time
import PostgresqlTypes.Via
import qualified PtrPeeker

-- | PostgreSQL @timetz@ type. Time of day with time zone.
--
-- Stored as microseconds since midnight and time zone offset in seconds.
--
-- Low value: @00:00:00+1559@. High value: @24:00:00-1559@.
--
-- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-datetime.html#DATATYPE-TIMEZONES).
data Timetz
  = Timetz
      -- | Time as microseconds since midnight (00:00:00)
      Time.TimetzTime
      -- | Timezone offset in seconds (positive is east of UTC, negative is west of UTC)
      Offset.TimetzOffset
  deriving stock (Timetz -> Timetz -> Bool
(Timetz -> Timetz -> Bool)
-> (Timetz -> Timetz -> Bool) -> Eq Timetz
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timetz -> Timetz -> Bool
== :: Timetz -> Timetz -> Bool
$c/= :: Timetz -> Timetz -> Bool
/= :: Timetz -> Timetz -> Bool
Eq, Eq Timetz
Eq Timetz =>
(Timetz -> Timetz -> Ordering)
-> (Timetz -> Timetz -> Bool)
-> (Timetz -> Timetz -> Bool)
-> (Timetz -> Timetz -> Bool)
-> (Timetz -> Timetz -> Bool)
-> (Timetz -> Timetz -> Timetz)
-> (Timetz -> Timetz -> Timetz)
-> Ord Timetz
Timetz -> Timetz -> Bool
Timetz -> Timetz -> Ordering
Timetz -> Timetz -> Timetz
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
$ccompare :: Timetz -> Timetz -> Ordering
compare :: Timetz -> Timetz -> Ordering
$c< :: Timetz -> Timetz -> Bool
< :: Timetz -> Timetz -> Bool
$c<= :: Timetz -> Timetz -> Bool
<= :: Timetz -> Timetz -> Bool
$c> :: Timetz -> Timetz -> Bool
> :: Timetz -> Timetz -> Bool
$c>= :: Timetz -> Timetz -> Bool
>= :: Timetz -> Timetz -> Bool
$cmax :: Timetz -> Timetz -> Timetz
max :: Timetz -> Timetz -> Timetz
$cmin :: Timetz -> Timetz -> Timetz
min :: Timetz -> Timetz -> Timetz
Ord)
  deriving (Int -> Timetz -> ShowS
[Timetz] -> ShowS
Timetz -> String
(Int -> Timetz -> ShowS)
-> (Timetz -> String) -> ([Timetz] -> ShowS) -> Show Timetz
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timetz -> ShowS
showsPrec :: Int -> Timetz -> ShowS
$cshow :: Timetz -> String
show :: Timetz -> String
$cshowList :: [Timetz] -> ShowS
showList :: [Timetz] -> ShowS
Show, ReadPrec [Timetz]
ReadPrec Timetz
Int -> ReadS Timetz
ReadS [Timetz]
(Int -> ReadS Timetz)
-> ReadS [Timetz]
-> ReadPrec Timetz
-> ReadPrec [Timetz]
-> Read Timetz
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Timetz
readsPrec :: Int -> ReadS Timetz
$creadList :: ReadS [Timetz]
readList :: ReadS [Timetz]
$creadPrec :: ReadPrec Timetz
readPrec :: ReadPrec Timetz
$creadListPrec :: ReadPrec [Timetz]
readListPrec :: ReadPrec [Timetz]
Read, String -> Timetz
(String -> Timetz) -> IsString Timetz
forall a. (String -> a) -> IsString a
$cfromString :: String -> Timetz
fromString :: String -> Timetz
IsString) via (ViaIsScalar Timetz)

instance Arbitrary Timetz where
  arbitrary :: Gen Timetz
arbitrary = do
    TimetzTime
time <- Gen TimetzTime
forall a. Arbitrary a => Gen a
arbitrary
    TimetzOffset
offset <- Gen TimetzOffset
forall a. Arbitrary a => Gen a
arbitrary
    pure (TimetzTime -> TimetzOffset -> Timetz
Timetz TimetzTime
time TimetzOffset
offset)

instance Hashable Timetz where
  hashWithSalt :: Int -> Timetz -> Int
hashWithSalt Int
salt (Timetz TimetzTime
time TimetzOffset
offset) =
    Int
salt Int -> Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` TimetzTime -> Int64
Time.toMicroseconds TimetzTime
time Int -> Int32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` TimetzOffset -> Int32
Offset.toSeconds TimetzOffset
offset

instance IsScalar Timetz where
  schemaName :: Tagged Timetz (Maybe Text)
schemaName = Maybe Text -> Tagged Timetz (Maybe Text)
forall {k} (s :: k) b. b -> Tagged s b
Tagged Maybe Text
forall a. Maybe a
Nothing
  typeName :: Tagged Timetz Text
typeName = Text -> Tagged Timetz Text
forall {k} (s :: k) b. b -> Tagged s b
Tagged Text
"timetz"
  baseOid :: Tagged Timetz (Maybe Word32)
baseOid = Maybe Word32 -> Tagged Timetz (Maybe Word32)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
1266)
  arrayOid :: Tagged Timetz (Maybe Word32)
arrayOid = Maybe Word32 -> Tagged Timetz (Maybe Word32)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
1270)
  typeParams :: Tagged Timetz [Text]
typeParams = [Text] -> Tagged Timetz [Text]
forall {k} (s :: k) b. b -> Tagged s b
Tagged []

  binaryEncoder :: Timetz -> Write
binaryEncoder (Timetz TimetzTime
time TimetzOffset
offset) =
    [Write] -> Write
forall a. Monoid a => [a] -> a
mconcat
      [ TimetzTime -> Write
Time.binaryEncoder TimetzTime
time,
        TimetzOffset -> Write
Offset.binaryEncoder TimetzOffset
offset
      ]

  binaryDecoder :: Variable (Either DecodingError Timetz)
binaryDecoder =
    Fixed (Either DecodingError Timetz)
-> Variable (Either DecodingError Timetz)
forall a. Fixed a -> Variable a
PtrPeeker.fixed do
      Either DecodingError TimetzTime
time <- Fixed (Either DecodingError TimetzTime)
Time.binaryDecoder
      Either DecodingError TimetzOffset
offset <- Fixed (Either DecodingError TimetzOffset)
Offset.binaryDecoder
      pure (TimetzTime -> TimetzOffset -> Timetz
Timetz (TimetzTime -> TimetzOffset -> Timetz)
-> Either DecodingError TimetzTime
-> Either DecodingError (TimetzOffset -> Timetz)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecodingError TimetzTime
time Either DecodingError (TimetzOffset -> Timetz)
-> Either DecodingError TimetzOffset -> Either DecodingError Timetz
forall a b.
Either DecodingError (a -> b)
-> Either DecodingError a -> Either DecodingError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either DecodingError TimetzOffset
offset)

  -- Format:
  -- 23:59:59-15:59:59
  -- 24:00:00-15:59:59
  -- 00:00:00+15:59:59
  textualEncoder :: Timetz -> TextBuilder
textualEncoder (Timetz TimetzTime
time TimetzOffset
offset) =
    TimetzTime -> TextBuilder
Time.renderInTextFormat TimetzTime
time TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TimetzOffset -> TextBuilder
Offset.renderInTextFormat TimetzOffset
offset
  textualDecoder :: Parser Timetz
textualDecoder = do
    -- Parse time part: HH:MM:SS[.microseconds]
    Int
h <- Parser Text Int
twoDigits
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
':'
    Int
m <- Parser Text Int
twoDigits
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
':'
    Int
s <- Parser Text Int
twoDigits
    Int64
micros <- Int64 -> Parser Text Int64 -> Parser Text Int64
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
Attoparsec.option Int64
0 Parser Text Int64
forall {b}. Num b => Parser Text b
parseFraction
    -- Parse time zone offset: [+-]HH[:MM[:SS]]
    -- PostgreSQL omits minutes and seconds when they are zero
    Int32
sign <- (Int32
1 Int32 -> Parser Text Char -> Parser Text Int32
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
Attoparsec.char Char
'+') Parser Text Int32 -> Parser Text Int32 -> Parser Text Int32
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((-Int32
1) Int32 -> Parser Text Char -> Parser Text Int32
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
Attoparsec.char Char
'-')
    Int
tzH <- Parser Text Int
twoDigits
    Int
tzM <- Int -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
Attoparsec.option Int
0 (Char -> Parser Text Char
Attoparsec.char Char
':' Parser Text Char -> Parser Text Int -> Parser Text Int
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Int
twoDigits)
    Int
tzS <- Int -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
Attoparsec.option Int
0 (Char -> Parser Text Char
Attoparsec.char Char
':' Parser Text Char -> Parser Text Int -> Parser Text Int
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Int
twoDigits)
    -- Build time and offset
    let timeMicros :: Int64
timeMicros = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
3600_000_000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
60_000_000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1_000_000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
micros
        -- Note: PostgreSQL stores offset with inverted sign (positive means west of UTC)
        offsetSeconds :: Int32
offsetSeconds = Int32 -> Int32
forall a. Num a => a -> a
negate Int32
sign Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tzH Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
3600 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tzM Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
60 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tzS)
    case (Int64 -> Maybe TimetzTime
Time.refineFromMicroseconds Int64
timeMicros, Int32 -> Maybe TimetzOffset
Offset.refineFromSeconds Int32
offsetSeconds) of
      (Just TimetzTime
time, Just TimetzOffset
offset) -> Timetz -> Parser Timetz
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimetzTime -> TimetzOffset -> Timetz
Timetz TimetzTime
time TimetzOffset
offset)
      (Maybe TimetzTime, Maybe TimetzOffset)
_ -> String -> Parser Timetz
forall a. HasCallStack => String -> Parser Text a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"Invalid timetz value"
    where
      twoDigits :: Parser Text Int
twoDigits = do
        Char
a <- Parser Text Char
Attoparsec.digit
        Char
b <- Parser Text Char
Attoparsec.digit
        pure (Char -> Int
digitToInt Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
b)
      parseFraction :: Parser Text b
parseFraction = do
        Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
'.'
        Text
digits <- (Char -> Bool) -> Parser Text Text
Attoparsec.takeWhile1 Char -> Bool
isDigit
        let paddedDigits :: String
paddedDigits = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
6 (Text -> String
Text.unpack Text
digits String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
'0')
            micros :: b
micros = (b -> Char -> b) -> b -> String -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\b
acc Char
c -> b
acc b -> b -> b
forall a. Num a => a -> a -> a
* b
10 b -> b -> b
forall a. Num a => a -> a -> a
+ Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c)) b
0 String
paddedDigits
        pure b
micros

-- * Accessors

-- | Extract time in microseconds since midnight.
toTimeInMicroseconds :: Timetz -> Int64
toTimeInMicroseconds :: Timetz -> Int64
toTimeInMicroseconds (Timetz TimetzTime
time TimetzOffset
_) = TimetzTime -> Int64
Time.toMicroseconds TimetzTime
time

-- | Extract time zone offset in seconds.
toTimeZoneInSeconds :: Timetz -> Int32
toTimeZoneInSeconds :: Timetz -> Int32
toTimeZoneInSeconds (Timetz TimetzTime
_ TimetzOffset
offset) = TimetzOffset -> Int32
Offset.toSeconds TimetzOffset
offset

-- | Extract time of day.
toTimeOfDay :: Timetz -> TimeLib.TimeOfDay
toTimeOfDay :: Timetz -> TimeOfDay
toTimeOfDay (Timetz TimetzTime
time TimetzOffset
_) = TimetzTime -> TimeOfDay
Time.toTimeOfDay TimetzTime
time

-- | Extract time zone rounding the offset in seconds to the nearest minute, because that's the precision supported by 'TimeLib.TimeZone'.
normalizeToTimeZone :: Timetz -> TimeLib.TimeZone
normalizeToTimeZone :: Timetz -> TimeZone
normalizeToTimeZone (Timetz TimetzTime
_ TimetzOffset
offset) = TimetzOffset -> TimeZone
Offset.normalizeToTimeZone TimetzOffset
offset

-- | Try to extract time zone, failing if the offset in seconds is not a multiple of 60.
refineToTimeZone :: Timetz -> Maybe TimeLib.TimeZone
refineToTimeZone :: Timetz -> Maybe TimeZone
refineToTimeZone (Timetz TimetzTime
_ TimetzOffset
offset) = TimetzOffset -> Maybe TimeZone
Offset.refineToTimeZone TimetzOffset
offset

-- * Constructors

-- | Construct 'Timetz' from time in microseconds since midnight and time zone offset in seconds, clamping the out of range values.
normalizeFromTimeInMicrosecondsAndOffsetInSeconds :: Int64 -> Int32 -> Timetz
normalizeFromTimeInMicrosecondsAndOffsetInSeconds :: Int64 -> Int32 -> Timetz
normalizeFromTimeInMicrosecondsAndOffsetInSeconds Int64
microseconds Int32
offset =
  TimetzTime -> TimetzOffset -> Timetz
Timetz (Int64 -> TimetzTime
Time.normalizeFromMicroseconds Int64
microseconds) (Int32 -> TimetzOffset
Offset.normalizeFromSeconds Int32
offset)

-- | Construct 'Timetz' from 'TimeLib.TimeOfDay' and 'TimeLib.TimeZone', clamping the out of range values.
normalizeFromTimeOfDayAndTimeZone :: TimeLib.TimeOfDay -> TimeLib.TimeZone -> Timetz
normalizeFromTimeOfDayAndTimeZone :: TimeOfDay -> TimeZone -> Timetz
normalizeFromTimeOfDayAndTimeZone TimeOfDay
timeOfDay TimeZone
timeZone =
  let time :: TimetzTime
time = TimeOfDay -> TimetzTime
Time.normalizeFromTimeOfDay TimeOfDay
timeOfDay
      offset :: TimetzOffset
offset = TimeZone -> TimetzOffset
Offset.normalizeFromTimeZone TimeZone
timeZone
   in TimetzTime -> TimetzOffset -> Timetz
Timetz TimetzTime
time TimetzOffset
offset

-- | Try to construct 'Timetz' from time in microseconds since midnight and time zone offset in seconds, failing if out of range.
refineFromTimeInMicrosecondsAndOffsetInSeconds :: Int64 -> Int32 -> Maybe Timetz
refineFromTimeInMicrosecondsAndOffsetInSeconds :: Int64 -> Int32 -> Maybe Timetz
refineFromTimeInMicrosecondsAndOffsetInSeconds Int64
microseconds Int32
offset = do
  TimetzTime
time <- Int64 -> Maybe TimetzTime
Time.refineFromMicroseconds Int64
microseconds
  TimetzOffset
offset <- Int32 -> Maybe TimetzOffset
Offset.refineFromSeconds Int32
offset
  pure (TimetzTime -> TimetzOffset -> Timetz
Timetz TimetzTime
time TimetzOffset
offset)

-- | Try to construct 'Timetz' from 'TimeLib.TimeOfDay' and 'TimeLib.TimeZone', failing if out of range.
refineFromTimeOfDayAndTimeZone :: TimeLib.TimeOfDay -> TimeLib.TimeZone -> Maybe Timetz
refineFromTimeOfDayAndTimeZone :: TimeOfDay -> TimeZone -> Maybe Timetz
refineFromTimeOfDayAndTimeZone TimeOfDay
timeOfDay TimeZone
timeZone = do
  TimetzTime
time <- TimeOfDay -> Maybe TimetzTime
Time.refineFromTimeOfDay TimeOfDay
timeOfDay
  TimetzOffset
offset <- TimeZone -> Maybe TimetzOffset
Offset.refineFromTimeZone TimeZone
timeZone
  pure (TimetzTime -> TimetzOffset -> Timetz
Timetz TimetzTime
time TimetzOffset
offset)