-- | 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 (Word16)
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 -> Text
formatAsLogTime (UTCTime Day
day DiffTime
time) = (Array, Int) -> Text
toText ((Array, Int) -> Text) -> (Array, Int) -> Text
forall a b. (a -> b) -> a -> b
$
  (forall s. ST s (MArray s, Int)) -> (Array, Int)
forall a. (forall s. ST s (MArray s, a)) -> (Array, a)
TA.run2 ((forall s. ST s (MArray s, Int)) -> (Array, Int))
-> (forall s. ST s (MArray s, Int)) -> (Array, Int)
forall a b. (a -> b) -> a -> b
$ do
    MArray s
buf <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
TA.new Int
19 -- length "2016-10-20 12:34:56"
    Int
_ <- MArray s -> Int -> Day -> ST s Int
forall s. MArray s -> Int -> Day -> ST s Int
writeDay MArray s
buf Int
0 Day
day
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
10 Word16
0x20 -- space
    Int
_ <- Bool -> MArray s -> Int -> TimeOfDay64 -> ST s Int
forall s. Bool -> MArray s -> Int -> TimeOfDay64 -> ST s Int
writeTimeOfDay Bool
False MArray s
buf Int
11 (DiffTime -> TimeOfDay64
diffTimeOfDay64 DiffTime
time)
    (MArray s, Int) -> ST s (MArray s, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (MArray s
buf, Int
19)
  where
    toText :: (Array, Int) -> Text
toText (Array
arr, Int
len) = Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
len
{-# INLINEABLE 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 -> Text
formatAsIso8601 (UTCTime Day
day DiffTime
time) = (Array, Int) -> Text
toText ((Array, Int) -> Text) -> (Array, Int) -> Text
forall a b. (a -> b) -> a -> b
$
  (forall s. ST s (MArray s, Int)) -> (Array, Int)
forall a. (forall s. ST s (MArray s, a)) -> (Array, a)
TA.run2 ((forall s. ST s (MArray s, Int)) -> (Array, Int))
-> (forall s. ST s (MArray s, Int)) -> (Array, Int)
forall a b. (a -> b) -> a -> b
$ do
    MArray s
buf <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
TA.new Int
33 -- length "2016-10-20 12:34:56.123456789012Z"
    Int
_ <- MArray s -> Int -> Day -> ST s Int
forall s. MArray s -> Int -> Day -> ST s Int
writeDay MArray s
buf Int
0 Day
day
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
10 Word16
0x54 -- T
    Int
next <- Bool -> MArray s -> Int -> TimeOfDay64 -> ST s Int
forall s. Bool -> MArray s -> Int -> TimeOfDay64 -> ST s Int
writeTimeOfDay Bool
True MArray s
buf Int
11 (DiffTime -> TimeOfDay64
diffTimeOfDay64 DiffTime
time)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
next Word16
0x5A -- Z
    (MArray s, Int) -> ST s (MArray s, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (MArray s
buf, Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  where
    toText :: (Array, Int) -> Text
toText (Array
arr, Int
len) = Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
len
{-# INLINEABLE formatAsIso8601 #-}

-- | Writes the @YYYY-MM-DD@ part of timestamp
writeDay :: TA.MArray s -> Int -> Day -> ST s Int
writeDay :: MArray s -> Int -> Day -> ST s Int
writeDay MArray s
buf Int
off Day
day =
  do
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0) (Int -> Word16
digit Int
y1)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word16
digit Int
y2)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Word16
digit Int
y3)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int -> Word16
digit Int
y4)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Word16
0x2d -- dash
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Word16
m1
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Word16
m2
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Word16
0x2d -- dash
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Word16
d1
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
9) Word16
d2
    Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
  where
    (Integer
yr, Int
m, Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
day
    (Int
y1, Int
ya) = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Integer
forall a. Num a => a -> a
abs Integer
yr) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
1000
    (Int
y2, Int
yb) = Int
ya Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100
    (Int
y3, Int
y4) = Int
yb Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
    T Word16
m1 Word16
m2 = Int -> T
twoDigits Int
m
    T Word16
d1 Word16
d2 = Int -> T
twoDigits Int
d
{-# INLINE writeDay #-}

-- | Write time of day, optionally with sub seconds
writeTimeOfDay :: Bool -> TA.MArray s -> Int -> TimeOfDay64 -> ST s Int
writeTimeOfDay :: Bool -> MArray s -> Int -> TimeOfDay64 -> ST s Int
writeTimeOfDay Bool
doSubSeconds MArray s
buf Int
off (TOD Int
hh Int
mm Int64
ss) =
  do
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off Word16
h1
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word16
h2
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word16
0x3A -- colon
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word16
m1
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Word16
m2
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Word16
0x3A -- colon
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Word16
s1
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Word16
s2
    if Bool
doSubSeconds Bool -> Bool -> Bool
&& Int64
frac Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
0
      then MArray s -> Int -> Int64 -> ST s Int
forall s. MArray s -> Int -> Int64 -> ST s Int
writeFracSeconds MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Int64
frac
      else Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8)
  where
    T Word16
