{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveAnyClass #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  OpenTelemetry.Attributes
-- Copyright   :  (c) Ian Duncan, 2021
-- License     :  BSD-3
-- Description :  Key-value pair metadata used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's
-- Maintainer  :  Ian Duncan
-- Stability   :  experimental
-- Portability :  non-portable (GHC extensions)
--
-- An Attribute is a key-value pair, which MUST have the following properties:
-- 
-- - The attribute key MUST be a non-null and non-empty string.
-- - The attribute value is either:
-- - A primitive type: string, boolean, double precision floating point (IEEE 754-1985) or signed 64 bit integer.
-- - An array of primitive type values. The array MUST be homogeneous, i.e., it MUST NOT contain values of different types. For protocols that do not natively support array values such values SHOULD be represented as JSON strings.
-- - Attribute values expressing a numerical value of zero, an empty string, or an empty array are considered meaningful and MUST be stored and passed on to processors / exporters.
--
-----------------------------------------------------------------------------
module OpenTelemetry.Attributes 
  ( Attributes
  , emptyAttributes
  , addAttribute
  , addAttributes
  , getAttributes
  , lookupAttribute
  , Attribute (..)
  , ToAttribute (..)
  , PrimitiveAttribute (..)
  , ToPrimitiveAttribute (..)
  -- * Attribute limits
  , AttributeLimits (..)
  , defaultAttributeLimits
  -- * Unsafe utilities
  , unsafeAttributesFromListIgnoringLimits
  , unsafeMergeAttributesIgnoringLimits 
  ) where
import Data.Int ( Int64 )
import Data.Text ( Text )
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import GHC.Generics
import Data.Data
import Data.Hashable
import Data.String

-- | Default attribute limits used in the global attribute limit configuration if no environment variables are set.
--
-- Values:
--
-- - 'attributeCountLimit': @Just 128@
-- - 'attributeLengthLimit':  or @Nothing@
defaultAttributeLimits :: AttributeLimits
defaultAttributeLimits :: AttributeLimits
defaultAttributeLimits = AttributeLimits :: Maybe Int -> Maybe Int -> AttributeLimits
AttributeLimits
  { attributeCountLimit :: Maybe Int
attributeCountLimit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
128
  , attributeLengthLimit :: Maybe Int
attributeLengthLimit = Maybe Int
forall a. Maybe a
Nothing
  }

data Attributes = Attributes
  { Attributes -> HashMap Text Attribute
attributes :: !(H.HashMap Text Attribute)
  , Attributes -> Int
attributesCount :: {-# UNPACK #-} !Int
  , Attributes -> Int
attributesDropped :: {-# UNPACK #-} !Int
  }
  deriving stock (Int -> Attributes -> ShowS
[Attributes] -> ShowS
Attributes -> String
(Int -> Attributes -> ShowS)
-> (Attributes -> String)
-> ([Attributes] -> ShowS)
-> Show Attributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attributes] -> ShowS
$cshowList :: [Attributes] -> ShowS
show :: Attributes -> String
$cshow :: Attributes -> String
showsPrec :: Int -> Attributes -> ShowS
$cshowsPrec :: Int -> Attributes -> ShowS
Show, Attributes -> Attributes -> Bool
(Attributes -> Attributes -> Bool)
-> (Attributes -> Attributes -> Bool) -> Eq Attributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attributes -> Attributes -> Bool
$c/= :: Attributes -> Attributes -> Bool
== :: Attributes -> Attributes -> Bool
$c== :: Attributes -> Attributes -> Bool
Eq)

emptyAttributes :: Attributes
emptyAttributes :: Attributes
emptyAttributes = HashMap Text Attribute -> Int -> Int -> Attributes
Attributes HashMap Text Attribute
forall a. Monoid a => a
mempty Int
0 Int
0

addAttribute :: ToAttribute a => AttributeLimits -> Attributes -> Text -> a -> Attributes
addAttribute :: AttributeLimits -> Attributes -> Text -> a -> Attributes
addAttribute AttributeLimits{Maybe Int
attributeLengthLimit :: Maybe Int
attributeCountLimit :: Maybe Int
attributeLengthLimit :: AttributeLimits -> Maybe Int
attributeCountLimit :: AttributeLimits -> Maybe Int
..} Attributes{Int
HashMap Text Attribute
attributesDropped :: Int
attributesCount :: Int
attributes :: HashMap Text Attribute
attributesDropped :: Attributes -> Int
attributesCount :: Attributes -> Int
attributes :: Attributes -> HashMap Text Attribute
..} Text
k a
v = case Maybe Int
attributeCountLimit of
  Maybe Int
Nothing -> HashMap Text Attribute -> Int -> Int -> Attributes
Attributes HashMap Text Attribute
newAttrs Int
newCount Int
attributesDropped
  Just Int
limit_ -> if Int
newCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit_
    then HashMap Text Attribute -> Int -> Int -> Attributes
Attributes HashMap Text Attribute
attributes Int
attributesCount (Int
attributesDropped Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    else HashMap Text Attribute -> Int -> Int -> Attributes
Attributes HashMap Text Attribute
newAttrs Int
newCount Int
attributesDropped
  where
    newAttrs :: HashMap Text Attribute
newAttrs = Text
-> Attribute -> HashMap Text Attribute -> HashMap Text Attribute
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
k (Attribute -> Attribute
limitLengths (Attribute -> Attribute) -> Attribute -> Attribute
forall a b. (a -> b) -> a -> b
$ a -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute a
v) HashMap Text Attribute
attributes
    newCount :: Int
newCount = if Text -> HashMap Text Attribute -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member Text
k HashMap Text Attribute
attributes
      then Int
attributesCount
      else Int
attributesCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

    limitPrimAttr :: Int -> PrimitiveAttribute -> PrimitiveAttribute
limitPrimAttr Int
limit_ (TextAttribute Text
t) = Text -> PrimitiveAttribute
TextAttribute (Int -> Text -> Text
T.take Int
limit_ Text
t)
    limitPrimAttr Int
_ PrimitiveAttribute
attr = PrimitiveAttribute
attr

    limitLengths :: Attribute -> Attribute
limitLengths Attribute
attr = case Maybe Int
attributeLengthLimit of
      Maybe Int
Nothing -> Attribute
attr
      Just Int
limit_ -> case Attribute
attr of
        AttributeValue PrimitiveAttribute
val -> PrimitiveAttribute -> Attribute
AttributeValue (PrimitiveAttribute -> Attribute)
-> PrimitiveAttribute -> Attribute
forall a b. (a -> b) -> a -> b
$ Int -> PrimitiveAttribute -> PrimitiveAttribute
limitPrimAttr Int
limit_ PrimitiveAttribute
val
        AttributeArray [PrimitiveAttribute]
arr -> [PrimitiveAttribute] -> Attribute
AttributeArray ([PrimitiveAttribute] -> Attribute)
-> [PrimitiveAttribute] -> Attribute
forall a b. (a -> b) -> a -> b
$ (PrimitiveAttribute -> PrimitiveAttribute)
-> [PrimitiveAttribute] -> [PrimitiveAttribute]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PrimitiveAttribute -> PrimitiveAttribute
limitPrimAttr Int
limit_) [PrimitiveAttribute]
arr
        
{-# INLINE addAttribute #-}

addAttributes :: ToAttribute a => AttributeLimits -> Attributes -> [(Text, a)] -> Attributes
-- TODO, this could be done more efficiently
addAttributes :: AttributeLimits -> Attributes -> [(Text, a)] -> Attributes
addAttributes AttributeLimits
limits = (Attributes -> (Text, a) -> Attributes)
-> Attributes -> [(Text, a)] -> Attributes
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Attributes
attrs' (Text
k, a
v) -> AttributeLimits -> Attributes -> Text -> a -> Attributes
forall a.
ToAttribute a =>
AttributeLimits -> Attributes -> Text -> a -> Attributes
addAttribute AttributeLimits
limits Attributes
attrs' Text
k a
v)
{-# INLINE addAttributes #-}

getAttributes :: Attributes -> (Int, H.HashMap Text Attribute)
getAttributes :: Attributes -> (Int, HashMap Text Attribute)
getAttributes Attributes{Int
HashMap Text Attribute
attributesDropped :: Int
attributesCount :: Int
attributes :: HashMap Text Attribute
attributesDropped :: Attributes -> Int
attributesCount :: Attributes -> Int
attributes :: Attributes -> HashMap Text Attribute
..} = (Int
attributesCount, HashMap Text Attribute
attributes)

lookupAttribute :: Attributes -> Text -> Maybe Attribute
lookupAttribute :: Attributes -> Text -> Maybe Attribute
lookupAttribute Attributes{Int
HashMap Text Attribute
attributesDropped :: Int
attributesCount :: Int
attributes :: HashMap Text Attribute
attributesDropped :: Attributes -> Int
attributesCount :: Attributes -> Int
attributes :: Attributes -> HashMap Text Attribute
..} Text
k = Text -> HashMap Text Attribute -> Maybe Attribute
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k HashMap Text Attribute
attributes

-- | It is possible when adding attributes that a programming error might cause too many
-- attributes to be added to an event. Thus, 'Attributes' use the limits set here as a safeguard
-- against excessive memory consumption.
data AttributeLimits = AttributeLimits
  { AttributeLimits -> Maybe Int
attributeCountLimit :: Maybe Int
  -- ^ The number of unique attributes that may be added to an 'Attributes' structure before they are dropped.
  , AttributeLimits -> Maybe Int
attributeLengthLimit :: Maybe Int
  -- ^ The maximum length of string attributes that may be set. Longer-length string values will be truncated to the
  -- specified amount.
  }
  deriving stock (ReadPrec [AttributeLimits]
ReadPrec AttributeLimits
Int -> ReadS AttributeLimits
ReadS [AttributeLimits]
(Int -> ReadS AttributeLimits)
-> ReadS [AttributeLimits]
-> ReadPrec AttributeLimits
-> ReadPrec [AttributeLimits]
-> Read AttributeLimits
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeLimits]
$creadListPrec :: ReadPrec [AttributeLimits]
readPrec :: ReadPrec AttributeLimits
$creadPrec :: ReadPrec AttributeLimits
readList :: ReadS [AttributeLimits]
$creadList :: ReadS [AttributeLimits]
readsPrec :: Int -> ReadS AttributeLimits
$creadsPrec :: Int -> ReadS AttributeLimits
Read, Int -> AttributeLimits -> ShowS
[AttributeLimits] -> ShowS
AttributeLimits -> String
(Int -> AttributeLimits -> ShowS)
-> (AttributeLimits -> String)
-> ([AttributeLimits] -> ShowS)
-> Show AttributeLimits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeLimits] -> ShowS
$cshowList :: [AttributeLimits] -> ShowS
show :: AttributeLimits -> String
$cshow :: AttributeLimits -> String
showsPrec :: Int -> AttributeLimits -> ShowS
$cshowsPrec :: Int -> AttributeLimits -> ShowS
Show, AttributeLimits -> AttributeLimits -> Bool
(AttributeLimits -> AttributeLimits -> Bool)
-> (AttributeLimits -> AttributeLimits -> Bool)
-> Eq AttributeLimits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeLimits -> AttributeLimits -> Bool
$c/= :: AttributeLimits -> AttributeLimits -> Bool
== :: AttributeLimits -> AttributeLimits -> Bool
$c== :: AttributeLimits -> AttributeLimits -> Bool
Eq, Eq AttributeLimits
Eq AttributeLimits
-> (AttributeLimits -> AttributeLimits -> Ordering)
-> (AttributeLimits -> AttributeLimits -> Bool)
-> (AttributeLimits -> AttributeLimits -> Bool)
-> (AttributeLimits -> AttributeLimits -> Bool)
-> (AttributeLimits -> AttributeLimits -> Bool)
-> (AttributeLimits -> AttributeLimits -> AttributeLimits)
-> (AttributeLimits -> AttributeLimits -> AttributeLimits)
-> Ord AttributeLimits
AttributeLimits -> AttributeLimits -> Bool
AttributeLimits -> AttributeLimits -> Ordering
AttributeLimits -> AttributeLimits -> AttributeLimits
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AttributeLimits -> AttributeLimits -> AttributeLimits
$cmin :: AttributeLimits -> AttributeLimits -> AttributeLimits
max :: AttributeLimits -> AttributeLimits -> AttributeLimits
$cmax :: AttributeLimits -> AttributeLimits -> AttributeLimits
>= :: AttributeLimits -> AttributeLimits -> Bool
$c>= :: AttributeLimits -> AttributeLimits -> Bool
> :: AttributeLimits -> AttributeLimits -> Bool
$c> :: AttributeLimits -> AttributeLimits -> Bool
<= :: AttributeLimits -> AttributeLimits -> Bool
$c<= :: AttributeLimits -> AttributeLimits -> Bool
< :: AttributeLimits -> AttributeLimits -> Bool
$c< :: AttributeLimits -> AttributeLimits -> Bool
compare :: AttributeLimits -> AttributeLimits -> Ordering
$ccompare :: AttributeLimits -> AttributeLimits -> Ordering
$cp1Ord :: Eq AttributeLimits
Ord, Typeable AttributeLimits
DataType
Constr
Typeable AttributeLimits
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AttributeLimits -> c AttributeLimits)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AttributeLimits)
-> (AttributeLimits -> Constr)
-> (AttributeLimits -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AttributeLimits))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AttributeLimits))
-> ((forall b. Data b => b -> b)
    -> AttributeLimits -> AttributeLimits)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AttributeLimits -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AttributeLimits -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AttributeLimits -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AttributeLimits -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AttributeLimits -> m AttributeLimits)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AttributeLimits -> m AttributeLimits)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AttributeLimits -> m AttributeLimits)
