DemoClient.hs

{-
  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.
-}

{-# LANGUAGE ApplicativeDo #-}
module Glean.Glass.Test.DemoClient ( main ) where

import Glean.Init as Glean ( withOptions )

import Glean.Glass.Types
import Glean.Glass.GlassService.Client

import Data.Default ( Default(def) )
import Data.Maybe ( catMaybes )
import Data.Text (Text)
import Options.Applicative
import Options.Applicative.Types ( readerAsk )
import System.FilePath ( pathSeparator )
import Util.Text ( textShow, textToInt )
import qualified Data.Text as Text
import qualified Data.Text.IO as Text

import Glean.Impl.ThriftService
import Glean.Util.ThriftService
import Glean.Util.Service
import Thrift.Protocol
import Thrift.Monad hiding (runThrift)
import Thrift.Channel

import Util.EventBase ( withEventBaseDataplane )

data Options =
  Options {
    optCommand :: Command,
    optHost :: Service
  }

defService :: Service
defService = HostPort "127.0.0.1" 26073

data Command
  = List RepoName Path
  | Describe SymbolId
  | FindRefs SymbolId
  | FindLocation SymbolId
  | Search RepoName Text Bool{- case-insensitve? -}

options :: ParserInfo Options
options = info (helper <*> parser) (fullDesc <>
    progDesc "Glass code navigation and search tool")
  where
    parser :: Parser Options
    parser = do
      optHost <- option readService
        (value defService
        <> long "service"
        <> metavar "HOST:PORT"
        )
      optCommand <- hsubparser $
        command "list" (info listCommand
          (progDesc $ unlines
            ["List symbols in file specified by REPO/PATH"
            ]
          )
        ) <>
        command "describe" (info describeCommand
          (progDesc $ unlines
            ["Describe basic details of a symbol"
            ]
          )
        ) <>
        command "references" (info findRefsCommand
          (progDesc $ unlines
            ["Find references to this symbol"
            ]
          )
        ) <>
        command "location" (info locationCommand
          (progDesc $ unlines
            ["Find the definition location of a symbol"
            ]
          )
        ) <>
        command "search" (info searchCommand
          (progDesc $ unlines
            ["Find entities matching string"
            ]
          )
        )
      return $ Options {..}

    cmd parser help = argument parser help

    symbolHelp = metavar "SYMBOL"
    searchHelp = metavar "REPO/STR"

    listCommand = cmd readListRepoPath (metavar "REPO/PATH")
    describeCommand = cmd (Describe <$> readSymbol) symbolHelp
    findRefsCommand = cmd (FindRefs <$> readSymbol) symbolHelp
    locationCommand = cmd (FindLocation <$> readSymbol) symbolHelp
    searchCommand = do
      ~(repo,needle) <- argument readSearch searchHelp
      ignoreCase <- switch
        (  long "case-insensitive"
        <> short 'i'
        )
      return $ Search repo needle ignoreCase

readService :: ReadM Service
readService = do
  hostPort <- Text.pack <$> readerAsk
  case Text.breakOn ":" hostPort of
    (_, "") -> fail "Not a valid host:port"
    (host, portStr) -> case textToInt (Text.drop 1 portStr) of
      Left _ -> fail ("Not a valid port: " <> show portStr)
      Right port -> return (HostPort host (fromIntegral port))

readSearch :: ReadM (RepoName, Text)
readSearch = do
  repoStr <- Text.pack <$> readerAsk
  case Text.breakOn "/" repoStr of
    (_, "") -> fail "Not a valid repo/string"
    (repo, str) -> return (RepoName repo, Text.tail str)

readListRepoPath :: ReadM Command
readListRepoPath = do
  path <- Text.pack <$> readerAsk
  case Text.breakOn sep path of
    (_, "") -> fail "Not a valid repo/path"
    (repo, file) -> return $ case Text.stripPrefix sep file of
        Nothing -> List (RepoName repo) (Path file)
        Just file' -> List (RepoName repo) (Path file')
    where
      sep = Text.singleton pathSeparator

