{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE InstanceSigs        #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Instana.SDK.Span.SpanData
Description : A type for span data, that is, the content in span.data.
-}
module Instana.SDK.Span.SpanData
  ( SpanData (SpanData)
  , Annotation (..)
  , AnnotationValue (..)
  , empty
  , listAnnotation
  , listValue
  , merge
  , nullAnnotation
  , objectAnnotation
  , optionalAnnotation
  , optionalValue
  , simpleAnnotation
  , simpleValue
  , singleAnnotation
  ) where


import           Data.Aeson                (KeyValue, ToJSON, Value, (.=))
import qualified Data.Aeson                as Aeson
import qualified Data.List                 as L
import qualified Data.Maybe                as Maybe
import           Data.Text                 (Text)
import qualified Data.Vector               as V
import           GHC.Generics

import           Instana.SDK.Internal.Util ((|>))


-- |Represents span.data, that is, the tree of free-form annotatiations for a
-- span.
data SpanData =
  SpanData [Annotation]
  deriving (SpanData -> SpanData -> Bool
(SpanData -> SpanData -> Bool)
-> (SpanData -> SpanData -> Bool) -> Eq SpanData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanData -> SpanData -> Bool
$c/= :: SpanData -> SpanData -> Bool
== :: SpanData -> SpanData -> Bool
$c== :: SpanData -> SpanData -> Bool
Eq, (forall x. SpanData -> Rep SpanData x)
-> (forall x. Rep SpanData x -> SpanData) -> Generic SpanData
forall x. Rep SpanData x -> SpanData
forall x. SpanData -> Rep SpanData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpanData x -> SpanData
$cfrom :: forall x. SpanData -> Rep SpanData x
Generic, Int -> SpanData -> ShowS
[SpanData] -> ShowS
SpanData -> String
(Int -> SpanData -> ShowS)
-> (SpanData -> String) -> ([SpanData] -> ShowS) -> Show SpanData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanData] -> ShowS
$cshowList :: [SpanData] -> ShowS
show :: SpanData -> String
$cshow :: SpanData -> String
showsPrec :: Int -> SpanData -> ShowS
$cshowsPrec :: Int -> SpanData -> ShowS
Show)


instance ToJSON SpanData where
  toJSON :: SpanData -> Value
  toJSON :: SpanData -> Value
toJSON (SpanData annotations :: [Annotation]
annotations) =
    [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      (Annotation -> Maybe Pair) -> [Annotation] -> [Maybe Pair]
forall a b. (a -> b) -> [a] -> [b]
map Annotation -> Maybe Pair
forall kv. KeyValue kv => Annotation -> Maybe kv
annotationToJson [Annotation]
annotations
      [Maybe Pair] -> ([Maybe Pair] -> [Pair]) -> [Pair]
forall a b. a -> (a -> b) -> b
|> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes


-- |Creates empty span data.
empty :: SpanData
empty :: SpanData
empty = [Annotation] -> SpanData
SpanData []


-- |Merges the given annotation into the given span data. If there is a conflict
-- between existing annotations and a new annotation (that is, both are at the
-- same path of keys), this will be resolved as follows:
-- - If both the existing and the new annotation are list annotations, they will
--   be merged. Duplicates are allowed (that is, duplicate values will not be
--   removed).
-- - Otherwise, if the existing annotation or the new annotation is a single
--   annotation, the new annotation will overwrite the existing one.
-- - If both the existing and the new annotation are object annotations, they
--   will be merged by applying these rules recursively.
merge :: Annotation -> SpanData -> SpanData
merge :: Annotation -> SpanData -> SpanData
merge newAnnotation :: Annotation
newAnnotation (SpanData existingAnnotations :: [Annotation]
existingAnnotations) =
  [Annotation] -> SpanData
SpanData ([Annotation] -> SpanData) -> [Annotation] -> SpanData
forall a b. (a -> b) -> a -> b
$ Annotation -> [Annotation] -> [Annotation]
mergeAnnotation Annotation
newAnnotation [Annotation]
existingAnnotations


mergeAnnotation :: Annotation -> [Annotation] -> [Annotation]
mergeAnnotation :: Annotation -> [Annotation] -> [Annotation]
mergeAnnotation newAnnotation :: Annotation
newAnnotation existingAnnotations :: [Annotation]
existingAnnotations =
  let
    key :: Text
key =
      Annotation -> Text
getKey Annotation
newAnnotation
    existingAnnotationForKeyMaybe :: Maybe Annotation
existingAnnotationForKeyMaybe =
      (Annotation -> Bool) -> [Annotation] -> Maybe Annotation
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key) (Text -> Bool) -> (Annotation -> Text) -> Annotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
getKey) [Annotation]
existingAnnotations
  in
  case Maybe Annotation