-> Data AttributeLimits
AttributeLimits -> DataType
AttributeLimits -> Constr
(forall b. Data b => b -> b) -> AttributeLimits -> AttributeLimits
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeLimits -> c AttributeLimits
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeLimits
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AttributeLimits -> u
forall u. (forall d. Data d => d -> u) -> AttributeLimits -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeLimits -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeLimits -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AttributeLimits -> m AttributeLimits
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeLimits -> m AttributeLimits
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeLimits
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeLimits -> c AttributeLimits
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeLimits)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeLimits)
$cAttributeLimits :: Constr
$tAttributeLimits :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AttributeLimits -> m AttributeLimits
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeLimits -> m AttributeLimits
gmapMp :: (forall d. Data d => d -> m d)
-> AttributeLimits -> m AttributeLimits
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeLimits -> m AttributeLimits
gmapM :: (forall d. Data d => d -> m d)
-> AttributeLimits -> m AttributeLimits
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AttributeLimits -> m AttributeLimits
gmapQi :: Int -> (forall d. Data d => d -> u) -> AttributeLimits -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeLimits -> u
gmapQ :: (forall d. Data d => d -> u) -> AttributeLimits -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AttributeLimits -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeLimits -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeLimits -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeLimits -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeLimits -> r
gmapT :: (forall b. Data b => b -> b) -> AttributeLimits -> AttributeLimits
$cgmapT :: (forall b. Data b => b -> b) -> AttributeLimits -> AttributeLimits
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeLimits)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeLimits)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AttributeLimits)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeLimits)
dataTypeOf :: AttributeLimits -> DataType
$cdataTypeOf :: AttributeLimits -> DataType
toConstr :: AttributeLimits -> Constr
$ctoConstr :: AttributeLimits -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeLimits
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeLimits
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeLimits -> c AttributeLimits
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeLimits -> c AttributeLimits
$cp1Data :: Typeable AttributeLimits
Data, (forall x. AttributeLimits -> Rep AttributeLimits x)
-> (forall x. Rep AttributeLimits x -> AttributeLimits)
-> Generic AttributeLimits
forall x. Rep AttributeLimits x -> AttributeLimits
forall x. AttributeLimits -> Rep AttributeLimits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeLimits x -> AttributeLimits
$cfrom :: forall x. AttributeLimits -> Rep AttributeLimits x
Generic)
  deriving anyclass (Eq AttributeLimits
Eq AttributeLimits
-> (Int -> AttributeLimits -> Int)
-> (AttributeLimits -> Int)
-> Hashable AttributeLimits
Int -> AttributeLimits -> Int
AttributeLimits -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: AttributeLimits -> Int
$chash :: AttributeLimits -> Int
hashWithSalt :: Int -> AttributeLimits -> Int
$chashWithSalt :: Int -> AttributeLimits -> Int
$cp1Hashable :: Eq AttributeLimits
Hashable)

