{-
  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.Symbol
  ( main
  ) where

import Data.Default ( Default(def) )
import Data.Int (Int64 ,Int32)
import Control.Exception ( handle )
import Control.Monad ( forM_ ,(<=<) )
import Data.Text ( Text )
import Text.Printf ( printf )
import Data.Tuple.Extra (fst3,thd3)
import Options.Applicative

import qualified Data.Text as Text
import qualified Data.Text.IO as Text

import Glean.Init ( withOptions )
import Util.OptParse ( maybeTextOption, maybeIntOption )
import Util.Timing ( showTime, timeIt )
import Util.Text ( textShow )
import Util.IO ( readFileUTF8Text )

import Glean.Glass.Types
import qualified Glean.Glass.Env as Glass
import qualified Glean.Glass.Handler.Symbols as Handle
import qualified Glean.Glass.Main as Glass
import qualified Glean.Glass.Options as Glass
import Glean.Glass.Tracing (GlassTrace)

data Config = Config
  { cfgGlass :: Glass.Config GlassTrace
  , cfgSymbol :: Maybe SymbolId
  , cfgFile :: Maybe Text
  , cfgCmd :: Cmd
  , cfgLimit :: Maybe Int32
  }

data Cmd
  = FindLocation
  | FindReferences
  | Describe

options :: ParserInfo Config
options = info (helper <*> parser) fullDesc
  where
    parser :: Parser Config
    parser = do
      cfgGlass <- Glass.configParser
      cfgCmd <- (\(cmd::String) -> case cmd of
                    "references" -> FindReferences
                    "describe" -> Describe
                    _ -> FindLocation)
            <$> strOption (short 'c' <> long "command" <> metavar "COMMAND")
      cfgSymbol <- fmap SymbolId <$>
        maybeTextOption (long "symbol" <> short 's' <> metavar "SYMBOL")
      cfgFile <-
        maybeTextOption (long "file" <> short 'f' <> metavar "FILE")
      cfgLimit <- fmap fromIntegral <$>
        maybeIntOption (long "limit" <> short 'n' <> metavar "LIMIT")
      return Config{..}

main :: IO ()
main =
  withOptions options $ \Config{cfgGlass = glassConfig, ..} ->
  Glass.withEnv glassConfig Nothing $ \env -> do

    syms <- case (cfgSymbol, cfgFile) of
      (Nothing, Nothing) ->
        map SymbolId . Text.lines <$> Text.getContents

      (Just symid, _) -> return [symid]
      (_, Just file) -> map SymbolId . Text.lines <$>
         readFileUTF8Text (Text.unpack file)

    case cfgCmd of
      FindLocation -> do
        let symbolLocation :: SymbolId -> IO SymbolLocation
            symbolLocation r =
              Handle.symbolLocation env r (def :: RequestOptions)
        forM_ syms $ Text.putStrLn <=< testSymbolLocation symbolLocation

      FindReferences -> do
        let findReferences :: SymbolId -> IO [LocationRange]
            findReferences r =
              Handle.findReferenceRanges env r
                (def  { requestOptions_limit = cfgLimit } )
        forM_ syms $ mapM_ Text.putStrLn <=< testFindReferences findReferences

      Describe -> do
        let describe :: SymbolId -> IO SymbolDescription
            describe r =
              Handle.describeSymbol env r
                (def  { requestOptions_limit = cfgLimit } )
        forM_ syms $ Text.putStrLn <=< testDescribe describe

testFindReferences
  :: (SymbolId -> IO [LocationRange])
  -> SymbolId
  -> IO [Text]
testFindReferences handler symbol@(SymbolId name) = do
  handle (\(ServerException e) -> return ["FAIL " <> e]) $ do
    res <- runTest handler symbol
    let title = Text.concat
          [ "OK "
          , Text.pack (showTime (fst3 res))
          , " "
          , name
          , Text.pack (printf " (Found %d references)" (length $ thd3 res))
          ]
    let body = map pprLocationRange (thd3 res)

    return $ title : body

testSymbolLocation
  :: (SymbolId -> IO SymbolLocation)
  -> SymbolId
  -> IO Text
testSymbolLocation handler symbol@(SymbolId name) = do
  handle (\(ServerException e) -> return ("FAIL " <> e)) $ do
    res <- runTest handler symbol
    return $ Text.concat
      [ "OK "
      , Text.pack (showTime (fst3 res))
      , " "
      , name
      ," -> "
      ,pprLocationRange (symbolLocation_location (thd3 res))
      ]

testDescribe
  :: (SymbolId -> IO SymbolDescription)
  -> SymbolId
  -> IO Text
testDescribe handler symbol@(SymbolId name) = do
  handle (\(ServerException e) -> return ("FAIL " <> e)) $ do
    res <- runTest handler symbol
    return $ Text.concat
      [ "OK "
      , Text.pack (showTime (fst3 res))
      , " "
      , name
      ," -> "
      ,pprDescription (thd3 res)
      ]

pprLocationRange :: LocationRange -> Text
pprLocationRange LocationRange{..} =
  Text.concat [
    unRepoName locationRange_repository, "@",
    unPath locationRange_filepath, " ",
    pprRange locationRange_range
  ]

pprSymbolPath :: SymbolPath -> Text
pprSymbolPath SymbolPath{..} = pprLocationRange LocationRange{..}
  where
    locationRange_filepath  = symbolPath_filepath
    locationRange_range = symbolPath_range
    locationRange_repository = symbolPath_repository

pprQName :: QualifiedName -> Text
pprQName QualifiedName{..} = Text.concat
  [ "container: ", unName qualifiedName_container
  , " "
  , "localname: ", unName qualifiedName_localName
  ]

pprKind :: Maybe SymbolKind -> Text
pprKind = textShow

pprDescription :: SymbolDescription -> Text
pprDescription SymbolDescription{..} =
  Text.unlines [
    pprSymbolPath symbolDescription_location,
    "qualified name: "<> pprQName symbolDescription_name,
    "symbol kind: "<> pprKind symbolDescription_kind
  ]

pprRange :: Range -> Text
pprRange Range{..} = Text.concat
  [ "("
  , textShow range_lineBegin, ":"
  , textShow range_columnBegin, "-"
  , textShow range_lineEnd, ":"
  , textShow range_columnEnd
  , ")"
  ]

runTest
  :: (a -> IO r)
  -> a
  -> IO (Double, Int64, r)
runTest handler sym = timeIt $ handler sym