<commit_before>{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.CLI
  ( main
  , CLI (..)
  , Command (..)
  , readCLIShowHelp
  ) where

import qualified Data.Aeson                 as JSON
import qualified Data.ByteString.Char8      as BS
import qualified Data.ByteString.Lazy       as LBS
import qualified Hasql.Pool                 as SQL
import qualified Hasql.Transaction.Sessions as SQL
import qualified Options.Applicative        as O

import Data.Text.IO (hPutStrLn)
import Text.Heredoc (str)

import PostgREST.AppState    (AppState)
import PostgREST.Config      (AppConfig (..))
import PostgREST.DbStructure (queryDbStructure)
import PostgREST.Version     (prettyVersion)
import PostgREST.Workers     (reReadConfig)

import qualified PostgREST.App      as App
import qualified PostgREST.AppState as AppState
import qualified PostgREST.Config   as Config

import Protolude hiding (hPutStrLn)


main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
  conf@AppConfig{..} <-
    either panic identity <$> Config.readAppConfig mempty cliPath Nothing
  appState <- AppState.init conf

  -- Override the config with config options from the db
  -- TODO: the same operation is repeated on connectionWorker, ideally this
  -- would be done only once, but dump CmdDumpConfig needs it for tests.
  when configDbConfig $ reReadConfig True appState

  exec cliCommand appState
  where
    exec :: Command -> AppState -> IO ()
    exec CmdDumpConfig appState = putStr . Config.toText =<< AppState.getConfig appState
    exec CmdDumpSchema appState = putStrLn =<< dumpSchema appState
    exec CmdRun appState = App.run installSignalHandlers runAppWithSocket appState

-- | Dump DbStructure schema to JSON
dumpSchema :: AppState -> IO LBS.ByteString
dumpSchema appState = do
  AppConfig{..} <- AppState.getConfig appState
  result <-
    let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
    SQL.use (AppState.getPool appState) $
      transaction SQL.ReadCommitted SQL.Read $
        queryDbStructure
          (toList configDbSchemas)
          configDbExtraSearchPath
          configDbPreparedStatements
  SQL.release $ AppState.getPool appState
  case result of
    Left e -> do
      hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
      exitFailure
    Right dbStructure -> return $ JSON.encode dbStructure

-- | Command line interface options
data CLI = CLI
  { cliCommand :: Command
  , cliPath    :: Maybe FilePath
  }<commit_msg>refactor: simplify main, address reReadConfig TODO<commit_after>{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.CLI
  ( main
  , CLI (..)
  , Command (..)
  , readCLIShowHelp
  ) where

import qualified Data.Aeson                 as JSON
import qualified Data.ByteString.Char8      as BS
import qualified Data.ByteString.Lazy       as LBS
import qualified Hasql.Pool                 as SQL
import qualified Hasql.Transaction.Sessions as SQL
import qualified Options.Applicative        as O

import Data.Text.IO (hPutStrLn)
import Text.Heredoc (str)

import PostgREST.AppState    (AppState)
import PostgREST.Config      (AppConfig (..))
import PostgREST.DbStructure (queryDbStructure)
import PostgREST.Version     (prettyVersion)
import PostgREST.Workers     (reReadConfig)

import qualified PostgREST.App      as App
import qualified PostgREST.AppState as AppState
import qualified PostgREST.Config   as Config

import Protolude hiding (hPutStrLn)


main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
  conf@AppConfig{..} <-
    either panic identity <$> Config.readAppConfig mempty cliPath Nothing
  appState <- AppState.init conf
  case cliCommand of
    CmdDumpConfig -> do
      when configDbConfig $ reReadConfig True appState
      putStr . Config.toText =<< AppState.getConfig appState
    CmdDumpSchema -> putStrLn =<< dumpSchema appState
    CmdRun -> App.run installSignalHandlers runAppWithSocket appState

-- | Dump DbStructure schema to JSON
dumpSchema :: AppState -> IO LBS.ByteString
dumpSchema appState = do
  AppConfig{..} <- AppState.getConfig appState
  result <-
    let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
    SQL.use (AppState.getPool appState) $
      transaction SQL.ReadCommitted SQL.Read $
        queryDbStructure
          (toList configDbSchemas)
          configDbExtraSearchPath
          configDbPreparedStatements
  SQL.release $ AppState.getPool appState
  case result of
    Left e -> do
      hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
      exitFailure
    Right dbStructure -> return $ JSON.encode dbStructure

-- | Command line interface options
data CLI = CLI
  { cliCommand :: Command
  , cliPath    :: Maybe FilePath
  }
{'fraction_non_alphanumeric': 0.07371920219006649, 'fraction_numerical': 0.00039108330074305825, 'mean_word_length': 3.3867924528301887, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 24, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4252920', 'n_tokens_mistral': 1536, 'n_tokens_neox': 1479, 'n_words': 456}