Status.hs

module Effectful.OpenTelemetry.Tracing.Span.Status where

import Data.Aeson.Types (ToJSON (..), Value (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Effectful.Exception (Exception, displayException)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (..), annotate)
import Prettyprinter.Extra (PrettyAnn (..))
import Prettyprinter.Extra qualified as Pretty
import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), color, colorDull)
import Proto3.Wire (fromProtoEnum)
import Proto3.Wire.Encode.Class qualified as Proto
import Prelude

-- | The final status of a 'Span'.
-- See <https://opentelemetry.io/docs/specs/otel/trace/api/#set-status the OpenTelemetry spec>.
data Status = Status
    { message :: Text
    -- ^ A human readable message, typically an error message.
    , code :: Code
    }
    deriving stock (Generic, Eq, Show)
    deriving anyclass (ToJSON)

data Code
    = -- | The operation the span tracked successfully completed without an error.
      Unset
    | -- | The span has been explicitly marked as successful.
      Ok
    | -- | Some error occurred in the operation the span tracked.
      Error
    deriving stock (Show, Eq, Enum, Bounded)

instance ToJSON Code where
    toJSON = Number . fromIntegral . fromEnum

instance PrettyAnn AnsiStyle Code where
    prettyAnn Unset = mempty
    prettyAnn Ok = annotate (colorDull Green) "OK"
    prettyAnn Error = annotate (color Red) "ERROR"

instance Proto.Encode Status where
    encode Status{..} =
        mconcat
            [ Proto.encodeField 2 message
            , Proto.encodeField 3 code
            ]

instance {-# OVERLAPPING #-} Proto.EncodeField Code where
    encodeField n = Proto.encodeField n . fromProtoEnum

instance PrettyAnn AnsiStyle Status where
    prettyAnn Status{..} =
        Pretty.unwords . filter (not . Pretty.null) $
            [ prettyAnn code
            , pretty message
            ]

fromException :: (Exception e) => e -> Status
fromException e =
    Status
        { message = Text.pack . displayException $ e
        , code = Error
        }

-- Create a 'Status' with an 'Ok' code.
ok :: Status
ok =
    Status
        { message = mempty
        , code = Ok
        }

-- Create a 'Status' with an 'Unset' code.
unset :: Status
unset =
    Status
        { message = mempty
        , code = Unset
        }