{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE InstanceSigs      #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Instana.SDK.Span.SpanType
Description : Describes the type of a span, either an SDK span or a
              registered span.
-}
module Instana.SDK.Span.SpanType
  ( RegisteredSpanType (..)
  , SpanType (SdkSpan, RegisteredSpan)
  , spanName
  ) where


import           Data.String  (IsString (fromString))
import           Data.Text    (Text)
import qualified Data.Text    as T
import           GHC.Generics


-- |Differentiates between SDK spans and registered spans (which receive
-- special treatment by Instana's processing pipeline.
data SpanType =
    SdkSpan Text
  | RegisteredSpan RegisteredSpanType
  deriving (SpanType -> SpanType -> Bool
(SpanType -> SpanType -> Bool)
-> (SpanType -> SpanType -> Bool) -> Eq SpanType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanType -> SpanType -> Bool
$c/= :: SpanType -> SpanType -> Bool
== :: SpanType -> SpanType -> Bool
$c== :: SpanType -> SpanType -> Bool
Eq, (forall x. SpanType -> Rep SpanType x)
-> (forall x. Rep SpanType x -> SpanType) -> Generic SpanType
forall x. Rep SpanType x -> SpanType
forall x. SpanType -> Rep SpanType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpanType x -> SpanType
$cfrom :: forall x. SpanType -> Rep SpanType x
Generic, Int -> SpanType -> ShowS
[SpanType] -> ShowS
SpanType -> String
(Int -> SpanType -> ShowS)
-> (SpanType -> String) -> ([SpanType] -> ShowS) -> Show SpanType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanType] -> ShowS
$cshowList :: [SpanType] -> ShowS
show :: SpanType -> String
$cshow :: SpanType -> String
showsPrec :: Int -> SpanType -> ShowS
$cshowsPrec :: Int -> SpanType -> ShowS
Show)


-- |All registered spans that the Haskell trace SDK will produce.
data RegisteredSpanType =
    HaskellWaiServer
  | HaskellHttpClient
  deriving (RegisteredSpanType -> RegisteredSpanType -> Bool
(RegisteredSpanType -> RegisteredSpanType -> Bool)
-> (RegisteredSpanType -> RegisteredSpanType -> Bool)
-> Eq RegisteredSpanType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisteredSpanType -> RegisteredSpanType -> Bool
$c/= :: RegisteredSpanType -> RegisteredSpanType -> Bool
== :: RegisteredSpanType -> RegisteredSpanType -> Bool
$c== :: RegisteredSpanType -> RegisteredSpanType -> Bool
Eq, (forall x. RegisteredSpanType -> Rep RegisteredSpanType x)
-> (forall x. Rep RegisteredSpanType x -> RegisteredSpanType)
-> Generic RegisteredSpanType
forall x. Rep RegisteredSpanType x -> RegisteredSpanType
forall x. RegisteredSpanType -> Rep RegisteredSpanType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisteredSpanType x -> RegisteredSpanType
$cfrom :: forall x. RegisteredSpanType -> Rep RegisteredSpanType x
Generic, Int -> RegisteredSpanType -> ShowS
[RegisteredSpanType] -> ShowS
RegisteredSpanType -> String
(Int -> RegisteredSpanType -> ShowS)
-> (RegisteredSpanType -> String)
-> ([RegisteredSpanType] -> ShowS)
-> Show RegisteredSpanType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisteredSpanType] -> ShowS
$cshowList :: [RegisteredSpanType] -> ShowS
show :: RegisteredSpanType -> String
$cshow :: RegisteredSpanType -> String
showsPrec :: Int -> RegisteredSpanType -> ShowS
$cshowsPrec :: Int -> RegisteredSpanType -> ShowS
Show)


-- |Returns the wire value of span.n for a SpanType value.
spanName    :: SpanType -> Text
spanName :: SpanType -> Text
spanName    (SdkSpan _)                 = "sdk"
spanName    (RegisteredSpan registered :: RegisteredSpanType
registered) = RegisteredSpanType -> Text
registeredSpanName RegisteredSpanType
registered


-- |Returns the wire value of span.n for a registered span.
registeredSpanName :: RegisteredSpanType -> Text
registeredSpanName :: RegisteredSpanType -> Text
registeredSpanName HaskellWaiServer  = "haskell.wai.server"
registeredSpanName HaskellHttpClient = "haskell.http.client"


-- |Enables passing any string as the span type argument to SDK.startEntrySpan
-- etc. - this will be automatically converted to an SDK span.
instance IsString SpanType where
  fromString :: String -> SpanType
  fromString :: String -> SpanType
fromString s :: String
s = Text -> SpanType
SdkSpan (Text -> SpanType) -> Text -> SpanType
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s