content: {-# language BangPatterns #-}
  {-# language NumericUnderscores #-}
  {-# language OverloadedStrings #-}
  {-# language PatternSynonyms #-}
  {-# language PartialTypeSignatures #-}
  {-# language TypeApplications #-}
  {-# language ViewPatterns #-}
  
  {-# options_ghc -Wno-partial-type-signatures #-}
  -- bytestring does not export Monoidal so we can't write a complete type
  -- signature for 'divide'
  
  {-# options_ghc -Wno-unused-top-binds #-}
  -- GHC considers the YMD pattern unused but we use its selectors
  
  module Rel8.Type.Builder.Time (
    calendarDiffTime,
    day,
    localTime,
    timeOfDay,
    utcTime,
  ) where
  
  -- base
  import Data.Char (chr)
  import Data.Fixed (Fixed (MkFixed), Pico)
  import Data.Int (Int32, Int64)
  import Prelude hiding ((<>))
  
  -- bytestring
  import Data.ByteString.Builder (Builder, string7)
  import Data.ByteString.Builder.Prim (
    BoundedPrim, condB, emptyB, liftFixedToBounded,
    FixedPrim, char8, int32Dec,
    (>$<), (>*<),
   )
  
  -- time
  import Data.Time.Calendar (Day, toGregorian)
  import Data.Time.Clock (UTCTime (utctDay, utctDayTime))
  import Data.Time.Format.ISO8601 (iso8601Show)
  import Data.Time.LocalTime (
    CalendarDiffTime,
    LocalTime (localDay, localTimeOfDay),
    TimeOfDay (todHour, todMin, todSec),
    timeToTimeOfDay
   )
  
  
  digit :: FixedPrim Int
  digit = (\x -> chr (x + 48)) >$< char8
  
  
  digits2 :: FixedPrim Int
  digits2 = divide (`quotRem` 10) digit digit
  
  
  digits3 :: FixedPrim Int
  digits3 = divide (`quotRem` 10) digits2 digit
  
  
  digits4 :: FixedPrim Int
  digits4 = divide (`quotRem` 10) digits3 digit
  
  
  frac :: BoundedPrim Int64
  frac = condB (== 0) emptyB $ liftFixedToBounded (char '.') <> trunc12
    where
      trunc12 =
        divide
          (`quotRem` 1_000_000)
          (fromIntegral >$< ifZero trunc6 (liftFixedToBounded digits6))
          (fromIntegral >$< nonZero trunc6)
  
      digitB = liftFixedToBounded digit
  
      digits6 = divide (`quotRem` 10) digits5 digit
      digits5 = divide (`quotRem` 10) digits4 digit
  
      trunc6 = divide (`quotRem` 100_000) digitB trunc5
      trunc5 = nonZero $ divide (`quotRem` 10_000) digitB trunc4
      trunc4 = nonZero $ divide (`quotRem` 1_000) digitB trunc3
      trunc3 = nonZero $ divide (`quotRem` 100) digitB trunc2
      trunc2 = nonZero $ divide (`quotRem` 10) digitB trunc1
      trunc1 = nonZero digitB
  
      nonZero = ifZero emptyB
      ifZero = condB (== 0)
  
  
  seconds :: BoundedPrim Pico
  seconds =
    (\(MkFixed s) -> fromIntegral s `quotRem` 1_000_000_000_000) >$<
    (liftFixedToBounded (fromIntegral >$< digits2) >*< frac)
  
  
  year :: BoundedPrim Int32
  year = condB (>= 10000) int32Dec (liftFixedToBounded (fromIntegral >$< digits4))
  
  
  day :: BoundedPrim Day
  day =
    (fromIntegral . ymdYear >$< year) <>
    liftFixedToBounded
      ( char '-' <> (ymdMonth >$< digits2) <> char '-' <> (ymdDay >$< digits2)
      )
  
  
  pattern YMD :: Integer -> Int -> Int -> Day
  pattern YMD {ymdYear, ymdMonth, ymdDay} <-
    (toGregorian -> (ymdYear, ymdMonth, ymdDay))
  
  
  timeOfDay :: BoundedPrim TimeOfDay
  timeOfDay =
    liftFixedToBounded
      ( (todHour >$< digits2) <> char ':' <> (todMin >$< digits2) <> char ':'
      ) <>
    (todSec >$< seconds)
  
  
  utcTime :: BoundedPrim UTCTime
  utcTime =
    (utctDay >$< day) <>
    liftFixedToBounded (char ' ') <>
    (timeToTimeOfDay . utctDayTime >$< timeOfDay) <>
    liftFixedToBounded (char 'Z')
  
  
  localTime :: BoundedPrim LocalTime
  localTime =
    (localDay >$< day) <>
    liftFixedToBounded (char ' ') <>
    (localTimeOfDay >$< timeOfDay)
  
  
  calendarDiffTime :: CalendarDiffTime -> Builder
  calendarDiffTime = string7 . iso8601Show
  
  
  char :: Char -> FixedPrim a
  char c = (\_ -> c) >$< char8
  
  
  (<>) :: _ => f a -> f a -> f a
  (<>) = divide (\a -> (a, a))
  infixr 6 <>
  
  
  divide :: _ => (a -> (b, c)) -> f b -> f c -> f a
  divide f a b = f >$< (a >*< b)
  