-- | Convert a Haskell value to a 'PrimitiveAttribute' value.
class ToPrimitiveAttribute a where
  toPrimitiveAttribute :: a -> PrimitiveAttribute

-- | An attribute represents user-provided metadata about a span, link, or event.
--
-- Telemetry tools may use this data to support high-cardinality querying, visualization
-- in waterfall diagrams, trace sampling decisions, and more.
data Attribute
  = AttributeValue PrimitiveAttribute
  -- ^ An attribute representing a single primitive value
  | AttributeArray [PrimitiveAttribute]
  -- ^ An attribute representing an array of primitive values.
  --
  -- All values in the array MUST be of the same primitive attribute type.
  deriving stock (ReadPrec [Attribute]
ReadPrec Attribute
Int -> ReadS Attribute
ReadS [Attribute]
(Int -> ReadS Attribute)
-> ReadS [Attribute]
-> ReadPrec Attribute
-> ReadPrec [Attribute]
-> Read Attribute
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Attribute]
$creadListPrec :: ReadPrec [Attribute]
readPrec :: ReadPrec Attribute
$creadPrec :: ReadPrec Attribute
readList :: ReadS [Attribute]
$creadList :: ReadS [Attribute]
readsPrec :: Int -> ReadS Attribute
$creadsPrec :: Int -> ReadS Attribute
Read, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show, Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Eq Attribute
Eq Attribute
-> (Attribute -> Attribute -> Ordering)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Attribute)
-> (Attribute -> Attribute -> Attribute)
-> Ord Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmax :: Attribute -> Attribute -> Attribute
>= :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c< :: Attribute -> Attribute -> Bool
compare :: Attribute -> Attribute -> Ordering
$ccompare :: Attribute -> Attribute -> Ordering
$cp1Ord :: Eq Attribute
Ord, Typeable Attribute
DataType
Constr
Typeable Attribute
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Attribute -> c Attribute)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Attribute)
-> (Attribute -> Constr)
-> (Attribute -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Attribute))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attribute))
-> ((forall b. Data b => b -> b) -> Attribute -> Attribute)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Attribute -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Attribute -> r)
-> (forall u. (forall d. Data d => d -> u) -> Attribute -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Attribute -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Attribute -> m Attribute)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attribute -> m Attribute)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attribute -> m Attribute)
-> Data Attribute
Attribute -> DataType
Attribute -> Constr
(forall b. Data b => b -> b) -> Attribute -> Attribute
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attribute -> c Attribute
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attribute
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Attribute -> u
forall u. (forall d. Data d => d -> u) -> Attribute -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attribute
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attribute -> c Attribute
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attribute)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attribute)
$cAttributeArray :: Constr
$cAttributeValue :: Constr
$tAttribute :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Attribute -> m Attribute
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
gmapMp :: (forall d. Data d => d -> m d) -> Attribute -> m Attribute
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
gmapM :: (forall d. Data d => d -> m d) -> Attribute -> m Attribute
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
gmapQi :: Int -> (forall d. Data d => d -> u) -> Attribute -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attribute -> u
gmapQ :: (forall d. Data d => d -> u) -> Attribute -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Attribute -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
gmapT :: (forall b. Data b => b -> b) -> Attribute -> Attribute
$cgmapT :: (forall b. Data b => b -> b) -> Attribute -> Attribute
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attribute)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attribute)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Attribute)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attribute)
dataTypeOf :: Attribute -> DataType
$cdataTypeOf :: Attribute -> DataType
toConstr :: Attribute -> Constr
$ctoConstr :: Attribute -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attribute
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attribute
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attribute -> c Attribute
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attribute -> c Attribute
$cp1Data :: Typeable Attribute
Data, (forall x. Attribute -> Rep Attribute x)
-> (forall x. Rep Attribute x -> Attribute) -> Generic Attribute
forall x. Rep Attribute x -> Attribute
forall x. Attribute -> Rep Attribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attribute x -> Attribute
$cfrom :: forall x. Attribute -> Rep Attribute x
Generic)
  deriving anyclass (Eq Attribute
Eq Attribute
-> (Int -> Attribute -> Int)
-> (Attribute -> Int)
-> Hashable Attribute
Int -> Attribute -> Int
Attribute -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Attribute -> Int
$chash :: Attribute -> Int
hashWithSalt :: Int -> Attribute -> Int
$chashWithSalt :: Int -> Attribute -> Int
$cp1Hashable :: Eq Attribute
Hashable)

