{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module OpenTelemetry.Internal.Common.Types (
  InstrumentationLibrary (..),
  AnyValue (..),
  ToValue (..),
  ShutdownResult (..),
  FlushResult (..),
  ExportResult (..),
  parseInstrumentationLibrary,
  detectInstrumentationLibrary,
) where

import Control.Exception (SomeException)
import Data.ByteString (ByteString)
import Data.Data (Data)
import qualified Data.HashMap.Strict as H
import Data.Hashable (Hashable)
import Data.Int (Int64)
import Data.String (IsString (fromString))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH
import OpenTelemetry.Attributes (Attributes, emptyAttributes)
import Text.Regex.TDFA ((=~~))


{- | An identifier for the library that provides the instrumentation for a given Instrumented Library.
 Instrumented Library and Instrumentation Library may be the same library if it has built-in OpenTelemetry instrumentation.

 The inspiration of the OpenTelemetry project is to make every library and application observable out of the box by having them call OpenTelemetry API directly.
 However, many libraries will not have such integration, and as such there is a need for a separate library which would inject such calls, using mechanisms such as wrapping interfaces,
 subscribing to library-specific callbacks, or translating existing telemetry into the OpenTelemetry model.

 A library that enables OpenTelemetry observability for another library is called an Instrumentation Library.

 An instrumentation library should be named to follow any naming conventions of the instrumented library (e.g. 'middleware' for a web framework).

 If there is no established name, the recommendation is to prefix packages with "hs-opentelemetry-instrumentation", followed by the instrumented library name itself.

 In general, the simplest way to get the instrumentation library is to use 'detectInstrumentationLibrary', which uses the Haskell package name and version.
-}
data InstrumentationLibrary = InstrumentationLibrary
  { InstrumentationLibrary -> Text
libraryName :: {-# UNPACK #-} !Text
  -- ^ The name of the instrumentation library
  , InstrumentationLibrary -> Text
libraryVersion :: {-# UNPACK #-} !Text
  -- ^ The version of the instrumented library
  , InstrumentationLibrary -> Text
librarySchemaUrl :: {-# UNPACK #-} !Text
  , InstrumentationLibrary -> Attributes
libraryAttributes :: Attributes
  }
  deriving (Eq InstrumentationLibrary
Eq InstrumentationLibrary =>
(InstrumentationLibrary -> InstrumentationLibrary -> Ordering)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary
    -> InstrumentationLibrary -> InstrumentationLibrary)
-> (InstrumentationLibrary
    -> InstrumentationLibrary -> InstrumentationLibrary)
-> Ord InstrumentationLibrary
InstrumentationLibrary -> InstrumentationLibrary -> Bool
InstrumentationLibrary -> InstrumentationLibrary -> Ordering
InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
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
$ccompare :: InstrumentationLibrary -> InstrumentationLibrary -> Ordering
compare :: InstrumentationLibrary -> InstrumentationLibrary -> Ordering
$c< :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
< :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c<= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
<= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c> :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
> :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c>= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
>= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$cmax :: InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
max :: InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
$cmin :: InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
min :: InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
Ord, InstrumentationLibrary -> InstrumentationLibrary -> Bool
(InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> Eq InstrumentationLibrary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
== :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c/= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
/= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
Eq, (forall x. InstrumentationLibrary -> Rep InstrumentationLibrary x)
-> (forall x.
    Rep InstrumentationLibrary x -> InstrumentationLibrary)
-> Generic InstrumentationLibrary
forall x. Rep InstrumentationLibrary x -> InstrumentationLibrary
forall x. InstrumentationLibrary -> Rep InstrumentationLibrary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InstrumentationLibrary -> Rep InstrumentationLibrary x
from :: forall x. InstrumentationLibrary -> Rep InstrumentationLibrary x
$cto :: forall x. Rep InstrumentationLibrary x -> InstrumentationLibrary
to :: forall x. Rep InstrumentationLibrary x -> InstrumentationLibrary
Generic, Int -> InstrumentationLibrary -> ShowS
[InstrumentationLibrary] -> ShowS
InstrumentationLibrary -> String
(Int -> InstrumentationLibrary -> ShowS)
-> (InstrumentationLibrary -> String)
-> ([InstrumentationLibrary] -> ShowS)
-> Show InstrumentationLibrary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstrumentationLibrary -> ShowS
showsPrec :: Int -> InstrumentationLibrary -> ShowS
$cshow :: InstrumentationLibrary -> String
show :: InstrumentationLibrary -> String
$cshowList :: [InstrumentationLibrary] -> ShowS
showList :: [InstrumentationLibrary] -> ShowS
Show, (forall (m :: * -> *). Quote m => InstrumentationLibrary -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    InstrumentationLibrary -> Code m InstrumentationLibrary)
-> Lift InstrumentationLibrary
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => InstrumentationLibrary -> m Exp
forall (m :: * -> *).
Quote m =>
InstrumentationLibrary -> Code m InstrumentationLibrary
$clift :: forall (m :: * -> *). Quote m => InstrumentationLibrary -> m Exp
lift :: forall (m :: * -> *). Quote m => InstrumentationLibrary -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
InstrumentationLibrary -> Code m InstrumentationLibrary
liftTyped :: forall (m :: * -> *).
Quote m =>
InstrumentationLibrary -> Code m InstrumentationLibrary
TH.Lift)


instance Hashable InstrumentationLibrary


instance IsString InstrumentationLibrary where
  fromString :: String -> InstrumentationLibrary
  fromString :: String -> InstrumentationLibrary
fromString String
str = Text -> Text -> Text -> Attributes -> InstrumentationLibrary
InstrumentationLibrary (String -> Text
forall a. IsString a => String -> a
fromString String
str) Text
"" Text
"" Attributes
emptyAttributes


{- | An attribute represents user-provided metadata about a span, link, or event.

 'Any' values are used in place of 'Standard Attributes' in logs because third-party
 logs may not conform to the 'Standard Attribute' format.

 Telemetry tools may use this data to support high-cardinality querying, visualization
 in waterfall diagrams, trace sampling decisions, and more.
-}
data AnyValue
  = TextValue Text
  | BoolValue Bool
  | DoubleValue Double
  | IntValue Int64
  | ByteStringValue ByteString
  | ArrayValue [AnyValue]
  | HashMapValue (H.HashMap Text AnyValue)
  | NullValue
  deriving stock (ReadPrec [AnyValue]
ReadPrec AnyValue
Int -> ReadS AnyValue
ReadS [AnyValue]
(Int -> ReadS AnyValue)
-> ReadS [AnyValue]
-> ReadPrec AnyValue
-> ReadPrec [AnyValue]
-> Read AnyValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AnyValue
readsPrec :: Int -> ReadS AnyValue
$creadList :: ReadS [AnyValue]
readList :: ReadS [AnyValue]
$creadPrec :: ReadPrec AnyValue
readPrec :: ReadPrec AnyValue
$creadListPrec :: ReadPrec [AnyValue]
readListPrec :: ReadPrec [AnyValue]
Read, Int -> AnyValue -> ShowS
[AnyValue] -> ShowS
AnyValue -> String
(Int -> AnyValue -> ShowS)
-> (AnyValue -> String) -> ([AnyValue] -> ShowS) -> Show AnyValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnyValue -> ShowS
showsPrec :: Int -> AnyValue -> ShowS
$cshow :: AnyValue -> String
show :: AnyValue -> String
$cshowList :: [AnyValue] -> ShowS
showList :: [AnyValue] -> ShowS
Show, AnyValue -> AnyValue -> Bool
(AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> Bool) -> Eq AnyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnyValue -> AnyValue -> Bool
== :: AnyValue -> AnyValue -> Bool
$c/= :: AnyValue -> AnyValue -> Bool
/= :: AnyValue -> AnyValue -> Bool
Eq, Eq AnyValue
Eq AnyValue =>
(AnyValue -> AnyValue -> Ordering)
-> (AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> AnyValue)
-> (AnyValue -> AnyValue -> AnyValue)
-> Ord AnyValue
AnyValue -> AnyValue -> Bool
AnyValue -> AnyValue -> Ordering
AnyValue -> AnyValue -> AnyValue
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
$ccompare :: AnyValue -> AnyValue -> Ordering
compare :: AnyValue -> AnyValue -> Ordering
$c< :: AnyValue -> AnyValue -> Bool
< :: AnyValue -> AnyValue -> Bool
$c<= :: AnyValue -> AnyValue -> Bool
<= :: AnyValue -> AnyValue -> Bool
$c> :: AnyValue -> AnyValue -> Bool
> :: AnyValue -> AnyValue -> Bool
$c>= :: AnyValue -> AnyValue -> Bool
>= :: AnyValue -> AnyValue -> Bool
$cmax :: AnyValue -> AnyValue -> AnyValue
max :: AnyValue -> AnyValue -> AnyValue
$cmin :: AnyValue -> AnyValue -> AnyValue
min :: AnyValue -> AnyValue -> AnyValue
Ord, Typeable AnyValue
Typeable AnyValue =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AnyValue -> c AnyValue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AnyValue)
-> (AnyValue -> Constr)
-> (AnyValue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AnyValue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnyValue))
-> ((forall b. Data b => b -> b) -> AnyValue -> AnyValue)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AnyValue -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AnyValue -> r)
-> (forall u. (forall d. Data d => d -> u) -> AnyValue -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> AnyValue -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AnyValue -> m AnyValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AnyValue -> m AnyValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AnyValue -> m AnyValue)
-> Data AnyValue
AnyValue -> Constr
AnyValue -> DataType
(forall b. Data b => b -> b) -> AnyValue -> AnyValue
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) -> AnyValue -> u
forall u. (forall d. Data d => d -> u) -> AnyValue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnyValue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnyValue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnyValue -> m AnyValue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnyValue -> m AnyValue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnyValue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnyValue -> c AnyValue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnyValue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnyValue)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnyValue -> c AnyValue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnyValue -> c AnyValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnyValue
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnyValue
$ctoConstr :: AnyValue -> Constr
toConstr :: AnyValue -> Constr
$cdataTypeOf :: AnyValue -> DataType
dataTypeOf :: AnyValue -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnyValue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnyValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnyValue)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnyValue)
$cgmapT :: (forall b. Data b => b -> b) -> AnyValue -> AnyValue
gmapT :: (forall b. Data b => b -> b) -> AnyValue -> AnyValue
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnyValue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnyValue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnyValue -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnyValue -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnyValue -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AnyValue -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AnyValue -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AnyValue -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnyValue -> m AnyValue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnyValue -> m AnyValue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnyValue -> m AnyValue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnyValue -> m AnyValue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnyValue -> m AnyValue
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnyValue -> m AnyValue
Data, (forall x. AnyValue -> Rep AnyValue x)
-> (forall x. Rep AnyValue x -> AnyValue) -> Generic AnyValue
forall x. Rep AnyValue x -> AnyValue
forall x. AnyValue -> Rep AnyValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnyValue -> Rep AnyValue x
from :: forall x. AnyValue -> Rep AnyValue x
$cto :: forall x. Rep AnyValue x -> AnyValue
to :: forall x. Rep AnyValue x -> AnyValue
Generic)
  deriving anyclass (Eq AnyValue
Eq AnyValue =>
(Int -> AnyValue -> Int) -> (AnyValue -> Int) -> Hashable AnyValue
Int -> AnyValue -> Int
AnyValue -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> AnyValue -> Int
hashWithSalt :: Int -> AnyValue -> Int
$chash :: AnyValue -> Int
hash :: AnyValue -> Int
Hashable)


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


