{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

module Df1.Types
   ( Log (Log, log_time, log_level, log_path, log_message)
   , Level (Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency)
   , Path (Attr, Push)
   , ToPath (path)
   , Segment
   , unSegment
   , ToSegment (segment)
   , Key
   , unKey
   , ToKey (key)
   , Value
   , unValue
   , ToValue (value)
   , Message
   , unMessage
   , ToMessage (message)
   ) where

import Control.Exception (SomeException)
import Data.Coerce (coerce)
import qualified Data.Fixed as Fixed
import Data.Foldable (toList)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Semigroup (Semigroup ((<>)))
import Data.Sequence as Seq
import Data.String (IsString (fromString))
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Time as Time
import qualified Data.Time.Clock.System as Time
import qualified Data.Time.Format.ISO8601 as Time
import Data.Word (Word16, Word32, Word64, Word8)
import Numeric.Natural (Natural)

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

data Log = Log
   { Log -> SystemTime
log_time :: !Time.SystemTime
   -- ^ First known timestamp when the log was generated.
   --
   -- We use 'Time.SystemTime' rather than 'Time.UTCTime' because it is
   -- cheaper to obtain and to render. You can use
   -- 'Data.Time.Clock.System.systemToUTCTime' to convert it if necessary.
   , Log -> Level
log_level :: !Level
   -- ^ Importance level of the logged message.
   , Log -> Seq Path
log_path :: !(Seq.Seq Path)
   -- ^ 'Path' where the logged message was created from.
   --
   -- The leftmost 'Path' is the closest to the root. The rightmost 'Path' is
   -- the one closest to where the log was generated.
   --
   -- An 'Seq.empty' 'Seq.Seq' is acceptable, conveying the idea of the “root
   -- path”.
   , Log -> Message
log_message :: !Message
   -- ^ Human-readable message itself.
   }
   deriving (Log -> Log -> Bool
(Log -> Log -> Bool) -> (Log -> Log -> Bool) -> Eq Log
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Log -> Log -> Bool
== :: Log -> Log -> Bool
$c/= :: Log -> Log -> Bool
/= :: Log -> Log -> Bool
Eq, Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show)

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

-- | A message text.
--
-- If you have the @OverloadedStrings@ GHC extension enabled, you can build a
-- 'Message' using a string literal:
--
-- @
-- \"foo\" :: 'Message'
-- @
--
-- Otherwise, you can use 'fromString' or 'message'.
--
-- Notice that @\"\" :: 'Message'@ is acceptable, and will be correctly rendered
-- and parsed back.
newtype Message = Message TL.Text
   deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)

