-- | @shomei-migrate@: the operator CLI for Shōmei's schema. -- -- The plan is embedded at compile time, so this binary can only ever migrate the schema -- it was built with. The application owns configuration (@DATABASE_URL@, overridable per -- command with @--database-url@), rendering, and the process exit code. module Main (main) where import Data.Aeson qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as LazyByteString import Data.Text qualified as Text import Data.Text.IO qualified as Text.IO import Database.PostgreSQL.Migrate (defaultRunOptions) import Database.PostgreSQL.Migrate.CLI import Hasql.Connection.Settings qualified as Settings import Options.Applicative import Shomei.Migrations (resolveShomeiMigrationPlan) import System.Environment (lookupEnv) import System.Exit qualified as System.Exit main :: IO () main = do plan <- resolveShomeiMigrationPlan parsedCommand <- execParser ( info (migrationCommandParser plan <**> helper) (fullDesc <> progDesc "Manage the Shōmei database schema" <> header "shomei-migrate") ) -- Absent DATABASE_URL is fine for plan/list/check/new, which never connect. The -- database-backed commands fail at acquisition with a clear connection error. databaseUrl <- maybe "" Text.pack <$> lookupEnv "DATABASE_URL" let environment = cliEnvironment (Settings.connectionString databaseUrl) plan defaultRunOptions outcome <- runMigrationCommand environment parsedCommand case commandOutputFormat parsedCommand of TextOutput -> Text.IO.putStrLn (renderMigrationCommandText outcome) JsonOutput -> LazyByteString.putStrLn (Aeson.encode (renderMigrationCommandJson outcome)) System.Exit.exitWith (exitCode outcome.exitClass) -- | Distinct codes so deployment automation can tell a plan/ledger mismatch from a -- failed apply from a bad invocation. exitCode :: ExitClass -> System.Exit.ExitCode exitCode = \case ExitSucceeded -> System.Exit.ExitSuccess ExitVerificationFailed -> System.Exit.ExitFailure 2 ExitUsageFailed -> System.Exit.ExitFailure 64 ExitExecutionFailed -> System.Exit.ExitFailure 1 commandOutputFormat :: MigrationCommand -> OutputFormat commandOutputFormat = \case Plan PlanOptions {output = OutputOptions format} -> format List ListOptions {output = OutputOptions format} -> format Check CheckOptions {output = OutputOptions format} -> format Status StatusOptions {output = OutputOptions format} -> format Verify VerifyOptions {output = OutputOptions format} -> format Up UpOptions {output = OutputOptions format} -> format Repair RepairOptions {output = OutputOptions format} -> format New NewOptions {output = OutputOptions format} -> format