existingAnnotationForKeyMaybe of
    Nothing ->
      -- The new key does not exist yet, simply add it.
      [Annotation]
existingAnnotations [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation
newAnnotation]
    Just existingAnnotationForKey :: Annotation
existingAnnotationForKey ->
      let
        annotationsWithoutPrevious :: [Annotation]
annotationsWithoutPrevious =
          (Annotation -> [Annotation] -> [Annotation]
forall a. Eq a => a -> [a] -> [a]
L.delete Annotation
existingAnnotationForKey [Annotation]
existingAnnotations)
      in
      case (Annotation
existingAnnotationForKey, Annotation
newAnnotation) of
        (Single _ (List values1 :: [Value]
values1), Single _ (List values2 :: [Value]
values2)) ->

          -- The key exists already and both the existing and the new annotation
          -- are lists. Merge both list values into one list annotation.
          [Annotation]
annotationsWithoutPrevious [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++
            [Text -> AnnotationValue -> Annotation
Single Text
key (AnnotationValue -> Annotation) -> AnnotationValue -> Annotation
forall a b. (a -> b) -> a -> b
$ [Value] -> AnnotationValue
List ([Value] -> AnnotationValue) -> [Value] -> AnnotationValue
forall a b. (a -> b) -> a -> b
$ [Value]
values1 [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value]
values2]

        (Single _ _, _) ->

          -- The key exists already but was previously a single value. We
          -- cannot merge the new annotation into the single value annotation,
          -- overwrite it.
          [Annotation]
annotationsWithoutPrevious [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation
newAnnotation]

        (_, Single _ _) ->

          -- The key exists already but the new value is single value. We
          -- cannot merge the new annotation into an existing annotation,
          -- overwrite it.
          [Annotation]
annotationsWithoutPrevious [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation
newAnnotation]

        (Object _ previousChildren :: [Annotation]
previousChildren, Object _ newChildren :: [Annotation]
newChildren) ->

          -- The key exists already and both the existing and the new annotation
          -- are object annotations. We merge both structures by recursively
          -- merging all child annotations from the new object annotation with
          -- the child annotations from the existing object annotation.
          let
            mergedChildAnnotations :: [Annotation]
mergedChildAnnotations =
              (Annotation -> [Annotation] -> [Annotation])
-> [Annotation] -> [Annotation] -> [Annotation]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr
                Annotation -> [Annotation] -> [Annotation]
mergeAnnotation
                [Annotation]
previousChildren -- starting value for foldr
                [Annotation]
newChildren      -- the list we iterate over
          in
          [Annotation]
annotationsWithoutPrevious [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Text -> [Annotation] -> Annotation
Object Text
key [Annotation]
mergedChildAnnotations]


-- |Represents a single item in span.data, either an object with child
-- annotations or a single annotation (String, Int, Boolean, List, Maybe etc.)
data Annotation =
  -- |Similar to the type Data.Aeson.Types.Object, an object annotation can hold
  -- multiple child annotations. In
  -- { "http":
  --   { "url": "http://localhost:8080"
  --   , "method": "GET"
  --   , "headers": [("X-Header-1", "value 1), ("X-Header-2", "value 2)]
  --   }
  -- }
  -- the "http" key would be an Object annotation.
  Object Text [Annotation]
  -- |Somewhat similar to Data.Aeson.Types.Pair, a single annotation holds one
  -- single value (String, Number, Boolean, List, Maybe etc.). In the example
  -- above, "url", "method" and headers would be Single annotations.
  | Single Text AnnotationValue
  deriving (Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq, (forall x. Annotation -> Rep Annotation x)
-> (forall x. Rep Annotation x -> Annotation) -> Generic Annotation
forall x. Rep Annotation x -> Annotation
forall x. Annotation -> Rep Annotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Annotation x -> Annotation
$cfrom :: forall x. Annotation -> Rep Annotation x
Generic, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show)


-- |Converts a single annotation to a Aeson.KeyValue. An annotation on its own
-- cannot be converted into an Aeson.Value, since it needs to be  wrapped in
-- another Object annotationa and ultimately in SpanData. This implementation
-- will also take care of removing optional annotations that are Nothing.
annotationToJson :: forall kv . KeyValue kv => Annotation -> Maybe kv
annotationToJson :: Annotation -> Maybe kv
annotationToJson annotation :: Annotation
annotation =
  case Annotation
annotation of
    Object key :: Text
key childAnnotations :: [Annotation]
childAnnotations ->
      let
        object :: Value
        object :: Value
object =
          [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Annotation -> Maybe Pair) -> [Annotation] -> [Maybe Pair]
forall a b. (a -> b) -> [a] -> [b]
map Annotation -> Maybe Pair
forall kv. KeyValue kv => Annotation -> Maybe kv
annotationToJson [Annotation]
childAnnotations [Maybe Pair] -> ([Maybe Pair] -> [Pair]) -> [Pair]
forall a b. a -> (a -> b) -> b
|> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
        keyValue :: kv
        keyValue :: kv
keyValue = (Text
key Text -> Value -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
object)
      in
      kv -> Maybe kv
forall a. a -> Maybe a
Just kv
keyValue

    Single _ (Optional Nothing) ->
      -- drop optional annotations that are Nothing
      Maybe kv
forall a. Maybe a
Nothing

    Single key :: Text
key annotationValue :: AnnotationValue
annotationValue ->
      let
        pair :: kv
        pair :: kv
pair = (Text
key Text -> Value -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (AnnotationValue -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON AnnotationValue
annotationValue))
      in
      kv -> Maybe kv
forall a. a -> Maybe a
Just kv
pair


-- |Retrieves the key from an annotation.
getKey :: Annotation -> Text
getKey :: Annotation -> Text
getKey (Object key :: Text
key _) = Text
key
getKey (Single key :: Text
key _) = Text
key


-- |Creates a new object annotation. Similar to the type
-- Data.Aeson.Types.Object, an object annotation can hold multiple child
-- annotations. In
-- { "http":
--   { "url": "http://localhost:8080"
--   , "method": "GET"
--   }
-- }
-- the "http" key would be an Object annotation.
objectAnnotation :: Text -> [Annotation] -> Annotation
objectAnnotation :: Text -> [Annotation] -> Annotation
objectAnnotation key :: Text
key children :: [Annotation]
children = Text -> [Annotation] -> Annotation
Object Text
key [Annotation]
children


-- |Creates a single annotation. Somewhat similar to Data.Aeson.Types.Pair, a
-- single annotation holds one value
-- (String, Number, Boolean, List, Maybe etc.).
--
-- The convenience functions simpleAnnotation, listAnnotation, and
-- optionalAnnotation allow creating a single annotation without creating the
-- AnnotationValue explicitly.
singleAnnotation :: Text -> AnnotationValue -> Annotation
singleAnnotation :: Text -> AnnotationValue -> Annotation
singleAnnotation key :: Text
key value :: AnnotationValue
value = Text -> AnnotationValue -> Annotation
Single Text
key AnnotationValue
value


-- |Creates a simple annotation, which holds one primitive value (String,
-- Number, Boolean, etc.).
simpleAnnotation :: ToJSON a => Text -> a -> Annotation
simpleAnnotation :: Text -> a -> Annotation
simpleAnnotation key :: Text
key = (Text -> AnnotationValue -> Annotation
Single Text
key) (AnnotationValue -> Annotation)
-> (a -> AnnotationValue) -> a -> Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AnnotationValue
forall a. ToJSON a => a -> AnnotationValue
simpleValue


-- |Creates a list annotation, which holds a list of items. For list
-- annotations, consecutive merges with the same key will add to the list
-- instead of overwriting previous values.
listAnnotation :: ToJSON a => Text -> [a] -> Annotation
listAnnotation :: Text -> [a] -> Annotation
listAnnotation key :: Text
key = (Text -> AnnotationValue -> Annotation
Single Text
key) (AnnotationValue -> Annotation)
-> ([a] -> AnnotationValue) -> [a] -> Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> AnnotationValue
forall a. ToJSON a => [a] -> AnnotationValue
listValue


-- |Creates an optional annotation, which holds a Maybe. If an optional
-- annotation holds a Nothing value, it will be ommitted when SpanData is
-- encoded to JSON.
optionalAnnotation :: ToJSON a => Text -> Maybe a -> Annotation
optionalAnnotation :: Text -> Maybe a -> Annotation
optionalAnnotation key :: Text
key = (Text -> AnnotationValue -> Annotation
Single Text
key) (AnnotationValue -> Annotation)
-> (Maybe a -> AnnotationValue) -> Maybe a -> Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> AnnotationValue
forall a. ToJSON a => Maybe a -> AnnotationValue
optionalValue


-- |A convenience function to create an optional annotation that holds a
-- Nothing.
nullAnnotation :: Text -> Annotation
nullAnnotation :: Text -> Annotation
nullAnnotation key :: Text
key = Text -> AnnotationValue -> Annotation
Single Text
key (AnnotationValue -> Annotation) -> AnnotationValue -> Annotation
forall a b. (a -> b) -> a -> b
$ Maybe Value -> AnnotationValue
Optional Maybe Value
forall a. Maybe a
Nothing


-- |Represents the value of a span.data item.
data AnnotationValue =
  Simple Value
  -- |For list annotations consecutive merges with the same key will add to the
  -- list instead of overwriting previous values.
  | List [Value]
  -- |If an annotation is marked as optional, it will be ommitted from the
  -- encoded JSON if it is Nothing.
  | Optional (Maybe Value)
  deriving (AnnotationValue -> AnnotationValue -> Bool
(AnnotationValue -> AnnotationValue -> Bool)
-> (AnnotationValue -> AnnotationValue -> Bool)
-> Eq AnnotationValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotationValue -> AnnotationValue -> Bool
$c/= :: AnnotationValue -> AnnotationValue -> Bool
== :: AnnotationValue -> AnnotationValue -> Bool
$c== :: AnnotationValue -> AnnotationValue -> Bool
Eq, (forall x. AnnotationValue -> Rep AnnotationValue x)
-> (forall x. Rep AnnotationValue x -> AnnotationValue)
-> Generic AnnotationValue
forall x. Rep AnnotationValue x -> AnnotationValue
forall x. AnnotationValue -> Rep AnnotationValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AnnotationValue x -> AnnotationValue
$cfrom :: forall x. AnnotationValue -> Rep AnnotationValue x
Generic, Int -> AnnotationValue -> ShowS
[AnnotationValue] -> ShowS
AnnotationValue -> String
(Int -> AnnotationValue -> ShowS)
-> (AnnotationValue -> String)
-> ([AnnotationValue] -> ShowS)
-> Show AnnotationValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnotationValue] -> ShowS
$cshowList :: [AnnotationValue] -> ShowS
show :: AnnotationValue -> String
$cshow :: AnnotationValue -> String
showsPrec :: Int -> AnnotationValue -> ShowS
$cshowsPrec :: Int -> AnnotationValue -> ShowS
Show)