-- | Create a `TextAttribute` from the string value.
--
-- @since 0.0.2.1
instance IsString PrimitiveAttribute where
  fromString :: String -> PrimitiveAttribute
fromString = Text -> PrimitiveAttribute
TextAttribute (Text -> PrimitiveAttribute)
-> (String -> Text) -> String -> PrimitiveAttribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | Create a `TextAttribute` from the string value.
--
-- @since 0.0.2.1
instance IsString Attribute where
  fromString :: String -> Attribute
fromString = PrimitiveAttribute -> Attribute
AttributeValue (PrimitiveAttribute -> Attribute)
-> (String -> PrimitiveAttribute) -> String -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PrimitiveAttribute
forall a. IsString a => String -> a
fromString

data PrimitiveAttribute
  = TextAttribute Text
  | BoolAttribute Bool
  | DoubleAttribute Double
  | IntAttribute Int64
  deriving stock (ReadPrec [PrimitiveAttribute]
ReadPrec PrimitiveAttribute
Int -> ReadS PrimitiveAttribute
ReadS [PrimitiveAttribute]
(Int -> ReadS PrimitiveAttribute)
-> ReadS [PrimitiveAttribute]
-> ReadPrec PrimitiveAttribute
-> ReadPrec [PrimitiveAttribute]
-> Read PrimitiveAttribute
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrimitiveAttribute]
$creadListPrec :: ReadPrec [PrimitiveAttribute]
readPrec :: ReadPrec PrimitiveAttribute
$creadPrec :: ReadPrec PrimitiveAttribute
readList :: ReadS [PrimitiveAttribute]
$creadList :: ReadS [PrimitiveAttribute]
readsPrec :: Int -> ReadS PrimitiveAttribute
$creadsPrec :: Int -> ReadS PrimitiveAttribute
Read, Int -> PrimitiveAttribute -> ShowS
[PrimitiveAttribute] -> ShowS
PrimitiveAttribute -> String
(Int -> PrimitiveAttribute -> ShowS)
-> (PrimitiveAttribute -> String)
-> ([PrimitiveAttribute] -> ShowS)
-> Show PrimitiveAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimitiveAttribute] -> ShowS
$cshowList :: [PrimitiveAttribute] -> ShowS
show :: PrimitiveAttribute -> String
$cshow :: PrimitiveAttribute -> String
showsPrec :: Int -> PrimitiveAttribute -> ShowS
$cshowsPrec :: Int -> PrimitiveAttribute -> ShowS
Show, PrimitiveAttribute -> PrimitiveAttribute -> Bool
(PrimitiveAttribute -> PrimitiveAttribute -> Bool)
-> (PrimitiveAttribute -> PrimitiveAttribute -> Bool)
-> Eq PrimitiveAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
$c/= :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
== :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
$c== :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
Eq, Eq PrimitiveAttribute
Eq PrimitiveAttribute
-> (PrimitiveAttribute -> PrimitiveAttribute -> Ordering)
-> (PrimitiveAttribute -> PrimitiveAttribute -> Bool)
-> (PrimitiveAttribute -> PrimitiveAttribute -> Bool)
-> (PrimitiveAttribute -> PrimitiveAttribute -> Bool)
-> (PrimitiveAttribute -> PrimitiveAttribute -> Bool)
-> (PrimitiveAttribute -> PrimitiveAttribute -> PrimitiveAttribute)
-> (PrimitiveAttribute -> PrimitiveAttribute -> PrimitiveAttribute)
-> Ord PrimitiveAttribute
PrimitiveAttribute -> PrimitiveAttribute -> Bool
PrimitiveAttribute -> PrimitiveAttribute -> Ordering
PrimitiveAttribute -> PrimitiveAttribute -> PrimitiveAttribute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrimitiveAttribute -> PrimitiveAttribute -> PrimitiveAttribute
$cmin :: PrimitiveAttribute -> PrimitiveAttribute -> PrimitiveAttribute
max :: PrimitiveAttribute -> PrimitiveAttribute -> PrimitiveAttribute
$cmax :: PrimitiveAttribute -> PrimitiveAttribute -> PrimitiveAttribute
>= :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
$c>= :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
> :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
$c> :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
<= :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
$c<= :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
< :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
$c< :: PrimitiveAttribute -> PrimitiveAttribute -> Bool
compare :: PrimitiveAttribute -> PrimitiveAttribute -> Ordering
$ccompare :: PrimitiveAttribute -> PrimitiveAttribute -> Ordering
$cp1Ord :: Eq PrimitiveAttribute
Ord, Typeable PrimitiveAttribute
DataType
Constr
Typeable PrimitiveAttribute
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> PrimitiveAttribute
    -> c PrimitiveAttribute)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PrimitiveAttribute)
