-- |
-- Module      : Net.DNSBase.Internal.Present
-- Description : TBD
-- Copyright   : (c) Viktor Dukhovni, 2026
-- License     : BSD-3-Clause
-- Maintainer  : ietf-dane@dukhovni.org
-- Stability   : unstable
module Net.DNSBase.Internal.Present
    ( -- * Presentable class
      Presentable(..)
    -- ** Builder combinators
    , presentByte
    , presentCharSep
    , presentCharSepLn
    , presentLn
    , presentSep
    , presentSepLn
    , presentSp
    , presentSpLn
    -- *** Newtype for parsing and presenting 64-bit epoch times.
    , Epoch64(..)
    -- ** Build directly to a 'String' or 'ByteString'
    , presentString
    , presentStrict
    -- ** Re-exports from "Data.ByteString.Builder"
    , Builder
    , hPutBuilder
    -- *** 'hPutBuilder' specialised to @stdout@
    , putBuilder
    ) where

import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Extra as B
import qualified Data.ByteString.Builder.Prim as P
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.IP.Builder as IP
import qualified System.IO as IO
import Data.ByteString.Builder (hPutBuilder)
import Data.ByteString.Builder.Prim ((>$<), (>*<))
import Data.String (IsString(..))
import Data.Time.Clock.System (SystemTime(..), utcToSystemTime)
import Data.Time.Format (defaultTimeLocale, parseTimeOrError)

import Net.DNSBase.Internal.Util

-- | Return DNS presentation form, as a lazy ByteString builder, taking a
-- continuation.  Since DNS record presentation form is ASCII, we don't need
-- Unicode strings, and lazy ByteString builders perform one to two orders of
-- magnitude faster.
--
-- Complex builders with nested sub-components are much more efficient when
-- constructed in continuation passing style.
--
class Presentable a where
    -- | Serialise the input value with the given continuation.
    present :: a        -- ^ Value to serialise
            -> Builder  -- ^ Continuation
            -> Builder  -- ^ Final output

    -- | Run the builder immediately, producing a lazy 'L.ByteString' with the
    -- given tail.
    presentLazy :: a -- ^ Value to serialise
                -> L.ByteString -- ^ Lazy bytestring suffix
                -> L.ByteString -- ^ Final output
    presentLazy a
a ByteString
k = AllocationStrategy -> ByteString -> Builder -> ByteString
B.toLazyByteStringWith AllocationStrategy
strat ByteString
k (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present a
a Builder
forall a. Monoid a => a
mempty
      where
        strat :: AllocationStrategy
strat = Int -> Int -> AllocationStrategy
B.safeStrategy Int
128 Int
B.smallChunkSize

instance Presentable Builder where
    present :: Builder -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>)

-- | Append a char, assumed 8-bit only.
instance Presentable Char where
    present :: Char -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Char -> Builder) -> Char -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
