content: {-
    Copyright (c) Meta Platforms, Inc. and affiliates.
    All rights reserved.
  
    This source code is licensed under the BSD-style license found in the
    LICENSE file in the root directory of this source tree.
  -}
  
  {-# OPTIONS_GHC -Wno-unused-matches #-}
  module Glean.Glass.Tracing
    ( GlassTrace(..)
    , GlassTraceWithId(..)
    , GlassTracer
    , TraceId
    , Tracer
    , traceSpan
    , glassTraceEvent
    ) where
  
  import Data.Text (Text)
  import TextShow
  
  import Control.Trace (traceMsg, Tracer)
  
  import Glean.Glass.GlassService.Service as Glass
  import Glean.Glass.Types
  import Data.Aeson ( pairs, fromEncoding, toEncoding, KeyValue((.=)) )
  import Data.Text.Lazy (toStrict)
  import Data.Text.Lazy.Encoding (decodeUtf8)
  import Data.Binary.Builder ( toLazyByteString )
  
  type GlassTracer = Tracer GlassTrace
  
  type TraceId = Int
  
  data GlassTraceWithId = GlassTraceWithId
    { traceId :: !TraceId
    , traceEvent :: !GlassTrace
    }
  
  instance TextShow GlassTraceWithId where
    showb t = case glassTraceEvent t of
      (id, _, _) -> showb id
  
  data GlassTrace where
    TraceCommand :: forall r . GlassServiceCommand r -> GlassTrace
    TraceSpan :: !Text -> Maybe Text -> GlassTrace
  
  instance TextShow GlassTrace where
    showb t = case glassTraceEvent (GlassTraceWithId 0 t) of
      (id, _, _) -> showb id
  
  traceSpan :: GlassTracer -> Text -> IO a -> IO a
  traceSpan tracer span = traceMsg tracer (TraceSpan span Nothing)
  
  {-# INLINE glassTraceEvent #-}
  glassTraceEvent :: GlassTraceWithId -> (Text, Int, Maybe Text)
  glassTraceEvent (GlassTraceWithId tid (TraceSpan event args)) =
    (event, tid, args)
  glassTraceEvent (GlassTraceWithId tid (TraceCommand cmd)) = case cmd of
    Glass.SuperFacebookService r -> ("SuperFacebookService", tid, Nothing)
    Glass.DocumentSymbolListX DocumentSymbolsRequest{..} opts ->
      ( "DocumentSymbolListX"
      , tid
      , json $ pairs $
         "filepath" .= documentSymbolsRequest_filepath <>
         "repository" .= documentSymbolsRequest_repository <>
         "revision" .= requestOptions_revision opts <>
         "exact" .= requestOptions_exact_revision opts <>
         "matching" .= requestOptions_matching_revision opts
      )
    Glass.DocumentSymbolIndex DocumentSymbolsRequest{..} opts ->
      ("DocumentSymbolIndex"
      , tid
      , json $ pairs $
         "filepath" .= documentSymbolsRequest_filepath <>
         "repository" .= documentSymbolsRequest_repository <>
         "revision" .= requestOptions_revision opts <>
         "exact" .= requestOptions_exact_revision opts <>
         "matching" .= requestOptions_matching_revision opts
      )
    Glass.FindReferenceRanges r opts ->
      ("FindReferenceRanges", tid, json $ toEncoding r)
    Glass.SymbolLocation r opts ->
      ("SymbolLocation", tid, json $ toEncoding r)
    Glass.ResolveSymbols r opts ->
      ("SymbolResolution", tid, json $ toEncoding r)
    Glass.DescribeSymbol r opts ->
      ("DescribeSymbol", tid, json $ toEncoding r)
    Glass.SearchSymbol r opts ->
      ("SearchSymbol", tid, json $ toEncoding r)
    Glass.SearchRelated r opts req ->
      ("SearchRelated", tid, json $ toEncoding r)
    Glass.SearchRelatedNeighborhood r opts req ->
      ("SearchRelatedNeighborhood", tid, json $ toEncoding r)
    Glass.FileIncludeLocations r opts ->
      ("FileIncludeLocations", tid, json $ toEncoding r)
    Glass.ClangUSRToDefinition r opts ->
      ("ClangUSRToDefinition", tid, json $ toEncoding r)
    Glass.UsrToDefinition r opts ->
      ("UsrToDefinition", tid, json $ toEncoding r)
  
    where
      json =
        Just . toStrict . decodeUtf8 . toLazyByteString . fromEncoding
  