-> (PrimitiveAttribute -> Constr)
-> (PrimitiveAttribute -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PrimitiveAttribute))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PrimitiveAttribute))
-> ((forall b. Data b => b -> b)
    -> PrimitiveAttribute -> PrimitiveAttribute)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PrimitiveAttribute -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PrimitiveAttribute -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PrimitiveAttribute -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PrimitiveAttribute -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PrimitiveAttribute -> m PrimitiveAttribute)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PrimitiveAttribute -> m PrimitiveAttribute)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PrimitiveAttribute -> m PrimitiveAttribute)
-> Data PrimitiveAttribute
PrimitiveAttribute -> DataType
PrimitiveAttribute -> Constr
(forall b. Data b => b -> b)
-> PrimitiveAttribute -> PrimitiveAttribute
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PrimitiveAttribute
-> c PrimitiveAttribute
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimitiveAttribute
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PrimitiveAttribute -> u
forall u. (forall d. Data d => d -> u) -> PrimitiveAttribute -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimitiveAttribute -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimitiveAttribute -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PrimitiveAttribute -> m PrimitiveAttribute
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PrimitiveAttribute -> m PrimitiveAttribute
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimitiveAttribute
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PrimitiveAttribute
-> c PrimitiveAttribute
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimitiveAttribute)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrimitiveAttribute)
$cIntAttribute :: Constr
$cDoubleAttribute :: Constr
$cBoolAttribute :: Constr
$cTextAttribute :: Constr
$tPrimitiveAttribute :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> PrimitiveAttribute -> m PrimitiveAttribute
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PrimitiveAttribute -> m PrimitiveAttribute
gmapMp :: (forall d. Data d => d -> m d)
-> PrimitiveAttribute -> m PrimitiveAttribute
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PrimitiveAttribute -> m PrimitiveAttribute
gmapM :: (forall d. Data d => d -> m d)
-> PrimitiveAttribute -> m PrimitiveAttribute
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PrimitiveAttribute -> m PrimitiveAttribute
gmapQi :: Int -> (forall d. Data d => d -> u) -> PrimitiveAttribute -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PrimitiveAttribute -> u
gmapQ :: (forall d. Data d => d -> u) -> PrimitiveAttribute -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PrimitiveAttribute -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimitiveAttribute -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimitiveAttribute -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimitiveAttribute -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimitiveAttribute -> r
gmapT :: (forall b. Data b => b -> b)
-> PrimitiveAttribute -> PrimitiveAttribute
$cgmapT :: (forall b. Data b => b -> b)
-> PrimitiveAttribute -> PrimitiveAttribute
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrimitiveAttribute)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrimitiveAttribute)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PrimitiveAttribute)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimitiveAttribute)
dataTypeOf :: PrimitiveAttribute -> DataType
$cdataTypeOf :: PrimitiveAttribute -> DataType
toConstr :: PrimitiveAttribute -> Constr
$ctoConstr :: PrimitiveAttribute -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimitiveAttribute
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimitiveAttribute
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PrimitiveAttribute
-> c PrimitiveAttribute
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PrimitiveAttribute
-> c PrimitiveAttribute
$cp1Data :: Typeable PrimitiveAttribute
Data, (forall x. PrimitiveAttribute -> Rep PrimitiveAttribute x)
-> (forall x. Rep PrimitiveAttribute x -> PrimitiveAttribute)
-> Generic PrimitiveAttribute
forall x. Rep PrimitiveAttribute x -> PrimitiveAttribute
forall x. PrimitiveAttribute -> Rep PrimitiveAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrimitiveAttribute x -> PrimitiveAttribute
$cfrom :: forall x. PrimitiveAttribute -> Rep PrimitiveAttribute x
Generic)
  deriving anyclass (Eq PrimitiveAttribute
Eq PrimitiveAttribute
-> (Int -> PrimitiveAttribute -> Int)
-> (PrimitiveAttribute -> Int)
-> Hashable PrimitiveAttribute
Int -> PrimitiveAttribute -> Int
PrimitiveAttribute -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PrimitiveAttribute -> Int
$chash :: PrimitiveAttribute -> Int
hashWithSalt :: Int -> PrimitiveAttribute -> Int
$chashWithSalt :: Int -> PrimitiveAttribute -> Int
$cp1Hashable :: Eq PrimitiveAttribute
Hashable)