B.char8
    {-# INLINE present #-}

-- | Append a string, assumed ASCII.
instance Presentable String where
    present :: String -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (String -> Builder) -> String -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
B.string8
    {-# INLINE present #-}

-- | Append a 'ShortByteString' assumed already escaped to not require
-- additional escaping or quoting.
--
instance Presentable ShortByteString where
    present :: ShortByteString -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (ShortByteString -> Builder)
-> ShortByteString
-> Builder
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Builder
B.shortByteString
    {-# INLINE present #-}

instance Presentable ByteString where
    present :: ByteString -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (ByteString -> Builder) -> ByteString -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
B.byteString
    {-# INLINE present #-}

-- Append a decimal Int
instance Presentable Int where
    present :: Int -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Int -> Builder) -> Int -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
B.intDec
    {-# INLINE present #-}

-- Append a decimal Int64
instance Presentable Int64 where
    present :: Int64 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Int64 -> Builder) -> Int64 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
B.int64Dec
    {-# INLINE present #-}

-- Append a decimal Int32
instance Presentable Int32 where
    present :: Int32 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Int32 -> Builder) -> Int32 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
B.int32Dec
    {-# INLINE present #-}

-- Append a decimal Int16
instance Presentable Int16 where
    present :: Int16 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Int16 -> Builder) -> Int16 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
B.int16Dec
    {-# INLINE present #-}

-- Append a decimal Int8
instance Presentable Int8 where
    present :: Int8 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Int8 -> Builder) -> Int8 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Builder
B.int8Dec
    {-# INLINE present #-}

-- Append a decimal word8
instance Presentable Word8 where
    present :: Word8 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Word8 -> Builder) -> Word8 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Builder
B.word8Dec
    {-# INLINE present #-}

instance Presentable Word16 where
    present :: Word16 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Word16 -> Builder) -> Word16 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
B.word16Dec
    {-# INLINE present #-}

instance Presentable Word32 where
    present :: Word32 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Word32 -> Builder) -> Word32 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
B.word32Dec
    {-# INLINE present #-}

instance Presentable Word64 where
    present :: Word64 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Word64 -> Builder) -> Word64 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
B.word64Dec
    {-# INLINE present #-}

instance Presentable IP where
    present :: IP -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (IP -> Builder) -> IP -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP -> Builder
IP.ipBuilder

instance Presentable IPv4 where
    present :: IPv4 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (IPv4 -> Builder) -> IPv4 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Builder
IP.ipv4Builder

instance Presentable IPv6 where
    present :: IPv6 -> Builder -> Builder
present = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (IPv6 -> Builder) -> IPv6 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> Builder
IP.ipv6Builder

-- | Prepend a single literal byte to a continuation builder.  The
-- workhorse separator primitive that the other combinators
-- ('presentSep', 'presentSp', 'presentLn', ...) are built on.
presentByte :: Word8 -> Builder -> Builder
presentByte :: Word8 -> Builder -> Builder
presentByte = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Word8 -> Builder) -> Word8 -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Builder
B.word8
{-# INLINE presentByte #-}

-- | Append the presentation of @a@ followed by a newline (@\\n@,
-- 0x0a).  Use this to terminate each record when emitting a
-- zone-file-style stream, as in
-- @foldr presentLn mempty records@.
presentLn :: Presentable a => a -> Builder -> Builder
presentLn :: forall a. Presentable a => a -> Builder -> Builder
presentLn a
a = a -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present a
a (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Builder -> Builder
presentByte Word8
0x0a
{-# INLINE presentLn #-}

-- | Append with a leading separator
presentSep :: Presentable a => Word8 -> a -> Builder -> Builder
presentSep :: forall a. Presentable a => Word8 -> a -> Builder -> Builder
presentSep Word8
sep a
a = Word8 -> Builder -> Builder
presentByte Word8
sep (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present a
a
{-# INLINE presentSep #-}

-- | Append with a leading separator and a trailing newline
presentSepLn :: Presentable a => Word8 -> a -> Builder -> Builder
presentSepLn :: forall a. Presentable a => Word8 -> a -> Builder -> Builder
presentSepLn Word8
sep a
a = Word8 -> Builder -> Builder
presentByte Word8
sep (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentLn a
a
{-# INLINE presentSepLn #-}

-- | Append with a leading 'Char' octet separator
presentCharSep :: Presentable a => Char -> a -> Builder -> Builder
presentCharSep :: forall a. Presentable a => Char -> a -> Builder -> Builder
presentCharSep Char
sep a
a = Char -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Char
sep (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present a
a
{-# INLINE presentCharSep #-}

-- | Append with a leading separator and a trailing newline
presentCharSepLn :: Presentable a => Char -> a -> Builder -> Builder
presentCharSepLn :: forall a. Presentable a => Char -> a -> Builder -> Builder
presentCharSepLn Char
sep a
a = Char -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Char
sep (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentLn a
a
{-# INLINE presentCharSepLn #-}

-- | Append with a leading space
presentSp :: Presentable a => a -> Builder -> Builder
presentSp :: forall a. Presentable a => a -> Builder -> Builder
presentSp = Word8 -> a -> Builder -> Builder
forall a. Presentable a => Word8 -> a -> Builder -> Builder
presentSep Word8
0x20
{-# INLINE presentSp #-}

-- | Append with a leading space and a trailing newline
presentSpLn :: Presentable a => a -> Builder -> Builder
presentSpLn :: forall a. Presentable a => a -> Builder -> Builder
presentSpLn a
a = Word8 -> Builder -> Builder
presentByte Word8
0x20 (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentLn a
a
{-# INLINE presentSpLn #-}

-- | Immediately construct a strict 'ByteString' from the input followed by
-- the given lazy 'L.ByteString' tail.
presentStrict :: Presentable a => a -> L.ByteString -> ByteString
presentStrict :: forall a. Presentable a => a -> ByteString -> ByteString
presentStrict a
a = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString -> ByteString
forall a. Presentable a => a -> ByteString -> ByteString
presentLazy a
a

-- | Immediately construct a 'String' from the input followed by the given
-- tail.
presentString :: Presentable a => a -> String -> String
presentString :: forall a. Presentable a => a -> String -> String
presentString a
a String
k = ByteString -> String
L8.unpack (a -> ByteString -> ByteString
forall a. Presentable a => a -> ByteString -> ByteString
presentLazy a
a ByteString
forall a. Monoid a => a
mempty) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k

-- | Execute the Builder writing output to @IO.stdout@.
-- Typically, @stdout@ should be set in 'IO.BinaryMode' with
-- 'IO.BlockBuffering'.  See 'IO.hSetBinaryMode' and
-- 'IO.hSetBuffering' for details.
--
putBuilder :: Builder -> IO ()
putBuilder :: Builder -> IO ()
putBuilder = Handle -> Builder -> IO ()
hPutBuilder Handle
IO.stdout

-- | 64-bit extended representation of 32-bit DNS clock-arithmetic types.
-- The presentation form is as a YYYYMMDDHHMMSS string.
newtype Epoch64 = Epoch64 Int64
    deriving newtype (Epoch64 -> Epoch64 -> Bool
(Epoch64 -> Epoch64 -> Bool)
-> (Epoch64 -> Epoch64 -> Bool) -> Eq Epoch64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Epoch64 -> Epoch64 -> Bool
== :: Epoch64 -> Epoch64 -> Bool
$c/= :: Epoch64 -> Epoch64 -> Bool
/= :: Epoch64 -> Epoch64 -> Bool
Eq, Eq Epoch64
Eq Epoch64 =>
(Epoch64 -> Epoch64 -> Ordering)
-> (Epoch64 -> Epoch64 -> Bool)
-> (Epoch64 -> Epoch64 -> Bool)
-> (Epoch64 -> Epoch64 -> Bool)
-> (Epoch64 -> Epoch64 -> Bool)
-> (Epoch64 -> Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64 -> Epoch64)
-> Ord Epoch64
Epoch64 -> Epoch64 -> Bool
Epoch64 -> Epoch64 -> Ordering
Epoch64 -> Epoch64 -> Epoch64
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Epoch64 -> Epoch64 -> Ordering
compare :: Epoch64 -> Epoch64 -> Ordering
$c< :: Epoch64 -> Epoch64 -> Bool
< :: Epoch64 -> Epoch64 -> Bool
$c<= :: Epoch64 -> Epoch64 -> Bool
<= :: Epoch64 -> Epoch64 -> Bool
$c> :: Epoch64 -> Epoch64 -> Bool
> :: Epoch64 -> Epoch64 -> Bool
$c>= :: Epoch64 -> Epoch64 -> Bool
>= :: Epoch64 -> Epoch64 -> Bool
$cmax :: Epoch64 -> Epoch64 -> Epoch64
max :: Epoch64 -> Epoch64 -> Epoch64
$cmin :: Epoch64 -> Epoch64 -> Epoch64
min :: Epoch64 -> Epoch64 -> Epoch64
Ord, Int -> Epoch64
Epoch64 -> Int
Epoch64 -> [Epoch64]
Epoch64 -> Epoch64
Epoch64 -> Epoch64 -> [Epoch64]
Epoch64 -> Epoch64 -> Epoch64 -> [Epoch64]
(Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64)
-> (Int -> Epoch64)
-> (Epoch64 -> Int)
-> (Epoch64 -> [Epoch64])
-> (Epoch64 -> Epoch64 -> [Epoch64])
-> (Epoch64 -> Epoch64 -> [Epoch64])
-> (Epoch64 -> Epoch64 -> Epoch64 -> [Epoch64])
-> Enum Epoch64
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Epoch64 -> Epoch64
succ :: Epoch64 -> Epoch64
$cpred :: Epoch64 -> Epoch64
pred :: Epoch64 -> Epoch64
$ctoEnum :: Int -> Epoch64
toEnum :: Int -> Epoch64
$cfromEnum :: Epoch64 -> Int
fromEnum :: Epoch64 -> Int
$cenumFrom :: Epoch64 -> [Epoch64]
enumFrom :: Epoch64 -> [Epoch64]
$cenumFromThen :: Epoch64 -> Epoch64 -> [Epoch64]
enumFromThen :: Epoch64 -> Epoch64 -> [Epoch64]
$cenumFromTo :: Epoch64 -> Epoch64 -> [Epoch64]
enumFromTo :: Epoch64 -> Epoch64 -> [Epoch64]
$cenumFromThenTo :: Epoch64 -> Epoch64 -> Epoch64 -> [Epoch64]
enumFromThenTo :: Epoch64 -> Epoch64 -> Epoch64 -> [Epoch64]
Enum, Epoch64
Epoch64 -> Epoch64 -> Bounded Epoch64
forall a. a -> a -> Bounded a
$cminBound :: Epoch64
minBound :: Epoch64
$cmaxBound :: Epoch64
maxBound :: Epoch64
Bounded, Integer -> Epoch64
Epoch64 -> Epoch64
Epoch64 -> Epoch64 -> Epoch64
(Epoch64 -> Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64)
-> (Integer -> Epoch64)
-> Num Epoch64
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Epoch64 -> Epoch64 -> Epoch64
+ :: Epoch64 -> Epoch64 -> Epoch64
$c- :: Epoch64 -> Epoch64 -> Epoch64
- :: Epoch64 -> Epoch64 -> Epoch64
$c* :: Epoch64 -> Epoch64 -> Epoch64
* :: Epoch64 -> Epoch64 -> Epoch64
$cnegate :: Epoch64 -> Epoch64
negate :: Epoch64 -> Epoch64
$cabs :: Epoch64 -> Epoch64
abs :: Epoch64 -> Epoch64
$csignum :: Epoch64 -> Epoch64
signum :: Epoch64 -> Epoch64
$cfromInteger :: Integer -> Epoch64
fromInteger :: Integer -> Epoch64
Num, Num Epoch64
Ord Epoch64
(Num Epoch64, Ord Epoch64) => (Epoch64 -> Rational) -> Real Epoch64
Epoch64 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Epoch64 -> Rational
toRational :: Epoch64 -> Rational
Real, Enum Epoch64
Real Epoch64
(Real Epoch64, Enum Epoch64) =>
(Epoch64 -> Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64 -> Epoch64)
-> (Epoch64 -> Epoch64 -> (Epoch64, Epoch64))
-> (Epoch64 -> Epoch64 -> (Epoch64, Epoch64))
-> (Epoch64 -> Integer)
-> Integral Epoch64
Epoch64 -> Integer
Epoch64 -> Epoch64 -> (Epoch64, Epoch64)
Epoch64 -> Epoch64 -> Epoch64
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Epoch64 -> Epoch64 -> Epoch64
quot :: Epoch64 -> Epoch64 -> Epoch64
$crem :: Epoch64 -> Epoch64 -> Epoch64
rem :: Epoch64 -> Epoch64 -> Epoch64
$cdiv :: Epoch64 -> Epoch64 -> Epoch64
div :: Epoch64 -> Epoch64 -> Epoch64
$cmod :: Epoch64 -> Epoch64 -> Epoch64
mod :: Epoch64 -> Epoch64 -> Epoch64
$cquotRem :: Epoch64 -> Epoch64 -> (Epoch64, Epoch64)
quotRem :: Epoch64 -> Epoch64 -> (Epoch64, Epoch64)
$cdivMod :: Epoch64 -> Epoch64 -> (Epoch64, Epoch64)
divMod :: Epoch64 -> Epoch64 -> (Epoch64, Epoch64)
$ctoInteger :: Epoch64 -> Integer
toInteger :: Epoch64 -> Integer
Integral)

-- | Parse DNSSEC YYYYmmddHHMMSS time format to 'Epoch64' value
instance IsString Epoch64 where
    fromString :: String -> Epoch64
fromString = Int64 -> Epoch64
forall a b. Coercible a b => a -> b
coerce (Int64 -> Epoch64) -> (String -> Int64) -> String -> Epoch64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Int64
systemSeconds (SystemTime -> Int64) -> (String -> SystemTime) -> String -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> SystemTime
utcToSystemTime (UTCTime -> SystemTime)
-> (String -> UTCTime) -> String -> SystemTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UTCTime
parseUTC
      where
        parseUTC :: String -> UTCTime
parseUTC = Bool -> TimeLocale -> String -> String -> UTCTime
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
False TimeLocale
defaultTimeLocale String
"%Y%m%d%H%M%S"

instance Show Epoch64 where
    showsPrec :: Int -> Epoch64 -> String -> String
showsPrec Int
_ Epoch64
e = Char -> String -> String
showChar Char
'"' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Epoch64 -> String -> String
forall a. Presentable a => a -> String -> String
presentString Epoch64
e (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
'"'

instance Presentable Epoch64 where
    -- <http://howardhinnant.github.io/date_algorithms.html>
    -- (years prior 1000 are not supported).
    -- This avoids all the pain of converting epoch time to NominalDiffTime ->
    -- UTCTime -> LocalTime then using formatTime with defaultTimeLocale!
    -- >>> :{
    -- let testVector :: [(String, Epoch64)]
    --     testVector =
    --         [ ( "19230704085602", -1467299038)
    --         , ( "19331017210945", -1142563815)
    --         , ( "19480919012827", -671668293 )
    --         , ( "19631210171455", -191227505 )
    --         , ( "20060819001740", 1155946660 )
    --         , ( "20180723061122", 1532326282 )
    --         , ( "20281019005024", 1855529424 )
    --         , ( "20751108024632", 3340406792 )
    --         , ( "21240926071415", 4883008455 )
    --         , ( "21270331070215", 4962150135 )
    --         , ( "21371220015305", 5300560385 )
    --         , ( "21680118121052", 6249787852 )
    --         , ( "21811012210032", 6683202032 )
    --         , ( "22060719093224", 7464648744 )
    --         , ( "22100427121648", 7583717808 )
    --         , ( "22530821173957", 8950757997 )
    --         , ( "23010804210243", 10463979763)
    --         , ( "23441111161706", 11829514626)
    --         , ( "23750511175551", 12791843751)
    --         , ( "23860427060801", 13137746881) ]
    --  in (==) <$> map (flip presentString "" . snd) <*> map fst $ testVector
    -- :}
    -- True
    --
    present :: Epoch64 -> Builder -> Builder
present (Epoch64 Int64
t) Builder
k =
        Int64 -> Builder
B.int64Dec Int64
year
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
forall a. Integral a => a -> Builder
pad2 Int64
mon
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
forall a. Integral a => a -> Builder
pad2 Int64
day
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
forall a. Integral a => a -> Builder
pad2 Int64
hh
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
forall a. Integral a => a -> Builder
pad2 Int64
mm
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
forall a. Integral a => a -> Builder
pad2 Int64
ss
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
k
      where
        (!Int64
z0, !Int64
s) = Int64
t Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
86400
        !z :: Int64
z = Int64
z0 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
719468
        (!Int64
era, !Int64
doe) = Int64
z Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
146097
        !yoe :: Int64
yoe = (Int64
doe Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
doe Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
1460 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
doe Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
36524
                   Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
doe Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
146096) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
365
        !y :: Int64
y = Int64
yoe Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
era Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
400
        !doy :: Int64
doy = Int64
doe Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- (Int64
365Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
yoe Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
yoe Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
yoe Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
100)
        !mp :: Int64
mp = (Int64
5Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
doy Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
153
        !day :: Int64
day = Int64
doy Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- (Int64
153Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
mp Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
5 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
        !mon :: Int64
mon = Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int64
mp Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`rem` Int64
12
        !year :: Int64
year = Int64
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int64
12 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
mon) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
10
        (!Int64
hh, (!Int64
mm, !Int64
ss)) = (Int64 -> Int64 -> (Int64, Int64))
-> Int64 -> Int64 -> (Int64, Int64)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
divMod Int64
60 (Int64 -> (Int64, Int64))
-> (Int64, Int64) -> (Int64, (Int64, Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64
s Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
3600

        pad2 :: Integral a => a -> Builder
        pad2 :: forall a. Integral a => a -> Builder
pad2 = BoundedPrim Word8 -> Word8 -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word8
w2 (Word8 -> Builder) -> (a -> Word8) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
          where
            w2 :: BoundedPrim Word8
w2 = (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB
                   do (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
9)
                   do P.word8Dec
                   do ((), ) (Word8 -> ((), Word8))
-> BoundedPrim ((), Word8) -> BoundedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (Word8 -> () -> Word8
forall a b. a -> b -> a
const Word8
0x30 (() -> Word8) -> BoundedPrim Word8 -> BoundedPrim ()
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded FixedPrim Word8
P.word8) BoundedPrim () -> BoundedPrim Word8 -> BoundedPrim ((), Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word8
P.word8Dec