{-# 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 -> 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 -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
10 Word8
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 a. a -> ST s a
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
{-# 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 -> 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 -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
10 Word8
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 -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
next Word8
0x5A -- Z
    (MArray s, Int) -> ST s (MArray s, Int)
forall a. a -> ST s a
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
{-# INLINE formatAsIso8601 #-}

-- | Writes the @YYYY-MM-DD@ part of timestamp
writeDay :: TA.MArray s -> Int -> Day -> ST s Int
writeDay :: forall s. MArray s -> Int -> Day -> ST s Int
writeDay MArray s
buf Int
off Day
day =
  do
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0) (Int -> Word8
digit Int
y1)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word8
digit Int
y2)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Word8
digit Int
y3)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int -> Word8
digit Int
y4)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Word8
0x2d -- dash
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Word8
m1
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Word8
m2
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Word8
0x2d -- dash
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Word8
d1
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
9) Word8
d2
    Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
  where
    (Year
yr, Int
m, Int
d) = Day -> (Year, Int, Int)
toGregorian Day
day
    (Int
y1, Int
ya) = Year -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Year -> Year
forall a. Num a => a -> a
abs Year
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 Word8
m1 Word8
m2 = Int -> T
twoDigits Int
m
    T Word8
d1 Word8
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 :: forall s. 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 -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off Word8
h1
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
h2
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
0x3A -- colon
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
m1
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Word8
m2
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Word8
0x3A -- colon
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Word8
s1
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Word8
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 a. a -> ST s a
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 Word8
h1 Word8
h2 = Int -> T
twoDigits Int
hh
    T Word8
m1 Word8
m2 = Int -> T
twoDigits Int
mm
    T Word8
s1 Word8
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
{-# INLINE writeTimeOfDay #-}

writeFracSeconds :: TA.MArray s -> Int -> Int64 -> ST s Int
writeFracSeconds :: forall s. MArray s -> Int -> Int64 -> ST s Int
writeFracSeconds MArray s
buf Int
off Int64
frac =
  do
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off Word8
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
{-# INLINE writeFracSeconds #-}

writeDigit6 :: TA.MArray s -> Int -> Int -> ST s ()
writeDigit6 :: forall s. 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 :: forall s. MArray s -> Int -> Int -> ST s ()
writeDigit3 MArray s
buf Int
off Int
i =
  do
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off (Int -> Word8
digit Int
d1)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word8
digit Int
d2)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Word8
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 :: forall s. 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 :: forall s. 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 -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off (Int -> Word8
digit Int
d1)
    Int -> ST s Int
forall a. a -> ST s a
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 -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off (Int -> Word8
digit Int
d1)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word8
digit Int
d2)
    Int -> ST s Int
forall a. a -> ST s a
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 -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf Int
off (Int -> Word8
digit Int
d1)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word8
digit Int
d2)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
buf (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Word8
digit Int
d3)
    Int -> ST s Int
forall a. a -> ST s a
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
#if MIN_VERSION_text(2,0,0)
  {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
#else
  {-# UNPACK #-} !Word16 {-# UNPACK #-} !Word16
#endif

twoDigits :: Int -> T
twoDigits :: Int -> T
twoDigits Int
a = Word8 -> Word8 -> T
T (Int -> Word8
digit Int
hi) (Int -> Word8
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 ->
#if MIN_VERSION_text(2,0,0)
  Word8
#else
  Word16
#endif
digit :: Int -> Word8
digit Int
x = Int -> Word8
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) = Year -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
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 :: Year
pico = DiffTime -> Year
forall a b. a -> b
unsafeCoerce DiffTime
t :: Integer