-- | Convert a Haskell value to an 'Attribute' value.
--
-- For most values, you can define an instance of 'ToPrimitiveAttribute' and use the default 'toAttribute' implementation:
--
-- @
--
-- data Foo = Foo
--
-- instance ToPrimitiveAttribute Foo where
--   toPrimitiveAttribute Foo = TextAttribute "Foo"
-- instance ToAttribute foo
--
-- @
class ToAttribute a where
  toAttribute :: a -> Attribute
  default toAttribute :: ToPrimitiveAttribute a => a -> Attribute
  toAttribute = PrimitiveAttribute -> Attribute
AttributeValue (PrimitiveAttribute -> Attribute)
-> (a -> PrimitiveAttribute) -> a -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PrimitiveAttribute
forall a. ToPrimitiveAttribute a => a -> PrimitiveAttribute
toPrimitiveAttribute

instance ToPrimitiveAttribute PrimitiveAttribute where
  toPrimitiveAttribute :: PrimitiveAttribute -> PrimitiveAttribute
toPrimitiveAttribute = PrimitiveAttribute -> PrimitiveAttribute
forall a. a -> a
id

instance ToAttribute PrimitiveAttribute where
  toAttribute :: PrimitiveAttribute -> Attribute
toAttribute = PrimitiveAttribute -> Attribute
AttributeValue

