{-# 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 (Eq, Generic, Show)


instance ToJSON SpanData where
  toJSON :: SpanData -> Value
  toJSON (SpanData annotations) =
    Aeson.object $
      map annotationToJson annotations
      |> Maybe.catMaybes


-- |Creates empty span data.
empty :: SpanData
empty = 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 newAnnotation (SpanData existingAnnotations) =
  SpanData $ mergeAnnotation newAnnotation existingAnnotations


mergeAnnotation :: Annotation -> [Annotation] -> [Annotation]
mergeAnnotation newAnnotation existingAnnotations =
  let
    key =
      getKey newAnnotation
    existingAnnotationForKeyMaybe =
      L.find ((== key) . getKey) existingAnnotations
  in
  case existingAnnotationForKeyMaybe of
    Nothing ->
      -- The new key does not exist yet, simply add it.
      existingAnnotations ++ [newAnnotation]
    Just existingAnnotationForKey ->
      let
        annotationsWithoutPrevious =
          (L.delete existingAnnotationForKey existingAnnotations)
      in
      case (existingAnnotationForKey, newAnnotation) of
        (Single _ (List values1), Single _ (List values2)) ->

          -- The key exists already and both the existing and the new annotation
          -- are lists. Merge both list values into one list annotation.
          annotationsWithoutPrevious ++
            [Single key $ List $ values1 ++ 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.
          annotationsWithoutPrevious ++ [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.
          annotationsWithoutPrevious ++ [newAnnotation]

        (Object _ previousChildren, Object _ 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 =
              L.foldr
                mergeAnnotation
                previousChildren -- starting value for foldr
                newChildren      -- the list we iterate over
          in
          annotationsWithoutPrevious ++ [Object key 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 (Eq, Generic, 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 =
  case annotation of
    Object key childAnnotations ->
      let
        object :: Value
        object =
          Aeson.object $
            map annotationToJson childAnnotations |> Maybe.catMaybes
        keyValue :: kv
        keyValue = (key .= object)
      in
      Just keyValue

    Single _ (Optional Nothing) ->
      -- drop optional annotations that are Nothing
      Nothing

    Single key annotationValue ->
      let
        pair :: kv
        pair = (key .= (Aeson.toJSON annotationValue))
      in
      Just pair


-- |Retrieves the key from an annotation.
getKey :: Annotation -> Text
getKey (Object key _) = key
getKey (Single key _) = 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 key children = Object key 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 key value = Single key value


-- |Creates a simple annotation, which holds one primitive value (String,
-- Number, Boolean, etc.).
simpleAnnotation :: ToJSON a => Text -> a -> Annotation
simpleAnnotation key = (Single key) . 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 key = (Single key) . 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 key = (Single key) . optionalValue


-- |A convenience function to create an optional annotation that holds a
-- Nothing.
nullAnnotation :: Text -> Annotation
nullAnnotation key = Single key $ Optional 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 (Eq, Generic, Show)


instance ToJSON AnnotationValue where
  toJSON :: AnnotationValue -> Value
  toJSON annotation =
    case annotation of
      Simple value ->
        value
      List values ->
        Aeson.Array $ V.fromList values
      Optional maybeValue ->
        case maybeValue of
          Just value -> value
          -- Optional Nothing is actually already dropped in annotationToJson.
          Nothing    -> 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 =
  Simple . 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 =
  List . map 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 value =
  Optional $ Aeson.toJSON <$> value