unMessage :: Message -> TL.Text
unMessage :: Message -> Text
unMessage = Message -> Text
forall a b. Coercible a b => a -> b
coerce
{-# INLINE unMessage #-}

instance IsString Message where
   fromString :: String -> Message
fromString = String -> Message
forall a. ToMessage a => a -> Message
message
   {-# INLINE fromString #-}

instance Semigroup Message where
   <> :: Message -> Message -> Message
(<>) = (Text -> Text -> Text) -> Message -> Message -> Message
forall a b. Coercible a b => a -> b
coerce (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) :: TL.Text -> TL.Text -> TL.Text)
   {-# INLINE (<>) #-}

instance Monoid Message where
   mempty :: Message
mempty = Text -> Message
Message Text
forall a. Monoid a => a
mempty
   {-# INLINE mempty #-}

-- | Convert an arbitrary type to a 'Message'.
--
-- You are encouraged to create custom 'ToMessage' instances for your types
-- making sure you avoid rendering sensitive details such as passwords, so that
-- they don't accidentally end up in logs.
--
-- Any characters that need to be escaped for rendering will be automatically
-- escaped at rendering time. You don't need to escape them here.
class ToMessage a where
   message :: a -> Message

-- | Identity.
instance ToMessage Message where
   message :: Message -> Message
message = Message -> Message
forall a. a -> a
id
   {-# INLINE message #-}

-- |
-- @
-- x :: 'TL.Text' == 'unMessage' ('message' x)
-- @
instance ToMessage TL.Text where
   message :: Text -> Message
message = Text -> Message
Message
   {-# INLINE message #-}

-- |
-- @
-- 'TB.toLazyText' (x :: 'TB.Builder') == 'unMessage' ('message' x)
-- @
instance ToMessage TB.Builder where
   message :: Builder -> Message
message = Text -> Message
Message (Text -> Message) -> (Builder -> Text) -> Builder -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
   {-# INLINE message #-}

-- |
-- @
-- x :: 'T.Text' == 'TL.toStrict' ('unMessage' ('message' x))
-- @
instance ToMessage T.Text where
   message :: Text -> Message
message = Text -> Message
Message (Text -> Message) -> (Text -> Text) -> Text -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
   {-# INLINE message #-}

-- |
-- @
-- x :: 'String' == 'TL.unpack' ('unMessage' ('message' x))
-- @
instance ToMessage String where
   message :: String -> Message
message = Text -> Message
Message (Text -> Message) -> (String -> Text) -> String -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
   {-# INLINE message #-}

instance ToMessage SomeException where
   message :: SomeException -> Message
message = String -> Message
forall a. ToMessage a => a -> Message
message (String -> Message)
-> (SomeException -> String) -> SomeException -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show
   {-# INLINE message #-}

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

-- | Importance of the logged message.
--
-- These levels, listed in increasing order of importance, correspond to the
-- levels used by [syslog(3)](https://linux.die.net/man/3/syslog).
data Level
   = -- | Message intended to be useful only when deliberately debugging a program.
     Debug
   | -- | Informational message.
     Info
   | -- | A condition that is not an error, but should possibly be handled
     -- specially.
     Notice
   | -- | A warning condition, such as an exception being gracefully handled or
     -- some missing configuration setting being assigned a default value.
     Warning
   | -- | Error condition, such as an unhandled exception.
     Error
   | -- | Critical condition that could result in system failure, such as a disk
     -- running out of space.
     Critical
   | -- | A condition that should be corrected immediately, such as a corrupted
     -- database.
     Alert
   | -- | System is unusable.
     Emergency
   deriving (Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
/= :: Level -> Level -> Bool
Eq, Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Level -> ShowS
showsPrec :: Int -> Level -> ShowS
$cshow :: Level -> String
show :: Level -> String
$cshowList :: [Level] -> ShowS
showList :: [Level] -> ShowS
Show, ReadPrec [Level]
ReadPrec Level
Int -> ReadS Level
ReadS [Level]
(Int -> ReadS Level)
-> ReadS [Level]
-> ReadPrec Level
-> ReadPrec [Level]
-> Read Level
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Level
readsPrec :: Int -> ReadS Level
$creadList :: ReadS [Level]
readList :: ReadS [Level]
$creadPrec :: ReadPrec Level
readPrec :: ReadPrec Level
$creadListPrec :: ReadPrec [Level]
readListPrec :: ReadPrec [Level]
Read, Level
Level -> Level -> Bounded Level
forall a. a -> a -> Bounded a
$cminBound :: Level
minBound :: Level
$cmaxBound :: Level
maxBound :: Level
Bounded, Int -> Level
Level -> Int
Level -> [Level]
Level -> Level
Level -> Level -> [Level]
Level -> Level -> Level -> [Level]
(Level -> Level)
-> (Level -> Level)
-> (Int -> Level)
-> (Level -> Int)
-> (Level -> [Level])
-> (Level -> Level -> [Level])
-> (Level -> Level -> [Level])
-> (Level -> Level -> Level -> [Level])
-> Enum Level
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 :: Level -> Level
succ :: Level -> Level
$cpred :: Level -> Level
pred :: Level -> Level
$ctoEnum :: Int -> Level
toEnum :: Int -> Level
$cfromEnum :: Level -> Int
fromEnum :: Level -> Int
$cenumFrom :: Level -> [Level]
enumFrom :: Level -> [Level]
$cenumFromThen :: Level -> Level -> [Level]
enumFromThen :: Level -> Level -> [Level]
$cenumFromTo :: Level -> Level -> [Level]
enumFromTo :: Level -> Level -> [Level]
$cenumFromThenTo :: Level -> Level -> Level -> [Level]
enumFromThenTo :: Level -> Level -> Level -> [Level]
Enum)

-- | Order of importance. For example, 'Emergency' is more important than
-- 'Debug':
--
-- @
-- 'Emergency' > 'Debug'  ==  'True'
-- @
deriving instance Ord Level

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

-- | A path segment.
--
-- If you have the @OverloadedStrings@ GHC extension enabled, you can build a
-- 'Segment' using a string literal:
--
-- @
-- \"foo\" :: 'Segment'
-- @
--
-- Otherwise, you can use 'fromString' or 'segment'.
--
-- Notice that @\"\" :: 'Segment'@ is acceptable, and will be correctly rendered
-- and parsed back.
newtype Segment = Segment TL.Text
   deriving (Segment -> Segment -> Bool
(Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool) -> Eq Segment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
/= :: Segment -> Segment -> Bool
Eq, Int -> Segment -> ShowS
[Segment] -> ShowS
Segment -> String
(Int -> Segment -> ShowS)
-> (Segment -> String) -> ([Segment] -> ShowS) -> Show Segment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Segment -> ShowS
showsPrec :: Int -> Segment -> ShowS
$cshow :: Segment -> String
show :: Segment -> String
$cshowList :: [Segment] -> ShowS
showList :: [Segment] -> ShowS
Show)

unSegment :: Segment -> TL.Text
unSegment :: Segment -> Text
unSegment = Segment -> Text
forall a b. Coercible a b => a -> b
coerce
{-# INLINE unSegment #-}

instance IsString Segment where
   fromString :: String -> Segment
fromString = String -> Segment
forall a. ToSegment a => a -> Segment
segment
   {-# INLINE fromString #-}

instance Semigroup Segment where
   <> :: Segment -> Segment -> Segment
(<>) = (Text -> Text -> Text) -> Segment -> Segment -> Segment
forall a b. Coercible a b => a -> b
coerce (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) :: TL.Text -> TL.Text -> TL.Text)
   {-# INLINE (<>) #-}

instance Monoid Segment where
   mempty :: Segment
mempty = Text -> Segment
Segment Text
forall a. Monoid a => a
mempty
   {-# INLINE mempty #-}

-- | Convert an arbitrary type to a 'Segment'.
--
-- You are encouraged to create custom 'ToSegment' instances for your types
-- making sure you avoid rendering sensitive details such as passwords, so that
-- they don't accidentally end up in logs.
--
-- Any characters that need to be escaped for rendering will be automatically
-- escaped at rendering time. You don't need to escape them here.
class ToSegment a where
   segment :: a -> Segment

-- | Identity.
instance ToSegment Segment where
   segment :: Segment -> Segment
segment = Segment -> Segment
forall a. a -> a
id
   {-# INLINE segment #-}

-- |
-- @
-- x :: 'TL.Text' == 'unSegment' ('segment' x)
-- @
instance ToSegment TL.Text where
   segment :: Text -> Segment
segment = Text -> Segment
Segment
   {-# INLINE segment #-}

-- |
-- @
-- 'TB.toLazyText' (x :: 'TB.Builder') == 'unSegment' ('segment' x)
-- @
instance ToSegment TB.Builder where
   segment :: Builder -> Segment
segment = Text -> Segment
Segment (Text -> Segment) -> (Builder -> Text) -> Builder -> Segment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
   {-# INLINE segment #-}

-- |
-- @
-- x :: 'T.Text' == 'TL.toStrict' ('unSegment' ('segment' x))
-- @
instance ToSegment T.Text where
   segment :: Text -> Segment
segment = Text -> Segment
Segment (Text -> Segment) -> (Text -> Text) -> Text -> Segment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
   {-# INLINE segment #-}

-- |
-- @
-- x :: 'String' == 'TL.unpack' ('unSegment' ('segment' x))
-- @
instance ToSegment String where
   segment :: String -> Segment
segment = Text -> Segment
Segment (Text -> Segment) -> (String -> Text) -> String -> Segment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
   {-# INLINE segment #-}

instance ToSegment Char where
   segment :: Char -> Segment
segment = Text -> Segment
Segment (Text -> Segment) -> (Char -> Text) -> Char -> Segment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
TL.singleton
   {-# INLINE segment #-}

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

-- | An attribute key (see 'Attr').
--
-- If you have the @OverloadedStrings@ GHC extension enabled, you can build a
-- 'Key' using a string literal:
--
-- @
-- \"foo\" :: 'Key'
-- @
--
-- Otherwise, you can use 'fromString' or 'key'.
--
-- Notice that @\"\" :: 'Key'@ is acceptable, and will be correctly rendered and
-- parsed back.
newtype Key = Key TL.Text
   deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show)

unKey :: Key -> TL.Text
unKey :: Key -> Text
unKey = Key -> Text
forall a b. Coercible a b => a -> b
coerce
{-# INLINE unKey #-}

instance IsString Key where
   fromString :: String -> Key
fromString = String -> Key
forall a. ToKey a => a -> Key
key
   {-# INLINE fromString #-}

instance Semigroup Key where
   <> :: Key -> Key -> Key
(<>) = (Text -> Text -> Text) -> Key -> Key -> Key
forall a b. Coercible a b => a -> b
coerce (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) :: TL.Text -> TL.Text -> TL.Text)
   {-# INLINE (<>) #-}

instance Monoid Key where
   mempty :: Key
mempty = Text -> Key
Key Text
forall a. Monoid a => a
mempty
   {-# INLINE mempty #-}

-- | Convert an arbitrary type to a 'Key'.
--
-- You are encouraged to create custom 'ToKey' instances for your types
-- making sure you avoid rendering sensitive details such as passwords, so that
-- they don't accidentally end up in logs.
--
-- Any characters that need to be escaped for rendering will be automatically
-- escaped at rendering time. You don't need to escape them here.
class ToKey a where
   key :: a -> Key

-- | Identity.
instance ToKey Key where
   key :: Key -> Key
key = Key -> Key
forall a. a -> a
id
   {-# INLINE key #-}

-- |
-- @
-- x :: 'TL.Text' == 'unKey' ('key' x)
-- @
instance ToKey TL.Text where
   key :: Text -> Key
key = Text -> Key
Key
   {-# INLINE key #-}

-- |
-- @
-- 'TB.toLazyText' (x :: 'TB.Builder') == 'unKey' ('key' x)
-- @
instance ToKey TB.Builder where
   key :: Builder -> Key
key = Text -> Key
Key (Text -> Key) -> (Builder -> Text) -> Builder -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
   {-# INLINE key #-}

-- |
-- @
-- x :: 'T.Text' == 'TL.toStrict' ('unKey' ('key' x))
-- @
instance ToKey T.Text where
   key :: Text -> Key
key = Text -> Key
Key (Text -> Key) -> (Text -> Text) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
   {-# INLINE key #-}

-- |
-- @
-- x :: 'String' == 'TL.unpack' ('unKey' ('key' x))
-- @
instance ToKey String where
   key :: String -> Key
key = Text -> Key
Key (Text -> Key) -> (String -> Text) -> String -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
   {-# INLINE key #-}

instance ToKey Char where
   key :: Char -> Key
key = Text -> Key
Key (Text -> Key) -> (Char -> Text) -> Char -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
TL.singleton
   {-# INLINE key #-}

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

-- | An attribute value (see 'Attr').
--
-- If you have the @OverloadedStrings@ GHC extension enabled, you can build a
-- 'Value' using a string literal:
--
-- @
-- \"foo\" :: 'Value'
-- @
--
-- Otherwise, you can use 'fromString' or 'value'.
--
-- Notice that @\"\" :: 'Value'@ is acceptable, and will be correctly rendered
-- and parsed back.
newtype Value = Value TL.Text
   deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

unValue :: Value -> TL.Text
unValue :: Value -> Text
unValue = Value -> Text
forall a b. Coercible a b => a -> b
coerce
{-# INLINE unValue #-}

instance IsString Value where
   fromString :: String -> Value
fromString = String -> Value
forall a. ToValue a => a -> Value
value
   {-# INLINE fromString #-}

instance Semigroup Value where
   <> :: Value -> Value -> Value
(<>) = (Text -> Text -> Text) -> Value -> Value -> Value
forall a b. Coercible a b => a -> b
coerce (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) :: TL.Text -> TL.Text -> TL.Text)
   {-# INLINE (<>) #-}

instance Monoid Value where
   mempty :: Value
mempty = Text -> Value
Value Text
forall a. Monoid a => a
mempty
   {-# INLINE mempty #-}

-- | Convert an arbitrary type to a 'Value'.
--
-- You are encouraged to create custom 'ToValue' instances for your types
-- making sure you avoid rendering sensitive details such as passwords, so that
-- they don't accidentally end up in logs.
--
-- Any characters that need to be escaped for rendering will be automatically
-- escaped at rendering time. You don't need to escape them here.
class ToValue a where
   value :: a -> Value

-- | Identity.
instance ToValue Value where
   value :: Value -> Value
value = Value -> Value
forall a. a -> a
id
   {-# INLINE value #-}

-- |
-- @
-- x :: 'TL.Text' == 'unValue' ('value' x)
-- @
instance ToValue TL.Text where
   value :: Text -> Value
value = Text -> Value
Value
   {-# INLINE value #-}

-- |
-- @
-- 'TB.toLazyText' (x :: 'TB.Builder') == 'unValue' ('value' x)
-- @
instance ToValue TB.Builder where
   value :: Builder -> Value
value = Text -> Value
Value (Text -> Value) -> (Builder -> Text) -> Builder -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
   {-# INLINE value #-}

-- |
-- @
-- x :: 'T.Text' == 'TL.toStrict' ('unValue' ('value' x))
-- @
instance ToValue T.Text where
   value :: Text -> Value
value = Text -> Value
Value (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
   {-# INLINE value #-}

-- |
-- @
-- x :: 'String' == 'TL.unpack' ('unValue' ('value' x))
-- @
instance ToValue String where
   value :: String -> Value
value = Text -> Value
Value (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
   {-# INLINE value #-}

instance ToValue SomeException where
   value :: SomeException -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value)
-> (SomeException -> String) -> SomeException -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Bool where
   value :: Bool -> Value
value = \Bool
b -> if Bool
b then Value
"true" else Value
"false"
   {-# INLINE value #-}
instance ToValue Char where
   value :: Char -> Value
value = Text -> Value
Value (Text -> Value) -> (Char -> Text) -> Char -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
TL.singleton
   {-# INLINE value #-}
instance ToValue Int where
   value :: Int -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Int -> String) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Int8 where
   value :: Int8 -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Int8 -> String) -> Int8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Int16 where
   value :: Int16 -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Int16 -> String) -> Int16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Int32 where
   value :: Int32 -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Int32 -> String) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Int64 where
   value :: Int64 -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Int64 -> String) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Word where
   value :: Word -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Word -> String) -> Word -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Word8 where
   value :: Word8 -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Word8 -> String) -> Word8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Word16 where
   value :: Word16 -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Word16 -> String) -> Word16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Word32 where
   value :: Word32 -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Word32 -> String) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Word64 where
   value :: Word64 -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Word64 -> String) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Integer where
   value :: Integer -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Integer -> String) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Natural where
   value :: Natural -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Natural -> String) -> Natural -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Float where
   value :: Float -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Float -> String) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}
instance ToValue Double where
   value :: Double -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Double -> String) -> Double -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}

-- | Chops trailing zeros.
instance (Fixed.HasResolution a) => ToValue (Fixed.Fixed a) where
   value :: Fixed a -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Fixed a -> String) -> Fixed a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
Fixed.showFixed Bool
True
   {-# INLINE value #-}

-- | See 'Time.ISO8601'.
instance ToValue Time.CalendarDiffDays where
   value :: CalendarDiffDays -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value)
-> (CalendarDiffDays -> String) -> CalendarDiffDays -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarDiffDays -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show
   {-# INLINE value #-}

-- | See 'Time.ISO8601'.
instance ToValue Time.CalendarDiffTime where
   value :: CalendarDiffTime -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value)
-> (CalendarDiffTime -> String) -> CalendarDiffTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarDiffTime -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show
   {-# INLINE value #-}

-- | See 'Time.ISO8601'.
instance ToValue Time.Day where
   value :: Day -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (Day -> String) -> Day -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show
   {-# INLINE value #-}

-- | See 'Time.ISO8601'.
instance ToValue Time.TimeZone where
   value :: TimeZone -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (TimeZone -> String) -> TimeZone -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show
   {-# INLINE value #-}

-- | See 'Time.ISO8601'.
instance ToValue Time.TimeOfDay where
   value :: TimeOfDay -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (TimeOfDay -> String) -> TimeOfDay -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show
   {-# INLINE value #-}

-- | See 'Time.ISO8601'.
instance ToValue Time.LocalTime where
   value :: LocalTime -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (LocalTime -> String) -> LocalTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show
   {-# INLINE value #-}

-- | See 'Time.ISO8601'.
instance ToValue Time.ZonedTime where
   value :: ZonedTime -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (ZonedTime -> String) -> ZonedTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show
   {-# INLINE value #-}

-- | @123456s@
instance ToValue Time.NominalDiffTime where
   value :: NominalDiffTime -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value)
-> (NominalDiffTime -> String) -> NominalDiffTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}

-- | @123456s@
instance ToValue Time.DiffTime where
   value :: DiffTime -> Value
value = String -> Value
forall a. ToValue a => a -> Value
value (String -> Value) -> (DiffTime -> String) -> DiffTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> String
forall a. Show a => a -> String
show
   {-# INLINE value #-}

-- | Lowercase @monday@, @tuesday@, etc.
instance ToValue Time.DayOfWeek where
   value :: DayOfWeek -> Value
value = \DayOfWeek
x -> case DayOfWeek
x of
      DayOfWeek
Time.Monday -> Value
"monday"
      DayOfWeek
Time.Tuesday -> Value
"tuesday"
      DayOfWeek
Time.Wednesday -> Value
"wednesday"
      DayOfWeek
Time.Thursday -> Value
"thursday"
      DayOfWeek
Time.Friday -> Value
"friday"
      DayOfWeek
Time.Saturday -> Value
"saturday"
      DayOfWeek
Time.Sunday -> Value
"sunday"

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

-- | 'Path' represents the hierarchical structure of logged messages.
--
-- For example, consider a /df1/ log line as like the following:
--
-- @
-- 1999-12-20T07:11:39.230553031Z \/foo x=a y=b \/bar \/qux z=c z=d WARNING Something
-- @
--
-- For that line, the 'log_path' attribute of the 'Log' datatype will contain
-- the following:
--
-- @
-- [ 'Push' ('segment' \"foo\")
-- , 'Attr' ('key' \"x\") ('value' \"a\")
-- , 'Attr' ('key' \"y\") ('value' \"b\")
-- , 'Push' ('segment' \"bar\")
-- , 'Push' ('segment' \"qux\")
-- , 'Attr' ('key' \"z\") ('value' \"c\")
-- , 'Attr' ('key' \"z\") ('value' \"d\")
-- ] :: 'Seq.Seq' 'Path'
-- @
--
-- Please notice that @[] :: 'Seq.Seq' 'Path'@ is a valid path insofar as /df1/
-- is concerned, and that 'Attr' and 'Push' can be juxtapositioned in any order.
data Path
   = Push !Segment
   | Attr !Key !Value
   deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> String
show :: Path -> String
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show)

-- | Convert an arbitrary type to a 'Seq'uence of 'Path's.
--
-- You are encouraged to create custom 'ToPath' instances for your types
-- making sure you avoid rendering sensitive details such as passwords, so that
-- they don't accidentally end up in logs.
--
-- Any characters that need to be escaped for rendering will be automatically
-- escaped at rendering time. You don't need to escape them here.
class ToPath a where
   -- | The leftmost 'Path' is the closest to the root. The rightmost 'Path' is
   -- the one closest to where the log was generated.
   --
   -- See the documentation for 'Path'.
   path :: a -> Seq.Seq Path

-- | Identity.
instance ToPath (Seq.Seq Path) where
   path :: Seq Path -> Seq Path
path = Seq Path -> Seq Path
forall a. a -> a
id
   {-# INLINE path #-}

-- |
-- @
-- 'path' = 'Seq.fromList' . 'toList'
-- @
instance {-# OVERLAPPABLE #-} (Foldable f) => ToPath (f Path) where
   path :: f Path -> Seq Path
path = [Path] -> Seq Path
forall a. [a] -> Seq a
Seq.fromList ([Path] -> Seq Path) -> (f Path -> [Path]) -> f Path -> Seq Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Path -> [Path]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
   {-# INLINE path #-}