instance ToPrimitiveAttribute Text where
  toPrimitiveAttribute :: Text -> PrimitiveAttribute
toPrimitiveAttribute = Text -> PrimitiveAttribute
TextAttribute
instance ToAttribute Text

instance ToPrimitiveAttribute Bool where
  toPrimitiveAttribute :: Bool -> PrimitiveAttribute
toPrimitiveAttribute = Bool -> PrimitiveAttribute
BoolAttribute
instance ToAttribute Bool

instance ToPrimitiveAttribute Double where
  toPrimitiveAttribute :: Double -> PrimitiveAttribute
toPrimitiveAttribute = Double -> PrimitiveAttribute
DoubleAttribute
instance ToAttribute Double

instance ToPrimitiveAttribute Int64 where
  toPrimitiveAttribute :: Int64 -> PrimitiveAttribute
toPrimitiveAttribute = Int64 -> PrimitiveAttribute
IntAttribute
instance ToAttribute Int64

instance ToPrimitiveAttribute Int where
  toPrimitiveAttribute :: Int -> PrimitiveAttribute
toPrimitiveAttribute = Int64 -> PrimitiveAttribute
IntAttribute (Int64 -> PrimitiveAttribute)
-> (Int -> Int64) -> Int -> PrimitiveAttribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToAttribute Int

