{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Df1.Render
 ( log
 , logColorANSI
 , key
 , message
 , iso8601
 , segment
 , value
 ) where

import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Builder.Prim as BBP
import Data.Function (fix)
import Data.Semigroup ((<>))
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Time as Time
import qualified Data.Time.Clock.System as Time
import Data.Word (Word8, Word32)
import Prelude hiding (log, filter, error)

import Df1.Types
 (Log(log_time, log_level, log_path, log_message),
  Level(Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency),
  Path(Attr, Push),
  Segment, unSegment,
  Key, unKey,
  Value, unValue, ToValue,
  Message, unMessage)
import qualified Df1.Types (value)

--------------------------------------------------------------------------------

-- | Like 'log', but with ANSI colors.
logColorANSI :: Log -> BB.Builder
{-# INLINABLE logColorANSI #-}
logColorANSI :: Log -> Builder
logColorANSI = \Log
log_ ->
 let t :: Builder
t = SystemTime -> Builder
iso8601 (Log -> SystemTime
log_time Log
log_) forall a. Semigroup a => a -> a -> a
<> Builder
space
     pDef :: Builder -> Builder
pDef = \Builder
fg -> Builder -> Builder -> Builder -> Seq Path -> Builder
renderPathColor Builder
fg Builder
fgBlue Builder
fgCyan (Log -> Seq Path
log_path Log
log_)
     pRed :: Builder
pRed = Builder -> Builder -> Builder -> Seq Path -> Builder
renderPathColor Builder
fgBlack Builder
fgWhite Builder
fgCyan (Log -> Seq Path
log_path Log
log_)
     m :: Builder
m = Builder
space forall a. Semigroup a => a -> a -> a
<> Message -> Builder
message (Log -> Message
log_message Log
log_) forall a. Semigroup a => a -> a -> a
<> Builder
reset
 in case Log -> Level
log_level Log
log_ of
     Level
Debug -> Builder
reset forall a. Semigroup a => a -> a -> a
<> Builder
t forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgDefault forall a. Semigroup a => a -> a -> a
<> Builder
fgDefault forall a. Semigroup a => a -> a -> a
<> Builder
debug forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Info -> Builder
reset forall a. Semigroup a => a -> a -> a
<> Builder
t forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgDefault forall a. Semigroup a => a -> a -> a
<> Builder
fgDefault forall a. Semigroup a => a -> a -> a
<> Builder
info forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Notice ->
       Builder
reset forall a. Semigroup a => a -> a -> a
<> Builder
t forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgDefault forall a. Semigroup a => a -> a -> a
<> Builder
fgGreen forall a. Semigroup a => a -> a -> a
<> Builder
notice forall a. Semigroup a => a -> a -> a
<> Builder
fgDefault forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Warning ->
       Builder
reset forall a. Semigroup a => a -> a -> a
<> Builder
t forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgDefault forall a. Semigroup a => a -> a -> a
<> Builder
fgYellow forall a. Semigroup a => a -> a -> a
<> Builder
warning forall a. Semigroup a => a -> a -> a
<> Builder
fgDefault forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Error ->
       Builder
bgWhite forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
t forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
fgRed forall a. Semigroup a => a -> a -> a
<> Builder
error forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Critical ->
       Builder
bgRed forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
t forall a. Semigroup a => a -> a -> a
<> Builder
pRed forall a. Semigroup a => a -> a -> a
<> Builder
fgWhite forall a. Semigroup a => a -> a -> a
<> Builder
critical forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Alert ->
       Builder
bgRed forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
t forall a. Semigroup a => a -> a -> a
<> Builder
pRed forall a. Semigroup a => a -> a -> a
<> Builder
fgWhite forall a. Semigroup a => a -> a -> a
<> Builder
alert forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Emergency ->
       Builder
bgRed forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
t forall a. Semigroup a => a -> a -> a
<> Builder
pRed forall a. Semigroup a => a -> a -> a
<> Builder
fgWhite forall a. Semigroup a => a -> a -> a
<> Builder
emergency forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack forall a. Semigroup a => a -> a -> a
<> Builder
m

-- | Renders a 'Log' on its own line. Doesn't include a trailing newline character.
--
-- For example:
--
-- @
-- 2019-11-15T18:05:54.949470902Z NOTICE Welcome to my program!
-- 2019-11-15T18:05:54.949623731Z \/initialization NOTICE Starting web server
-- 2019-11-15T18:05:54.949630205Z \/initialization ALERT Disk is almost full!!!
-- 2019-11-15T18:05:54.949640299Z \/server port=80 INFO Listening for new clients
-- 2019-11-15T18:05:54.949652133Z \/server port=80 \/handler client-address=10.0.0.8 INFO Connection established
-- 2019-11-15T18:05:54.949664482Z \/server port=80 \/handler client-address=10.0.0.8 WARNING user error (Oops!)
-- @
log :: Log -> BB.Builder
{-# INLINABLE log #-}
log :: Log -> Builder
log = \Log
x ->
  SystemTime -> Builder
iso8601 (Log -> SystemTime
log_time Log
x) forall a. Semigroup a => a -> a -> a
<> Builder
space forall a. Semigroup a => a -> a -> a
<>
  Seq Path -> Builder
renderPath (Log -> Seq Path
log_path Log
x) forall a. Semigroup a => a -> a -> a
<>
  Level -> Builder
level (Log -> Level
log_level Log
x) forall a. Semigroup a => a -> a -> a
<> Builder
space forall a. Semigroup a => a -> a -> a
<>
  Message -> Builder
message (Log -> Message
log_message Log
x)

-- | @'renderPathColor' a b c p@ renders @p@ using @a@ as the default color (for
-- things like whitespace or attribute values), @b@ as the color for path names,
-- and @c@ as the color for attribute keys. This adds a trailing whitespace if
-- necessary.
renderPathColor
  :: BB.Builder -> BB.Builder -> BB.Builder -> Seq.Seq Path -> BB.Builder
{-# INLINE renderPathColor #-}
renderPathColor :: Builder -> Builder -> Builder -> Seq Path -> Builder
renderPathColor Builder
defc Builder
pathc Builder
keyc = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \Seq Path -> Builder
f -> \case
  Seq Path
ps Seq.:|> Attr Key
k Value
v ->
    Seq Path -> Builder
f Seq Path
ps forall a. Semigroup a => a -> a -> a
<> Builder
defc forall a. Semigroup a => a -> a -> a
<> Builder
keyc forall a. Semigroup a => a -> a -> a
<> Key -> Builder
key Key
k forall a. Semigroup a => a -> a -> a
<>
    Builder
defc forall a. Semigroup a => a -> a -> a
<> Builder
equals forall a. Semigroup a => a -> a -> a
<> Value -> Builder
value Value
v forall a. Semigroup a => a -> a -> a
<> Builder
space
  Seq Path
ps Seq.:|> Push Segment
s -> Seq Path -> Builder
f Seq Path
ps forall a. Semigroup a => a -> a -> a
<> Builder
defc forall a. Semigroup a => a -> a -> a
<> Builder
pathc forall a. Semigroup a => a -> a -> a
<> Builder
slash forall a. Semigroup a => a -> a -> a
<> Segment -> Builder
segment Segment
s forall a. Semigroup a => a -> a -> a
<> Builder
space
  Seq Path
Seq.Empty -> forall a. Monoid a => a
mempty

-- | Like 'renderPathColor', but without color.
renderPath :: Seq.Seq Path -> BB.Builder
{-# INLINE renderPath #-}
renderPath :: Seq Path -> Builder
renderPath = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \Seq Path -> Builder
f -> \case
  Seq Path
ps Seq.:|> Attr Key
k Value
v -> Seq Path -> Builder
f Seq Path
ps forall a. Semigroup a => a -> a -> a
<> Key -> Builder
key Key
k forall a. Semigroup a => a -> a -> a
<> Builder
equals forall a. Semigroup a => a -> a -> a
<> Value -> Builder
value Value
v forall a. Semigroup a => a -> a -> a
<> Builder
space
  Seq Path
ps Seq.:|> Push Segment
s -> Seq Path -> Builder
f Seq Path
ps forall a. Semigroup a => a -> a -> a
<> Builder
slash forall a. Semigroup a => a -> a -> a
<> Segment -> Builder
segment Segment
s forall a. Semigroup a => a -> a -> a
<> Builder
space
  Seq Path
Seq.Empty -> forall a. Monoid a => a
mempty

-- | Escaping rules for 'Segment':
--
-- * A \'%\' anywhere is always percent-escaped (\"%25\")
--
-- * An ASCII-7 control character anywhere is always percent-escaped.
--
-- The output is encoded as UTF-8.
message :: Message -> BB.Builder
{-# INLINE message #-}
message :: Message -> Builder
message Message
x = Text -> Builder
eall (Message -> Text
unMessage Message
x)
  where
    {-# INLINE eall #-}
    eall :: Text -> Builder
eall = BoundedPrim Word8 -> Text -> Builder
TL.encodeUtf8BuilderEscaped
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (forall a. Eq a => a -> a -> Bool
== Word8
37) BoundedPrim Word8
word8HexPercent  -- '%'
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8

-- | Escaping rules for 'Segment':
--
-- * An ASCII-7 punctuation character as first character is always percent-escaped.
--
-- * An ASCII-7 punctuation character anywhere else is always percent-escaped, unless it is
--   \'-\' or \'_\'.
--
-- * An ASCII-7 control character anywhere is always percent-escaped.
--
-- The output is encoded as UTF-8.
segment :: Segment -> BB.Builder
{-# INLINE segment #-}
segment :: Segment -> Builder
segment Segment
x = case Text -> Maybe (Char, Text)
TL.uncons (Segment -> Text
unSegment Segment
x) of
    Maybe (Char, Text)
Nothing -> forall a. Monoid a => a
mempty
    Just (Char
hd,Text
tl) -> Text -> Builder
ehead (Char -> Text
T.singleton Char
hd) forall a. Semigroup a => a -> a -> a
<> Text -> Builder
etail Text
tl
  where
    {-# INLINE ehead #-}
    ehead :: Text -> Builder
ehead = BoundedPrim Word8 -> Text -> Builder
T.encodeUtf8BuilderEscaped
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isPunctuation7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8
    {-# INLINE etail #-}
    etail :: Text -> Builder
etail = BoundedPrim Word8 -> Text -> Builder
TL.encodeUtf8BuilderEscaped
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (\Word8
w -> Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x2d    -- '-'
                      Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x5f)   -- '_'
                  (forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8)
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isPunctuation7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8

-- | Escaping rules for 'Key':
--
-- * An ASCII-7 control character is always percent-escaped.
--
-- * An ASCII-7 punctuation character is always percent-escaped.
--
-- * An ASCII-7 punctuation character anywhere else is always percent-escaped, unless it is
--   \'-\' or \'_\'.
--
-- The output is encoded as UTF-8.
key :: Key -> BB.Builder
{-# INLINE key #-}
key :: Key -> Builder
key Key
x = case Text -> Maybe (Char, Text)
TL.uncons (Key -> Text
unKey Key
x) of
    Maybe (Char, Text)
Nothing -> forall a. Monoid a => a
mempty
    Just (Char
hd,Text
tl) -> Text -> Builder
ehead (Char -> Text
T.singleton Char
hd) forall a. Semigroup a => a -> a -> a
<> Text -> Builder
etail Text
tl
  where
    {-# INLINE ehead #-}
    ehead :: Text -> Builder
ehead = BoundedPrim Word8 -> Text -> Builder
T.encodeUtf8BuilderEscaped
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isPunctuation7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8
    {-# INLINE etail #-}
    etail :: Text -> Builder
etail = BoundedPrim Word8 -> Text -> Builder
TL.encodeUtf8BuilderEscaped
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (\Word8
w -> Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x2d    -- '-'
                      Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x5f)   -- '_'
                  (forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8)
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isPunctuation7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8

-- | Escaping rules for 'Value':
--
-- * A \' \' anywhere is always percent-escaped (\"%20\").
--
-- * A \'%\' anywhere is always percent-escaped (\"%25\")"
--
-- * A \'=\' anywhere is always percent-escaped (\"%3d\").
--
-- * An ASCII-7 control character anywhere is always percent-escaped.
--
-- The output is encoded as UTF-8.
value :: Value -> BB.Builder
{-# INLINE value #-}
value :: Value -> Builder
value Value
x = Text -> Builder
eall (Value -> Text
unValue Value
x)
  where
    {-# INLINE eall #-}
    eall :: Text -> Builder
eall = BoundedPrim Word8 -> Text -> Builder
TL.encodeUtf8BuilderEscaped
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (forall a. Eq a => a -> a -> Bool
== Word8
0x20) BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (forall a. Eq a => a -> a -> Bool
== Word8
0x25) BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (forall a. Eq a => a -> a -> Bool
== Word8
0x3d) BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      forall a b. (a -> b) -> a -> b
$ forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8

--------------------------------------------------------------------------------
-- Some hardcoded stuff we use time and time again

debug :: BB.Builder
debug :: Builder
debug = String -> Builder
BB.string7 String
"DEBUG"
{-# INLINE debug #-}

info :: BB.Builder
info :: Builder
info = String -> Builder
BB.string7 String
"INFO"
{-# INLINE info #-}

notice :: BB.Builder
notice :: Builder
notice = String -> Builder
BB.string7 String
"NOTICE"
{-# INLINE notice #-}

warning :: BB.Builder
warning :: Builder
warning = String -> Builder
BB.string7 String
"WARNING"
{-# INLINE warning #-}

error :: BB.Builder
error :: Builder
error = String -> Builder
BB.string7 String
"ERROR"
{-# INLINE error #-}

critical :: BB.Builder
critical :: Builder
critical = String -> Builder
BB.string7 String
"CRITICAL"
{-# INLINE critical #-}

alert :: BB.Builder
alert :: Builder
alert = String -> Builder
BB.string7 String
"ALERT"
{-# INLINE alert #-}

emergency :: BB.Builder
emergency :: Builder
emergency = String -> Builder
BB.string7 String
"EMERGENCY"
{-# INLINE emergency #-}

level :: Level -> BB.Builder
{-# INLINE level #-}
level :: Level -> Builder
level = \case
  { Level
Debug -> Builder
debug; Level
Info -> Builder
info;
    Level
Notice -> Builder
notice; Level
Warning -> Builder
warning;
    Level
Error -> Builder
error; Level
Critical -> Builder
critical;
    Level
Alert -> Builder
alert; Level
Emergency -> Builder
emergency }

space :: BB.Builder
space :: Builder
space = Char -> Builder
BB.char7 Char
' '
{-# INLINE space #-}

slash :: BB.Builder
slash :: Builder
slash = Char -> Builder
BB.char7 Char
'/'
{-# INLINE slash #-}

equals :: BB.Builder
equals :: Builder
equals = Char -> Builder
BB.char7 Char
'='
{-# INLINE equals #-}

--------------------------------------------------------------------------------
-- ANSI escape codes

-- | Reset all
reset :: BB.Builder
reset :: Builder
reset = String -> Builder
BB.string7 String
"\x1b[0m"
{-# INLINE reset #-}

-- | Default foreground
fgDefault :: BB.Builder
fgDefault :: Builder
fgDefault = String -> Builder
BB.string7 String
"\x1b[39m"
{-# INLINE fgDefault #-}

-- -- | Reset background
-- bgDefault :: BB.Builder
-- bgDefault = BB.string7 "\x1b[49m"
-- {-# INLINE bgDefault #-}

-- | green foreground
fgGreen :: BB.Builder
fgGreen :: Builder
fgGreen = String -> Builder
BB.string7 String
"\x1b[32m"
{-# INLINE fgGreen #-}

-- | green foreground
fgRed :: BB.Builder
fgRed :: Builder
fgRed = String -> Builder
BB.string7 String
"\x1b[31m"
{-# INLINE fgRed #-}

-- | Yellow foreground
fgYellow :: BB.Builder
fgYellow :: Builder
fgYellow = String -> Builder
BB.string7 String
"\x1b[33m"
{-# INLINE fgYellow #-}

-- | Cyan foreground
fgCyan :: BB.Builder
fgCyan :: Builder
fgCyan = String -> Builder
BB.string7 String
"\x1b[36m"
{-# INLINE fgCyan #-}

-- | Blue foreground
fgBlue :: BB.Builder
fgBlue :: Builder
fgBlue = String -> Builder
BB.string7 String
"\x1b[34m"
{-# INLINE fgBlue #-}

-- | Black foreground
fgBlack :: BB.Builder
fgBlack :: Builder
fgBlack = String -> Builder
BB.string7 String
"\x1b[30m"
{-# INLINE fgBlack #-}

-- | White foreground
fgWhite :: BB.Builder
fgWhite :: Builder
fgWhite = String -> Builder
BB.string7 String
"\x1b[37m"
{-# INLINE fgWhite #-}

-- | Red background
bgRed :: BB.Builder
bgRed :: Builder
bgRed = String -> Builder
BB.string7 String
"\x1b[41m"
{-# INLINE bgRed #-}

-- | Red background
bgWhite :: BB.Builder
bgWhite :: Builder
bgWhite = String -> Builder
BB.string7 String
"\x1b[47m"
{-# INLINE bgWhite #-}

-- | Render @'%'@ followed by the given 'Word8' rendered as two hexadecimal
-- nibbles.
word8HexPercent :: BBP.BoundedPrim Word8
word8HexPercent :: BoundedPrim Word8
word8HexPercent = forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded
  ((\Word8
x -> (Word8
37, Word8
x)) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BBP.>$< FixedPrim Word8
BBP.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BBP.>*< FixedPrim Word8
BBP.word8HexFixed)
{-# INLINE word8HexPercent #-}

--------------------------------------------------------------------------------

-- | Renders /YYYY-MM-DDThh:mm:ss.sssssssssZ/ (nanosecond precision).
--
-- The rendered string is 30 characters long, and it's encoded as ASCII/UTF-8.
iso8601 :: Time.SystemTime -> BB.Builder
{-# INLINE iso8601 #-}
iso8601 :: SystemTime -> Builder
iso8601 SystemTime
syst =
  SystemTime -> UTCTime -> Builder
iso8601SystemTimeUTCTime SystemTime
syst (SystemTime -> UTCTime
Time.systemToUTCTime SystemTime
syst)

-- | Like 'iso8601', but takes a 'Time.UTCTime'.
iso8601UTCTime :: Time.UTCTime -> BB.Builder
{-# INLINE iso8601UTCTime #-}
iso8601UTCTime :: UTCTime -> Builder
iso8601UTCTime UTCTime
utct =
  SystemTime -> UTCTime -> Builder
iso8601SystemTimeUTCTime (UTCTime -> SystemTime
Time.utcToSystemTime UTCTime
utct) UTCTime
utct

-- | INTERNAL. Used by 'iso8601' and 'iso8601UTCTime'.
iso8601SystemTimeUTCTime :: Time.SystemTime -> Time.UTCTime -> BB.Builder
{-# INLINE iso8601SystemTimeUTCTime #-}
iso8601SystemTimeUTCTime :: SystemTime -> UTCTime -> Builder
iso8601SystemTimeUTCTime SystemTime
syst (Time.UTCTime Day
tday DiffTime
tdaytime) =
  let (Year
year, MonthOfYear
month, MonthOfYear
day) = Day -> (Year, MonthOfYear, MonthOfYear)
Time.toGregorian Day
tday
      Time.TimeOfDay MonthOfYear
hour MonthOfYear
min' Pico
sec = DiffTime -> TimeOfDay
Time.timeToTimeOfDay DiffTime
tdaytime
  in -- Notice that 'TB.decimal' RULES dispatch to faster code for smaller
     -- types (e.g., 'Word8' is faster to render than 'Int'), so we make
     -- seemingly redundant 'fromIntegral' conversions here to that effect.
     Int16 -> Builder
BB.int16Dec (forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
year) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'-' forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
month) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'-' forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
day) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'T' forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
hour) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
':' forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
min') forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
':' forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (forall a b. (RealFrac a, Integral b) => a -> b
truncate Pico
sec) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'.' forall a. Semigroup a => a -> a -> a
<>
     Word32 -> Builder
word32Dec_pad100000000 (SystemTime -> Word32
Time.systemNanoseconds SystemTime
syst) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'Z'

word8Dec_pad10 :: Word8 -> BB.Builder
{-# INLINE word8Dec_pad10 #-}
word8Dec_pad10 :: Word8 -> Builder
word8Dec_pad10 Word8
x =
  let !y :: Builder
y = Word8 -> Builder
BB.word8Dec Word8
x
  in if Word8
x forall a. Ord a => a -> a -> Bool
< Word8
10 then (Builder
_zero1 forall a. Semigroup a => a -> a -> a
<> Builder
y) else Builder
y

word32Dec_pad100000000 :: Word32 -> BB.Builder
{-# INLINE word32Dec_pad100000000 #-}
word32Dec_pad100000000 :: Word32 -> Builder
word32Dec_pad100000000 Word32
x =
  let !y :: Builder
y = Word32 -> Builder
BB.word32Dec Word32
x
  in if | Word32
x forall a. Ord a => a -> a -> Bool
< Word32
10 -> Builder
_zero8 forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x forall a. Ord a => a -> a -> Bool
< Word32
100 -> Builder
_zero7 forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x forall a. Ord a => a -> a -> Bool
< Word32
1000 -> Builder
_zero6 forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x forall a. Ord a => a -> a -> Bool
< Word32
10000 -> Builder
_zero5 forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x forall a. Ord a => a -> a -> Bool
< Word32
100000 -> Builder
_zero4 forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x forall a. Ord a => a -> a -> Bool
< Word32
1000000 -> Builder
_zero3 forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x forall a. Ord a => a -> a -> Bool
< Word32
10000000 -> Builder
_zero2 forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x forall a. Ord a => a -> a -> Bool
< Word32
100000000 -> Builder
_zero1 forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Bool
otherwise -> Builder
y

_zero1, _zero2, _zero3, _zero4, _zero5, _zero6, _zero7, _zero8 :: BB.Builder
_zero1 :: Builder
_zero1 = String -> Builder
BB.string7 String
"0"
_zero2 :: Builder
_zero2 = String -> Builder
BB.string7 String
"00"
_zero3 :: Builder
_zero3 = String -> Builder
BB.string7 String
"000"
_zero4 :: Builder
_zero4 = String -> Builder
BB.string7 String
"0000"
_zero5 :: Builder
_zero5 = String -> Builder
BB.string7 String
"00000"
_zero6 :: Builder
_zero6 = String -> Builder
BB.string7 String
"000000"
_zero7 :: Builder
_zero7 = String -> Builder
BB.string7 String
"0000000"
_zero8 :: Builder
_zero8 = String -> Builder
BB.string7 String
"00000000"
{-# INLINE _zero1 #-}
{-# INLINE _zero2 #-}
{-# INLINE _zero3 #-}
{-# INLINE _zero4 #-}
{-# INLINE _zero5 #-}
{-# INLINE _zero6 #-}
{-# INLINE _zero7 #-}
{-# INLINE _zero8 #-}

-- | 'True' for all ASCII-7 punctuation characters.
isPunctuation7 :: Word8 -> Bool
{-# INLINE isPunctuation7 #-}
isPunctuation7 :: Word8 -> Bool
isPunctuation7 Word8
w =
  (Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
32 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
47)   Bool -> Bool -> Bool
||
  (Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
58 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
64)   Bool -> Bool -> Bool
||
  (Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
91 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
96)   Bool -> Bool -> Bool
||
  (Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
123 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
126)

-- | 'True' for ASCII-7 control characters.
isControl7 :: Word8 -> Bool
{-# INLINE isControl7 #-}
isControl7 :: Word8 -> Bool
isControl7 Word8
w = (Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
31) Bool -> Bool -> Bool
|| (Word8
w forall a. Eq a => a -> a -> Bool
== Word8
127)

--------------------------------------------------------------------------------

-- | See 'iso8601'.
instance ToValue Time.SystemTime where
  value :: SystemTime -> Value
value = forall a. ToValue a => a -> Value
Df1.Types.value forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Builder
iso8601
  {-# NOINLINE value #-}

-- | See 'iso8601'.
instance ToValue Time.UTCTime where
  value :: UTCTime -> Value
value = forall a. ToValue a => a -> Value
Df1.Types.value forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Builder
iso8601UTCTime
  {-# NOINLINE value #-}