readSymbol :: ReadM SymbolId
readSymbol = do
  sym <- Text.pack <$> readerAsk
  if length (Text.splitOn "/" sym) < 3
    then err
    else return (SymbolId sym)
  where
    err = fail "Not a valid symbol. Symbols have the form: repo/lang/path-ish"

defDocumentSymbolsReq :: DocumentSymbolsRequest
defDocumentSymbolsReq = def {
  documentSymbolsRequest_repository = RepoName "react",
  documentSymbolsRequest_filepath = Path "packages/react/src/ReactHooks.js",
  documentSymbolsRequest_include_refs = False -- just definitions
}

defCfg :: ThriftServiceOptions
defCfg = def { processingTimeout = Just 15000 }

type GlassM p a = forall c . ClientChannel c => ThriftM p c GlassService a

svc :: Service -> ThriftService GlassService
svc s =  mkThriftService s defCfg

main :: IO ()
main = Glean.withOptions options $ \Options{..} ->
  withEventBaseDataplane $ \evp -> do
    res <- runThrift evp (svc optHost) $
      case optCommand of
        List repo path -> runListSymbols repo path
        Describe sym -> runDescribe sym
        FindRefs sym -> runFindRefs sym
        FindLocation sym -> runLocation sym
        Search repo str ignoreCase -> runSearch repo str ignoreCase
    mapM_ Text.putStrLn res

runListSymbols :: Protocol p => RepoName -> Path -> GlassM p [Text]
runListSymbols repo path = do
  DocumentSymbolListXResult{..} <- documentSymbolListX query def
  return $ pprDefs documentSymbolListXResult_definitions
  where
    query = defDocumentSymbolsReq {
            documentSymbolsRequest_repository = repo
          , documentSymbolsRequest_filepath = path
    }

runDescribe :: Protocol p => SymbolId -> GlassM p [Text]
runDescribe sym = do
  SymbolDescription{..} <- describeSymbol sym def
  let loc = pprLocationRange $ locationRange symbolDescription_location
      name = pprQName symbolDescription_name
      kind = textShow <$> symbolDescription_kind
      annot = textShow <$> symbolDescription_annotations
  return $ [loc,name] <> catMaybes [kind,annot]

runSearch :: Protocol p => RepoName -> Text -> Bool -> GlassM p [Text]
runSearch repoName strName ignoreCase = do
  SymbolSearchResult syms _ <- searchSymbol req def
  return (map textShow syms)
  where
    req = SymbolSearchRequest
        strName
        (Just repoName)
        def -- language
        def -- kinds
        def { -- search options
          symbolSearchOptions_ignoreCase = ignoreCase
        }

runLocation :: Protocol p => SymbolId -> GlassM p [Text]
runLocation sym = do
  range <- symbolLocation sym def
  return [pprLocationRange (symbolLocation_location range)]

runFindRefs :: Protocol p => SymbolId -> GlassM p [Text]
runFindRefs sym = do
  ranges <- findReferenceRanges sym def
  return $
    ("Found " <> textShow (length ranges) <> " references") :
    map pprLocationRange ranges

-- List unique definition symbols
pprDefs :: [DefinitionSymbolX] -> [Text]
pprDefs = map (unSymbolId . definitionSymbolX_sym)

pprLocationRange :: LocationRange -> Text
pprLocationRange LocationRange{..} =
   Text.concat [repo, "@", path,":", pprRange range]
  where
    RepoName repo = locationRange_repository
    Path path = locationRange_filepath
    range = locationRange_range

pprRange :: Range -> Text
pprRange (Range lineBegin colBegin lineEnd colEnd) = Text.concat [
    textShow lineBegin, ":", textShow colBegin, "-",
    textShow lineEnd, ":", textShow colEnd
  ]

pprQName :: QualifiedName -> Text
pprQName QualifiedName{..} =
  unName qualifiedName_container <> ":" <> unName qualifiedName_localName

locationRange :: SymbolPath -> LocationRange
locationRange SymbolPath{..} = LocationRange {
    locationRange_repository = symbolPath_repository,
    locationRange_filepath = symbolPath_filepath,
    locationRange_range = symbolPath_range
  }