{- | Convert a Haskell value to an 'Any' value.

 @

 data Foo = Foo

 instance ToValue Foo where
   toValue Foo = TextValue "Foo"

 @
-}
class ToValue a where
  toValue :: a -> AnyValue


instance ToValue Text where
  toValue :: Text -> AnyValue
  toValue :: Text -> AnyValue
toValue = Text -> AnyValue
TextValue


instance ToValue Bool where
  toValue :: Bool -> AnyValue
  toValue :: Bool -> AnyValue
toValue = Bool -> AnyValue
BoolValue


instance ToValue Double where
  toValue :: Double -> AnyValue
  toValue :: Double -> AnyValue
toValue = Double -> AnyValue
DoubleValue


instance ToValue Int64 where
  toValue :: Int64 -> AnyValue
  toValue :: Int64 -> AnyValue
toValue = Int64 -> AnyValue
IntValue


instance ToValue ByteString where
  toValue :: ByteString -> AnyValue
  toValue :: ByteString -> AnyValue
toValue = ByteString -> AnyValue
ByteStringValue


instance (ToValue a) => ToValue [a] where
  toValue :: (ToValue a) => [a] -> AnyValue
  toValue :: ToValue a => [a] -> AnyValue
toValue = [AnyValue] -> AnyValue
ArrayValue ([AnyValue] -> AnyValue) -> ([a] -> [AnyValue]) -> [a] -> AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> AnyValue) -> [a] -> [AnyValue]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> AnyValue
forall a. ToValue a => a -> AnyValue
toValue


