{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StrictData #-}

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

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

{- |
 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.Data
import qualified Data.HashMap.Strict as H
import Data.Hashable
import Data.Int (Int64)
import Data.List (foldl')
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics


{- | 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
    { attributeCountLimit :: Maybe Int
attributeCountLimit = forall a. a -> Maybe a
Just Int
128
    , attributeLengthLimit :: Maybe Int
attributeLengthLimit = 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
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
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 forall a. Monoid a => a
mempty Int
0 Int
0


addAttribute :: ToAttribute a => AttributeLimits -> Attributes -> Text -> a -> Attributes
addAttribute :: forall a.
ToAttribute a =>
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 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 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 = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
k (Attribute -> Attribute
limitLengths forall a b. (a -> b) -> a -> b
$ forall a. ToAttribute a => a -> Attribute
toAttribute a
v) HashMap Text Attribute
attributes
    newCount :: Int
newCount =
      if 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 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 forall a b. (a -> b) -> a -> b
$ Int -> PrimitiveAttribute -> PrimitiveAttribute
limitPrimAttr Int
limit_ PrimitiveAttribute
val
        AttributeArray [PrimitiveAttribute]
arr -> [PrimitiveAttribute] -> Attribute
AttributeArray forall a b. (a -> b) -> a -> b
$ 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 :: forall a.
ToAttribute a =>
AttributeLimits -> Attributes -> [(Text, a)] -> Attributes
addAttributes AttributeLimits
limits = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(!Attributes
attrs') (!Text
k, !a
v) -> 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 = 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]
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
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
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
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
Ord, Typeable AttributeLimits
AttributeLimits -> DataType
AttributeLimits -> Constr
(forall b. Data b => b -> b) -> AttributeLimits -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeLimits -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeLimits -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AttributeLimits -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AttributeLimits -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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
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
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
  = -- | An attribute representing a single primitive value
    AttributeValue PrimitiveAttribute
  | -- | An attribute representing an array of primitive values.
    --
    -- All values in the array MUST be of the same primitive attribute type.
    AttributeArray [PrimitiveAttribute]
  deriving stock (ReadPrec [Attribute]
ReadPrec Attribute
Int -> ReadS Attribute
ReadS [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
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
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
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
Ord, Typeable Attribute
Attribute -> DataType
Attribute -> Constr
(forall b. Data b => b -> b) -> Attribute -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Attribute -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attribute -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Attribute -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Attribute -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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
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
Hashable)


{- | Create a `TextAttribute` from the string value.

 @since 0.0.2.1
-}
instance IsString PrimitiveAttribute where
  fromString :: String -> PrimitiveAttribute
fromString = Text -> PrimitiveAttribute
TextAttribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
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
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
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
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
Ord, Typeable PrimitiveAttribute
PrimitiveAttribute -> DataType
PrimitiveAttribute -> Constr
(forall b. Data b => b -> b)
-> PrimitiveAttribute -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> PrimitiveAttribute -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PrimitiveAttribute -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PrimitiveAttribute -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PrimitiveAttribute -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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
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
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToPrimitiveAttribute a => a -> PrimitiveAttribute
toPrimitiveAttribute


instance ToPrimitiveAttribute PrimitiveAttribute where
  toPrimitiveAttribute :: PrimitiveAttribute -> PrimitiveAttribute
toPrimitiveAttribute = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance ToAttribute Int


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


instance ToPrimitiveAttribute a => ToAttribute [a] where
  toAttribute :: [a] -> Attribute
toAttribute = [PrimitiveAttribute] -> Attribute
AttributeArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 forall a. Semigroup a => a -> a -> a
<> HashMap Text Attribute
r) (Int
lc forall a. Num a => a -> a -> a
+ Int
rc) (Int
ld 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 = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(Text, Attribute)]
l
    c :: Int
c = forall k v. HashMap k v -> Int
H.size HashMap Text Attribute
hm