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 #-}
  {-# LANGUAGE CPP #-}
  module Glean.Regression.Snapshot.Options
    ( Config(..)
    , options
    , optionsWith
    ) where
  
  import qualified Options.Applicative as O
  import System.Directory
  import System.FilePath
  
  #if !defined(OSS)
  import Control.Monad (unless)
  import System.Process (readProcess)
  import Data.List (isPrefixOf, isSuffixOf)
  #endif
  
  data Config = Config
    { cfgProjectRoot :: FilePath
      -- ^ path to root of source tree
    , cfgRoot :: FilePath
      -- ^ parent path of all sources, *.query, golden *.out
    , cfgOutput :: Maybe FilePath
      -- ^ parent path of *.query results
    , cfgReplace :: Maybe FilePath
      -- ^ when True overwrite golden *.out with query result
    , cfgSchema :: Maybe FilePath
      -- ^ Schema directory
    , cfgTests :: [String]
      -- ^ specific directories of tests we want to run (ignoring other
      --   directories)
    , cfgOmitTests :: [String]
      -- ^ specific directories of tests we don't want to run
    } deriving Show
  
  options :: O.ParserInfo (IO Config)
  options = fst <$> optionsWith (pure ())
  
  optionsWith :: O.Parser a -> O.ParserInfo (IO Config,a)
  optionsWith other = O.info (O.helper <*> ((,) <$> parser <*> other)) O.fullDesc
    where
      parser = do
        cfgProjectRoot <- O.strOption
          $ O.long "project-root" <> O.metavar "PATH" <> O.value ""
        cfgRoot <- O.strOption $ O.long "root" <> O.metavar "PATH"
        cfgOutput <- O.optional $ O.strOption $
          O.short 'o' <> O.long "output" <> O.metavar "PATH"
        cfgReplace <- O.optional $ O.strOption $
          O.long "replace" <> O.metavar "PATH" <>
          O.help "Generate (overwrite) golden *.out files instead of testing"
        replaceAll <- O.switch $
          O.long "replace-all" <>
          O.help "Generate (overwrite) all golden *.out files instead of testing"
        cfgSchema <- O.optional $ O.strOption $
          O.long "schema" <>
          O.help "Directory containing schema source files"
        cfgTests <- O.many $ O.strOption $
          O.long "only" <> O.metavar "DIR" <>
          O.help "Run tests from DIR only"
        cfgOmitTests <- O.many $ O.strOption $
          O.long "omit" <> O.metavar "DIR" <>
          O.help "Do not run tests from DIR"
        return $ resolve replaceAll Config{..}
  
      resolve replaceAll cfg@Config{..} = do
        projectRoot <- if null cfgProjectRoot
          then getCurrentDirectory
          else makeAbsolute cfgProjectRoot
        -- We do `equalFilePath root` in the code that searches for test cases,
        -- which requires `canonicalizePath` for correctness
        root <- canonicalizePath cfgRoot
        replace <-
          if replaceAll
          then do
  #if OSS
            src <- pure (cfgProjectRoot </> root)
  #else
            src <- sourcePath root
  #endif
            putStrLn src
            return (Just src)
          else mapM makeAbsolute cfgReplace
        return $ cfg {
          cfgProjectRoot = projectRoot,
          cfgRoot = root,
          cfgReplace = replace
        }
  
  #if !defined(OSS)
  -- | Simple heuristics to get the path of the source files
  -- from the buck-out path. Will take a path like
  --
  --   /data/users/unixname/fbsource/buck-out/v2/gen/fbcode/e1b1d0a81b509819/glean/facebook/tools/diff-sketch/test/__hack-sources__/hack-sources/hack
  --
  --  and transform it into
  --
  --   /data/users/unixname/fbsource/fbcode/glean/facebook/tools/diff-sketch/test/hack
  --
  sourcePath :: FilePath -> IO FilePath
  sourcePath path = do
    root <- head . lines <$> readProcess "buck" ["root"] ""
    let
      sourcePath = root </> path'
  
      path' = joinPath
        $ removeBuckFileGroup
        $ dropWhile (/= "glean") -- drop hash
        $ go (splitDirectories root) (splitDirectories path)
    exists <- doesDirectoryExist sourcePath
    putStrLn $ unlines
      [ "sourcePath: "
      , sourcePath
      , path
      ]
    unless exists $
      error $ unlines
       [ "Unable to find tests path."
       , "Expected to find it in: " <> sourcePath
       , "Specify it with --replace PATH"
       ]
    return sourcePath
    where
      -- A buck file_group target will add two directories with the name
      -- of the target to the path. The first one will be surrounded by
      -- double underscores. i.e. ../__dir__/dir/..
      removeBuckFileGroup p = xs ++ drop 2 ys
        where
          (xs, ys) = break isBuckFileGroupDir p
  
          isBuckFileGroupDir = isSurroundedBy "__"
          isSurroundedBy term str =
            term `isPrefixOf` str &&
            term `isSuffixOf` str
  
      go [] ys = ys
      go _  [] = error "test path is not a subdirectory of root"
      go (x:xs) (y:ys) =
        if x == y
        then go xs ys
        else go (x:xs) ys
  #endif
  