instance (ToValue a) => ToValue (H.HashMap Text a) where
  toValue :: (ToValue a) => H.HashMap Text a -> AnyValue
  toValue :: ToValue a => HashMap Text a -> AnyValue
toValue = HashMap Text AnyValue -> AnyValue
HashMapValue (HashMap Text AnyValue -> AnyValue)
-> (HashMap Text a -> HashMap Text AnyValue)
-> HashMap Text a
-> AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> AnyValue) -> HashMap Text a -> HashMap Text AnyValue
forall a b. (a -> b) -> HashMap Text a -> HashMap Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> AnyValue
forall a. ToValue a => a -> AnyValue
toValue


instance ToValue AnyValue where
  toValue :: AnyValue -> AnyValue
  toValue :: AnyValue -> AnyValue
toValue = AnyValue -> AnyValue
forall a. a -> a
id


data ShutdownResult = ShutdownSuccess | ShutdownFailure | ShutdownTimeout


-- | The outcome of a call to @OpenTelemetry.Trace.forceFlush@ or @OpenTelemetry.Logs.forceFlush@
data FlushResult
  = -- | One or more spans or @LogRecord@s did not export from all associated exporters
    -- within the alotted timeframe.
    FlushTimeout
  | -- | Flushing spans or @LogRecord@s to all associated exporters succeeded.
    FlushSuccess
  | -- | One or more exporters failed to successfully export one or more
    -- unexported spans or @LogRecord@s.
    FlushError
  deriving (Int -> FlushResult -> ShowS
[FlushResult] -> ShowS
FlushResult -> String
(Int -> FlushResult -> ShowS)
-> (FlushResult -> String)
-> ([FlushResult] -> ShowS)
-> Show FlushResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlushResult -> ShowS
showsPrec :: Int -> FlushResult -> ShowS
$cshow :: FlushResult -> String
show :: FlushResult -> String
$cshowList :: [FlushResult] -> ShowS
showList :: [FlushResult] -> ShowS
Show)


