content: {-# LANGUAGE CPP #-}
  
  -- | Time and memory efficient time encoding helper functions.
  module Katip.Format.Time
    ( formatAsLogTime,
      formatAsIso8601,
    )
  where
  
  import Control.Monad.ST (ST)
  import Data.Int (Int64)
  import Data.Text (Text)
  import qualified Data.Text.Array as TA
  import Data.Text.Internal (Text (..))
  import Data.Time (Day, DiffTime, UTCTime (..), toGregorian)
  import Data.Word
  #if MIN_VERSION_text(2,0,0)
    (Word8)
  #else
    (Word16)
  #endif
  import Unsafe.Coerce (unsafeCoerce)
  
  -- Note: All functions here are optimized to never allocate anything
  -- on heap. At least on ghc 8.0.1 no extra strictness annotations are
  -- seem to be needed.
  --
  -- Exported functions are INLINEABLE
  
  -- | Format 'UTCTime' into a short human readable format.
  --
  -- >>> formatAsLogTime $ UTCTime (fromGregorian 2016 1 23) 5025.123456789012
  -- "2016-01-23 01:23:45"
  formatAsLogTime :: UTCTime -> Text
  formatAsLogTime (UTCTime day time) = toText $
    TA.run2 $ do
      buf <- TA.new 19 -- length "2016-10-20 12:34:56"
      _ <- writeDay buf 0 day
      TA.unsafeWrite buf 10 0x20 -- space
      _ <- writeTimeOfDay False buf 11 (diffTimeOfDay64 time)
      return (buf, 19)
    where
      toText (arr, len) = Text arr 0 len
  {-# INLINE formatAsLogTime #-}
  
  -- | Format 'UTCTime' into a Iso8601 format.
  --
  --  Note that this function may overcommit up to 12*2 bytes, depending
  --  on sub-second precision. If this is an issue, make a copy with a
  --  'Data.Text.copy'.
  --
  -- >>> formatAsIso8601 $ UTCTime (fromGregorian 2016 1 23) 5025.123456789012
  -- "2016-11-23T01:23:45.123456789012Z"
  -- >>> formatAsIso8601 $ UTCTime (fromGregorian 2016 1 23) 5025.123
  -- "2016-01-23T01:23:45.123Z"
  -- >>> formatAsIso8601 $ UTCTime (fromGregorian 2016 1 23) 5025
  -- "2016-01-23T01:23:45Z"
  
  --
  formatAsIso8601 :: UTCTime -> Text
  formatAsIso8601 (UTCTime day time) = toText $
    TA.run2 $ do
      buf <- TA.new 33 -- length "2016-10-20 12:34:56.123456789012Z"
      _ <- writeDay buf 0 day
      TA.unsafeWrite buf 10 0x54 -- T
      next <- writeTimeOfDay True buf 11 (diffTimeOfDay64 time)
      TA.unsafeWrite buf next 0x5A -- Z
      return (buf, next + 1)
    where
      toText (arr, len) = Text arr 0 len
  {-# INLINE formatAsIso8601 #-}
  
  -- | Writes the @YYYY-MM-DD@ part of timestamp
  writeDay :: TA.MArray s -> Int -> Day -> ST s Int
  writeDay buf off day =
    do
      TA.unsafeWrite buf (off + 0) (digit y1)
      TA.unsafeWrite buf (off + 1) (digit y2)
      TA.unsafeWrite buf (off + 2) (digit y3)
      TA.unsafeWrite buf (off + 3) (digit y4)
      TA.unsafeWrite buf (off + 4) 0x2d -- dash
      TA.unsafeWrite buf (off + 5) m1
      TA.unsafeWrite buf (off + 6) m2
      TA.unsafeWrite buf (off + 7) 0x2d -- dash
      TA.unsafeWrite buf (off + 8) d1
      TA.unsafeWrite buf (off + 9) d2
      return (off + 10)
    where
      (yr, m, d) = toGregorian day
      (y1, ya) = fromIntegral (abs yr) `quotRem` 1000
      (y2, yb) = ya `quotRem` 100
      (y3, y4) = yb `quotRem` 10
      T m1 m2 = twoDigits m
      T d1 d2 = twoDigits d
  {-# INLINE writeDay #-}
  
  -- | Write time of day, optionally with sub seconds
  writeTimeOfDay :: Bool -> TA.MArray s -> Int -> TimeOfDay64 -> ST s Int
  writeTimeOfDay doSubSeconds buf off (TOD hh mm ss) =
    do
      TA.unsafeWrite buf off h1
      TA.unsafeWrite buf (off + 1) h2
      TA.unsafeWrite buf (off + 2) 0x3A -- colon
      TA.unsafeWrite buf (off + 3) m1
      TA.unsafeWrite buf (off + 4) m2
      TA.unsafeWrite buf (off + 5) 0x3A -- colon
      TA.unsafeWrite buf (off + 6) s1
      TA.unsafeWrite buf (off + 7) s2
      if doSubSeconds && frac /= 0
        then writeFracSeconds buf (off + 8) frac
        else return (off + 8)
    where
      T h1 h2 = twoDigits hh
      T m1 m2 = twoDigits mm
      T s1 s2 = twoDigits (fromIntegral real)
      (real, frac) = ss `quotRem` pico
      pico = 1000000000000 -- number of picoseconds  in 1 second
  {-# INLINE writeTimeOfDay #-}
  
  writeFracSeconds :: TA.MArray s -> Int -> Int64 -> ST s Int
  writeFracSeconds buf off frac =
    do
      TA.unsafeWrite buf off 0x2e -- period
      if mills == 0
        then do
          writeTrunc6 buf (off + 1) (fromIntegral mics)
        else do
          writeDigit6 buf (off + 1) (fromIntegral mics)
          writeTrunc6 buf (off + 7) (fromIntegral mills)
    where
      (mics, mills) = frac `quotRem` micro
      micro = 1000000 -- number of microseconds in 1 second
  {-# INLINE writeFracSeconds #-}
  
  writeDigit6 :: TA.MArray s -> Int -> Int -> ST s ()
  writeDigit6 buf off i =
    do
      writeDigit3 buf off f1
      writeDigit3 buf (off + 3) f2
    where
      (f1, f2) = i `quotRem` 1000
  {-# INLINE writeDigit6 #-}
  
  writeDigit3 :: TA.MArray s -> Int -> Int -> ST s ()
  writeDigit3 buf off i =
    do
      TA.unsafeWrite buf off (digit d1)
      TA.unsafeWrite buf (off + 1) (digit d2)
      TA.unsafeWrite buf (off + 2) (digit d3)
    where
      (d1, d) = i `quotRem` 100
      (d2, d3) = d `quotRem` 10
  {-# INLINE writeDigit3 #-}
  
  writeTrunc6 :: TA.MArray s -> Int -> Int -> ST s Int
  writeTrunc6 buf off i =
    if f2 == 0
      then writeTrunc3 buf off f1
      else do
        writeDigit3 buf off f1
        writeTrunc3 buf (off + 3) f2
    where
      (f1, f2) = i `quotRem` 1000
  {-# INLINE writeTrunc6 #-}
  
  writeTrunc3 :: TA.MArray s -> Int -> Int -> ST s Int
  writeTrunc3 buf off i
    | d == 0 = do
      TA.unsafeWrite buf off (digit d1)
      return (off + 1)
    | d3 == 0 = do
      TA.unsafeWrite buf off (digit d1)
      TA.unsafeWrite buf (off + 1) (digit d2)
      return (off + 2)
    | otherwise = do
      TA.unsafeWrite buf off (digit d1)
      TA.unsafeWrite buf (off + 1) (digit d2)
      TA.unsafeWrite buf (off + 2) (digit d3)
      return (off + 3)
    where
      (d1, d) = i `quotRem` 100
      (d2, d3) = d `quotRem` 10
  {-# INLINE writeTrunc3 #-}
  
  -- Following code was adapted from aeson package.
  --
  -- Copyright:   (c) 2015-2016 Bryan O'Sullivan
  -- License:     BSD3
  
  data T = T
  #if MIN_VERSION_text(2,0,0)
    {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
  #else
    {-# UNPACK #-} !Word16 {-# UNPACK #-} !Word16
  #endif
  
  twoDigits :: Int -> T
  twoDigits a = T (digit hi) (digit lo)
    where
      (hi, lo) = a `quotRem` 10
  
  digit :: Int ->
  #if MIN_VERSION_text(2,0,0)
    Word8
  #else
    Word16
  #endif
  digit x = fromIntegral (x + 48)
  
  data TimeOfDay64
    = TOD
        {-# UNPACK #-} !Int
        {-# UNPACK #-} !Int
        {-# UNPACK #-} !Int64
  
  diffTimeOfDay64 :: DiffTime -> TimeOfDay64
  diffTimeOfDay64 t = TOD (fromIntegral h) (fromIntegral m) s
    where
      (h, mp) = fromIntegral pico `quotRem` 3600000000000000
      (m, s) = mp `quotRem` 60000000000000
      pico = unsafeCoerce t :: Integer
  