instance ToAttribute Attribute where
  toAttribute :: Attribute -> Attribute
toAttribute = Attribute -> Attribute
forall a. a -> a
id

instance ToPrimitiveAttribute a => ToAttribute [a] where
  toAttribute :: [a] -> Attribute
toAttribute = [PrimitiveAttribute] -> Attribute
AttributeArray ([PrimitiveAttribute] -> Attribute)
-> ([a] -> [PrimitiveAttribute]) -> [a] -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> PrimitiveAttribute) -> [a] -> [PrimitiveAttribute]
forall a b. (a -> b) -> [a] -> [b]
map a -> PrimitiveAttribute
forall a. ToPrimitiveAttribute a => a -> PrimitiveAttribute
toPrimitiveAttribute

unsafeMergeAttributesIgnoringLimits :: Attributes -> Attributes -> Attributes
unsafeMergeAttributesIgnoringLimits :: Attributes -> Attributes -> Attributes
unsafeMergeAttributesIgnoringLimits (Attributes HashMap Text Attribute
l Int
lc Int
ld) (Attributes HashMap Text Attribute
r Int
rc Int
rd) = HashMap Text Attribute -> Int -> Int -> Attributes
Attributes (HashMap Text Attribute
l HashMap Text Attribute
-> HashMap Text Attribute -> HashMap Text Attribute
forall a. Semigroup a => a -> a -> a
<> HashMap Text Attribute
r) (Int
lc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rc) (Int
ld Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rd)

unsafeAttributesFromListIgnoringLimits :: [(Text, Attribute)] -> Attributes
unsafeAttributesFromListIgnoringLimits :: [(Text, Attribute)] -> Attributes
unsafeAttributesFromListIgnoringLimits [(Text, Attribute)]
l = HashMap Text Attribute -> Int -> Int -> Attributes
Attributes HashMap Text Attribute
hm Int
c Int
0
  where
    hm :: HashMap Text Attribute
hm = [(Text, Attribute)] -> HashMap Text Attribute
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(Text, Attribute)]
l
    c :: Int
c = HashMap Text Attribute -> Int
forall k v. HashMap k v -> Int
H.size HashMap Text Attribute
hm