data ExportResult
  = Success
  | Failure (Maybe SomeException)


-- | Parses a package-version string into an InstrumentationLibrary'.
parseInstrumentationLibrary :: (MonadFail m) => String -> m InstrumentationLibrary
parseInstrumentationLibrary :: forall (m :: * -> *).
MonadFail m =>
String -> m InstrumentationLibrary
parseInstrumentationLibrary String
packageString = do
  let String
packageNameRegex :: String = String
"([a-zA-Z0-9-]+[a-zA-Z0-9]+)"
  let String
versionRegex :: String = String
"([0-9\\.]+)"
  -- First try and parse with a mandatory version string on the end. If that fails, try
  -- to parse just a package name
  let String
fullRegex :: String = String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
packageNameRegex String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
versionRegex String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")|" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
packageNameRegex
  (String
_ :: String, String
_ :: String, String
_ :: String, [String]
groups :: [String]) <- String
packageString String -> String -> m (String, String, String, [String])
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ String
fullRegex
  -- We end up with 5 groups overall
  (String
name, String
version) <- case [String]
groups of
    [String
_, String
name, String
version, String
""] -> (String, String) -> m (String, String)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
name, String
version)
    [String
_, String
_, String
_, String
name] -> (String, String) -> m (String, String)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
name, String
"")
    [String]
_ -> String -> m (String, String)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (String, String)) -> String -> m (String, String)
forall a b. (a -> b) -> a -> b
$ String
"could not parse package string: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
packageString
  InstrumentationLibrary -> m InstrumentationLibrary
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstrumentationLibrary -> m InstrumentationLibrary)
-> InstrumentationLibrary -> m InstrumentationLibrary
forall a b. (a -> b) -> a -> b
$ InstrumentationLibrary {libraryName :: Text
libraryName = String -> Text
T.pack String
name, libraryVersion :: Text
libraryVersion = String -> Text
T.pack String
version, librarySchemaUrl :: Text
librarySchemaUrl = Text
"", libraryAttributes :: Attributes
libraryAttributes = Attributes
emptyAttributes}


-- | Works out the instrumentation library for your package.
detectInstrumentationLibrary :: forall m. (TH.Quasi m, TH.Quote m) => m TH.Exp
detectInstrumentationLibrary :: forall (m :: * -> *). (Quasi m, Quote m) => m Exp
detectInstrumentationLibrary = do
  TH.Loc {String
loc_package :: String
loc_package :: Loc -> String
loc_package} <- m Loc
forall (m :: * -> *). Quasi m => m Loc
TH.qLocation
  InstrumentationLibrary
lib <- String -> m InstrumentationLibrary
forall (m :: * -> *).
MonadFail m =>
String -> m InstrumentationLibrary
parseInstrumentationLibrary String
loc_package
  InstrumentationLibrary -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => InstrumentationLibrary -> m Exp
TH.lift InstrumentationLibrary
lib