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.
  -}
  
  {-
  
  Convert Data.SCIP into glean/schema/lsif.angle-compatible data via JSON.
  
  Note: this module generates Angle but has no dependency on the Glean LSIF
  schema (which it targets), to make developer iteration quicker.
  
  -}
  
  {-# LANGUAGE DataKinds         #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Data.SCIP.Angle (
      scipToAngle,
      SCIP.LanguageId(..)
    ) where
  
  import Control.Monad
  import Lens.Micro ((^.))
  import Data.Bits ( Bits(testBit) )
  import Data.Maybe ( catMaybes, fromMaybe )
  import Data.Function ((&))
  import Data.Text ( Text )
  import qualified Data.Text as Text
  import Data.Set ( Set )
  import qualified Data.Set as Set
  import qualified Data.Aeson as Aeson
  import Data.Int ( Int32, Int64 )
  import qualified Data.ByteString as B
  import Data.HashMap.Strict ( HashMap )
  import qualified Data.HashMap.Strict as HashMap
  import Data.Map.Strict ( Map, ( !? ) )
  import qualified Data.Map.Strict as Map
  import Control.Monad.State.Strict
  import qualified Data.ProtoLens as Proto
  import qualified Data.Vector as V
  import Data.Aeson
  
  import qualified Proto.Scip as Scip
  import qualified Proto.Scip_Fields as Scip
  
  import qualified Data.LSIF.Gen as SCIP
  
  {-
  
  Debug scip files directly via protoc. Assuming you the scip.proto file handy
  From https://github.com/sourcegraph/scip/blob/main/scip.proto
  
  > protoc --decode scip.Index scip.proto  < index.scip
  
  The approach is to faithfully capture SCIP keyed by scip.Symbol.
  Then derive xref relationships (and connect hovers to definitions),
  in the Glean side
  
  -}
  
  type Parse a = forall m . Monad m => StateT Env m a
  
  data StringPredicate =
    Symbol
    | LocalName
    | File
    | DisplayName
    deriving (Eq, Ord)
  
  data Env = Env {
      -- unique supply for new Glean fact identifiers
      unique :: {-# UNPACK #-}!Int64,
  
      -- Hashmaps from any raw text fact to the id we generated.
      -- Used to do a bit of sharing before emitting to Glean.
      -- We maintain one hashmap per string predicate.
      factId :: !(Map StringPredicate (HashMap Text SCIP.Id))
    }
  
  emptyState :: Env
  emptyState = Env
    1 {- cannot use 0 as a fact id -}
    Map.empty
  
  --
  -- Scip doesn't number facts, but it is still useful for us to do so,
  -- to get more sharing in the output json
  --
  nextId :: Parse SCIP.Id
  nextId = do
    !i <- gets unique
    modify $ \e -> e { unique = i + 1 }
    return (SCIP.Id i)
  
  setDefFact :: StringPredicate -> Text -> SCIP.Id -> Parse ()
  setDefFact pred val i = modify $ \e ->
    let m = factId e !? pred & fromMaybe HashMap.empty & HashMap.insert val i in
    e { factId = Map.insert pred m (factId e)}
  
  getDefFactId :: StringPredicate -> Text -> Parse (Maybe SCIP.Id)
  getDefFactId pred sym = do
    m <- gets factId
    pure $ m !? pred >>= HashMap.lookup sym
  
  -- | Make a fresh name or return an existing one if we've seen it
  getOrSetFact :: StringPredicate -> Text -> Parse (SCIP.Id, Bool)
  getOrSetFact pred sym = do
    mId <- getDefFactId pred sym
    case mId of
      Nothing -> do
        id_ <- nextId
        setDefFact pred sym id_
        return (id_, False)
      Just id_ -> return (id_, True)
  
  --
  -- | Parse scip.proto into JSON-encoded Angle facts for the scip.angle schema
  --
  -- Uses the proto-lens interface to scip.proto
  --
  scipToAngle
    :: Maybe SCIP.LanguageId
    -> Bool
    -> Maybe FilePath
    -> Maybe FilePath
    -> B.ByteString
    -> Aeson.Value
  scipToAngle mlang inferLanguage mPathPrefix mStripPrefix scip =
    Aeson.Array $ V.fromList $
      SCIP.generateSCIPJSON (SCIP.insertPredicateMap HashMap.empty result)
    where
      (result,_) = runState (runTranslate mlang
        inferLanguage mPathPrefix mStripPrefix scip) emptyState
  
  -- | First pass, grab all the occurences with _role := Definition
  -- build up symbol string -> fact id for all defs
  runTranslate
    :: Maybe SCIP.LanguageId
    -> Bool
    -> Maybe FilePath
    -> Maybe FilePath
    -> B.ByteString
    -> Parse [SCIP.Predicate]
  runTranslate mlang inferLanguage mPathPrefix mStripPrefix scip =
    case Proto.decodeMessage scip of
      Left err -> error err
      Right (v :: Scip.Index) -> do
        a <- decodeScipMetadata (v ^. Scip.metadata)
        bs <- mapM
          (decodeScipDoc mlang inferLanguage mPathPrefix mStripPrefix)
          (v ^. Scip.documents)
        return (a <> concat bs)
  
  --
  -- Each document has a repo-relative filepath, defs and refs (symbols and
  -- occurences). Generate fact ids and record symbol id facts as we find them,
  -- then cross-reference with occurences in second pass
  --
  decodeScipDoc
    :: Maybe SCIP.LanguageId
    -> Bool
    -> Maybe FilePath
    -> Maybe FilePath
    -> Scip.Document
    -> Parse [SCIP.Predicate]
  decodeScipDoc mlang inferLanguage mPathPrefix mStripPrefix doc = do
    srcFileId <- nextId
    let filepath0 = doc ^. Scip.relativePath
        -- first, strip any matching prefix
        filepath1 = case Text.pack <$> mStripPrefix of
          Nothing -> filepath0
          Just prefix -> fromMaybe filepath0 $ Text.stripPrefix prefix filepath0
        -- and maybe prepend a new prefix
        filepath = case Text.pack <$> mPathPrefix of
          Nothing -> filepath1
          Just prefix -> prefix <> filepath1
    setDefFact File filepath srcFileId
    let srcFile = SCIP.srcFile srcFileId filepath
    langFileId <- nextId
    let parseLang = SCIP.parseLanguage (doc ^. Scip.language)
        langEnum = fromEnum $ case parseLang of
                  SCIP.UnknownLanguage
                    -- if --infer-language , look at the suffix
                    | inferLanguage
                    , Just langId <- fileLanguageOf filepath
                    -> langId
                    -- otherwise if --language, assume that's correct
                    | Just langId <- mlang -> langId -- use default if present
                    -- otherwise its really unknown
                    | otherwise -> SCIP.UnknownLanguage
                  x -> x -- scip document provides the language
    fileLang <- SCIP.predicateId "scip.FileLanguage" langFileId
      [ "file" .= srcFileId
      , "language" .= langEnum
      ]
    occs <- mapM (decodeScipOccurence srcFileId filepath)
        (doc ^. Scip.occurrences)
    infos <- mapM (decodeScipInfo filepath) (doc ^. Scip.symbols)
    return (srcFile : fileLang <> concat (occs <> infos))
  
  -- We really don't want to do a general purpose language detector
  -- but rely on the indexer knowing things. For the Java/Kotlin case,
  -- files are frequently intermingled in the same build so we can't
  -- decide a priori which language is being indexed
  fileLanguageOf :: Text -> Maybe  SCIP.LanguageId
  fileLanguageOf filepath
    | "kt" `Text.isSuffixOf` filepath = Just SCIP.Kotlin
    | "java" `Text.isSuffixOf` filepath = Just SCIP.Java
    | otherwise = Nothing
  
  decodeScipInfo :: Text -> Scip.SymbolInformation -> Parse [SCIP.Predicate]
  decodeScipInfo filepath info = do
    (docIds, docFacts) <- unzip <$> forM scipDocs (\docStr -> do
      docId <- nextId
      return (docId, SCIP.Predicate "scip.Documentation" [
              object [ SCIP.factId docId, "key" .= Text.strip docStr ]
            ]))
    mSymId <- getSymbolId scipSymbol filepath
    symDocFacts <- case mSymId of
      Nothing -> return []
      Just symId -> forM docIds (\docId ->
          SCIP.predicateId "scip.SymbolDocumentation" docId [
            "symbol" .= symId,
            "docs" .= docId
          ])
    displayNameFacts <- case mSymId of
      Nothing -> return []
      Just symId -> case scipDisplayName of
        "" -> return []
        _ ->  displayNameFacts scipDisplayName symId
    relationshipsFacts <- case mSymId of
      Nothing -> return []
      Just symId -> forM scipRelationshps (\rel ->
          if rel ^. Scip.isImplementation then do
            let implementedSymbol = rel ^. Scip.symbol
            implementedSymbolId <- getSymbolId implementedSymbol filepath
            case implementedSymbolId of
              Nothing -> return []
              Just implementedSymbolId ->
                SCIP.predicate "scip.IsImplementation" [
                    "symbol" .= symId,
                    "implemented" .= implementedSymbolId
                  ]
          else
            pure [] )
    return
      ( docFacts
      <> concat symDocFacts
      <> displayNameFacts
      <> concat relationshipsFacts )
  
    where
      scipSymbol = info ^. Scip.symbol
      scipDocs = info ^. Scip.documentation
      scipDisplayName = info ^. Scip.displayName
      scipRelationshps = info ^. Scip.relationships
  
  getSymbolId :: Text -> Text -> Parse (Maybe SCIP.Id)
  getSymbolId symbol filepath = do
    let eSym = symbolFromString symbol
    let qualifiedSymbol = case eSym of
          Left err -> error(show err)
          Right (Local _) -> filepath <> "/" <> symbol
          Right (Global {}) -> symbol
    getDefFactId Symbol qualifiedSymbol
  
  
  displayNameFacts :: Text -> SCIP.Id -> Parse [SCIP.Predicate]
  displayNameFacts scipDisplayName symId = do
    (displayNameId, seenDisplayName) <- getOrSetFact DisplayName scipDisplayName
    let displayNameFact =
          ([ SCIP.Predicate "scip.DisplayName"
                [object [SCIP.factId displayNameId, "key" .= scipDisplayName]] |
            not seenDisplayName ])
    symbolDisplayNameFact <-
      SCIP.predicate
        "scip.DisplayNameSymbol"
        ["symbol" .= symId, "displayName" .= displayNameId]
    return (displayNameFact <> symbolDisplayNameFact)
  
  
  -- | An occurence of a symbol in a given document the optional symbol role
  -- will tell us if it is an xref or a def or other
  decodeScipOccurence
    :: SCIP.Id
    -> Text
    -> Scip.Occurrence
    -> Parse [SCIP.Predicate]
  decodeScipOccurence fileId filepath occ = do
      fileRangeId <- nextId
      fileRange <- SCIP.predicateId "scip.FileRange" fileRangeId
        [ "file" .= fileId
        , "range" .= decodeScipRange scipRange
        ]
      let eSym = symbolFromString scipSymbol
      symbolFacts <- case eSym of
            Left err -> error (show err) -- Can't handle this symbol format
            Right (Local _) -> decodeLocalOccurence filepath scipSymbol symRoles
                fileRangeId
            Right Global{..} -> decodeGlobalOccurence scipSymbol symRoles
                fileRangeId descriptor
      return (fileRange <> symbolFacts)
    where
      scipRange = occ ^. Scip.range
      scipSymbol = occ ^. Scip.symbol
      symRoles = toSymbolRole (occ ^. Scip.symbolRoles)
  
  decodeGlobalOccurence
    :: Text -> Set Scip.SymbolRole -> SCIP.Id -> Descriptor
    -> Parse [SCIP.Predicate]
  decodeGlobalOccurence scipSymbol symRoles fileRangeId Descriptor{..} = do
    (symbolId, seenSymbol) <- getOrSetFact Symbol scipSymbol
    let symbolFact :: [SCIP.Predicate]
          | seenSymbol = []
          | otherwise = pure $
              SCIP.Predicate "scip.Symbol" [
                  object [ SCIP.factId symbolId, "key" .= scipSymbol ]
              ]
    let roleFact :: [[SCIP.Predicate]] = if Scip.Definition `Set.member` symRoles
          then SCIP.predicate "scip.Definition" [
              "symbol" .= symbolId,
              "location" .= fileRangeId
            ]
          else SCIP.predicate "scip.Reference" [
              "symbol" .= symbolId,
              "location" .= fileRangeId
            ]
    (nameId, seenName) <- getOrSetFact LocalName text
    let nameFact :: [SCIP.Predicate]
          | seenName = []
          | otherwise = pure $
              SCIP.Predicate "scip.LocalName" [
                  object [ SCIP.factId nameId, "key" .= text ]
              ]
    let symbolNameFact :: [[SCIP.Predicate]]
          | seenSymbol = []
          | otherwise = SCIP.predicate "scip.SymbolName" [
                "symbol" .= symbolId,
                "name" .= nameId
             ]
    let kindFact :: [SCIP.Predicate] = concat $
          case SCIP.kindFromSuffix suffix of
            SCIP.SkUnknown -> [[]]
            kind -> SCIP.predicate "scip.SymbolKind" [
                "symbol" .= symbolId,
                "kind" .= fromEnum kind
              ]
    return $ symbolFact <> concat roleFact <> nameFact <>
              concat symbolNameFact <> kindFact
  
  decodeLocalOccurence
    :: Text
    -> Text
    -> Set Scip.SymbolRole
    -> SCIP.Id
    -> Parse [SCIP.Predicate]
  decodeLocalOccurence filepath localSymbol symRoles fileRangeId = do
    let qualifiedSymbol = filepath <> "/" <> localSymbol
    (symbolId, seenSymbol) <- getOrSetFact Symbol qualifiedSymbol
    let symbolFact :: [SCIP.Predicate]
          | seenSymbol = []
          | otherwise = pure $
              SCIP.Predicate "scip.Symbol" [
                  object [ SCIP.factId symbolId, "key" .= qualifiedSymbol ]
              ]
    let roleFact :: [[SCIP.Predicate]] = if Scip.Definition `Set.member` symRoles
          then SCIP.predicate "scip.Definition" [
              "symbol" .= symbolId,
              "location" .= fileRangeId
            ]
          else SCIP.predicate "scip.Reference" [
              "symbol" .= symbolId,
              "location" .= fileRangeId
            ]
    (nameId, seenName) <- getOrSetFact LocalName localSymbol
    let nameFact :: [SCIP.Predicate]
          | seenName = []
          | otherwise = pure $
              SCIP.Predicate "scip.LocalName" [
                  object [ SCIP.factId nameId, "key" .= localSymbol ]
              ]
    let symbolNameFact :: [[SCIP.Predicate]]
          | seenSymbol = []
          | otherwise = SCIP.predicate "scip.SymbolName" [
                "symbol" .= symbolId,
                "name" .= nameId
             ]
    let kindFact :: [[SCIP.Predicate]]
          | seenSymbol = []
          | otherwise = SCIP.predicate "scip.SymbolKind" [
                "symbol" .= symbolId,
                -- TODO: this could be any SymbolInformation.Kind
                "kind" .= fromEnum SCIP.SkVariable
              ]
    return $ symbolFact <> concat roleFact <> nameFact <>
              concat symbolNameFact <> concat kindFact
  
  -- | For sharding we might want to take a repo-relative anchor here
  -- as it potentially differs to project root when combining SCIP files
  decodeScipMetadata :: Scip.Metadata -> Parse [SCIP.Predicate]
  decodeScipMetadata v = SCIP.predicate "scip.Metadata" $
    [ "version" .= fromEnum (v ^. Scip.version)
    , "textEncoding" .= fromEnum (v ^. Scip.textDocumentEncoding)
    ] ++ (case v ^. Scip.maybe'toolInfo of
            Nothing -> []
            Just ti ->
              ["toolInfo" .= object [
                "toolName" .= (ti ^. Scip.name),
                "toolArgs" .= (ti ^. Scip.arguments),
                "version" .= (ti ^. Scip.version)
              ]])
  
  -- scip ranges are int32
  toNat :: Int32 -> Int64
  toNat = fromIntegral
  
  -- [startLine, startCharacter, endCharacter]`. The end line
  --  is inferred to have the same value as the start line.
  decodeScipRange :: [Int32] -> Aeson.Value
  decodeScipRange [lineBegin,colBegin,colEnd] =
    SCIP.toRange (SCIP.Range
      (SCIP.Position (toNat lineBegin) (toNat colBegin))
      (SCIP.Position (toNat lineBegin) (toNat colEnd))) -- n.b
  -- : `[startLine, startCharacter, endLine, endCharacter]`
  decodeScipRange [lineBegin,colBegin,lineEnd,colEnd] =
    SCIP.toRange (SCIP.Range
      (SCIP.Position (toNat lineBegin) (toNat colBegin))
      (SCIP.Position (toNat lineEnd) (toNat colEnd)))
  decodeScipRange range = error $
    "decodeScipRange: unexpected range format: " <> show range
  
  {-
  
  //   <symbol>               ::= <scheme> ' ' <package> ' ' { <descriptor> }
  //      | 'local ' <local-id>
  //   <package>              ::= <manager> ' ' <package-name> ' ' <version>
  //   <scheme>               ::= any UTF-8, escape spaces with double space.
  //   <manager>              ::= same as above, use the placeholder '.' to
  //          indicate an empty value
  //   <package-name>         ::= same as above
  //   <version>              ::= same as above
  //   <descriptor>           ::= <package> | <type> | <term> | <method>
  //       | <type-parameter> | <parameter> | <meta>
  //   <package>              ::= <name> '/'
  //   <type>                 ::= <name> '#'
  //   <term>                 ::= <name> '.'
  //   <meta>                 ::= <name> ':'
  //   <method>               ::= <name> '(' <method-disambiguator> ').'
  //   <type-parameter>       ::= '[' <name> ']'
  //   <parameter>            ::= '(' <name> ')'
  //   <name>                 ::= <identifier>
  //   <method-disambiguator> ::= <simple-identifier>
  //   <identifier>           ::= <simple-identifier> | <escaped-identifier>
  //   <simple-identifier>    ::= { <identifier-character> }
  //   <identifier-character> ::= '_' | '+' | '-' | '$' | ASCII letter or digit
  //   <escaped-identifier>   ::= '`' { <escaped-character> } '`'
  //   <escaped-characters>   ::= any UTF-8 character, escape backticks with
  //   d        ouble backtick.
  
  -}
  
  data ScipSymbol
    = Local !Text
    | Global
        { scheme :: !Text
        , package :: !Package
        , descriptor :: !Descriptor -- grammar says these can be repetitions...
        }
  
  data Package = Package
    { manager :: !Text
    , pkgname :: !Text
    , version :: !Text
  }
  
  data Descriptor = Descriptor
    { text:: !Text
    , suffix :: !SCIP.Suffix
    }
  
  --
  -- Parser and ADT for Scip.Symbol strings.
  -- These are well structured but stored as strings for reasons
  --
  -- https://github.com/sourcegraph/scip/blob/main/scip.proto#L81
  -- e.g.
  --
  -- >  "scip-typescript npm new.docusaurus.io 2.0.0-beta.17 \
  -- >      functionUtils/`playgroundUtils.ts`/CookieName."
  --
  symbolFromString :: Text -> Either Text ScipSymbol
  symbolFromString str
    -- 'local ' <local-id>
    | ("local", localId) <- split normalStr
    = Right $ Local localId
    --  <scheme> ' ' <package> ' ' { <descriptor> }
    | (scheme, rest1) <- split normalStr
    -- <package> ::= <manager> ' ' <package-name> ' ' <version>
    , (manager, rest2) <- split rest1
    , (pkgname, rest3) <- split rest2
    , (version, symStrs) <- split rest3
    , (text, suffix) <- SCIP.parseSuffix symStrs
    = Right $ Global scheme Package{..} Descriptor {..}
  
    where
      -- we normalize space-escaping in identifiers with underscore
      normalStr = Text.intercalate "_" (Text.splitOn doubleSpace str)
        where doubleSpace = "  "
  
      split xs = case Text.breakOn " " xs of
        (tok, rest) -> (tok, if Text.null rest then rest else Text.tail rest)
  
  {-
  bitmask in i32
  
  enum SymbolRole {
    // unused
    UnspecifiedSymbolRole = 0;
    // Is the symbol defined here? If not, then this is a symbol reference.
    Definition = 0x1;
    // Is the symbol imported here?
    Import = 0x2;
    // Is the symbol written here?
    WriteAccess = 0x4;
    // Is the symbol read here?
    ReadAccess = 0x8;
    // Is the symbol in generated code?
    Generated = 0x10;
    // Is the symbol in test code?
    Test = 0x20;
  -}
  toSymbolRole :: Int32 -> Set Scip.SymbolRole
  toSymbolRole i = Set.fromList $ catMaybes
    [ Nothing -- if i == 0 then Just Scip.UnspecifiedSymbolRole else Nothing
    , has 0 Scip.Definition
    , has 1 Scip.Import
    , has 2 Scip.WriteAccess
    , has 3 Scip.ReadAccess
    , has 4 Scip.Generated
    , has 5 Scip.Test
    ]
    where
      has n ty
        | i `testBit` n = Just ty
        | otherwise = Nothing
  