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.
  -}
  
  {-# LANGUAGE ApplicativeDo #-}
  module Disassemble(main) where
  
  import Control.Monad
  import Data.Default
  import Data.List (sortOn)
  import Data.Text (Text)
  import qualified Data.Text as Text
  import qualified Data.Text.IO as Text
  import Options.Applicative
  import System.Exit (die)
  
  import Util.OptParse
  
  import Glean.Database.Config (
    schemaLocationOption, schemaLocationToSource, SchemaLocation)
  import Glean.Database.Schema
  import Glean.Database.Schema.Types
  import Glean.Impl.ConfigProvider
  import Glean.RTS.Bytecode.Disassemble (disassemble)
  import Glean.Types (PredicateRef(..))
  import Glean.Schema.Util (parseRef)
  import Glean.Util.ConfigProvider
  import qualified Glean.Util.ThriftSource as ThriftSource
  import Glean.Bytecode.SysCalls (typecheckSysCalls)
  
  data Config = Config
    { cfgSchemaLocation :: SchemaLocation
    , cfgCommand :: Command
    }
  
  newtype Command
    = PTC [Text]
  
  options :: ParserInfo Config
  options = info (parser <**> helper)
    (fullDesc <> progDesc "Disassemble bytecode")
    where
      parser :: Parser Config
      parser = do
        cfgSchemaLocation <- schemaLocationOption
        cfgCommand <- typecheckerCmd
        return Config{..}
  
      typecheckerCmd =
        commandParser "ptc" (progDesc "Disassemble predicate typecheckers")
          $ fmap (PTC . map Text.pack)
          $ many
          $ strArgument
            (  metavar "PREDICATE"
            <> help "Predicate reference"
            )
  
  main :: IO ()
  main =
    withConfigOptions options $ \(Config{..}, cfg) ->
    withConfigProvider cfg $ \(cfgAPI :: ConfigAPI) -> do
  
    schemas <- ThriftSource.load cfgAPI (schemaLocationToSource cfgSchemaLocation)
    db_schema <- newDbSchema Nothing schemas LatestSchema readWriteContent def
  
    case cfgCommand of
      PTC args -> predicateTypecheckers db_schema args
  
  predicateTypecheckers :: DbSchema -> [Text] -> IO ()
  predicateTypecheckers schema args = do
    preds <- case args of
      [] -> return $ schemaPredicates schema
      refs -> forM refs $ \ref -> do
        let sourceRef = parseRef ref
        either (die . Text.unpack) return
          $ lookupPredicateSourceRef sourceRef LatestSchema schema
    forM_ (sortOn predicateRef preds) $ \d@PredicateDetails{..} -> do
      let PredicateRef{..} = predicateRef d
      mapM_ Text.putStrLn $ disassemble
        ("ptc_"
          <> predicateRef_name
          <> "."
          <> Text.pack (show $ predicateRef_version))
        typecheckSysCalls
        predicateTypecheck
      putStrLn ""
  