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

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_) Builder -> Builder -> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Message -> Builder
message (Log -> Message
log_message Log
log_) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
reset
 in case Log -> Level
log_level Log
log_ of
     Level
Debug -> Builder
reset Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgDefault Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgDefault Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
debug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Info -> Builder
reset Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgDefault Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgDefault Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
info Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Notice ->
       Builder
reset Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgDefault Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgGreen Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
notice Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgDefault Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Warning ->
       Builder
reset Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgDefault Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgYellow Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
warning Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgDefault Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Error ->
       Builder
bgWhite Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
pDef Builder
fgBlack Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgRed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
error Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Critical ->
       Builder
bgRed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pRed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgWhite Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
critical Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Alert ->
       Builder
bgRed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pRed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgWhite Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
alert Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m
     Level
Emergency ->
       Builder
bgRed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pRed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgWhite Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
emergency Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fgBlack Builder -> Builder -> Builder
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) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
space Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Seq Path -> Builder
renderPath (Log -> Seq Path
log_path Log
x) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Level -> Builder
level (Log -> Level
log_level Log
x) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
space Builder -> Builder -> Builder
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 = ((Seq Path -> Builder) -> Seq Path -> Builder)
-> Seq Path -> Builder
forall a. (a -> a) -> a
fix (((Seq Path -> Builder) -> Seq Path -> Builder)
 -> Seq Path -> Builder)
-> ((Seq Path -> Builder) -> Seq Path -> Builder)
-> Seq Path
-> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
defc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
keyc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Key -> Builder
key Key
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
defc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
equals Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Value -> Builder
value Value
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
space
  Seq Path
ps Seq.:|> Push Segment
s -> Seq Path -> Builder
f Seq Path
ps Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
defc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pathc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
slash Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Segment -> Builder
segment Segment
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
space
  Seq Path
Seq.Empty -> Builder
forall a. Monoid a => a
mempty

-- | Like 'renderPathColor', but without color.
renderPath :: Seq.Seq Path -> BB.Builder
{-# INLINE renderPath #-}
renderPath :: Seq Path -> Builder
renderPath = ((Seq Path -> Builder) -> Seq Path -> Builder)
-> Seq Path -> Builder
forall a. (a -> a) -> a
fix (((Seq Path -> Builder) -> Seq Path -> Builder)
 -> Seq Path -> Builder)
-> ((Seq Path -> Builder) -> Seq Path -> Builder)
-> Seq Path
-> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Key -> Builder
key Key
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
equals Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Value -> Builder
value Value
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
space
  Seq Path
ps Seq.:|> Push Segment
s -> Seq Path -> Builder
f Seq Path
ps Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
slash Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Segment -> Builder
segment Segment
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
space
  Seq Path
Seq.Empty -> Builder
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
      (BoundedPrim Word8 -> Text -> Builder)
-> BoundedPrim Word8 -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x25) BoundedPrim Word8
word8HexPercent -- '%'
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ FixedPrim Word8 -> BoundedPrim Word8
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 -> Builder
forall a. Monoid a => a
mempty
    Just (Char
hd,Text
tl) -> Text -> Builder
ehead (Char -> Text
T.singleton Char
hd) Builder -> Builder -> Builder
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
      (BoundedPrim Word8 -> Text -> Builder)
-> BoundedPrim Word8 -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isPunctuation7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8
    {-# INLINE etail #-}
    etail :: Text -> Builder
etail = BoundedPrim Word8 -> Text -> Builder
TL.encodeUtf8BuilderEscaped
      (BoundedPrim Word8 -> Text -> Builder)
-> BoundedPrim Word8 -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2d    -- '-'
                      Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x5f)   -- '_'
                  (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8)
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isPunctuation7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ FixedPrim Word8 -> BoundedPrim Word8
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 -> Builder
forall a. Monoid a => a
mempty
    Just (Char
hd,Text
tl) -> Text -> Builder
ehead (Char -> Text
T.singleton Char
hd) Builder -> Builder -> Builder
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
      (BoundedPrim Word8 -> Text -> Builder)
-> BoundedPrim Word8 -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isPunctuation7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8
    {-# INLINE etail #-}
    etail :: Text -> Builder
etail = BoundedPrim Word8 -> Text -> Builder
TL.encodeUtf8BuilderEscaped
      (BoundedPrim Word8 -> Text -> Builder)
-> BoundedPrim Word8 -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2d    -- '-'
                      Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x5f)   -- '_'
                  (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8)
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isPunctuation7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ FixedPrim Word8 -> BoundedPrim Word8
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\")"
--
-- * 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
      (BoundedPrim Word8 -> Text -> Builder)
-> BoundedPrim Word8 -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20) BoundedPrim Word8
word8HexPercent -- ' '
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x25) BoundedPrim Word8
word8HexPercent -- '%'
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB Word8 -> Bool
isControl7 BoundedPrim Word8
word8HexPercent
      (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ FixedPrim Word8 -> BoundedPrim Word8
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 = FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded
  ((\Word8
x -> (Word8
37, Word8
x)) (Word8 -> (Word8, Word8))
-> FixedPrim (Word8, Word8) -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BBP.>$< FixedPrim Word8
BBP.word8 FixedPrim Word8 -> FixedPrim Word8 -> FixedPrim (Word8, 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 (Year -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
year) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (MonthOfYear -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
month) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (MonthOfYear -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
day) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'T' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (MonthOfYear -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
hour) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (MonthOfYear -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
min') Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
     Word8 -> Builder
word8Dec_pad10 (Pico -> Word8
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Pico
sec) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
     Word32 -> Builder
word32Dec_pad100000000 (SystemTime -> Word32
Time.systemNanoseconds SystemTime
syst) Builder -> Builder -> Builder
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10 then (Builder
_zero1 Builder -> Builder -> Builder
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 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
10 -> Builder
_zero8 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
100 -> Builder
_zero7 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
1000 -> Builder
_zero6 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
10000 -> Builder
_zero5 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
100000 -> Builder
_zero4 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
1000000 -> Builder
_zero3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
10000000 -> Builder
_zero2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y
        | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
100000000 -> Builder
_zero1 Builder -> Builder -> Builder
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
32 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
47)   Bool -> Bool -> Bool
||
  (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
58 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
64)   Bool -> Bool -> Bool
||
  (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
91 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
96)   Bool -> Bool -> Bool
||
  (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
123 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
31) Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
127)

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

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