{- |
Module      : GHC.Eventlog.Live.Attribute
Description : Representation for attributes.
Stability   : experimental
Portability : portable
-}
module GHC.Eventlog.Live.Data.Attribute (
  Attr,
  AttrKey,
  AttrValue (..),
  IsAttrValue (..),
  (~=),
) where

import Data.Int (Int16, Int32, Int64, Int8)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Word (Word16, Word32, Word64, Word8)

{- |
An attribute is a key-value pair where the key is any string and the value is
some numeric type, string, or null. Attributes should be constructed using the
`(~=)` operator, which automatically converts Haskell types to t`AttrValue`.
-}
type Attr = (AttrKey, AttrValue)

{- |
Construct an t`Attr` as a pair of an t`AttrKey` and an t`AttrValue`,
constructed via the t`IsAttrValue` class.
-}
(~=) :: (IsAttrValue v) => AttrKey -> v -> Attr
AttrKey
k ~= :: forall v. IsAttrValue v => AttrKey -> v -> Attr
~= v
v = (AttrKey
ak, AttrValue
av)
 where
  !ak :: AttrKey
ak = AttrKey
k
  !av :: AttrValue
av = v -> AttrValue
forall v. IsAttrValue v => v -> AttrValue
toAttrValue v
v
{-# INLINE (~=) #-}

{- |
The type of attribute keys.
-}
type AttrKey =
  Text

{- |
The type of attribute values.
-}
data AttrValue
  = AttrInt !Int
  | AttrInt8 !Int8
  | AttrInt16 !Int16
  | AttrInt32 !Int32
  | AttrInt64 !Int64
  | AttrWord !Word
  | AttrWord8 !Word8
  | AttrWord16 !Word16
  | AttrWord32 !Word32
  | AttrWord64 !Word64
  | AttrDouble !Double
  | AttrText !Text
  | AttrNull
  deriving (Int -> AttrValue -> ShowS
[AttrValue] -> ShowS
AttrValue -> String
(Int -> AttrValue -> ShowS)
-> (AttrValue -> String)
-> ([AttrValue] -> ShowS)
-> Show AttrValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttrValue -> ShowS
showsPrec :: Int -> AttrValue -> ShowS
$cshow :: AttrValue -> String
show :: AttrValue -> String
$cshowList :: [AttrValue] -> ShowS
showList :: [AttrValue] -> ShowS
Show)

{- |
Utility class to help construct values of the t`AttrValue` type.
-}
class IsAttrValue v where
  toAttrValue :: v -> AttrValue

instance IsAttrValue AttrValue where
  toAttrValue :: AttrValue -> AttrValue
  toAttrValue :: AttrValue -> AttrValue
toAttrValue = AttrValue -> AttrValue
forall a. a -> a
id
  {-# INLINE toAttrValue #-}

instance IsAttrValue Int where
  toAttrValue :: Int -> AttrValue
  toAttrValue :: Int -> AttrValue
toAttrValue = Int -> AttrValue
AttrInt
  {-# INLINE toAttrValue #-}

instance IsAttrValue Int8 where
  toAttrValue :: Int8 -> AttrValue
  toAttrValue :: Int8 -> AttrValue
toAttrValue = Int8 -> AttrValue
AttrInt8
  {-# INLINE toAttrValue #-}

instance IsAttrValue Int16 where
  toAttrValue :: Int16 -> AttrValue
  toAttrValue :: Int16 -> AttrValue
toAttrValue = Int16 -> AttrValue
AttrInt16
  {-# INLINE toAttrValue #-}

instance IsAttrValue Int32 where
  toAttrValue :: Int32 -> AttrValue
  toAttrValue :: Int32 -> AttrValue
toAttrValue = Int32 -> AttrValue
AttrInt32
  {-# INLINE toAttrValue #-}

instance IsAttrValue Int64 where
  toAttrValue :: Int64 -> AttrValue
  toAttrValue :: Int64 -> AttrValue
toAttrValue = Int64 -> AttrValue
AttrInt64
  {-# INLINE toAttrValue #-}

instance IsAttrValue Word where
  toAttrValue :: Word -> AttrValue
  toAttrValue :: Word -> AttrValue
toAttrValue = Word -> AttrValue
AttrWord
  {-# INLINE toAttrValue #-}

instance IsAttrValue Word8 where
  toAttrValue :: Word8 -> AttrValue
  toAttrValue :: Word8 -> AttrValue
toAttrValue = Word8 -> AttrValue
AttrWord8
  {-# INLINE toAttrValue #-}

instance IsAttrValue Word16 where
  toAttrValue :: Word16 -> AttrValue
  toAttrValue :: Word16 -> AttrValue
toAttrValue = Word16 -> AttrValue
AttrWord16
  {-# INLINE toAttrValue #-}

instance IsAttrValue Word32 where
  toAttrValue :: Word32 -> AttrValue
  toAttrValue :: Word32 -> AttrValue
toAttrValue = Word32 -> AttrValue
AttrWord32
  {-# INLINE toAttrValue #-}

instance IsAttrValue Word64 where
  toAttrValue :: Word64 -> AttrValue
  toAttrValue :: Word64 -> AttrValue
toAttrValue = Word64 -> AttrValue
AttrWord64
  {-# INLINE toAttrValue #-}

instance IsAttrValue Double where
  toAttrValue :: Double -> AttrValue
  toAttrValue :: Double -> AttrValue
toAttrValue = Double -> AttrValue
AttrDouble
  {-# INLINE toAttrValue #-}

instance IsAttrValue String where
  toAttrValue :: String -> AttrValue
  toAttrValue :: String -> AttrValue
toAttrValue = AttrKey -> AttrValue
AttrText (AttrKey -> AttrValue)
-> (String -> AttrKey) -> String -> AttrValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AttrKey
T.pack
  {-# INLINE toAttrValue #-}

instance IsAttrValue Text where
  toAttrValue :: Text -> AttrValue
  toAttrValue :: AttrKey -> AttrValue
toAttrValue = AttrKey -> AttrValue
AttrText
  {-# INLINE toAttrValue #-}

instance (IsAttrValue v) => IsAttrValue (Maybe v) where
  toAttrValue :: Maybe v -> AttrValue
  toAttrValue :: Maybe v -> AttrValue
toAttrValue = AttrValue -> (v -> AttrValue) -> Maybe v -> AttrValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AttrValue
AttrNull v -> AttrValue
forall v. IsAttrValue v => v -> AttrValue
toAttrValue
  {-# INLINE toAttrValue #-}