packages feed

shomei-migrations-0.2.0.0: app/Main.hs

-- | @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