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 #-}
  {-# OPTIONS_GHC -Wno-orphans #-}
  module Glean.Shell
    ( ShellCommand
    ) where
  
  import Control.Concurrent
  import Control.Exception hiding (evaluate)
  import Control.Monad.Extra
  import qualified Control.Monad.Catch as C
  import Control.Monad.IO.Class (liftIO, MonadIO)
  import Control.Monad.Trans.Class (lift)
  import qualified Control.Monad.Trans.State.Strict as State
  import qualified Data.ByteString.UTF8 as UTF8
  import Data.Char
  import Data.Default
  import Data.Foldable
  import qualified Data.HashMap.Strict as HashMap
  import Data.Int
  import Data.IORef
  import Data.List
  import Data.List.Split
  import qualified Data.Map as Map
  import Data.Maybe
  import Data.Ord
  import qualified Data.Set as Set
  import Text.Printf
  import qualified Data.Text as Text
  import qualified Data.Text.Encoding as Text
  import Compat.Prettyprinter as Pretty hiding ((<>), pageWidth)
  import Compat.Prettyprinter.Util as Pretty hiding (words)
  import qualified Prettyprinter.Render.Terminal as Pretty
  import Data.Time.Clock
  import Data.Time.Clock.POSIX
  import qualified Options.Applicative as O
  import Options.Applicative hiding (help)
  import qualified System.Console.Haskeline as Haskeline
  import System.Environment (lookupEnv)
  import System.FilePath ((</>), takeBaseName)
  import System.IO
  import System.IO.Temp
  import System.Process (callCommand)
  import System.Mem.Weak
  import System.Posix.Signals
  import System.Exit
  import qualified Text.JSON as JSON
  import Text.Parsec (runParser)
  
  #if MIN_VERSION_haskeline(0,8,0)
  import qualified Control.Monad.Catch as HEx (handle, bracket)
  #else
  import qualified System.Console.Haskeline as HEx (handle, bracket)
  #endif
  
  import Util.JSON.Pretty ()
  import Util.List
  import Util.OptParse
  import Util.String
  import Util.Text
  import Util.TimeSec
  
  import qualified Glean
  import qualified Glean.BuildInfo as BuildInfo
  import Glean.Angle.Types as SchemaTypes hiding (describe)
  import Glean.Display
  import Glean.Remote (clientInfo, thriftBackendClientConfig)
  import Glean.Database.Ownership
  import Glean.Database.Open
  import Glean.Database.Schema ( newDbSchema, readWriteContent )
  import Glean.Database.Schema.Types ( SchemaSelector(..) )
  import Glean.Database.Schema.ComputeIds (
    emptyHashedSchema, HashedSchema(..), RefTargetId )
  import Glean.Database.Config (parseSchemaDir, SchemaIndex(..),
    ProcessedSchema(..), SchemaLocation(..), schemaLocation)
  import qualified Glean.Database.Config as DB (Config(..))
  import Glean.Database.Storage (describe)
  import Glean.Database.Types (Env(..))
  import Glean.Indexer
  import Glean.Indexer.List
  import Glean.LocalOrRemote as Glean hiding (options, withBackend)
  import Glean.RTS.Types (Pid(..), Fid(..))
  import Glean.RTS.Foreign.Query (interruptRunningQueries)
  import Glean.Schema.Types
  import Glean.Schema.Util
  import Glean.Shell.Index
  import Glean.Shell.Terminal
  import Glean.Shell.Types
  import Glean.Shell.Error (Ann, BadQuery(..), prettyBadQuery)
  import qualified Glean.Types as Thrift
  import Glean.Util.ConfigProvider
  #if GLEAN_FACEBOOK
  import Glean.Util.CxxXRef
  #endif
  import Glean.Util.Service
  import Glean.Util.ShellPrint
  import Glean.Util.Some
  import qualified Glean.Util.ThriftSource as ThriftSource
  
  import GleanCLI.Types
  
  data Config = Config
    { cfgDatabase :: Maybe String
    , cfgQuery :: [String]
    , cfgLimit :: Int64
    , cfgWidth :: Maybe Int
    , cfgPager :: Bool
    }
  
  options :: Parser Config
  options = commandParser "shell" (progDesc "Start the Glean shell") parser
    where
      parser = do
        cfgDatabase <- optional $ strOption
          (  long "db"
          <> metavar "NAME"
          <> O.help "database to use (default: use latest complete DB)" )
        cfgLimit <- option auto
          (  long "limit"
          <> metavar "N"
          <> value 100
          <> O.help "Set max number of results to fetch"
          )
        cfgQuery <- many $ strArgument
          (  metavar "QUERY"
          <> O.help
            ( "Perform one or more queries or commands"
            <> " (default: enter the REPL)")
          )
        cfgWidth <- optional $ option auto
          (  long "width"
          <> metavar "N"
          <> O.help "Output line width (0: unbounded, default: adaptive)"
          )
        cfgPager <- switch
          (  long "pager"
          <> O.help "Use a pager for displaying long output"
          )
        return Config{..}
  
  output :: Doc Ann -> Eval ()
  output doc = do
    ShellState{..} <- getState
    out <- liftIO $ readMVar outputHandle
    liftIO
      $ Pretty.renderIO out
      $ layoutPretty
          LayoutOptions{ layoutPageWidth = fromMaybe Unbounded pageWidth }
      $ (if isTTY then id else Pretty.unAnnotate)
      $ doc <> hardline
  
  outputShellPrint :: ShellPrint a => a -> Eval ()
  outputShellPrint x = do
    ShellState{..} <- getState
    out <- liftIO $ readMVar outputHandle
    now <- liftIO $ utcTimeToPOSIXSeconds <$> getCurrentTime
    let
      t0 = Time (round now)
      format = if isTTY then TTY else PlainText
      opts = PrintOpts
        { poFormat = format
        , poNow = t0
        , poWidth = pageWidth
        }
    liftIO $ do
      shellPrint out opts x
      hPutStrLn out ""
  
  newtype Repl a = Repl
    { unRepl :: Haskeline.InputT Eval a
    }
    deriving (Functor, Applicative, Monad, MonadIO
  #if MIN_VERSION_haskeline(0,8,0)
      , C.MonadThrow, C.MonadCatch, C.MonadMask
  #else
      , Haskeline.MonadException
  #endif
    )
  repoString :: Thrift.Repo -> String
  repoString repo = concat
    [Text.unpack (Thrift.repo_name repo)
    ,"/"
    ,Text.unpack (Thrift.repo_hash repo)
    ]
  
  lookupPid :: Pid -> Eval (Maybe PredicateRef)
  lookupPid (Pid pid) = do
    m <- schemaInfo <$> getState
    case m of
      Nothing -> return Nothing
      Just Thrift.SchemaInfo{..} ->
        return $ Map.lookup pid schemaInfo_predicateIds
  
  withRepo :: (Thrift.Repo -> Eval a) -> Eval a
  withRepo f = do
    r <- getRepo
    case r of
      Just repo -> f repo
      Nothing -> liftIO $ throwIO $ ErrorCall "no database selected"
  
  useSchema :: String -> Eval ()
  useSchema "" = do
    ShellState{..} <- getState
    maybeCurrentId <- getSchemaId
    forM_ maybeCurrentId $ \currentId ->
      output $ "Using Schema ID: " <> pretty (Thrift.unSchemaId currentId)
    forM_ schemaInfo $ \Thrift.SchemaInfo{..} -> do
      output $ vcat $ map (nest 4 . vcat)
        [ [ "Current schema ID(s):",
            showSchemaIds schemaInfo_schemaIds ]
        , [ "Schema ID(s) stored in the DB:",
            showSchemaIds schemaInfo_dbSchemaIds ]
        , [ "Other available schema ID(s):",
            vcat (map showSchemaIds schemaInfo_otherSchemaIds) ]
        ]
    where
    showSchemaIds m = vcat
      [ pretty schemaId <+> parens ("all." <> pretty ver)
      | (schemaId, ver) <- Map.toList m
      ]
  useSchema str = do
    state <- getState
    sel <- case str of
      "current" -> return (Thrift.SelectSchema_current def)
      "stored" -> return (Thrift.SelectSchema_stored def)
      id | Just Thrift.SchemaInfo{..} <- schemaInfo state,
           Text.pack id `Map.member` schemaInfo_schemaIds ||
           Text.pack id `Map.member` schemaInfo_dbSchemaIds ||
           any (Text.pack id `Map.member`) schemaInfo_otherSchemaIds ->
             return (Thrift.SelectSchema_schema_id
               (Thrift.SchemaId (Text.pack id)))
         | otherwise -> liftIO $ throwIO $ ErrorCall $ "unknown schema: " <> id
    Eval $ State.modify $ \s -> s { useSchemaId = sel }
    -- Fetch the new schema
    mapM_ setRepo =<< getRepo
  
  getSchemaCmd :: String -> Eval ()
  getSchemaCmd str = do
    maybeProc <- schemas <$> getState
  
    ProcessedSchema{..} <- case maybeProc of
      Nothing -> liftIO $ throwIO $ ErrorCall
        "no schema loaded. Use :db to load a DB."
      Just proc  -> return proc
  
    nameEnv <- getNameEnv
    let
      HashedSchema{..} = procSchemaHashed
  
      opts = defaultDisplayOpts { predicateStyle = PredicateWithoutHash }
  
      found refs = output $ vcat $ punctuate line $ map pp refs
        where
        pp ref = case ref of
          RefPred p -> case HashMap.lookup p hashedPreds of
            Nothing -> mempty
            Just def -> display opts def
          RefType p -> case HashMap.lookup p hashedTypes of
            Nothing -> mempty
            Just def -> display opts def
  
    env <- case nameEnv of
      Nothing -> liftIO $ throwIO $ ErrorCall "can't find schema"
      Just env -> return env
  
    let name = Text.pack (strip str)
    case resolveRef env (parseRef name) of
      ResolvesTo one -> found [one]
      Ambiguous many -> found many
      OutOfScope ->  -- doesn't match exactly; match it as a prefix
        found $ Set.toList $ Set.unions $ HashMap.elems $
          HashMap.filterWithKey prefixMatch env
        where
        prefixMatch k _ = name `Text.isPrefixOf` showRef k
  
  displayStatistics :: String -> Eval ()
  displayStatistics arg =
    withRepo $ \repo ->
    withBackend $ \backend -> do
    let containsRemove element list = return (filter (/=element) list,
                                              isJust (find (==element) list))
    let args = words arg
    (args, sortBySize) <- containsRemove "-s" args
    (args, topmost) <- containsRemove "--topmost" args
    predicate <- case args of
      [] -> return ""
      [predicate] -> return predicate
      _ -> liftIO $ throwIO $
        ErrorCall "syntax: :statistics [--topmost] [-s] [<predicate>]"
    let
    xs <- liftIO $ Glean.predicateStats backend repo (
        if topmost then Glean.ExcludeBase else Glean.IncludeBase)
    preds <- forM (Map.toList xs) $ \(id,stats) -> do
      ref <- maybe (Left id) Right <$> lookupPid (Pid id)
      return (ref,stats)
    let
      filterPred :: Either Thrift.Id PredicateRef -> Bool
      filterPred ref =
        null predicate ||
            case ref of
              Right pref -> predicate `isPrefixOf` show (pretty pref)
              Left _ -> False
    let showTotal = null predicate
    let format = StatsFormatOpts { showTotal, sortBySize }
    outputShellPrint $ (filterPred, preds) `withFormatOpts` format
  
  getDatabases
    :: Bool -- ^ Include DBs that can be restored from backups
    -> String -- ^ Only display dbs with a repo name containing this string
    -> Eval [Thrift.Database]
  getDatabases all filterStr = do
    state <- getState
    r <- withBackend $ \be ->
      liftIO $ Glean.listDatabases be
        def { Thrift.listDatabases_includeBackups = all
            , Thrift.listDatabases_client_info = Just (client_info state)
            }
    let
      -- argument can be NAME or NAME/HASH
      repoFilter str db =
        str `isInfixOf` repoString repo ||
        Text.pack str `Text.isInfixOf` Thrift.repo_name repo
        where repo = Thrift.database_repo db
      xs = Thrift.listDatabasesResult_databases r
      match = strip filterStr
      dbs = if null match then xs else filter (repoFilter match) xs
    return dbs
  
  displayDatabases:: Bool -> Bool -> String -> Eval ()
  displayDatabases all verbose filterStr = do
    dbs <- getDatabases all filterStr
    forM_ (sortOn Thrift.database_created_since_epoch dbs) $ \db ->
      outputShellPrint $ db
        `withFormatOpts` if verbose then DbDescribe else DbSummarise
  
  dbCmd :: String -> Eval ()
  dbCmd "" = do
    r <- getRepo
    case r of
      Nothing -> output "no database selected"
      Just repo -> displayDatabases False True (repoString repo)
  dbCmd str
    | Just repo <- Glean.parseRepo str = setRepo repo
    | otherwise = do
        let repoName = Text.pack str
        result <- C.try $ withBackend $ \be ->
          liftIO $ Glean.getLatestRepo be repoName
        case result of
          Left e
            | Just Glean.NoDatabase{} <- fromException e -> do
              output $ pretty $ "no " <> repoName <> " database available"
            | Just SomeAsyncException{} <- fromException e -> liftIO $ throwIO e
            | otherwise -> do
              output $ pretty $ "couldn't find database: " <>
                Text.pack (show e)
          Right repo -> do
            output $ pretty $ "using database " ++ repoString repo
            setRepo repo
  
  restoreDatabase :: String -> Eval ()
  restoreDatabase loc = withBackend $ \be ->
    liftIO $ Glean.restoreDatabase be $ Text.pack loc
  
  deleteDatabase :: String -> Eval ()
  deleteDatabase db
    | Just repo <- Glean.parseRepo db = withBackend $ \be ->
      void $ liftIO $ Glean.deleteDatabase be repo
    | otherwise
    = liftIO $ throwIO $ ErrorCall "syntax:  :!delete <name>/<hash>"
  
  
  initialize :: Config -> Eval ()
  initialize cfg = mapM_ dbCmd (cfgDatabase cfg)
  
  hello :: Eval ()
  hello = output msg
    where
      msg
        | "dev" `Text.isPrefixOf` BuildInfo.buildMode =
          "Glean Shell (dev build)"
        | otherwise =
          "Glean Shell, built on " <> pretty BuildInfo.buildTimeISO8601 <>
          ", from rev " <> pretty BuildInfo.buildRevision
  
  help :: Eval ()
  help = do
    hello
    output $ "" <> line <> helptext
  
  helptext :: Doc ann
  helptext = vcat
    [ "Commands:"
    , indent 2 $ vcat
        [ fillBreak (command_width + 2) (":" <> pretty command)
            <+> align (reflow text)
          | (command,text) <- commands ]
    , ""
    , helpAngle ]
    where
      command_width = maximum $ map (Text.length . fst) commands
  
      commands :: [(Text.Text,Text.Text)]
      commands =
        [ ("database [<db>]",
              "Use database <db>")
        , ("index <lang> <dir>",
              "Index source files in <dir> and create a database.")
        , ("list [<db>]",
              "List available databases which match <db>")
        , ("list-all [<db>]",
              "List available databases and restorable backups which match "
              <> "<db>")
        , ("debug off|[-]ir|[-]bytecode|all",
              "Enable/disable query debugging options")
        , ("describe [<db>]",
              "Like :list, but show more details")
        , ("describe-all [<db>]",
              "Like :list-all, but show more details")
        , ("schema [predicate|type]",
              "Show schema for the given predicate or type")
        , ("edit",
              "Edit a query in an external editor. "
              <> "Set the EDITOR environment variable to choose an editor")
        , ("limit <n>",
              "Set limit on the number of query results")
        , ("load [<file> | <db>/<hash> <file> ...]",
              "Create a DB from file(s) of JSON facts")
        , ("create [<db>/<hash>]",
              "Create an empty DB")
        , ("timeout off|<n>",
              "Set the query time budget")
        , ("expand off|on|<predicate>...",
              "Recursively expand nested facts in the response")
        , ("pager off|on",
              "Enable/disable result paging")
        , ("count <query>",
              "Show only a count of query results, not the results themselves")
        , ("more",
              "Fetch more results from the previous query")
        , ("profile [off|summary|full]",
              "Show query profiling information")
        , ("reload",
              "Reload the schema (when using --schema)")
        , ("statistics [--topmost] [-s] [<predicate>]",
              "Show statistics for the database."
              <> " Use --topmost to only show statisticsfor the top database"
              <> " and -s to sort by decreasing size")
        , ("use-schema [current|stored|<schema-id>]",
              "Select which schema to use. Without an argument lists the"
              <> " available schemas")
        , ("quit",
              "Exit the shell")
        ]
  
  helpAngle :: Doc ann
  helpAngle = vcat
    [ "Queries:"
    , "  {1234}                    Look up a fact by its Id"
    , "  <predicate> <pat>         Query a predicate for facts matching <pat>"
    , ""
    , "Pattern syntax:"
    , "  1234                     :: byte or nat"
    , "  \"abc\"                    :: string"
    , "  \"abc\"..                  :: string prefix match"
    , "  true|false               :: bool"
    , "  [ val1, val2]            :: [T]"
    , "  [ val1, val2, ..]        :: [T] prefix"
    , "  { field = val, ... }     :: record(fields), omitted fields are wild"
    , "  { field = val }          :: sum(fields)"
    , ""
    , "Please consult the documentation for the full query syntax."
    , ""
    , "Examples:"
    , "  {1234}                                   fetch a fact by its Id"
    , "  pp1.Define _                             all the pp1.Define facts"
    , "  pp1.Define { macro = \"NULL\" }            every #define of NULL"
    ]
  
  withTTY :: Eval a -> Eval (Maybe a)
  withTTY action = do
    state <- getState
    if not (isTTY state) then Just <$> action else do
      let !preset_width = pageWidth state
          !outh = outputHandle state
      page_width <- case preset_width of
        Just w -> return w
        Nothing -> do
          width <- fromMaybe 80 <$> liftIO getTerminalWidth
          return $ AvailablePerLine width 1
      let without_pager f = Just <$> f outh
      r <- liftIO $ (if pager state then withPager else without_pager) $
        \handle_var -> State.runStateT (unEval action) state
          { pageWidth = Just page_width
          , outputHandle = handle_var
          }
      forM_ r $ \(_, new_state) -> Eval $ State.put $ new_state
        { pageWidth = preset_width
        , outputHandle = outh
        }
      return $ fst <$> r
  
  evaluate :: String -> Eval Bool
  evaluate s =
    case runParser parse () "<input>" s of
      Left err -> do
        output $ "*** Syntax error:" <+> pretty (show err)
        return False
      Right stmt -> doAngleStmt stmt
  
  doAngleStmt :: Statement AngleQuery -> Eval Bool
  doAngleStmt (Command name arg) = doCmd name arg
  doAngleStmt (FactRef fid) = userFact fid >> return False
  doAngleStmt (Pattern query) = do
    q <- fromAngleQuery query
    pager_on <- pager <$> getState
    runUserQuery q { sqContinue = pager_on }
    return False
  
  fromAngleQuery :: AngleQuery -> Eval SchemaQuery
  fromAngleQuery (AngleQuery deprecatedRec stored pat) = do
    exp <- expandResults <$> getState
    when deprecatedRec deprecatedExpansionWarning
    return SchemaQuery
      { sqPredicate = ""
      , sqRecursive = exp
      , sqStored = stored
      , sqQuery = pat'
      , sqCont = Nothing
      , sqTransform = trans
      , sqSyntax = Thrift.QuerySyntax_ANGLE
      , sqOmitResults = False
      , sqContinue = False }
    where
      -- magic transformation when we query for "xrefs". This is to make
      -- debugging of xref issues easier by presenting xref data in an
      -- easier-to-comprehend format.
      (pat', trans)
  #if GLEAN_FACEBOOK
        | Just rest <- stripPrefix "xrefs " pat
        = ("cxx1.FileXRefs " <> rest, Just transformXRefs)
  #endif
        | otherwise = (pat, Nothing)
  
  deprecatedExpansionWarning :: Eval ()
  deprecatedExpansionWarning = output $ vcat
    [ "WARNING: Deprecated syntax. '!' at the start of a line to "
      <> "recursively expand facts is deprecated."
    , "Fact expansion is now enabled by default."
    , "Use ':expand off' to disable it."
    ]
  
  data Cmd = Cmd
    { cmdName :: String
    , cmdCompletion :: Haskeline.CompletionFunc Eval
    , cmdImpl :: String -> IORef Bool -> Eval ()
    }
  
  commands :: [Cmd]
  commands =
    [ Cmd "quit" Haskeline.noCompletion $ const $
        \stop -> liftIO $ writeIORef stop True
    , Cmd "statistics" (completeWords availablePredicates) $
        \str _ -> displayStatistics str
    , Cmd "edit" Haskeline.noCompletion $ \_ _ -> editCmd
    , Cmd "limit" Haskeline.noCompletion $ \str _ -> limitCmd str
    , Cmd "describe" completeDatabaseName $ const . displayDatabases False True
    , Cmd "describe-all" completeDatabaseName $ const . displayDatabases True True
    , Cmd "index" indexCompletion $ \str _ -> indexCmd str
    , Cmd "list" completeDatabaseName $ const . displayDatabases False False
    , Cmd "list-all" completeDatabaseName $ const . displayDatabases True False
    , Cmd "dump" Haskeline.noCompletion $ \str _ -> dumpCmd str
    , Cmd "load" Haskeline.completeFilename $ \str _ -> loadCmd str
    , Cmd "create" Haskeline.noCompletion $ \str _ -> createCmd str
    , Cmd "more" Haskeline.noCompletion $ const $ const moreCmd
    , Cmd "database" completeDatabases $ const . dbCmd
    , Cmd "db" completeDatabaseName $ const . dbCmd
    , Cmd "debug" (completeWords (pure
        ["off", "ir", "-ir", "bytecode", "-bytecode", "all"])) $
          \str _ -> debugCmd str
    , Cmd "reload" Haskeline.noCompletion $ const $ const reloadCmd
    , Cmd "schema" (completeWords availablePredicatesAndTypes) $
        \str _ -> getSchemaCmd str
    , Cmd "use-schema" completeUseSchema $ \str _ -> useSchema str
    , Cmd "profile" (completeWords (pure ["off","summary","full"])) $
        \str _ -> statsCmd str
    , Cmd "timeout" Haskeline.noCompletion $ \str _ -> timeoutCmd str
    , Cmd "expand" (completeWords (pure ["on", "off"])) $ \str _ -> expandCmd str
    , Cmd "pager" (completeWords (pure ["on", "off"])) $ \str _ -> pagerCmd str
    , Cmd "count" (completeWords availablePredicates) $ \str _ -> countCmd str
    , Cmd "!restore" Haskeline.noCompletion $ const . restoreDatabase
    , Cmd "!delete" completeDatabases $ const . deleteDatabase
    , Cmd "!owner" Haskeline.noCompletion $ \str _ -> ownerCmd str
    , Cmd "help" Haskeline.noCompletion $ \_ _ -> help
    , Cmd "?" Haskeline.noCompletion $ \_ _ -> help
    ]
  
  doCmd :: String -> String -> Eval Bool
  doCmd name arg0 = do
    stop <- liftIO $ newIORef False
    let arg = strip arg0
    case filter ((== name) . cmdName) commands of
      [Cmd{..}] -> cmdImpl arg stop
      _otherwise -> case filter (isPrefixOf name . cmdName) commands of
        [Cmd{..}]
          | "!" `isPrefixOf` cmdName -> output
              "*** This is an unsafe command, it can't be abbreviated"
          | otherwise -> cmdImpl arg stop
        [] -> output "*** Unknown command. Type :help for help."
        _ -> output "*** Ambiguous command. Type :help for help."
    liftIO $ readIORef stop
  
  ownerCmd :: String -> Eval ()
  ownerCmd str
    | Right fid <- textToInt (Text.pack str) = do
      withBackend $ \backend ->
        case backendKind backend of
          BackendEnv env -> withRepo $ \repo -> do
            maybeExpr <- liftIO $ factOwnership env repo (Fid (fromIntegral fid))
            case maybeExpr of
              Nothing -> output "*** no ownership information"
              Just expr -> output (prettyOwner expr)
          _other -> liftIO $ throwIO $ ErrorCall
            "!owner only works with --db-root"
    | otherwise = liftIO $ throwIO $ ErrorCall "syntax:  :!owner <fact>"
    where
    prettyOwner (Unit x) = pretty (Text.decodeUtf8 x)
    prettyOwner (OrOwners [one]) = prettyOwner one
    prettyOwner (OrOwners many) = sep $ intersperse "||" (map prettyOwner1 many)
    prettyOwner (AndOwners [one]) = prettyOwner one
    prettyOwner (AndOwners many) = sep $ intersperse "&&" (map prettyOwner1 many)
  
    prettyOwner1 (Unit x) = prettyOwner (Unit x)
    prettyOwner1 (OrOwners [one]) = prettyOwner1 one
    prettyOwner1 (AndOwners [one]) = prettyOwner1 one
    prettyOwner1 owner = parens (prettyOwner owner)
  
  moreCmd :: Eval ()
  moreCmd = do
    last_query <- lastSchemaQuery <$> getState
    case last_query of
      Just q -> runUserQuery q
      Nothing -> liftIO $ throwIO $ ErrorCall "no last query"
  
  reloadCmd :: Eval ()
  reloadCmd = do
    state <- getState
    case updateSchema state of
      Nothing -> output ":reload requires the shell to be started with --schema"
      Just io ->
        io `C.catch` \(ErrorCall err) ->
          output (pretty err)
    case repo state of
      Nothing -> return ()
      Just repo -> do
        Thrift.GetDatabaseResult{..} <- withBackend $ \be ->
          liftIO $ Glean.getDatabase be repo
        case Thrift.database_status getDatabaseResult_database of
          Thrift.DatabaseStatus_Complete -> return ()
          _otherwise -> output $ vcat
            [ "WARNING: the current database is writable, so its schema will not"
            , "be updated. To use the new schema, complete the current database"
            , "and restart the shell, or create a new database and load it." ]
  
  loadCmd :: String -> Eval ()
  loadCmd str
    | (db : files@(_ : _)) <- args
    , Just repo <- Glean.parseRepo db
    = do load repo files; setRepo repo
  
    -- Just a file: derive the repo from the filename and pick an unused hash
    | [file] <- args = do
      let name = Text.pack (takeBaseName file)
      hash <- pickHash name
      let repo = Thrift.Repo name hash
      load repo [file]
      setRepo repo
  
    -- no files: behave like :new
    | [] <- args = createCmd str
  
    | otherwise
    = liftIO $ throwIO $ ErrorCall
        "syntax:  :load (<file> | <db>/<hash> <file> ...)"
    where
      args = Data.List.words str
  
  createCmd :: String -> Eval ()
  createCmd str
    | [db] <- args
    , Just repo <- Glean.parseRepo db = do
      create repo
      setRepo repo
  
    | [] <- args = do
      let name = "tmp"
      hash <- pickHash name
      let repo = Thrift.Repo name hash
      create repo
      setRepo repo
  
    | otherwise =
       liftIO $ throwIO $ ErrorCall "syntax:  :create [<db>/<hash>]"
    where
      args = Data.List.words str
  
  dumpCmd :: String -> Eval ()
  dumpCmd str =
    withBackend $ \backend ->
    withRepo $ \repo ->
    liftIO $ Glean.dumpJsonToFile backend repo str
  
  editCmd :: Eval ()
  editCmd = do
    file <- query_file <$> getState
    meditor <- liftIO getEditor
    case meditor of
      Nothing -> liftIO $ do
        putStrLn "EDITOR not set."
        putStrLn "Set the EDITOR environment variable choose an editor."
      Just editor -> do
        query <- liftIO $ do
          callCommand $ unwords [editor, file]
          readFile file
        void $ evaluate query
  
  getEditor :: IO (Maybe String)
  getEditor = asum <$> sequence
    [ lookupEnv "EDITOR"
    , lookupEnv "VISUAL"
    ]
  
  limitCmd :: String -> Eval ()
  limitCmd "" = do
    l <- limit <$> getState
    output $ "current limit: " <> pretty l
  limitCmd str
    | Right n <- textToInt (Text.pack str) =
      Eval $ State.modify $ \s -> s { limit = fromIntegral n }
    | otherwise = liftIO $ throwIO $ ErrorCall "syntax: :limit <number>"
  
  timeoutCmd :: String -> Eval ()
  timeoutCmd "" = do
    t <- timeout <$> getState
    output $ "current query time limit:" <+>
      maybe "not set" (\ms -> pretty ms <> "ms") t
  timeoutCmd "off" =
    Eval $ State.modify $ \s -> s { timeout = Nothing }
  timeoutCmd str
    | Right n <- textToInt (Text.pack str) =
      Eval $ State.modify $ \s -> s { timeout = Just (fromIntegral n) }
    | otherwise = liftIO $ throwIO $ ErrorCall "syntax: :timeout off|<number>"
  
  countCmd :: String -> Eval ()
  countCmd str = do
    case runParser parse () "<input>" str of
      Left err -> do
        output $ "*** Syntax error:" <+> pretty (show err)
        return ()
      Right query -> do
        q <- fromAngleQuery query
        runUserQuery q { sqOmitResults = True, sqContinue = True }
  
  statsCmd :: String -> Eval ()
  statsCmd "" = do
    s <- stats <$> getState
    output $ "current profile setting: " <>
      case s of
        NoStats -> "off"
        SummaryStats -> "summary"
        FullStats -> "full"
  statsCmd str = do
    new <-  case str of
      "off" -> return NoStats
      "summary" -> return SummaryStats
      "full" -> return FullStats
      _ -> liftIO $ throwIO $ ErrorCall "syntax: :stats off|summary|full"
    Eval $ State.modify $ \s -> s { stats = new }
  
  
  debugCmd :: String -> Eval ()
  debugCmd str = case words (strip str) of
    [] -> do
      d <- debug <$> getState
      output $ "query debugging is currently: " <>
        let opts =
              [ "ir" | Thrift.queryDebugOptions_ir d ] ++
              [ "bytecode" | Thrift.queryDebugOptions_bytecode d ]
        in
        if null opts then "off" else hcat (punctuate "," opts)
    ["all"] -> do
      Eval $ State.modify $ \s -> s
        { debug = Thrift.QueryDebugOptions
          { queryDebugOptions_ir = True
          , queryDebugOptions_bytecode = True
          , queryDebugOptions_pred_has_facts = False
          }
        }
    [word] | Just onoff <- irFlag word -> Eval $ State.modify $ \s -> s
      { debug = (debug s) { Thrift.queryDebugOptions_ir = onoff } }
    [word] | Just onoff <- bytecodeFlag word -> Eval $ State.modify $ \s -> s
      { debug = (debug s) { Thrift.queryDebugOptions_bytecode = onoff } }
    ["off"] -> Eval $ State.modify $ \s -> s { debug = def }
    _ -> liftIO $ throwIO $ ErrorCall "syntax: :debug off|[-]ir|[-]bytecode|all"
    where
    irFlag "ir" = Just True
    irFlag "-ir" = Just False
    irFlag _ = Nothing
  
    bytecodeFlag "bytecode" = Just True
    bytecodeFlag "-bytecode" = Just False
    bytecodeFlag _ = Nothing
  
  
  expandCmd :: String -> Eval ()
  expandCmd str = case str of
    "" -> do
      expand <- expandResults <$> getState
      output $ case expand of
        ExpandRecursive -> "result expansion is on"
        ExpandPredicates ps -> "expanding " <> hsep (map (pretty . showRef) ps)
    "off" -> Eval $ State.modify $ \s -> s { expandResults = ExpandPredicates [] }
    "on" -> Eval $ State.modify $ \s -> s { expandResults = ExpandRecursive }
    other -> Eval $ State.modify $ \s -> s { expandResults = ExpandPredicates $
      map (parseRef . Text.pack) (words other) }
  
  pagerCmd :: String -> Eval ()
  pagerCmd str = case str of
    "" -> do
      pagerOn <- pager <$> getState
      output $ "result paging is " <> if pagerOn then "on" else "off"
    "off" -> Eval $ State.modify $ \s -> s { pager = False }
    "on" -> Eval $ State.modify $ \s -> s { pager = True }
    _ -> liftIO $ throwIO $ ErrorCall "syntax: :pager [off|on]"
  
  getExpandResults :: Eval (Bool, [Thrift.SourcePredicate])
  getExpandResults =  expandResultsOpts . expandResults <$> getState
  
  expandResultsOpts :: ExpandResults -> (Bool, [Thrift.SourcePredicate])
  expandResultsOpts exp = case exp of
    ExpandRecursive -> (True, [])
    ExpandPredicates refs -> (False, ps)
      where
      ps = [ Thrift.SourcePredicate name ver | SourceRef name ver <- refs ]
  
  userFact :: Glean.Fid -> Eval ()
  userFact fid = do
    (rec, expandPreds) <- getExpandResults
    Thrift.UserQueryResults{..} <- withRepo $ \repo -> withBackend $ \be ->
      liftIO $ Glean.userQueryFacts be repo $
        def { Thrift.userQueryFacts_facts =
                [def { Thrift.factQuery_id = fromFid fid }]
            , Thrift.userQueryFacts_options = Just def
              { Thrift.userQueryOptions_no_base64_binary = True
              , Thrift.userQueryOptions_expand_results = True
              , Thrift.userQueryOptions_recursive = rec
              , Thrift.userQueryOptions_expand_predicates = expandPreds }
            }
    Thrift.Fact{..} <- withRepo $ \repo -> withBackend $ \be -> do
      r <- liftIO $ Glean.queryFact be repo (fromFid fid)
      case r of
        Nothing -> liftIO $ throwIO $ ErrorCall "cannot fetch fact"
        Just f -> return f
    pref <- lookupPid (Pid fact_type) >>= \case
      Nothing -> liftIO $ throwIO $ ErrorCall "unknown predicate type"
      Just p -> return p
    case userQueryResults_stats of
      Nothing -> return ()
      Just Thrift.UserQueryStats{..} -> output $ pretty
        ( printf "%d facts, %.2fms, %ld bytes"
            userQueryStats_num_facts
            (realToFrac userQueryStats_elapsed_ns / 1000000 :: Double)
            userQueryStats_allocated_bytes
          :: String )
    case JSON.decode (UTF8.toString (head userQueryResults_facts)) of
      JSON.Error err -> output $ pretty err
      JSON.Ok (value :: JSON.JSValue) ->
        output $ pretty pref <> line <> pretty value
  
  asBadQuery :: String -> Thrift.BadQuery -> BadQuery
  asBadQuery query (Thrift.BadQuery err) = BadQuery (Text.pack query) err
  
  -- | Run a query, calling an accumulator function with each page of
  -- results.  The accumulator function returns a Bool to indicate
  -- whether to continue querying the next page or not.
  withQueryPages
    :: forall s .
       Thrift.UserQuery
    -> s
    -> (s -> Thrift.UserQueryResults -> Eval (s, Bool))
    -> Eval s
  withQueryPages query s f = do
    (s', results, continue) <- withRepo $ \repo -> withBackend $ \be -> do
      results <- liftIO $ Glean.userQuery be repo query
      (s', continue) <- f s results
      return (s', results, continue)
    case Thrift.userQueryResults_continuation results of
      Just cont | continue ->
        withQueryPages query {
          Thrift.userQuery_options =
            Just (fromMaybe def (Thrift.userQuery_options query)) {
              Thrift.userQueryOptions_continuation = Just cont }} s' f
      _otherwise -> return s'
  
  mkUserQuery :: SchemaQuery -> Eval Thrift.UserQuery
  mkUserQuery
    SchemaQuery
      { sqPredicate = str
      , sqRecursive = exp
      , sqStored = stored
      , sqQuery = rest
      , sqCont = cont
      , sqSyntax = syntax
      , sqOmitResults = omitResults } = do
    let SourceRef pred maybeVer = parseRef (Text.pack str)
        (recursive, expandPreds) = expandResultsOpts exp
    schema_id <- getSchemaId
    ShellState{..} <- getState
    return def {
        Thrift.userQuery_predicate = pred
      , Thrift.userQuery_predicate_version = maybeVer
      , Thrift.userQuery_query = UTF8.fromString rest
      , Thrift.userQuery_options = Just def
          { Thrift.userQueryOptions_no_base64_binary = True
          , Thrift.userQueryOptions_expand_results = True
          , Thrift.userQueryOptions_recursive = recursive
          , Thrift.userQueryOptions_max_results = Just limit
          , Thrift.userQueryOptions_max_time_ms = timeout
          , Thrift.userQueryOptions_continuation = cont
          , Thrift.userQueryOptions_syntax = syntax
          , Thrift.userQueryOptions_store_derived_facts = stored
          , Thrift.userQueryOptions_collect_facts_searched =
              stats == FullStats
          , Thrift.userQueryOptions_debug = debug
          , Thrift.userQueryOptions_omit_results = omitResults
          , Thrift.userQueryOptions_expand_predicates = expandPreds
          }
       -- When running locally with --enable-logging, logs are emitted
       -- before the ThriftBackend has a chance to incude client_info in the
       -- request.  This makes sure client_info will appear in the logs
      , Thrift.userQuery_client_info = Just client_info
      , Thrift.userQuery_schema_id = schema_id
      }
  
  runUserQuery :: SchemaQuery -> Eval ()
  runUserQuery sQuery = do
    state@ShellState{..} <- getState
    query <- mkUserQuery sQuery
  
    C.handle (C.throwM . asBadQuery (sqQuery sQuery)) $ do
  
    (finalStats, finalResults) <-
      withQueryPages query (Nothing,def) $
      \(prevStats,_) results@Thrift.UserQueryResults{..} -> do
  
      when (not (null userQueryResults_diagnostics)) $ output $ vcat $
        [ "*** " <> pretty diag | diag <- userQueryResults_diagnostics ]
        ++
        [ "" ]
  
      when (not (null userQueryResults_facts)) $ output $ vcat $
        [ case JSON.decode (UTF8.toString fact) of
              JSON.Error err -> pretty err
              JSON.Ok (value :: JSON.JSValue) -> case sqTransform sQuery of
                Nothing -> pretty value
                Just t -> case t value of
                  JSON.Error err -> pretty err
                  JSON.Ok transformed -> pretty transformed
          | fact <- userQueryResults_facts
        ]
  
      let
        stats
          | Just s <- userQueryResults_stats = s
          | otherwise = def { Thrift.userQueryStats_result_count =
              fromIntegral (length userQueryResults_facts) }
  
        timeout = Thrift.userQueryStats_result_count stats < fromIntegral limit
  
      return
        ((prevStats <> Just stats, results), sqContinue sQuery && not timeout)
  
    statsSummary state finalStats finalResults
    Eval $ State.modify $ \s -> s {
      lastSchemaQuery = Just sQuery {
        sqCont = Thrift.userQueryResults_continuation finalResults }}
  
    where
    statsSummary ShellState{..} finalStats finalResults = output $ vcat $
       [ "" ]
       ++
       [ case finalStats of
           Nothing -> mempty
           Just Thrift.UserQueryStats{..} ->
             pretty
               ( printf "%d results, %d facts, %.2fms, %ld bytes"
                 userQueryStats_result_count
                 userQueryStats_num_facts
                 (realToFrac userQueryStats_elapsed_ns / 1000000 :: Double)
                 userQueryStats_allocated_bytes
               :: String ) <>
             maybe mempty (\n -> "," <+> pretty n <+> "compiled bytes")
               userQueryStats_bytecode_size
       | stats == SummaryStats || stats == FullStats
       ]
       ++
       [ vcat $ "Facts searched:" :
           [ pretty (printf "%40s : %d%s" (show (pretty ref)) count
               (if ref `elem` scans then " (full scan)" else "" :: String)
                 :: String)
           | (pid, count) <- sortOn (Down . snd) $ Map.toList m
           , Just info <- [schemaInfo]
           , Just ref <- [Map.lookup pid (Thrift.schemaInfo_predicateIds info)] ]
       | stats == FullStats
       , Just stats <- [finalStats]
       , Just m <- [Thrift.userQueryStats_facts_searched stats]
       , let scans = Thrift.userQueryStats_full_scans stats
       ]
       ++
       [ vcat $ if Thrift.userQueryStats_result_count stats < fromIntegral limit
           then
               [ case timeout of
                   Nothing -> "timeout (server-side time limit)"
                   Just ms ->
                     "timeout (currently " <> pretty ms <> "ms), " <>
                     "use :timeout <ms> to change it"
              , "Use :more to continue the query." ]
           else
             [ "results truncated (current limit " <> pretty limit <> ", " <>
               "use :limit <n> to change it)"
             , "Use :more to see more results"
             ]
       | isJust (Thrift.userQueryResults_continuation finalResults)
       , Just stats <- [finalStats]
       ]
  
  -- | A line from the user (or entry on the command line) may end in a backslash
  -- and be a 'Cont' continued line, otherwise it is a 'Whole' line, see 'endBS'
  data OneLine = Whole String | Cont String
  
  -- | The REPL input may be complete line , or a message to 'Stop'
  data GotLines = Stop | Go String
  
  -- | The 'whole' is a list of command that do not end in a backslash (such
  -- lines have been combined with spaces).  The 'cont' should be an empty
  -- list, but if there are trailing lines with backslashes then they are
  -- collected into 'cont' for clear error reporting.
  data ManyLines = ManyLines { whole :: [String], cont :: [String]}
  
  -- | Check if line should continue onto the next line
  -- Detect (odd number of) ending backslashes (REPL and command line).
  -- If found then remove last backslash and return 'Cont' otherwise
  -- if the line ends in ';' or '|' return 'Cont' otherwise
  -- return input unchanged as 'Whole'
  shouldCont :: String -> OneLine
  shouldCont s =
    if cont then Cont s' else Whole s
    where
      bs = odd . length . takeWhile ('\\' ==) $ revS
      revS = reverse s
      cont = bs || semi || vert
      semi = ";" `isPrefixOf` revS
      vert = "|" `isPrefixOf` revS
      s' = if bs then init s else s
  
  -- | Parse sequence of lines (from command line) for ending backslashes.
  -- This converts zero or more partial Cont lines that end in a Whole line into
  -- one element in the 'whole' list in 'ManyLines'.  If there are trailing
  -- 'Cont' lines that do not end in a 'Whole' line then return these (as a
  -- syntax error) as the 'cont' list of 'ManyLines'
  manyWhole :: [String] -> ManyLines
  manyWhole = foldl' go (ManyLines [] []) where
    go ml x = case shouldCont x of
      Whole s -> let fullLine = unwords (cont ml ++ [s]) -- pending cont plus s
                     newWhole = whole ml ++ [fullLine] -- append complete line
                 in ml{whole = newWhole, cont = []} -- no pending cont lines now
      Cont c -> ml{cont = cont ml ++ [c]} -- collect a pending cont line
  
  -- | Any line ending in an odd number of backslashes means we will
  -- continue accepting input on the next line.  Returned string will
  -- have multiple input lines separated by spaces, not newlines.
  getInputLines :: Repl GotLines
  getInputLines = Repl $ getLines prompt1 []
    where
      promptWith suffix = do
        r <- lift getState
        return $ maybe "" (Text.unpack . Thrift.repo_name) (repo r) ++ suffix
  
      prompt1 = promptWith "> "
      prompt2 = promptWith "| "
  
      getLines prompt prior = do
        maybeLine <-
          HEx.handle (\(e::IOError) -> do
            liftIO $ hPrint stderr e
            return Nothing) $
            Haskeline.getInputLine =<< prompt
        case maybeLine of
          Nothing -> return Stop  -- stop on IOError, ^D or EOF
          Just sIn -> case shouldCont sIn of
            Whole s -> return (Go (intercalate "\n" (reverse (s:prior))))
            Cont c -> getLines prompt2 (c:prior)
  
  repl :: Repl ()
  repl = replMask $ \restore ->
    let
      loop = do
        eitherStop <- replTry $ restore $ do
          gotLines <- getInputLines
          case gotLines of
            Stop -> return True  -- stop on ^D or EOF
            Go s
              | all isSpace s -> return False -- ignore blank input
              | otherwise -> fmap (fromMaybe False) $
                  Repl $ lift $ withTTY $ evaluate s
        stop <- case eitherStop of
          Right stop -> return stop
          Left e
            | Just UserInterrupt{} <- fromException e -> do
              liftIO $ putStrLn "Interrupted"
              return False
            | Just SomeAsyncException{} <- fromException e -> liftIO $ throwIO e
            | Just (err :: BadQuery) <- fromException e -> do
              Repl $ lift $ output $ prettyBadQuery err
              return False
            | otherwise -> do
              liftIO $ putStrLn $ "*** Exception: " <> show e
              return False
        when (not stop) loop
    in
    loop
  
  #if MIN_VERSION_haskeline(0,8,0)
  
  replTry :: Exception e => Repl a -> Repl (Either e a)
  replTry = C.try
  
  replMask :: ((Repl a -> Repl a) -> Repl b) -> Repl b
  replMask = C.mask
  
  #else
  
  replTry :: Exception e => Repl a -> Repl (Either e a)
  replTry r = Haskeline.controlIO $ \(Haskeline.RunIO run) -> do
    result <- try (run r)
    case result of
      Left e -> return (return (Left e))
      Right r -> return (Right <$> r)
  
  replMask :: ((Repl a -> Repl a) -> Repl b) -> Repl b
  replMask f = Haskeline.controlIO $ \(Haskeline.RunIO run) -> do
    mask $ \restore ->
      run (f (\repl -> Haskeline.controlIO $ \(Haskeline.RunIO run') ->
                  restore (run' repl)))
  #endif
  
  -- | Temporarily install standard signal handlers for catching ^C, which just
  -- throw an exception in the current thread.
  withSignalHandlers :: Repl a -> Repl a
  withSignalHandlers act = do
    main_thread <- liftIO myThreadId
    wtid <- liftIO (mkWeakThreadId main_thread)
  
    let
      interrupt = do
        r <- deRefWeak wtid
        case r of
          Nothing -> return ()
          Just t  -> do
            interruptRunningQueries
            throwTo t UserInterrupt
  
      installHandlers = liftIO $ do
        let installHandler' a b = installHandler a b Nothing
        hdlQUIT <- installHandler' sigQUIT  (Catch interrupt)
        hdlINT  <- installHandler' sigINT   (Catch interrupt)
        return (hdlQUIT,hdlINT)
  
      uninstallHandlers (hdlQUIT,hdlINT) = liftIO $ do
        _ <- installHandler sigQUIT  hdlQUIT Nothing
        _ <- installHandler sigINT   hdlINT  Nothing
        return ()
  
    HEx.bracket installHandlers uninstallHandlers (const act)
  
  completeDatabases :: Haskeline.CompletionFunc Eval
  completeDatabases =
    completeWords $ do
      dbs <- getDatabases False ""
      return (map (repoString . Thrift.database_repo) dbs)
  
  completeDatabaseName :: Haskeline.CompletionFunc Eval
  completeDatabaseName =
    completeWords $ do
      dbs <- getDatabases False ""
      return $
        uniq (map (Text.unpack . Thrift.repo_name . Thrift.database_repo) dbs) ++
        map (repoString . Thrift.database_repo) dbs
  
  completeWords :: Eval [String] -> Haskeline.CompletionFunc Eval
  completeWords words =
    Haskeline.completeWord Nothing " \t" $ \str ->
      fromVocabulary str <$> words
  
  completeUseSchema :: Haskeline.CompletionFunc Eval
  completeUseSchema =
    completeWords ((["current", "stored"] <>) <$> availableSchemaIds)
  
  fromVocabulary :: String -> [String] -> [Haskeline.Completion]
  fromVocabulary str words =
    map Haskeline.simpleCompletion $ filter (str `isPrefixOf`) words
  
  availableSchemaIds :: Eval [String]
  availableSchemaIds = do
    m <- schemaInfo <$> getState
    case m of
      Nothing -> return []
      Just Thrift.SchemaInfo{..} ->
        return $ map Text.unpack $ uniq $
          Map.keys schemaInfo_schemaIds <>
          Map.keys schemaInfo_dbSchemaIds <>
          concatMap Map.keys schemaInfo_otherSchemaIds
  
  getSchemaId :: Eval (Maybe Thrift.SchemaId)
  getSchemaId = do
    ShellState{..} <- getState
    return $ do
      ProcessedSchema{..} <- schemas
      case useSchemaId of
        Thrift.SelectSchema_schema_id id -> Just id
        _ -> Just $ hashedSchemaId procSchemaHashed
  
  getNameEnv :: Eval (Maybe (NameEnv RefTargetId))
  getNameEnv = do
    ShellState{..} <- getState
    case schemas of
      Nothing -> return Nothing
      Just ProcessedSchema{..} ->
        return $ Just $ hashedSchemaEnv procSchemaHashed
  
  availablePredicates :: Eval [String]
  availablePredicates = maybe [] preds <$> getNameEnv
    where
      isPred RefPred{} = True
      isPred _ = False
  
      preds env =
          [ Text.unpack (showRef ref)
          | (ref, set) <- HashMap.toList env
          , any isPred (Set.toList set) ]
  
  indexCompletion :: Haskeline.CompletionFunc Eval
  indexCompletion line@(left,_) =
    case splitWhen isSpace (reverse left) of
      [_cmd, _lang] -> ($ line) $ Haskeline.completeWord Nothing " \t" $ \str ->
        let words = [ indexerShortName ix | SomeIndexer ix <- indexers ] in
        return (fromVocabulary str words)
      (_cmd : _lang : rest)
        | not (null rest) -> Haskeline.completeFilename line
      _otherwise -> Haskeline.noCompletion line
  
  availablePredicatesAndTypes :: Eval [String]
  availablePredicatesAndTypes = do
    env <- getNameEnv
    let names env = [ Text.unpack (showRef ref) | ref <- HashMap.keys env ]
    return $ maybe [] names env
  
  commandSpecificCompletion :: String -> Haskeline.CompletionFunc Eval
  commandSpecificCompletion cmd =
    case [ cmdCompletion | Cmd{..} <- commands, cmd `isPrefixOf` cmdName ] of
      (comp:_) -> comp
      _ -> Haskeline.noCompletion
  
  completeFirstWord :: Haskeline.CompletionFunc Eval
  completeFirstWord = completeWords $ (++) <$> availablePredicates <*> pure cmds
    where cmds = map ((":"++) . cmdName) commands
  
  -- Based on GHCi's completion
  completion :: Haskeline.CompletionFunc Eval
  completion line@(left,_) =
    case firstWord of
      -- if the first word is a command, choose completion based on it:
      ':':cmd | not (null rest) -> commandSpecificCompletion cmd line
      -- otherwise, we only know how to complete the first word (for now):
      _ | not (null rest) -> Haskeline.noCompletion line
      _otherwise -> completeFirstWord line
    where
    (firstWord,rest) = break isSpace $ dropWhile isSpace $ reverse left
  
  reportService :: LocalOrRemote backend => backend -> Eval ()
  reportService backend = case backendKind backend of
    BackendEnv Env{..} -> do
      output $  "Using local DBs from " <> pretty (describe envStorage)
    BackendThrift thrift -> do
      case Glean.clientConfig_serv (thriftBackendClientConfig thrift) of
        Tier tier -> output $ "Using service " <> pretty tier
        HostPort host port ->
          output $ "Using service at " <> pretty host <> ":" <> pretty port
        _ -> error "shouldn't happen"
  
  evalMain :: Config -> Maybe String -> Eval ()
  evalMain cfg maybeErr = do
    case cfgQuery cfg of
      [] -> do
        hello
        reportService . backend =<< getState
        output "type :help for help."
        initialize cfg
        case maybeErr of
          Nothing -> return ()
          Just err -> do
            output $ vcat [
              "schema failed to load:", "",
              pretty err,
              "", "use :reload to try again"
              ]
        home <- liftIO $ lookupEnv "HOME"
  
        let settings = Haskeline.setComplete completion Haskeline.defaultSettings
                { Haskeline.historyFile = fmap (</> ".glean.shell.history") home }
        Haskeline.runInputT settings $ unRepl $ withSignalHandlers repl
      qs@(_:_) -> do
        let ManyLines{whole, cont} = manyWhole qs
        if not (null cont) then liftIO $ do
          putStrLn "Error: Final command(s) end in continuation backslash: "
          when (not (null whole)) $ putStrLn "whole lines:" >> mapM_ print whole
          putStrLn "incomplete cont line(s):" >> mapM_ print cont
        else do
          initialize cfg
          forM_ whole $ \ q -> do
            liftIO $ putStr "> " >> putStrLn q;
            void (evaluate q) `C.catch` \e -> do
              output $ prettyBadQuery e
              liftIO exitFailure
  
  parseAndTypecheckSchema :: Maybe Env -> FilePath -> IO SchemaIndex
  parseAndTypecheckSchema env dir = do
    parsed <- parseSchemaDir dir
    -- typecheck the schema now, so that we find out about
    -- errors before we try updating the schema for DBs.
    void $ liftIO $ newDbSchema (fmap envDbSchemaCache env) parsed
      LatestSchema readWriteContent (maybe def envDebug env)
    return parsed
  
  setupLocalSchema
    :: ConfigProvider cfg
    => cfg
    -> Glean.Service
    -> IO (Glean.Service, Maybe (Eval ()), Maybe String)
  setupLocalSchema cfgAPI service = do
    case service of
      Remote{} -> return (service, Nothing, Nothing)
      Local dbConfig logging -> do
        server_config <- ThriftSource.load cfgAPI (DB.cfgServerConfig dbConfig)
        loc <- schemaLocation dbConfig server_config
        case loc of
          SchemaLocation_dir dir -> do
            r <- try $ parseAndTypecheckSchema Nothing (Text.unpack dir)
            (schema, maybeErr) <- case r of
              Right schema -> return (schema, Nothing)
              Left (ErrorCall err) -> do
                let proc = ProcessedSchema
                      (SourceSchemas (AngleVersion 0) [] [])
                      (ResolvedSchemas Nothing [])
                      emptyHashedSchema
                return (SchemaIndex proc [], Just err)
            (schemaTS, update) <- ThriftSource.mutable schema
            let
              updateSchema :: Eval ()
              updateSchema = do
                be <- backend <$> getState
                case backendKind be of
                  BackendThrift{} -> return ()
                  BackendEnv env -> do
                    new <- liftIO $
                      parseAndTypecheckSchema (Just env) (Text.unpack dir)
                    liftIO $ update (const new)
                    let current = schemaIndexCurrent new
  
                    -- Update all the schemas for open DBs. This would
                    -- normally be done in the background by the schema
                    -- updater thread, but we're doing it manually and
                    -- disabling the auto-update so that we can
                    -- synchronously check for errors and update our local
                    -- view of the schema in the monad.
                    liftIO $ schemaUpdated env Nothing
                    state <- getState
                    whenJust (repo state) $ \r -> do
                      info <- liftIO $
                        Glean.getSchemaInfo env (Just r)
                          def { Thrift.getSchemaInfo_select = useSchemaId state }
  
                      Eval $ State.modify $ \s ->
                        s { schemaInfo = Just info, schemas = Just current }
  
                    let
                      numSchemas = length (srcSchemas (procSchemaSource current))
                      numPredicates = HashMap.size (hashedPreds
                        (procSchemaHashed current))
                    output $ "reloading schema [" <>
                      pretty numSchemas <> " schemas, " <>
                      pretty numPredicates <> " predicates]"
            return
              ( Local dbConfig {
                  DB.cfgSchemaHook = const (schemaTS, False) } logging
              , Just updateSchema
              , maybeErr
              )
  
          _other -> return (service, Nothing, Nothing)
  
  type ShellCommand = Config
  
  instance Plugin ShellCommand where
    parseCommand = options
  
    argTransform _ args
      | "-v" `elem` args = args
      | otherwise = "--minloglevel=2" : args
  
    withService evb cfgAPI service cfg = do
      (service', updateSchema, maybeErr) <- setupLocalSchema cfgAPI service
      Glean.withBackendWithDefaultOptions evb cfgAPI
        service' Nothing $ \backend -> do
      withSystemTempFile "scratch-query.angle" $ \q handle -> do
        hClose handle
        client_info <- clientInfo
        tty <- hIsTerminalDevice stdout
        outh <- newMVar stdout
        let state = ShellState
              { backend = Some backend
              , repo = Nothing
              , schemas = Nothing
              , schemaInfo = def
              , useSchemaId = Thrift.SelectSchema_current def
              , limit = cfgLimit cfg
              , timeout = Just 10000      -- Sensible default for fresh shell.
              , stats = SummaryStats
              , lastSchemaQuery = Nothing
              , updateSchema = updateSchema
              , isTTY = tty
              , pageWidth =
                  (\n -> if n == 0 then Unbounded else AvailablePerLine n 1)
                  <$> cfgWidth cfg
              , expandResults = ExpandRecursive
              , outputHandle = outh
              , pager = cfgPager cfg
              , debug = def
              , client_info = client_info
              , query_file = q
              }
        flip State.evalStateT state $ unEval $
          evalMain cfg maybeErr
  