postgresql-types-0.1: src/library/PostgresqlTypes/Timetz/Time.hs
module PostgresqlTypes.Timetz.Time where
import qualified Data.Time as Time
import PostgresqlTypes.Algebra
import PostgresqlTypes.Prelude
import qualified PtrPeeker
import qualified PtrPoker.Write as Write
import qualified Test.QuickCheck as QuickCheck
import qualified TextBuilder
import qualified TimeExtras.TimeOfDay as TimeOfDay
-- | Time component of the @timetz@ type.
newtype TimetzTime = TimetzTime Int64
deriving newtype (Eq, Ord, Show)
instance Arbitrary TimetzTime where
arbitrary = TimetzTime <$> QuickCheck.choose (toMicroseconds minBound, toMicroseconds maxBound)
instance Bounded TimetzTime where
minBound = TimetzTime 0
maxBound = TimetzTime 86_400_000_000
toMicroseconds :: TimetzTime -> Int64
toMicroseconds (TimetzTime microseconds) = microseconds
toTimeOfDay :: TimetzTime -> Time.TimeOfDay
toTimeOfDay =
TimeOfDay.fromMicroseconds . fromIntegral . toMicroseconds
refineFromMicroseconds :: Int64 -> Maybe TimetzTime
refineFromMicroseconds microseconds
| microseconds >= toMicroseconds minBound && microseconds <= toMicroseconds maxBound = Just (TimetzTime microseconds)
| otherwise = Nothing
refineFromPicoseconds :: Integer -> Maybe TimetzTime
refineFromPicoseconds picoseconds =
let (microseconds, picoseconds') = divMod picoseconds 1_000_000
in if picoseconds' == 0
then refineFromMicroseconds (fromIntegral microseconds)
else Nothing
refineFromTimeOfDay :: Time.TimeOfDay -> Maybe TimetzTime
refineFromTimeOfDay (Time.TimeOfDay hours minutes picoseconds) =
let MkFixed picoseconds' = picoseconds
picoseconds'' = fromIntegral ((hours * 60 + minutes) * 60) * 1_000_000_000_000 + picoseconds'
in refineFromPicoseconds picoseconds''
-- | Clamp the overflow values to the valid range.
normalizeFromMicroseconds :: Int64 -> TimetzTime
normalizeFromMicroseconds microseconds =
if microseconds < toMicroseconds minBound
then minBound
else
if microseconds > toMicroseconds maxBound
then maxBound
else TimetzTime microseconds
normalizeFromPicoseconds :: Integer -> TimetzTime
normalizeFromPicoseconds picoseconds =
let microseconds = fromIntegral (mod (div picoseconds 1_000_000) 86_400_000_000)
in TimetzTime microseconds
normalizeFromTimeOfDay :: Time.TimeOfDay -> TimetzTime
normalizeFromTimeOfDay (Time.TimeOfDay hours minutes picoseconds) =
let MkFixed picoseconds' = picoseconds
picoseconds'' = fromIntegral ((hours * 60 + minutes) * 60) * 1_000_000_000_000 + picoseconds'
in normalizeFromPicoseconds picoseconds''
renderInTextFormat :: TimetzTime -> TextBuilder.TextBuilder
renderInTextFormat (TimetzTime microseconds) =
-- Handle the special case of 24:00:00 (86400000000 microseconds)
if microseconds == 86_400_000_000
then "24:00:00"
else
let (seconds, microseconds') = divMod microseconds 1_000_000
(minutes, seconds') = divMod seconds 60
(hours, minutes') = divMod minutes 60
in mconcat
[ TextBuilder.fixedLengthDecimal 2 hours,
":",
TextBuilder.fixedLengthDecimal 2 minutes',
":",
TextBuilder.fixedLengthDecimal 2 seconds',
if microseconds' == 0
then ""
else "." <> TextBuilder.fixedLengthDecimal 6 microseconds'
]
binaryEncoder :: TimetzTime -> Write.Write
binaryEncoder (TimetzTime microseconds) =
Write.bInt64 microseconds
binaryDecoder :: PtrPeeker.Fixed (Either DecodingError TimetzTime)
binaryDecoder =
PtrPeeker.beSignedInt8 <&> \int ->
if int < toMicroseconds minBound
then
Left
DecodingError
{ location = [],
reason =
UnsupportedValueDecodingErrorReason
"Value is less than minimum bound"
(TextBuilder.toText (TextBuilder.decimal int))
}
else
if int > toMicroseconds maxBound
then
Left
DecodingError
{ location = [],
reason =
UnsupportedValueDecodingErrorReason
"Value is greater than maximum bound"
(TextBuilder.toText (TextBuilder.decimal int))
}
else Right (TimetzTime int)