Add --debug-query flag

Summary:
Also allow debug flags to be specified via an environment variable
`GLEAN_DEBUG` which is useful for tests that don't pass CLI flags to
the Glean backend.

Reviewed By: bochko

Differential Revision: D62849607

fbshipit-source-id: 97d9d6e763c620c23beb491ebc56ba63b0218f2e

glean.cabal.in

@@ -543,6 +543,7 @@ library db
         Glean.Logger
 
     build-depends:
+        split,
         glean:bytecode,
         glean:config,
         glean:core,

glean/db/Glean/Database/Config.hs

@@ -165,10 +165,20 @@ data Config = Config
 
 data DebugFlags = DebugFlags
   { tcDebug :: !Bool
+  , queryDebug :: !Bool
   }
 
 instance Default DebugFlags where
-  def = DebugFlags { tcDebug = False }
+  def = DebugFlags { tcDebug = False, queryDebug = False }
+
+instance Semigroup DebugFlags where
+  a <> b = DebugFlags
+    { tcDebug = tcDebug a || tcDebug b
+    , queryDebug = queryDebug a || queryDebug b
+    }
+
+instance Monoid DebugFlags where
+  mempty = def
 
 instance Show Config where
   show c = unwords [ "Config {"
@@ -447,6 +457,7 @@ options = do
     debugParser :: Parser DebugFlags
     debugParser = do
       tcDebug <- switch (long "debug-tc")
+      queryDebug <- switch (long "debug-query")
       return DebugFlags{..}
 
     recipesConfigThriftSource = option (eitherReader ThriftSource.parse)

glean/db/Glean/Database/Env.hs

@@ -14,8 +14,10 @@ import Control.Exception.Safe
 import Control.Monad.Extra
 import Data.Default
 import qualified Data.HashMap.Strict as HashMap
+import Data.List.Split
 import Data.Time
 import System.Clock (TimeSpec(..))
+import System.Environment
 import System.Time.Extra (sleep, Seconds, timeout)
 
 import Data.RateLimiterMap
@@ -128,6 +130,8 @@ initEnv evb envStorage envCatalog shardManager cfg
 
     envDbSchemaCache <- newMVar HashMap.empty
 
+    debug <- getDebugEnv
+
     return Env
       { envEventBase = evb
       , envServerLogger = cfgServerLogger cfg
@@ -146,9 +150,22 @@ initEnv evb envStorage envCatalog shardManager cfg
           else DisableRecursion
       , envFilterAvailableDBs = cfgFilterAvailableDBs cfg
       , envTracer = cfgTracer cfg
-      , envDebug = cfgDebug cfg
+      , envDebug = cfgDebug cfg <> debug
       , .. }
 
+getDebugEnv :: IO DebugFlags
+getDebugEnv = do
+  m <- lookupEnv "GLEAN_DEBUG"
+  case m of
+    Just str -> mconcat <$> mapM add (splitOn "," str)
+    Nothing -> return def
+  where
+  add "tc" = return def { tcDebug = True }
+  add "query" = return def { queryDebug = True }
+  add other = do
+    logWarning $ "Unkonwn GLEAN_DEBUG class: " <> other
+    return def
+
 spawnThreads :: Env -> IO ()
 spawnThreads env@Env{..} = do
   ServerConfig.Config{..} <- Observed.get envServerConfig

glean/db/Glean/Query/UserQuery.hs

@@ -41,6 +41,7 @@ import Compat.Prettyprinter.Render.Text
 import qualified Data.Vector as Vector
 import Data.Vector (Vector)
 import Data.Word (Word64)
+import System.IO
 import TextShow
 
 import ServiceData.GlobalStats as Stats
@@ -865,29 +866,29 @@ compileAngleQuery
   -> IO (CodegenQuery, Type)
 compileAngleQuery rec ver dbSchema mode source stored debug = do
   parsed <- checkBadQuery Text.pack $ Angle.parseQuery source
-  vlog 2 $ "parsed query: " <> show (displayDefault parsed)
+  ifDebug $ "parsed query: " <> show (displayDefault parsed)
 
   let scope = addTmpPredicate $ fromMaybe HashMap.empty $
         schemaNameEnv dbSchema ver
 
   resolved <- checkBadQuery id $ runExcept $
     runResolve latestAngleVersion scope $ resolveQuery parsed
-  vlog 2 $ "resolved query: " <> show (displayDefault resolved)
+  ifDebug $ "resolved query: " <> show (displayDefault resolved)
 
   typechecked <- (checkBadQuery id =<<) $ runExceptT $
     typecheck dbSchema (defaultTcOpts debug latestAngleVersion)
       (dbSchemaRtsType dbSchema) resolved
-  vlog 2 $ "typechecked query: " <> show (displayDefault (qiQuery typechecked))
+  ifDebug $ "typechecked query: " <> show (displayDefault (qiQuery typechecked))
 
   flattened <- checkBadQuery id $ runExcept $
     flatten rec dbSchema latestAngleVersion stored typechecked
-  vlog 2 $ "flattened query: " <> show (displayDefault (qiQuery flattened))
+  ifDebug $ "flattened query: " <> show (displayDefault (qiQuery flattened))
 
   optimised <- checkBadQuery id $ runExcept $ optimise flattened
-  vlog 2 $ "optimised query: " <> show (displayDefault (qiQuery optimised))
+  ifDebug $ "optimised query: " <> show (displayDefault (qiQuery optimised))
 
-  -- no need to vlog, compileQuery will vlog it later
   reordered <- checkBadQuery id $ runExcept $ reorder dbSchema optimised
+  ifDebug $ "reordered query: " <> show (displayDefault (qiQuery reordered))
 
   final <- case mode of
     NoExtraSteps -> return reordered
@@ -897,6 +898,8 @@ compileAngleQuery rec ver dbSchema mode source stored debug = do
 
   return (final, qiReturnType typechecked)
   where
+  ifDebug = when (queryDebug debug) . hPutStrLn stderr
+
   checkBadQuery :: (err -> Text) -> Either err a -> IO a
   checkBadQuery txt act = case act of
     Left str -> throwIO $ Thrift.BadQuery $ txt str