h1 Word16
h2 = Int -> T
twoDigits Int
hh
    T Word16
m1 Word16
m2 = Int -> T
twoDigits Int
mm
    T Word16
s1 Word16
s2 = Int -> T
twoDigits (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
real)
    (Int64
real, Int64
frac) = Int64
ss Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
pico
    pico :: Int64
pico = Int64
1000000000000 -- number of picoseconds  in 1 second

writeFracSeconds :: TA.MArray s -> Int -> Int64 -> ST s Int
writeFracSeconds :: MArray s -> Int -> Int64 -> ST s Int
writeFracSeconds MArray s
buf Int
off Int64
frac =
  do
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off Word16
0x2e -- period
    if Int64
mills Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
      then do
        MArray s -> Int -> Int -> ST s Int
forall s. MArray s -> Int -> Int -> ST s Int
writeTrunc6 MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
mics)
      else do
        MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Int -> ST s ()
writeDigit6 MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
mics)
        MArray s -> Int -> Int -> ST s Int
forall s. MArray s -> Int -> Int -> ST s Int
writeTrunc6 MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
mills)
  where
    (Int64
mics, Int64
mills) = Int64
frac Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
micro
    micro :: Int64
micro = Int64
1000000 -- number of microseconds in 1 second

writeDigit6 :: TA.MArray s -> Int -> Int -> ST s ()
writeDigit6 :: MArray s -> Int -> Int -> ST s ()
writeDigit6 MArray s
buf Int
off Int
i =
  do
    MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Int -> ST s ()
writeDigit3 MArray s
buf Int
off Int
f1
    MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Int -> ST s ()
writeDigit3 MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int
f2
  where
    (Int
f1, Int
f2) = Int
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
1000
{-# INLINE writeDigit6 #-}

writeDigit3 :: TA.MArray s -> Int -> Int -> ST s ()
writeDigit3 :: MArray s -> Int -> Int -> ST s ()
writeDigit3 MArray s
buf Int
off Int
i =
  do
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off (Int -> Word16
digit Int
d1)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word16
digit Int
d2)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Word16
digit Int
d3)
  where
    (Int
d1, Int
d) = Int
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100
    (Int
d2, Int
d3) = Int
d Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
{-# INLINE writeDigit3 #-}

writeTrunc6 :: TA.MArray s -> Int -> Int -> ST s Int
writeTrunc6 :: MArray s -> Int -> Int -> ST s Int
writeTrunc6 MArray s
buf Int
off Int
i =
  if Int
f2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then MArray s -> Int -> Int -> ST s Int
forall s. MArray s -> Int -> Int -> ST s Int
writeTrunc3 MArray s
buf Int
off Int
f1
    else do
      MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Int -> ST s ()
writeDigit3 MArray s
buf Int
off Int
f1
      MArray s -> Int -> Int -> ST s Int
forall s. MArray s -> Int -> Int -> ST s Int
writeTrunc3 MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int
f2
  where
    (Int
f1, Int
f2) = Int
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
1000
{-# INLINE writeTrunc6 #-}

writeTrunc3 :: TA.MArray s -> Int -> Int -> ST s Int
writeTrunc3 :: MArray s -> Int -> Int -> ST s Int
writeTrunc3 MArray s
buf Int
off Int
i
  | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = do
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off (Int -> Word16
digit Int
d1)
    Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  | Int
d3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = do
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off (Int -> Word16
digit Int
d1)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word16
digit Int
d2)
    Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
  | Bool
otherwise = do
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off (Int -> Word16
digit Int
d1)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word16
digit Int
d2)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Word16
digit Int
d3)
    Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
  where
    (Int
d1, Int
d) = Int
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100
    (Int
d2, Int
d3) = Int
d Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
{-# INLINE writeTrunc3 #-}

-- Following code was adapted from aeson package.
--
-- Copyright:   (c) 2015-2016 Bryan O'Sullivan
-- License:     BSD3

data T = T {-# UNPACK #-} !Word16 {-# UNPACK #-} !Word16

twoDigits :: Int -> T
twoDigits :: Int -> T
twoDigits Int
a = Word16 -> Word16 -> T
T (Int -> Word16
digit Int
hi) (Int -> Word16
digit Int
lo)
  where
    (Int
hi, Int
lo) = Int
a Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10

digit :: Int -> Word16
digit :: Int -> Word16
digit Int
x = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48)

data TimeOfDay64
  = TOD
      {-# UNPACK #-} !Int
      {-# UNPACK #-} !Int
      {-# UNPACK #-} !Int64

diffTimeOfDay64 :: DiffTime -> TimeOfDay64
diffTimeOfDay64 :: DiffTime -> TimeOfDay64
diffTimeOfDay64 DiffTime
t = Int -> Int -> Int64 -> TimeOfDay64
TOD (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
h) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m) Int64
s
  where
    (Int64
h, Int64
mp) = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pico Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
3600000000000000
    (Int64
m, Int64
s) = Int64
mp Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
60000000000000
    pico :: Integer
pico = DiffTime -> Integer
forall a b. a -> b
unsafeCoerce DiffTime
t :: Integer