instance ToJSON AnnotationValue where
  toJSON :: AnnotationValue -> Value
  toJSON :: AnnotationValue -> Value
toJSON annotation :: AnnotationValue
annotation =
    case AnnotationValue
annotation of
      Simple value :: Value
value ->
        Value
value
      List values :: [Value]
values ->
        Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
values
      Optional maybeValue :: Maybe Value
maybeValue ->
        case Maybe Value
maybeValue of
          Just value :: Value
value -> Value
value
          -- Optional Nothing is actually already dropped in annotationToJson.
          Nothing    -> Value
Aeson.Null


-- |Creates the value part of a simple annotation, that is, a primitive value
-- (String, Number, Boolean, etc.). You might want to use simpleAnnotation
-- directly instead of creating the simple value beforehand.
simpleValue :: ToJSON a => a -> AnnotationValue
simpleValue :: a -> AnnotationValue
simpleValue =
  Value -> AnnotationValue
Simple (Value -> AnnotationValue) -> (a -> Value) -> a -> AnnotationValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON


-- |Creates the value part of a list annotation. You might want to use
-- listAnnotation directly instead of creating the list value beforehand.
listValue :: ToJSON a => [a] -> AnnotationValue
listValue :: [a] -> AnnotationValue
listValue =
  [Value] -> AnnotationValue
List ([Value] -> AnnotationValue)
-> ([a] -> [Value]) -> [a] -> AnnotationValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON


-- |Creates the value part of an optional annotation. You might want to use
-- optionalAnnotation directly instead of creating the optional value
-- beforehand.
optionalValue :: ToJSON a => Maybe a -> AnnotationValue
optionalValue :: Maybe a -> AnnotationValue
optionalValue value :: Maybe a
value =
  Maybe Value -> AnnotationValue
Optional (Maybe Value -> AnnotationValue) -> Maybe Value -> AnnotationValue
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (a -> Value) -> Maybe a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
value