{-
  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-orphans #-}

module Glean.Glass.Logging
  (
  -- * classes for convenient typed logging
    LogResult(..)
  , LogRequest(..)
  , LogError(..)

  -- * some types
  , QueryEachRepoLog(..)
  , ErrorText(..)
  , ErrorLogger(..)
  , AttrDBsLog(..)
  , errorText
  , errorsText

  ) where

import Control.Applicative ((<|>))
import Data.Coerce
import Data.List.Extra (nubOrd)
import Data.List.NonEmpty(NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Function (on)
import Util.Text (textShow)

import Util.Logger (ActionLog(..))
import Logger.GleanGlass (GleanGlassLogger)
import qualified Logger.GleanGlass as Logger

import Glean (Repo(..), repoToText)
import Glean.Glass.Types
import Glean.Glass.SnapshotBackend ( SnapshotStatus(..) )
import qualified Thrift.Protocol.JSON as Thrift

instance ActionLog GleanGlassLogger where
  successLog = Logger.setSuccess True
  failureLog ex = mconcat
    [ Logger.setSuccess False
    , Logger.setError (textShow ex)
    ]
  timeLog = Logger.setTimeElapsedUs . floor . (* 1000) . (* 1000)
  allocLog = Logger.setAllocatedBytes . fromIntegral

class LogRequest a where
  logRequest :: a -> GleanGlassLogger

instance LogRequest a => LogRequest (Maybe a) where
  logRequest = maybe mempty logRequest

instance LogRequest RequestOptions where
  logRequest RequestOptions{..} =
    maybe mempty (Logger.setRevision . unRevision) requestOptions_revision <>
    maybe mempty (Logger.setLimit . fromIntegral) requestOptions_limit <>
    Logger.setExactRevision requestOptions_exact_revision <>
    Logger.setMatchingRevision requestOptions_matching_revision <>
    Logger.setContentCheck requestOptions_content_check <>
    logRequest requestOptions_feature_flags <>
    logRequest requestOptions_attribute_opts

instance LogRequest AttributeOptions where
  logRequest AttributeOptions{..} =
    Logger.setAttributeOptions $ textShow $ Thrift.serializeJSON AttributeOptions{..}

instance LogRequest FeatureFlags where
  logRequest FeatureFlags{..} =
    maybe mempty Logger.setIncludeXlangXrefs featureFlags_include_xlang_refs

instance LogRequest DocumentSymbolsRequest where
  logRequest = logDocumentSymbolsRequestSG Logger.setFilepath Logger.setRepo

instance LogRequest SymbolId where
  logRequest = logSymbolSG Logger.setSymbol

instance LogRequest USRHash where
  logRequest (USRHash hash) = logSymbolSG Logger.setSymbol (SymbolId hash)

instance LogRequest USR where
  logRequest (USR usr) = logSymbolSG Logger.setSymbol (SymbolId usr)

instance LogRequest USRToDefinitionRequest where
  logRequest = logUSRToDefinitionRequestSG Logger.setSymbol Logger.setRepo

instance LogRequest SymbolPath where
  logRequest = logSymbolPathSG Logger.setFilepath Logger.setRepo

instance LogRequest SymbolSearchRequest where
  logRequest = logSymbolSearchRequestSG Logger.setSymbol Logger.setRepo

instance LogRequest FileIncludeLocationRequest where
  logRequest FileIncludeLocationRequest{..} =
    Logger.setFilepath (unPath fileIncludeLocationRequest_filepath) <>
      Logger.setRepo (unRepoName fileIncludeLocationRequest_repository)

class LogResult a where
  logResult :: a -> GleanGlassLogger

instance LogResult () where
  logResult = mempty

instance LogResult GleanGlassLogger where
  logResult = id

instance LogResult a => LogResult (Maybe a) where
  logResult = maybe mempty logResult

instance (LogResult a, LogResult b) => LogResult (a,b) where
  logResult (a,b) = logResult a <> logResult b

instance (LogResult a, LogResult b, LogResult c) => LogResult (a,b,c) where
  logResult (a,b,c) = logResult a <> logResult b <> logResult c

instance (LogResult a, LogResult b, LogResult c,  LogResult d)
  => LogResult (a,b,c,d) where
    logResult (a,b,c,d) =
      logResult a <> logResult b <> logResult c  <> logResult d

instance LogResult DocumentSymbolListXResult  where
  logResult DocumentSymbolListXResult{..} =
    Logger.setTruncated documentSymbolListXResult_truncated <>
    Logger.setItemCount (length documentSymbolListXResult_references +
      length documentSymbolListXResult_definitions) <>
    Logger.setRevisionUsed (coerce documentSymbolListXResult_revision) <>
    maybe mempty Logger.setContentMatch documentSymbolListXResult_content_match

instance LogResult FileIncludeLocationResults where
  logResult FileIncludeLocationResults{..} =
    Logger.setItemCount (sum
       (map (length . fileIncludeXRef_includes)
          (unXRefFileList fileIncludeLocationResults_references)
       ))

instance LogResult SnapshotStatus where
  logResult st = logSnapshotStatus st

data QueryEachRepoLog
  = FoundNone
  | FoundSome (NonEmpty Glean.Repo)
  | QueryEachRepoUnrequested

instance LogResult QueryEachRepoLog where
  logResult glog = case glog of
    FoundSome (one :| more) ->
      Logger.setDbUsedName (Glean.repo_name one) <>
      Logger.setDbUsedInstance (Glean.repo_hash one) <>
      if null more
        then mempty
        else Logger.setRepoOther (map Glean.repo_name more)
    _ -> mempty

instance LogResult DocumentSymbolIndex where
  logResult DocumentSymbolIndex{..} =
    Logger.setItemCount (fromIntegral documentSymbolIndex_size)
        <> Logger.setTruncated documentSymbolIndex_truncated
        <> Logger.setRevisionUsed (coerce documentSymbolIndex_revision)
        <> maybe mempty Logger.setContentMatch documentSymbolIndex_content_match

instance LogResult Range where
  logResult _ = mempty

instance LogResult [LocationRange] where
  logResult xs = Logger.setItemCount (length xs)

instance LogResult LocationRange where
  logResult LocationRange{..} = mconcat
    [ Logger.setItemCount 1
    , Logger.setRepo $ unRepoName locationRange_repository
    ]

instance LogResult SymbolLocation where
  logResult SymbolLocation{..} = logResult symbolLocation_location
      <> Logger.setRevisionUsed (coerce symbolLocation_revision)

instance LogResult SymbolDescription where
  logResult SymbolDescription{..} =
    logResult symbolDescription_location <>
    logResult symbolDescription_sym <>
    Logger.setItemCount 1

instance LogResult [SymbolResolution] where
  logResult xs = Logger.setItemCount (length xs)

instance LogResult SymbolResolutionFailure where
  logResult SymbolResolutionFailure{..} =
      Logger.setInternalError (errorText symbolResolutionFailure_reason)

instance LogResult SymbolPath where
  logResult SymbolPath{..} =
    Logger.setRepo (unRepoName symbolPath_repository)

instance LogResult SymbolId where
  logResult sym = logSymbolSG Logger.setSymbol sym

instance LogResult [SymbolId] where
  logResult xs = Logger.setItemCount (length xs)

instance LogResult [(SymbolResult, Maybe SymbolDescription)] where
  logResult rs = Logger.setItemCount (length rs)

instance LogResult SymbolSearchResult where
  logResult SymbolSearchResult{..} =
    Logger.setItemCount (length symbolSearchResult_symbols)

instance LogResult SearchRelatedResult where
  logResult SearchRelatedResult{..} =
    logResult searchRelatedResult_edges

instance LogResult RelatedNeighborhoodResult where
  logResult RelatedNeighborhoodResult{..} =
    Logger.setItemCount
      (length relatedNeighborhoodResult_childrenContained +
        length relatedNeighborhoodResult_childrenExtended +
        length relatedNeighborhoodResult_containsParents +
        length relatedNeighborhoodResult_parentsExtended +
        sum (map (\x -> 1 + length (inheritedSymbols_provides x))
              relatedNeighborhoodResult_inheritedSymbols
            )
      )

instance LogResult USRSymbolDefinition where
  logResult USRSymbolDefinition{..} =
    logResult uSRSymbolDefinition_location <>
    Logger.setItemCount 1


instance LogResult USRSymbolReference  where
  logResult USRSymbolReference{..} =
    logResult uSRSymbolReference_location <>
    Logger.setItemCount 1

instance LogResult [USRSymbolReference] where
  logResult xs = Logger.setItemCount (length xs)

instance LogResult [RelatedSymbols] where
  logResult edges = Logger.setItemCount (length edges)

newtype AttrDBsLog = AttrDBsLog { attrDb :: Glean.Repo }
instance LogResult [AttrDBsLog] where
  logResult logs = Logger.setAttributeDbs (map (Glean.repoToText . attrDb) logs)

--
-- | Intern error logging
--

newtype ErrorText = ErrorText Text

errorText :: GlassExceptionReason -> Text
errorText e = case e of
  GlassExceptionReason_noSrcFileFact t -> t
  GlassExceptionReason_noSrcFileLinesFact t -> t
  GlassExceptionReason_notIndexedFile t -> t
  GlassExceptionReason_entitySearchFail t -> t
  GlassExceptionReason_entityNotSupported t -> t
  GlassExceptionReason_attributesError t -> t
  GlassExceptionReason_exactRevisionNotAvailable t -> t
  GlassExceptionReason_matchingRevisionNotAvailable t -> t
  GlassExceptionReason_EMPTY -> ""

errorsText :: NonEmpty GlassExceptionReason -> Text
errorsText errs =
  Text.unlines $ "Multiple errors:": map
    (("  " <>) . errorText)
    (NE.toList errs)

data ErrorLogger = ErrorLogger
  { errorTy :: ![GlassExceptionReason]
  , errorGleanRepo :: ![Glean.Repo]
    -- ^ The repo(s) in which the error(s) occurred.
  }

instance Semigroup ErrorLogger where
  e1 <> e2 = ErrorLogger
    { errorTy = errorTy e1 <|> errorTy e2
    , errorGleanRepo = errorGleanRepo e1 <> errorGleanRepo e2
    }

instance Monoid ErrorLogger where
  mempty = ErrorLogger mempty []

instance LogResult ErrorLogger where
  logResult ErrorLogger{..} =
    case nubOrd errorTy of
      [] -> mempty
      [e] ->
        Logger.setInternalError (errorText e) <>
        Logger.setInternalErrorType (case e of
          GlassExceptionReason_noSrcFileFact{} -> "NoSrcFileFact"
          GlassExceptionReason_noSrcFileLinesFact{} -> "NoSrcFileLinesFact"
          GlassExceptionReason_entitySearchFail{} -> "EntitySearchFail"
          GlassExceptionReason_entityNotSupported{} -> "EntityNotSupported"
          GlassExceptionReason_attributesError{} -> "AttributesError"
          GlassExceptionReason_notIndexedFile{} -> "NotIndexedFile"
          GlassExceptionReason_exactRevisionNotAvailable{} ->
            "ExactRevisionNotAvaiable"
          GlassExceptionReason_matchingRevisionNotAvailable{} ->
            "MatchingRevisionNotAvailable"
          GlassExceptionReason_EMPTY{} -> "EMPTY"
        )
      (e:es) ->
        Logger.setInternalError (errorsText (e :| es)) <>
        Logger.setInternalErrorType "AggregateError"

class LogError a where
  logError :: a -> ErrorLogger

instance LogError GlassExceptionReason where
  logError e = ErrorLogger [e] []

instance LogError (NonEmpty GlassExceptionReason) where
  logError (e :| []) = logError e
  logError errors = ErrorLogger (NE.toList errors) []

instance LogError Glean.Repo where
  logError x =
    ErrorLogger [] [x]

instance LogError (NonEmpty (a, Glean.Repo)) where
  logError = logError . NE.map snd

instance LogError (NonEmpty Glean.Repo) where
  logError (repo :| []) = logError repo
  logError rs0 = ErrorLogger [] (NE.toList rs)
    where
    rs = NE.sortBy (compare `on` Glean.repo_name) rs0

--
-- Lift log accessors generically over Glass types
--

logSymbolSG :: Semigroup a => (Text -> a)
  -> SymbolId -> a
logSymbolSG f (SymbolId s) = f s

logSymbolPathSG :: Semigroup a => (Text -> a) -> (Text -> a)
  -> SymbolPath -> a
logSymbolPathSG f g SymbolPath{..} =
    f (unPath symbolPath_filepath) <>
      g (unRepoName symbolPath_repository)

logDocumentSymbolsRequestSG :: Semigroup a => (Text -> a) -> (Text -> a)
  -> DocumentSymbolsRequest  -> a
logDocumentSymbolsRequestSG f g DocumentSymbolsRequest{..} =
    f (unPath documentSymbolsRequest_filepath) <>
    g (unRepoName documentSymbolsRequest_repository)

logSymbolSearchRequestSG :: Semigroup a => (Text -> a) -> (Text -> a)
  -> SymbolSearchRequest -> a
logSymbolSearchRequestSG logQuery logRepo SymbolSearchRequest{..} =
  case repo of
    Nothing -> logQuery symbolSearchRequest_name
    Just r -> logRepo r <> logQuery symbolSearchRequest_name
  where
    repo = unRepoName <$> symbolSearchRequest_repo_name

logUSRToDefinitionRequestSG ::
  Semigroup a =>
  (Text -> a) ->
  (Text -> a) ->
  USRToDefinitionRequest ->
  a
logUSRToDefinitionRequestSG
    logQuery
    logRepo
    (USRToDefinitionRequest usrr repo_name) =
  case repo of
    Nothing -> logQuery usr
    Just r -> logRepo r <> logQuery usr
 where
  usr = unUSR usrr
  repo = unRepoName <$> repo_name

logSnapshotStatus :: SnapshotStatus -> GleanGlassLogger
logSnapshotStatus st = case st of
  Unrequested -> mempty
  DbError -> Logger.setSnapshot "DB error"
  InternalError -> Logger.setSnapshot "Internal error"
  Timeout -> Logger.setSnapshot "Timeout"
  NotFound -> Logger.setSnapshot  "Not found"
  ExactMatch -> Logger.setSnapshot  "Exact"
  CompatibleMatch -> Logger.setSnapshot  "Matching"
  Ignored -> Logger.setSnapshot  "Ignored"
  Latest -> Logger.setSnapshot "Latest"