packages feed

pg-migrate-cli (empty) → 1.0.0.0

raw patch · 32 files changed

+2382/−0 lines, 32 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, containers, directory, filepath, hasql, optparse-applicative, pg-migrate, pg-migrate-cli, pg-migrate-embed, tasty, tasty-hunit, text, time

Files

+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Changelog++## 1.0.0.0 — 2026-07-10++- Initial stable release of the reusable command tree, typed dispatcher, text output,+  parser-derived completion, and JSON schema v1 including history-import reports.
+ pg-migrate-cli.cabal view
@@ -0,0 +1,112 @@+cabal-version:   3.8+name:            pg-migrate-cli+version:         1.0.0.0+synopsis:        Reusable command parsers and renderers for pg-migrate+category:        Database+maintainer:      nadeem@gmail.com+description:+  Lets service executables mount pg-migrate commands while retaining ownership+  of configuration precedence, output streams, logging, and process exit.++license:         BSD-3-Clause+build-type:      Simple+extra-doc-files: CHANGELOG.md+data-files:+  test/golden/help/*.txt+  test/golden/json/*.json++common common+  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    MultilineStrings+    OverloadedLabels+    OverloadedStrings++  ghc-options:        -Wall -Wcompat++library+  import:          common+  hs-source-dirs:  src+  exposed-modules:+    Database.PostgreSQL.Migrate.CLI+    PgMigrate.CLI.Prelude++  other-modules:+    Database.PostgreSQL.Migrate.CLI.Handler+    Database.PostgreSQL.Migrate.CLI.Json+    Database.PostgreSQL.Migrate.CLI.Outcome+    Database.PostgreSQL.Migrate.CLI.Parser+    Database.PostgreSQL.Migrate.CLI.Text+    Database.PostgreSQL.Migrate.CLI.Types++  build-depends:+    , aeson                 >=2.2  && <2.3+    , base                  >=4.20 && <4.22+    , bytestring            >=0.12 && <0.13+    , containers            >=0.7  && <0.8+    , hasql                 >=1.10 && <1.11+    , optparse-applicative  >=0.19 && <0.20+    , pg-migrate            >=1.0  && <1.1+    , pg-migrate-embed      >=1.0  && <1.1+    , text                  >=2.1  && <2.2+    , time                  >=1.12 && <1.15++test-suite pg-migrate-cli-test+  import:          common+  type:            exitcode-stdio-1.0+  hs-source-dirs:  test/unit+  main-is:         Main.hs+  other-modules:+    Paths_pg_migrate_cli+    Test.Handler+    Test.Json+    Test.Parser++  autogen-modules: Paths_pg_migrate_cli+  build-depends:+    , aeson                 >=2.2  && <2.3+    , base                  >=4.20 && <4.22+    , bytestring            >=0.12 && <0.13+    , containers            >=0.7  && <0.8+    , directory             >=1.3  && <1.4+    , filepath              >=1.5  && <1.6+    , hasql                 >=1.10 && <1.11+    , optparse-applicative  >=0.19 && <0.20+    , pg-migrate+    , pg-migrate-cli+    , pg-migrate-embed+    , tasty                 >=1.5  && <1.6+    , tasty-hunit           >=0.10 && <0.11+    , text                  >=2.1  && <2.2+    , time                  >=1.12 && <1.15++test-suite pg-migrate-cli-integration+  import:         common+  type:           exitcode-stdio-1.0+  ghc-options:    -threaded+  hs-source-dirs: test/integration+  main-is:        Main.hs+  build-depends:+    , base            >=4.20 && <4.22+    , bytestring      >=0.12 && <0.13+    , containers      >=0.7  && <0.8+    , hasql           >=1.10 && <1.11+    , pg-migrate+    , pg-migrate-cli+    , tasty           >=1.5  && <1.6+    , tasty-hunit     >=0.10 && <0.11+    , text            >=2.1  && <2.2++executable pg-migrate-cli-help-fixture+  import:         common+  hs-source-dirs: test/help-fixture+  main-is:        Main.hs+  build-depends:+    , base                  >=4.20 && <4.22+    , bytestring            >=0.12 && <0.13+    , containers            >=0.7  && <0.8+    , optparse-applicative  >=0.19 && <0.20+    , pg-migrate+    , pg-migrate-cli
+ src/Database/PostgreSQL/Migrate/CLI.hs view
@@ -0,0 +1,49 @@+-- | Reusable parser, dispatcher, and text/JSON rendering boundary. Applications retain+-- ownership of their plan, connection configuration, streams, logging, and process exit.+module Database.PostgreSQL.Migrate.CLI+  ( migrationCommandParser,+    CliEnvironment,+    cliEnvironment,+    cliEnvironmentWithConnectionProvider,+    runMigrationCommand,+    renderMigrationCommandText,+    jsonSchemaVersion,+    renderMigrationCommandJson,+    renderHistoryImportJson,+    ExitClass (..),+    CheckedMigration (..),+    CliPayload (..),+    CliError (..),+    CliOutcome (..),+    OutputFormat (..),+    ConnectionOptions (..),+    ExecutionOptions (..),+    OutputOptions (..),+    InspectionOptions (..),+    PlanOptions (..),+    ListOptions (..),+    CheckOptions (..),+    StatusOptions (..),+    VerifyOptions (..),+    UpOptions (..),+    RepairOptions (..),+    NewOptions (..),+    MigrationCommand (..),+  )+where++import Database.PostgreSQL.Migrate.CLI.Handler+  ( CliEnvironment,+    cliEnvironment,+    cliEnvironmentWithConnectionProvider,+    runMigrationCommand,+  )+import Database.PostgreSQL.Migrate.CLI.Json+  ( jsonSchemaVersion,+    renderHistoryImportJson,+    renderMigrationCommandJson,+  )+import Database.PostgreSQL.Migrate.CLI.Outcome+import Database.PostgreSQL.Migrate.CLI.Parser (migrationCommandParser)+import Database.PostgreSQL.Migrate.CLI.Text (renderMigrationCommandText)+import Database.PostgreSQL.Migrate.CLI.Types
+ src/Database/PostgreSQL/Migrate/CLI/Handler.hs view
@@ -0,0 +1,268 @@+module Database.PostgreSQL.Migrate.CLI.Handler+  ( CliEnvironment,+    cliEnvironment,+    cliEnvironmentWithConnectionProvider,+    runMigrationCommand,+  )+where++import Data.List.NonEmpty qualified as NonEmpty+import Data.Text.Encoding qualified as Text.Encoding+import Database.PostgreSQL.Migrate+  ( ComponentName,+    Confirmation,+    ConnectionProvider,+    MigrationId,+    MigrationPlan,+    RepairOperation,+    RunOptions,+    StatusReport (..),+    StoredMigration (..),+    VerificationReport (..),+    connectionProviderFromSettings,+    migrationFingerprint,+    migrationStatusWith,+    repairMigration,+    repairRequest,+    runMigrationPlanWith,+    verifyMigrationPlanWith,+    withLockWait,+    withStatementTimeout,+  )+import Database.PostgreSQL.Migrate.CLI.Outcome+import Database.PostgreSQL.Migrate.CLI.Types+import Database.PostgreSQL.Migrate.Embed+  ( AuthoringError (..),+    checkMigrationManifest,+    newMigration,+    newMigrationOptions,+  )+import Database.PostgreSQL.Migrate.Internal+  ( ComponentDescription (..),+    MigrationDescription (..),+    PlanDescription (..),+    migrationIdComponent,+    migrationIdName,+    planDescription,+  )+import Hasql.Connection.Settings qualified as Settings+import PgMigrate.CLI.Prelude++data CliConnection+  = SettingsConnection !Settings.Settings+  | ProviderConnection !ConnectionProvider++-- | Application-supplied plan, runner defaults, and connection ownership boundary.+data CliEnvironment = CliEnvironment+  { defaultConnection :: !CliConnection,+    migrationPlan :: !MigrationPlan,+    runnerOptions :: !RunOptions+  }++-- | Construct a CLI environment from concrete Hasql settings.+cliEnvironment :: Settings.Settings -> MigrationPlan -> RunOptions -> CliEnvironment+cliEnvironment settings = CliEnvironment (SettingsConnection settings)++-- | Construct a CLI environment from an application connection provider.+cliEnvironmentWithConnectionProvider ::+  ConnectionProvider ->+  MigrationPlan ->+  RunOptions ->+  CliEnvironment+cliEnvironmentWithConnectionProvider provider = CliEnvironment (ProviderConnection provider)++-- | Dispatch a parsed command without writing streams or exiting the process.+runMigrationCommand :: CliEnvironment -> MigrationCommand -> IO CliOutcome+runMigrationCommand environment commandValue =+  case commandValue of+    Plan PlanOptions {inspection} ->+      pure+        ( success+            "plan"+            (PlanPayload (filterPlan inspection (planDescription (migrationPlan environment))))+        )+    List ListOptions {inspection} ->+      pure+        ( success+            "list"+            ( ListPayload+                ( filterMigrations+                    inspection+                    (flattenPlanDescription (planDescription (migrationPlan environment)))+                )+            )+        )+    Check CheckOptions {manifestPath} -> runCheck manifestPath+    Status StatusOptions {inspection, connection} -> runStatus environment inspection connection+    Verify VerifyOptions {inspection, connection} -> runVerify environment inspection connection+    Up UpOptions {connection, execution} -> runUp environment connection execution+    Repair RepairOptions {target, operation, reason, confirmation, connection, execution} ->+      runRepair environment connection execution target operation reason confirmation+    New NewOptions {manifestPath, description, requestedName} ->+      runNew manifestPath description requestedName++runCheck :: FilePath -> IO CliOutcome+runCheck manifestPath = do+  checked <- checkMigrationManifest manifestPath+  pure $ case checked of+    Left manifestError -> failure "check" ExitUsageFailed (CliManifestError manifestError)+    Right entries ->+      success+        "check"+        ( CheckPayload+            ((\(file, bytes) -> CheckedMigration file (migrationFingerprint bytes)) <$> entries)+        )++runStatus :: CliEnvironment -> InspectionOptions -> ConnectionOptions -> IO CliOutcome+runStatus environment inspection connection = do+  result <-+    migrationStatusWith+      (runnerOptions environment)+      (selectProvider environment connection)+      (migrationPlan environment)+  pure $ case result of+    Left migrationError -> failure "status" ExitExecutionFailed (CliMigrationError migrationError)+    Right report -> success "status" (StatusPayload (filterStatus inspection report))++runVerify :: CliEnvironment -> InspectionOptions -> ConnectionOptions -> IO CliOutcome+runVerify environment inspection connection = do+  result <-+    verifyMigrationPlanWith+      (runnerOptions environment)+      (selectProvider environment connection)+      (migrationPlan environment)+  pure $ case result of+    Left migrationError -> failure "verify" ExitExecutionFailed (CliMigrationError migrationError)+    Right report ->+      CliOutcome+        { command = "verify",+          exitClass = verificationExitClass report,+          payload = Right (VerifyPayload (filterVerification inspection report))+        }++runUp :: CliEnvironment -> ConnectionOptions -> ExecutionOptions -> IO CliOutcome+runUp environment connection execution = do+  result <-+    runMigrationPlanWith+      (applyExecution execution (runnerOptions environment))+      (selectProvider environment connection)+      (migrationPlan environment)+  pure $ case result of+    Left migrationError -> failure "up" ExitExecutionFailed (CliMigrationError migrationError)+    Right report -> success "up" (UpPayload report)++runRepair ::+  CliEnvironment ->+  ConnectionOptions ->+  ExecutionOptions ->+  MigrationId ->+  RepairOperation ->+  Text ->+  Confirmation ->+  IO CliOutcome+runRepair environment connection execution target operation reason confirmation =+  case repairRequest target operation reason confirmation of+    Left definitionError ->+      pure (failure "repair" ExitUsageFailed (CliRepairDefinitionError definitionError))+    Right request -> do+      result <-+        repairMigration+          (applyExecution execution (runnerOptions environment))+          (selectProvider environment connection)+          (migrationPlan environment)+          request+      pure $ case result of+        Left repairError -> failure "repair" ExitExecutionFailed (CliRepairError repairError)+        Right report -> success "repair" (RepairPayload report)++runNew :: FilePath -> Text -> Maybe FilePath -> IO CliOutcome+runNew manifestPath description requestedName =+  case newMigrationOptions manifestPath requestedName initialSql of+    Left authoringError ->+      pure (failure "new" ExitUsageFailed (CliAuthoringError authoringError))+    Right options -> do+      result <- newMigration options+      pure $ case result of+        Left authoringError ->+          failure "new" (authoringExitClass authoringError) (CliAuthoringError authoringError)+        Right path -> success "new" (NewPayload path)+  where+    initialSql = Text.Encoding.encodeUtf8 ("-- " <> description <> "\n\n")++selectProvider :: CliEnvironment -> ConnectionOptions -> ConnectionProvider+selectProvider CliEnvironment {defaultConnection} ConnectionOptions {databaseSettings} =+  case databaseSettings of+    Just settings -> connectionProviderFromSettings settings+    Nothing ->+      case defaultConnection of+        SettingsConnection settings -> connectionProviderFromSettings settings+        ProviderConnection provider -> provider++applyExecution :: ExecutionOptions -> RunOptions -> RunOptions+applyExecution ExecutionOptions {lockWait, statementTimeout} =+  withStatementTimeout statementTimeout . withLockWait lockWait++verificationExitClass :: VerificationReport -> ExitClass+verificationExitClass VerificationReport {issues}+  | null issues = ExitSuccess+  | otherwise = ExitVerificationFailed++authoringExitClass :: AuthoringError -> ExitClass+authoringExitClass authoringError =+  case authoringError of+    AuthoringIoError {} -> ExitExecutionFailed+    AuthoringCleanupError {} -> ExitExecutionFailed+    _ -> ExitUsageFailed++success :: Text -> CliPayload -> CliOutcome+success command payload = CliOutcome {command, exitClass = ExitSuccess, payload = Right payload}++failure :: Text -> ExitClass -> CliError -> CliOutcome+failure command exitClass cliError = CliOutcome {command, exitClass, payload = Left cliError}++flattenPlanDescription :: PlanDescription -> [MigrationDescription]+flattenPlanDescription (PlanDescription components) =+  concatMap (toList . migrations) (toList components)++filterPlan :: InspectionOptions -> PlanDescription -> [ComponentDescription]+filterPlan inspection (PlanDescription components) =+  foldr filterComponent [] (toList components)+  where+    filterComponent componentDescription@ComponentDescription {name, migrations} remaining+      | not (matchesComponent inspection name) = remaining+      | otherwise =+          case NonEmpty.nonEmpty (filter (matchesMigrationDescription inspection) (toList migrations)) of+            Nothing -> remaining+            Just filteredMigrations ->+              componentDescription {migrations = filteredMigrations} : remaining++filterMigrations :: InspectionOptions -> [MigrationDescription] -> [MigrationDescription]+filterMigrations inspection = filter (matchesMigrationDescription inspection)++filterStatus :: InspectionOptions -> StatusReport -> StatusReport+filterStatus inspection (StatusReport issues applied pending unknown) =+  StatusReport+    issues+    (filter (matchesMigrationId inspection) applied)+    (filter (matchesMigrationId inspection) pending)+    (filter (matchesMigrationId inspection . storedMigrationId) unknown)++filterVerification :: InspectionOptions -> VerificationReport -> VerificationReport+filterVerification inspection (VerificationReport issues applied pending unknown) =+  VerificationReport+    issues+    (filter (matchesMigrationId inspection) applied)+    (filter (matchesMigrationId inspection) pending)+    (filter (matchesMigrationId inspection . storedMigrationId) unknown)++matchesMigrationDescription :: InspectionOptions -> MigrationDescription -> Bool+matchesMigrationDescription inspection MigrationDescription {migrationId} =+  matchesMigrationId inspection migrationId++matchesMigrationId :: InspectionOptions -> MigrationId -> Bool+matchesMigrationId InspectionOptions {component, migration} identifier =+  maybe True (== migrationIdComponent identifier) component+    && maybe True (== migrationIdName identifier) migration++matchesComponent :: InspectionOptions -> ComponentName -> Bool+matchesComponent InspectionOptions {component} candidate = maybe True (== candidate) component
+ src/Database/PostgreSQL/Migrate/CLI/Json.hs view
@@ -0,0 +1,305 @@+module Database.PostgreSQL.Migrate.CLI.Json+  ( jsonSchemaVersion,+    renderMigrationCommandJson,+    renderHistoryImportJson,+  )+where++import Data.Aeson (Value, object, (.=))+import Data.Aeson.Types (Pair)+import Data.ByteString qualified as ByteString+import Data.List.NonEmpty qualified as NonEmpty+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Time (UTCTime, defaultTimeLocale, formatTime)+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.CLI.Outcome+import Database.PostgreSQL.Migrate.Internal+import Numeric qualified+import PgMigrate.CLI.Prelude++-- | Supported machine-readable CLI schema version.+jsonSchemaVersion :: Int+jsonSchemaVersion = 1++-- | Render a command outcome using JSON schema v1.+renderMigrationCommandJson :: CliOutcome -> Value+renderMigrationCommandJson CliOutcome {command, exitClass, payload} =+  object+    ( [ "schemaVersion" .= jsonSchemaVersion,+        "command" .= command,+        "ok" .= (exitClass == ExitSuccess)+      ]+        <> case payload of+          Left cliError -> ["error" .= errorValue cliError]+          Right cliPayload -> ["data" .= payloadValue cliPayload]+    )++-- | Render an adapter import report using JSON schema v1.+renderHistoryImportJson :: Text -> HistoryImportReport -> Value+renderHistoryImportJson sourceName HistoryImportReport {importResults} =+  object+    [ "schemaVersion" .= jsonSchemaVersion,+      "command" .= ("import" :: Text),+      "ok" .= True,+      "data"+        .= object+          [ "source" .= sourceName,+            "results" .= (historyImportResultValue <$> NonEmpty.toList importResults)+          ]+    ]++historyImportResultValue :: HistoryImportResult -> Value+historyImportResultValue HistoryImportResult {importedMigration, importOutcome} =+  object+    [ "id" .= migrationIdText importedMigration,+      "outcome" .= case importOutcome of Imported -> ("imported" :: Text); AlreadyImported -> "alreadyImported"+    ]++payloadValue :: CliPayload -> Value+payloadValue cliPayload =+  case cliPayload of+    PlanPayload components ->+      object ["components" .= (componentValue <$> components)]+    ListPayload migrations ->+      object ["migrations" .= (migrationValue <$> migrations)]+    CheckPayload checked ->+      object ["migrations" .= (checkedValue <$> NonEmpty.toList checked)]+    StatusPayload report -> statusValue report+    VerifyPayload report -> verificationValue report+    UpPayload report -> migrationReportValue report+    RepairPayload report -> repairReportValue report+    NewPayload path -> object ["path" .= path]++componentValue :: ComponentDescription -> Value+componentValue (ComponentDescription name position dependencies migrations) =+  object+    [ "name" .= componentNameText name,+      "position" .= position,+      "dependencies" .= (componentNameText <$> Set.toAscList dependencies),+      "migrations" .= (migrationValue <$> NonEmpty.toList migrations)+    ]++migrationValue :: MigrationDescription -> Value+migrationValue (MigrationDescription identifier position checksum kind mode) =+  object+    [ "id" .= migrationIdText identifier,+      "position" .= position,+      "checksum" .= checksumText checksum,+      "kind" .= kindText kind,+      "transactionMode" .= modeText mode+    ]++checkedValue :: CheckedMigration -> Value+checkedValue (CheckedMigration file checksum) =+  object+    [ "file" .= file,+      "checksum" .= checksumText checksum+    ]++statusValue :: StatusReport -> Value+statusValue (StatusReport issues applied pending unknown) =+  object+    [ "issues" .= (verificationIssueValue <$> issues),+      "applied" .= (migrationIdText <$> applied),+      "pending" .= (migrationIdText <$> pending),+      "unknown" .= (storedMigrationValue <$> unknown)+    ]++verificationValue :: VerificationReport -> Value+verificationValue (VerificationReport issues applied pending unknown) =+  object+    [ "issues" .= (verificationIssueValue <$> issues),+      "applied" .= (migrationIdText <$> applied),+      "pending" .= (migrationIdText <$> pending),+      "unknown" .= (storedMigrationValue <$> unknown)+    ]++storedMigrationValue :: StoredMigration -> Value+storedMigrationValue+  ( StoredMigration+      identifier+      position+      checksum+      kind+      mode+      status+      startedAt+      finishedAt+      executionTimeMilliseconds+      errorMessage+      runnerVersion+    ) =+    object+      [ "id" .= migrationIdText identifier,+        "position" .= position,+        "checksum" .= checksumText checksum,+        "kind" .= kindText kind,+        "transactionMode" .= modeText mode,+        "status" .= statusText status,+        "startedAt" .= utcText startedAt,+        "finishedAt" .= (utcText <$> finishedAt),+        "durationMilliseconds" .= executionTimeMilliseconds,+        "error" .= errorMessage,+        "runnerVersion" .= runnerVersion+      ]++verificationIssueValue :: VerificationIssue -> Value+verificationIssueValue issue =+  case issue of+    DuplicateStoredMigration identifier -> issueWithId "duplicateStoredMigration" identifier+    DuplicateStoredPosition component position ->+      object+        [ "type" .= ("duplicateStoredPosition" :: Text),+          "component" .= componentNameText component,+          "position" .= position+        ]+    StoredMigrationRunning identifier -> issueWithId "storedMigrationRunning" identifier+    StoredMigrationFailed identifier -> issueWithId "storedMigrationFailed" identifier+    MigrationPositionMismatch identifier expected actual ->+      mismatchValue "migrationPositionMismatch" identifier ("expected" .= expected) ("actual" .= actual)+    MigrationChecksumMismatch identifier expected actual ->+      mismatchValue+        "migrationChecksumMismatch"+        identifier+        ("expected" .= checksumText expected)+        ("actual" .= checksumText actual)+    MigrationKindMismatch identifier expected actual ->+      mismatchValue+        "migrationKindMismatch"+        identifier+        ("expected" .= kindText expected)+        ("actual" .= kindText actual)+    MigrationTransactionModeMismatch identifier expected actual ->+      mismatchValue+        "migrationTransactionModeMismatch"+        identifier+        ("expected" .= modeText expected)+        ("actual" .= modeText actual)+    AppliedMigrationAfterGap identifier missing ->+      object+        [ "type" .= ("appliedMigrationAfterGap" :: Text),+          "id" .= migrationIdText identifier,+          "missing" .= migrationIdText missing+        ]+    UnknownStoredMigration identifier -> issueWithId "unknownStoredMigration" identifier+    PendingMigration identifier -> issueWithId "pendingMigration" identifier++issueWithId :: Text -> MigrationId -> Value+issueWithId issueType identifier =+  object+    [ "type" .= issueType,+      "id" .= migrationIdText identifier+    ]++mismatchValue :: Text -> MigrationId -> Pair -> Pair -> Value+mismatchValue issueType identifier expected actual =+  object ["type" .= issueType, "id" .= migrationIdText identifier, expected, actual]++migrationReportValue :: MigrationReport -> Value+migrationReportValue (MigrationReport startedAt finishedAt results) =+  object+    [ "startedAt" .= utcText startedAt,+      "finishedAt" .= utcText finishedAt,+      "results" .= (migrationResultValue <$> NonEmpty.toList results)+    ]++migrationResultValue :: MigrationResult -> Value+migrationResultValue (MigrationResult identifier outcome duration) =+  object+    [ "id" .= migrationIdText identifier,+      "outcome" .= outcomeText outcome,+      "durationMilliseconds" .= (durationMilliseconds <$> duration)+    ]++repairReportValue :: RepairReport -> Value+repairReportValue (RepairReport identifier operation oldStatus newStatus) =+  object+    [ "id" .= migrationIdText identifier,+      "operation" .= repairOperationText operation,+      "oldStatus" .= statusText oldStatus,+      "newStatus" .= statusText newStatus+    ]++errorValue :: CliError -> Value+errorValue cliError =+  object+    [ "type" .= cliErrorType cliError,+      "message" .= Text.pack (renderCliErrorMessage cliError)+    ]++cliErrorType :: CliError -> Text+cliErrorType cliError =+  case cliError of+    CliMigrationError migrationError -> "migration." <> migrationErrorType migrationError+    CliRepairDefinitionError _ -> "repair.definition"+    CliRepairError _ -> "repair.execution"+    CliManifestError _ -> "manifest.invalid"+    CliAuthoringError _ -> "authoring.failed"++renderCliErrorMessage :: CliError -> String+renderCliErrorMessage cliError =+  case cliError of+    CliMigrationError err -> show err+    CliRepairDefinitionError err -> show err+    CliRepairError err -> show err+    CliManifestError err -> show err+    CliAuthoringError err -> show err++migrationErrorType :: MigrationError -> Text+migrationErrorType migrationError =+  case migrationError of+    ConnectionAcquisitionFailed _ -> "connectionAcquisitionFailed"+    DatabaseSessionFailed _ -> "databaseSessionFailed"+    UnsupportedPostgresVersion _ -> "unsupportedPostgresVersion"+    InvalidLockWait _ -> "invalidLockWait"+    InvalidStatementTimeout _ -> "invalidStatementTimeout"+    AdvisoryLockUnavailable -> "advisoryLockUnavailable"+    AdvisoryLockTimedOut _ -> "advisoryLockTimedOut"+    LedgerInitializationFailed _ -> "ledgerInitializationFailed"+    PlanVerificationFailed _ -> "planVerificationFailed"+    UnsupportedNonTransactionalMigration _ -> "unsupportedNonTransactionalMigration"+    TransactionCondemned _ -> "transactionCondemned"+    EventHandlerFailed _ _ -> "eventHandlerFailed"+    MigrationActionFailed _ -> "migrationActionFailed"+    InvalidMigrationAction _ -> "invalidMigrationAction"+    NonTransactionalMigrationFailed _ _ -> "nonTransactionalMigrationFailed"+    LedgerTransitionDidNotMatch _ _ _ -> "ledgerTransitionDidNotMatch"+    NonTransactionalFailureRecordingFailed _ _ _ -> "nonTransactionalFailureRecordingFailed"+    CleanupFailed _ _ -> "cleanupFailed"++migrationIdText :: MigrationId -> Text+migrationIdText identifier =+  componentNameText (migrationIdComponent identifier)+    <> "/"+    <> migrationNameText (migrationIdName identifier)++checksumText :: MigrationChecksum -> Text+checksumText =+  Text.pack . concatMap renderByte . ByteString.unpack . migrationChecksumBytes+  where+    renderByte byte =+      case Numeric.showHex byte "" of+        [digit] -> ['0', digit]+        digits -> digits++kindText :: MigrationKind -> Text+kindText kind = case kind of SqlKind -> "sql"; HaskellKind -> "haskell"++modeText :: TransactionMode -> Text+modeText mode = case mode of Transactional -> "transactional"; NonTransactional -> "nontransactional"++statusText :: MigrationStatus -> Text+statusText status = case status of Running -> "running"; Applied -> "applied"; Failed -> "failed"++outcomeText :: MigrationOutcome -> Text+outcomeText outcome = case outcome of AlreadyApplied -> "alreadyApplied"; AppliedNow -> "appliedNow"++repairOperationText :: RepairOperation -> Text+repairOperationText operation = case operation of MarkApplied -> "markApplied"; Retry -> "retry"++durationMilliseconds :: NominalDiffTime -> Integer+durationMilliseconds duration = round (duration * 1000)++utcText :: UTCTime -> Text+utcText = Text.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ"
+ src/Database/PostgreSQL/Migrate/CLI/Outcome.hs view
@@ -0,0 +1,69 @@+module Database.PostgreSQL.Migrate.CLI.Outcome+  ( ExitClass (..),+    CheckedMigration (..),+    CliPayload (..),+    CliError (..),+    CliOutcome (..),+  )+where++import Database.PostgreSQL.Migrate+  ( MigrationChecksum,+    MigrationError,+    MigrationReport,+    RepairDefinitionError,+    RepairError,+    RepairReport,+    StatusReport,+    VerificationReport,+  )+import Database.PostgreSQL.Migrate.Embed (AuthoringError, ManifestError)+import Database.PostgreSQL.Migrate.Internal+  ( ComponentDescription,+    MigrationDescription,+  )+import PgMigrate.CLI.Prelude++-- | Stable process-exit classification chosen by the application.+data ExitClass+  = ExitSuccess+  | ExitVerificationFailed+  | ExitUsageFailed+  | ExitExecutionFailed+  deriving stock (Generic, Eq, Ord, Show)++-- | One migration summarized by local plan checking.+data CheckedMigration = CheckedMigration+  { file :: !FilePath,+    checksum :: !MigrationChecksum+  }+  deriving stock (Generic, Eq, Show)++-- | Successful command-specific structured payload.+data CliPayload+  = PlanPayload ![ComponentDescription]+  | ListPayload ![MigrationDescription]+  | CheckPayload !(NonEmpty CheckedMigration)+  | StatusPayload !StatusReport+  | VerifyPayload !VerificationReport+  | UpPayload !MigrationReport+  | RepairPayload !RepairReport+  | NewPayload !FilePath+  deriving stock (Generic, Eq, Show)++-- | Structured CLI definition, runner, repair, authoring, or import failure.+data CliError+  = CliMigrationError !MigrationError+  | CliRepairDefinitionError !RepairDefinitionError+  | CliRepairError !RepairError+  | CliManifestError !ManifestError+  | CliAuthoringError !AuthoringError+  deriving stock (Generic, Show)++-- | Renderable command result with stable exit classification.+data CliOutcome = CliOutcome+  { command :: !Text,+    exitClass :: !ExitClass,+    payload :: !(Either CliError CliPayload)+  }+  deriving stock (Generic, Show)
+ src/Database/PostgreSQL/Migrate/CLI/Parser.hs view
@@ -0,0 +1,222 @@+module Database.PostgreSQL.Migrate.CLI.Parser+  ( migrationCommandParser,+  )+where++import Data.Text qualified as Text+import Database.PostgreSQL.Migrate+  ( ComponentName,+    Confirmation (Confirmed),+    DefinitionError,+    LockWait (..),+    MigrationId,+    MigrationName,+    MigrationPlan,+    RepairOperation (..),+    componentName,+    migrationId,+    migrationName,+  )+import Database.PostgreSQL.Migrate.CLI.Types+import Hasql.Connection.Settings qualified as Settings+import Options.Applicative+import PgMigrate.CLI.Prelude+import Text.Read qualified as Read++-- | Build the reusable parser, using the plan for target-aware choices.+migrationCommandParser :: MigrationPlan -> Parser MigrationCommand+migrationCommandParser _ =+  subparser (commandGroup "Inspection" <> inspectionCommands)+    <|> subparser (commandGroup "Execution" <> executionCommands)+    <|> subparser (commandGroup "Authoring" <> authoringCommands)+  where+    inspectionCommands =+      command+        "plan"+        (info (Plan <$> planOptionsParser <**> helper) (progDesc "Show component order and dependencies"))+        <> command+          "status"+          (info (Status <$> statusOptionsParser <**> helper) (progDesc "Show declared and stored migration status"))+        <> command+          "verify"+          ( info+              (Verify <$> verifyOptionsParser <**> helper)+              (progDesc "Strictly compare the declared plan with the migration ledger (not live schema snapshots)")+          )+        <> command+          "list"+          (info (List <$> listOptionsParser <**> helper) (progDesc "List declared migrations and metadata"))+        <> command+          "check"+          (info (Check <$> checkOptionsParser <**> helper) (progDesc "Validate an ordered SQL manifest without a database"))+    executionCommands =+      command+        "up"+        ( info+            (Up <$> upOptionsParser <**> helper)+            (progDesc "Apply the complete migration plan; selective execution is unavailable in v1")+        )+        <> command+          "repair"+          (info (Repair <$> repairOptionsParser <**> helper) (progDesc "Repair one nontransactional migration after operator inspection"))+    authoringCommands =+      command+        "new"+        (info (New <$> newOptionsParser <**> helper) (progDesc "Create and append one SQL migration without applying it"))++planOptionsParser :: Parser PlanOptions+planOptionsParser =+  PlanOptions+    <$> inspectionOptionsParser+    <*> outputOptionsParser++listOptionsParser :: Parser ListOptions+listOptionsParser =+  ListOptions+    <$> inspectionOptionsParser+    <*> outputOptionsParser++checkOptionsParser :: Parser CheckOptions+checkOptionsParser =+  CheckOptions+    <$> strArgument (metavar "MANIFEST" <> help "Path to the ordered migration manifest")+    <*> outputOptionsParser++statusOptionsParser :: Parser StatusOptions+statusOptionsParser =+  StatusOptions+    <$> inspectionOptionsParser+    <*> connectionOptionsParser+    <*> outputOptionsParser++verifyOptionsParser :: Parser VerifyOptions+verifyOptionsParser =+  VerifyOptions+    <$> inspectionOptionsParser+    <*> connectionOptionsParser+    <*> outputOptionsParser++upOptionsParser :: Parser UpOptions+upOptionsParser =+  UpOptions+    <$> connectionOptionsParser+    <*> executionOptionsParser+    <*> outputOptionsParser++repairOptionsParser :: Parser RepairOptions+repairOptionsParser =+  RepairOptions+    <$> argument migrationIdReader (metavar "COMPONENT/MIGRATION")+    <*> repairOperationParser+    <*> strOption (long "reason" <> metavar "TEXT" <> help "Audit reason for the repair")+    <*> flag' Confirmed (long "confirm" <> help "Confirm that the database result was inspected")+    <*> connectionOptionsParser+    <*> executionOptionsParser+    <*> outputOptionsParser++newOptionsParser :: Parser NewOptions+newOptionsParser =+  NewOptions+    <$> strOption (long "manifest" <> metavar "PATH" <> help "Ordered manifest to append")+    <*> strOption (long "description" <> metavar "TEXT" <> help "Human description written into the new SQL file")+    <*> optional (strOption (long "name" <> metavar "BASENAME" <> help "Explicit SQL basename when numeric inference is unavailable"))+    <*> outputOptionsParser++connectionOptionsParser :: Parser ConnectionOptions+connectionOptionsParser =+  parserOptionGroup+    "Connection"+    ( ConnectionOptions+        <$> optional+          ( option+              databaseSettingsReader+              ( long "database-url"+                  <> metavar "URL"+                  <> help "PostgreSQL URI or keyword/value connection string; no environment variable is read"+              )+          )+    )++executionOptionsParser :: Parser ExecutionOptions+executionOptionsParser =+  parserOptionGroup+    "Execution"+    ( ExecutionOptions+        <$> lockWaitParser+        <*> optional+          ( option+              positiveMillisecondsReader+              ( long "statement-timeout"+                  <> metavar "MILLISECONDS"+                  <> help "Positive PostgreSQL statement timeout in milliseconds"+              )+          )+    )++outputOptionsParser :: Parser OutputOptions+outputOptionsParser =+  parserOptionGroup+    "Output"+    ( OutputOptions+        <$> flag TextOutput JsonOutput (long "json" <> help "Emit JSON schema version 1")+    )++inspectionOptionsParser :: Parser InspectionOptions+inspectionOptionsParser =+  parserOptionGroup+    "Filters"+    ( InspectionOptions+        <$> optional+          (option componentNameReader (long "component" <> metavar "COMPONENT" <> help "Limit inspection output to one component"))+        <*> optional+          (option migrationNameReader (long "migration" <> metavar "MIGRATION" <> help "Limit inspection output to one migration name"))+    )++lockWaitParser :: Parser LockWait+lockWaitParser =+  flag' NoWait (long "no-wait" <> help "Fail immediately when the advisory lock is unavailable")+    <|> ( WaitFor+            <$> option+              positiveMillisecondsReader+              ( long "lock-timeout"+                  <> metavar "MILLISECONDS"+                  <> help "Wait at most this many positive milliseconds for the advisory lock"+              )+        )+    <|> pure WaitIndefinitely++repairOperationParser :: Parser RepairOperation+repairOperationParser =+  flag' MarkApplied (long "mark-applied" <> help "Record the inspected nontransactional result as applied")+    <|> flag' Retry (long "retry" <> help "Return the migration to running and execute its action again")++positiveMillisecondsReader :: ReadM NominalDiffTime+positiveMillisecondsReader = eitherReader $ \input ->+  case Read.readMaybe input :: Maybe Integer of+    Just milliseconds+      | milliseconds > 0 -> Right (fromRational (toRational milliseconds / 1000))+    _ -> Left "expected a positive integer number of milliseconds"++databaseSettingsReader :: ReadM Settings.Settings+databaseSettingsReader = Settings.connectionString . Text.pack <$> str++componentNameReader :: ReadM ComponentName+componentNameReader = validatedTextReader componentName++migrationNameReader :: ReadM MigrationName+migrationNameReader = validatedTextReader migrationName++validatedTextReader :: (Text -> Either DefinitionError value) -> ReadM value+validatedTextReader validate = eitherReader $ \input ->+  case validate (Text.pack input) of+    Left err -> Left (show err)+    Right validated -> Right validated++migrationIdReader :: ReadM MigrationId+migrationIdReader = eitherReader $ \input ->+  case Text.splitOn "/" (Text.pack input) of+    [component, migration] ->+      case migrationId component migration of+        Left err -> Left (show err)+        Right validated -> Right validated+    _ -> Left "expected COMPONENT/MIGRATION"
+ src/Database/PostgreSQL/Migrate/CLI/Text.hs view
@@ -0,0 +1,159 @@+module Database.PostgreSQL.Migrate.CLI.Text+  ( renderMigrationCommandText,+  )+where++import Data.ByteString qualified as ByteString+import Data.List.NonEmpty qualified as NonEmpty+import Data.Set qualified as Set+import Data.Text qualified as Text+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.CLI.Outcome+import Database.PostgreSQL.Migrate.Internal+import Numeric qualified+import PgMigrate.CLI.Prelude++-- | Render a stable human-oriented outcome.+renderMigrationCommandText :: CliOutcome -> Text+renderMigrationCommandText CliOutcome {command, payload = Left cliError} =+  command <> ": error: " <> renderCliError cliError+renderMigrationCommandText CliOutcome {payload = Right cliPayload} = renderPayload cliPayload++renderCliError :: CliError -> Text+renderCliError cliError =+  case cliError of+    CliMigrationError err -> Text.pack (show err)+    CliRepairDefinitionError err -> Text.pack (show err)+    CliRepairError err -> Text.pack (show err)+    CliManifestError err -> Text.pack (show err)+    CliAuthoringError err -> Text.pack (show err)++renderPayload :: CliPayload -> Text+renderPayload cliPayload =+  case cliPayload of+    PlanPayload components -> renderPlan components+    ListPayload migrations -> Text.unlines (renderMigration <$> migrations)+    CheckPayload checked -> Text.unlines (renderChecked <$> NonEmpty.toList checked)+    StatusPayload report -> renderStatus report+    VerifyPayload report -> renderVerification report+    UpPayload report -> renderMigrationReport report+    RepairPayload report -> renderRepairReport report+    NewPayload path -> "created " <> Text.pack path <> "\n"++renderPlan :: [ComponentDescription] -> Text+renderPlan components = Text.unlines (renderComponent <$> components)++renderComponent :: ComponentDescription -> Text+renderComponent (ComponentDescription name position dependencies migrations) =+  Text.intercalate+    " "+    [ Text.pack (show position) <> ".",+      componentNameText name,+      "depends=[" <> Text.intercalate "," (componentNameText <$> Set.toAscList dependencies) <> "]",+      "migrations=" <> Text.pack (show (NonEmpty.length migrations))+    ]++renderMigration :: MigrationDescription -> Text+renderMigration (MigrationDescription identifier position checksum kind mode) =+  Text.intercalate+    " "+    [ renderMigrationId identifier,+      "position=" <> Text.pack (show position),+      "checksum=" <> checksumText checksum,+      "kind=" <> renderKind kind,+      "transaction=" <> renderMode mode+    ]++renderChecked :: CheckedMigration -> Text+renderChecked (CheckedMigration file checksum) =+  Text.pack file <> " checksum=" <> checksumText checksum++renderStatus :: StatusReport -> Text+renderStatus (StatusReport issues applied pending unknown) =+  Text.unlines+    ( [ "applied=" <> Text.pack (show (length applied)),+        "pending=" <> Text.pack (show (length pending)),+        "unknown=" <> Text.pack (show (length unknown)),+        "issues=" <> Text.pack (show (length issues))+      ]+        <> (("applied " <>) . renderMigrationId <$> applied)+        <> (("pending " <>) . renderMigrationId <$> pending)+        <> (("unknown " <>) . renderStoredMigrationId <$> unknown)+        <> (("issue " <>) . Text.pack . show <$> issues)+    )++renderVerification :: VerificationReport -> Text+renderVerification (VerificationReport issues applied pending unknown) =+  Text.unlines+    ( [ if null issues then "verification ok" else "verification failed",+        "applied=" <> Text.pack (show (length applied)),+        "pending=" <> Text.pack (show (length pending)),+        "unknown=" <> Text.pack (show (length unknown))+      ]+        <> (("issue " <>) . Text.pack . show <$> issues)+    )++renderMigrationReport :: MigrationReport -> Text+renderMigrationReport (MigrationReport startedAt finishedAt results) =+  Text.unlines+    ( [ "started=" <> Text.pack (show startedAt),+        "finished=" <> Text.pack (show finishedAt)+      ]+        <> (renderMigrationResult <$> NonEmpty.toList results)+    )++renderMigrationResult :: MigrationResult -> Text+renderMigrationResult (MigrationResult identifier outcome duration) =+  Text.intercalate+    " "+    [ renderMigrationId identifier,+      "outcome=" <> renderOutcome outcome,+      "duration_ms=" <> maybe "null" renderDurationMilliseconds duration+    ]++renderRepairReport :: RepairReport -> Text+renderRepairReport (RepairReport identifier operation oldStatus newStatus) =+  Text.intercalate+    " "+    [ renderMigrationId identifier,+      "operation=" <> renderRepairOperation operation,+      "old_status=" <> renderStatusName oldStatus,+      "new_status=" <> renderStatusName newStatus+    ]+    <> "\n"++renderStoredMigrationId :: StoredMigration -> Text+renderStoredMigrationId StoredMigration {storedMigrationId} = renderMigrationId storedMigrationId++renderMigrationId :: MigrationId -> Text+renderMigrationId identifier =+  componentNameText (migrationIdComponent identifier)+    <> "/"+    <> migrationNameText (migrationIdName identifier)++checksumText :: MigrationChecksum -> Text+checksumText =+  Text.pack . concatMap renderByte . ByteString.unpack . migrationChecksumBytes+  where+    renderByte byte =+      case Numeric.showHex byte "" of+        [digit] -> ['0', digit]+        digits -> digits++renderKind :: MigrationKind -> Text+renderKind kind = case kind of SqlKind -> "sql"; HaskellKind -> "haskell"++renderMode :: TransactionMode -> Text+renderMode mode = case mode of Transactional -> "transactional"; NonTransactional -> "nontransactional"++renderOutcome :: MigrationOutcome -> Text+renderOutcome outcome = case outcome of AlreadyApplied -> "already_applied"; AppliedNow -> "applied_now"++renderRepairOperation :: RepairOperation -> Text+renderRepairOperation operation = case operation of MarkApplied -> "mark_applied"; Retry -> "retry"++renderStatusName :: MigrationStatus -> Text+renderStatusName status = case status of Running -> "running"; Applied -> "applied"; Failed -> "failed"++renderDurationMilliseconds :: NominalDiffTime -> Text+renderDurationMilliseconds duration = Text.pack (show (round (duration * 1000) :: Integer))
+ src/Database/PostgreSQL/Migrate/CLI/Types.hs view
@@ -0,0 +1,138 @@+module Database.PostgreSQL.Migrate.CLI.Types+  ( OutputFormat (..),+    ConnectionOptions (..),+    ExecutionOptions (..),+    OutputOptions (..),+    InspectionOptions (..),+    PlanOptions (..),+    ListOptions (..),+    CheckOptions (..),+    StatusOptions (..),+    VerifyOptions (..),+    UpOptions (..),+    RepairOptions (..),+    NewOptions (..),+    MigrationCommand (..),+  )+where++import Database.PostgreSQL.Migrate+  ( ComponentName,+    Confirmation,+    LockWait,+    MigrationId,+    MigrationName,+    RepairOperation,+  )+import Hasql.Connection.Settings qualified as Settings+import PgMigrate.CLI.Prelude++-- | Human-readable or versioned JSON rendering.+data OutputFormat+  = TextOutput+  | JsonOutput+  deriving stock (Generic, Eq, Ord, Show)++-- | Optional command-line database connection override.+newtype ConnectionOptions = ConnectionOptions+  { databaseSettings :: Maybe Settings.Settings+  }+  deriving stock (Generic, Eq, Show)++-- | Shared lock and statement-timeout flags.+data ExecutionOptions = ExecutionOptions+  { lockWait :: !LockWait,+    statementTimeout :: !(Maybe NominalDiffTime)+  }+  deriving stock (Generic, Eq, Show)++-- | Shared output selection.+newtype OutputOptions = OutputOptions+  { outputFormat :: OutputFormat+  }+  deriving stock (Generic, Eq, Show)++-- | Shared read-only command options.+data InspectionOptions = InspectionOptions+  { component :: !(Maybe ComponentName),+    migration :: !(Maybe MigrationName)+  }+  deriving stock (Generic, Eq, Show)++-- | Shared local plan-rendering options.+data PlanOptions = PlanOptions+  { inspection :: !InspectionOptions,+    output :: !OutputOptions+  }+  deriving stock (Generic, Eq, Show)++-- | Parsed @list@ command options.+data ListOptions = ListOptions+  { inspection :: !InspectionOptions,+    output :: !OutputOptions+  }+  deriving stock (Generic, Eq, Show)++-- | Parsed @check@ command options.+data CheckOptions = CheckOptions+  { manifestPath :: !FilePath,+    output :: !OutputOptions+  }+  deriving stock (Generic, Eq, Show)++-- | Parsed @status@ command options.+data StatusOptions = StatusOptions+  { inspection :: !InspectionOptions,+    connection :: !ConnectionOptions,+    output :: !OutputOptions+  }+  deriving stock (Generic, Eq, Show)++-- | Parsed strict @verify@ command options.+data VerifyOptions = VerifyOptions+  { inspection :: !InspectionOptions,+    connection :: !ConnectionOptions,+    output :: !OutputOptions+  }+  deriving stock (Generic, Eq, Show)++-- | Parsed @up@ command options.+data UpOptions = UpOptions+  { connection :: !ConnectionOptions,+    execution :: !ExecutionOptions,+    output :: !OutputOptions+  }+  deriving stock (Generic, Eq, Show)++-- | Parsed confirmed @repair@ command options.+data RepairOptions = RepairOptions+  { target :: !MigrationId,+    operation :: !RepairOperation,+    reason :: !Text,+    confirmation :: !Confirmation,+    connection :: !ConnectionOptions,+    execution :: !ExecutionOptions,+    output :: !OutputOptions+  }+  deriving stock (Generic, Eq, Show)++-- | Parsed migration-authoring command options.+data NewOptions = NewOptions+  { manifestPath :: !FilePath,+    description :: !Text,+    requestedName :: !(Maybe FilePath),+    output :: !OutputOptions+  }+  deriving stock (Generic, Eq, Show)++-- | Complete reusable command algebra mounted by an application executable.+data MigrationCommand+  = Plan !PlanOptions+  | Status !StatusOptions+  | Verify !VerifyOptions+  | List !ListOptions+  | Check !CheckOptions+  | Up !UpOptions+  | Repair !RepairOptions+  | New !NewOptions+  deriving stock (Generic, Eq, Show)
+ src/PgMigrate/CLI/Prelude.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_HADDOCK hide #-}++module PgMigrate.CLI.Prelude+  ( module X,+  )+where++import "base" Control.Applicative as X (Alternative (..), optional)+import "base" Data.Foldable as X (toList)+import "base" Data.List.NonEmpty as X (NonEmpty (..))+import "base" Data.Maybe as X (fromMaybe)+import "base" GHC.Generics as X (Generic)+import "text" Data.Text as X (Text)+import "time" Data.Time as X (NominalDiffTime)+import "base" Prelude as X
+ test/golden/help/check.txt view
@@ -0,0 +1,10 @@+Usage: pg-migrate-cli-help-fixture check MANIFEST [--json]++  Validate an ordered SQL manifest without a database++Available options:+  MANIFEST                 Path to the ordered migration manifest+  -h,--help                Show this help text++Output+  --json                   Emit JSON schema version 1
+ test/golden/help/list.txt view
@@ -0,0 +1,14 @@+Usage: pg-migrate-cli-help-fixture list+         [--component COMPONENT] [--migration MIGRATION] [--json]++  List declared migrations and metadata++Filters+  --component COMPONENT    Limit inspection output to one component+  --migration MIGRATION    Limit inspection output to one migration name++Output+  --json                   Emit JSON schema version 1++Available options:+  -h,--help                Show this help text
+ test/golden/help/new.txt view
@@ -0,0 +1,14 @@+Usage: pg-migrate-cli-help-fixture new+         --manifest PATH --description TEXT [--name BASENAME] [--json]++  Create and append one SQL migration without applying it++Available options:+  --manifest PATH          Ordered manifest to append+  --description TEXT       Human description written into the new SQL file+  --name BASENAME          Explicit SQL basename when numeric inference is+                           unavailable+  -h,--help                Show this help text++Output+  --json                   Emit JSON schema version 1
+ test/golden/help/plan.txt view
@@ -0,0 +1,14 @@+Usage: pg-migrate-cli-help-fixture plan+         [--component COMPONENT] [--migration MIGRATION] [--json]++  Show component order and dependencies++Filters+  --component COMPONENT    Limit inspection output to one component+  --migration MIGRATION    Limit inspection output to one migration name++Output+  --json                   Emit JSON schema version 1++Available options:+  -h,--help                Show this help text
+ test/golden/help/repair.txt view
@@ -0,0 +1,31 @@+Usage: pg-migrate-cli-help-fixture repair+         COMPONENT/MIGRATION (--mark-applied | --retry) --reason TEXT --confirm+         [--database-url URL] [--no-wait | --lock-timeout MILLISECONDS]+         [--statement-timeout MILLISECONDS] [--json]++  Repair one nontransactional migration after operator inspection++Available options:+  --mark-applied           Record the inspected nontransactional result as+                           applied+  --retry                  Return the migration to running and execute its+                           action again+  --reason TEXT            Audit reason for the repair+  --confirm                Confirm that the database result was inspected+  -h,--help                Show this help text++Connection+  --database-url URL       PostgreSQL URI or keyword/value connection string; no+                           environment variable is read++Execution+  --no-wait                Fail immediately when the advisory lock is+                           unavailable+  --lock-timeout MILLISECONDS+                           Wait at most this many positive milliseconds for the+                           advisory lock+  --statement-timeout MILLISECONDS+                           Positive PostgreSQL statement timeout in milliseconds++Output+  --json                   Emit JSON schema version 1
+ test/golden/help/status.txt view
@@ -0,0 +1,19 @@+Usage: pg-migrate-cli-help-fixture status+         [--component COMPONENT] [--migration MIGRATION] [--database-url URL]+         [--json]++  Show declared and stored migration status++Filters+  --component COMPONENT    Limit inspection output to one component+  --migration MIGRATION    Limit inspection output to one migration name++Connection+  --database-url URL       PostgreSQL URI or keyword/value connection string; no+                           environment variable is read++Output+  --json                   Emit JSON schema version 1++Available options:+  -h,--help                Show this help text
+ test/golden/help/top.txt view
@@ -0,0 +1,24 @@+Usage: pg-migrate-cli-help-fixture (COMMAND | COMMAND | COMMAND)++  Manage the fixture service migration plan++Available options:+  -h,--help                Show this help text++Inspection+  plan                     Show component order and dependencies+  status                   Show declared and stored migration status+  verify                   Strictly compare the declared plan with the migration+                           ledger (not live schema snapshots)+  list                     List declared migrations and metadata+  check                    Validate an ordered SQL manifest without a database++Execution+  up                       Apply the complete migration plan; selective+                           execution is unavailable in v1+  repair                   Repair one nontransactional migration after operator+                           inspection++Authoring+  new                      Create and append one SQL migration without applying+                           it
+ test/golden/help/up.txt view
@@ -0,0 +1,24 @@+Usage: pg-migrate-cli-help-fixture up+         [--database-url URL] [--no-wait | --lock-timeout MILLISECONDS]+         [--statement-timeout MILLISECONDS] [--json]++  Apply the complete migration plan; selective execution is unavailable in v1++Connection+  --database-url URL       PostgreSQL URI or keyword/value connection string; no+                           environment variable is read++Execution+  --no-wait                Fail immediately when the advisory lock is+                           unavailable+  --lock-timeout MILLISECONDS+                           Wait at most this many positive milliseconds for the+                           advisory lock+  --statement-timeout MILLISECONDS+                           Positive PostgreSQL statement timeout in milliseconds++Output+  --json                   Emit JSON schema version 1++Available options:+  -h,--help                Show this help text
+ test/golden/help/verify.txt view
@@ -0,0 +1,20 @@+Usage: pg-migrate-cli-help-fixture verify+         [--component COMPONENT] [--migration MIGRATION] [--database-url URL]+         [--json]++  Strictly compare the declared plan with the migration ledger (not live schema+  snapshots)++Filters+  --component COMPONENT    Limit inspection output to one component+  --migration MIGRATION    Limit inspection output to one migration name++Connection+  --database-url URL       PostgreSQL URI or keyword/value connection string; no+                           environment variable is read++Output+  --json                   Emit JSON schema version 1++Available options:+  -h,--help                Show this help text
+ test/golden/json/error.json view
@@ -0,0 +1,9 @@+{+  "schemaVersion": 1,+  "command": "check",+  "ok": false,+  "error": {+    "type": "manifest.invalid",+    "message": "EmptyManifest"+  }+}
+ test/golden/json/import.json view
@@ -0,0 +1,18 @@+{+  "schemaVersion": 1,+  "command": "import",+  "ok": true,+  "data": {+    "source": "codd",+    "results": [+      {+        "id": "accounts/0001",+        "outcome": "imported"+      },+      {+        "id": "accounts/0002",+        "outcome": "alreadyImported"+      }+    ]+  }+}
+ test/golden/json/plan.json view
@@ -0,0 +1,23 @@+{+  "schemaVersion": 1,+  "command": "plan",+  "ok": true,+  "data": {+    "components": [+      {+        "name": "accounts",+        "position": 1,+        "dependencies": [],+        "migrations": [+          {+            "id": "accounts/0001",+            "position": 1,+            "checksum": "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855",+            "kind": "sql",+            "transactionMode": "transactional"+          }+        ]+      }+    ]+  }+}
+ test/golden/json/repair.json view
@@ -0,0 +1,11 @@+{+  "schemaVersion": 1,+  "command": "repair",+  "ok": true,+  "data": {+    "id": "accounts/0001",+    "operation": "markApplied",+    "oldStatus": "failed",+    "newStatus": "applied"+  }+}
+ test/golden/json/status.json view
@@ -0,0 +1,11 @@+{+  "schemaVersion": 1,+  "command": "status",+  "ok": true,+  "data": {+    "issues": [],+    "applied": ["accounts/0001"],+    "pending": [],+    "unknown": []+  }+}
+ test/golden/json/up.json view
@@ -0,0 +1,16 @@+{+  "schemaVersion": 1,+  "command": "up",+  "ok": true,+  "data": {+    "startedAt": "2026-07-10T12:00:00Z",+    "finishedAt": "2026-07-10T12:00:01Z",+    "results": [+      {+        "id": "accounts/0001",+        "outcome": "appliedNow",+        "durationMilliseconds": 125+      }+    ]+  }+}
+ test/golden/json/verify.json view
@@ -0,0 +1,13 @@+{+  "schemaVersion": 1,+  "command": "verify",+  "ok": false,+  "data": {+    "issues": [+      {"type": "pendingMigration", "id": "accounts/0001"}+    ],+    "applied": [],+    "pending": ["accounts/0001"],+    "unknown": []+  }+}
+ test/help-fixture/Main.hs view
@@ -0,0 +1,40 @@+module Main (main) where++import Data.List.NonEmpty (NonEmpty (..))+import Data.Set qualified as Set+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.CLI+import Options.Applicative++main :: IO ()+main = do+  _ <-+    execParser+      ( info+          (migrationCommandParser fixturePlan <**> helper)+          (fullDesc <> progDesc "Manage the fixture service migration plan")+      )+  pure ()++fixturePlan :: MigrationPlan+fixturePlan =+  expectRight+    ( migrationPlan+        ( expectRight+            ( migrationComponent+                "accounts"+                Set.empty+                (expectRight (sqlMigration "0001" "SELECT 1") :| [])+            )+            :| [ expectRight+                   ( migrationComponent+                       "billing"+                       (Set.singleton "accounts")+                       (expectRight (sqlMigration "0001" "SELECT 2") :| [])+                   )+               ]+        )+    )++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id
+ test/integration/Main.hs view
@@ -0,0 +1,210 @@+module Main (main) where++import Control.Exception qualified as Exception+import Data.Int (Int64)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Set qualified as Set+import Data.Text qualified as Text+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.CLI+import Hasql.Connection qualified as Connection+import Hasql.Connection.Settings qualified as Settings+import Hasql.Session qualified as Session+import System.Environment (lookupEnv)+import Test.Tasty+import Test.Tasty.HUnit++main :: IO ()+main = do+  maybeConnectionString <- lookupEnv "PG_CONNECTION_STRING"+  case maybeConnectionString of+    Nothing ->+      putStrLn+        "pg-migrate-cli integration tests skipped: PG_CONNECTION_STRING is not set"+    Just connectionString ->+      defaultMain (tests (Settings.connectionString (Text.pack connectionString)))++tests :: Settings.Settings -> TestTree+tests settings =+  testGroup+    "pg-migrate CLI PostgreSQL"+    [ testCase "status verify and full up preserve their contracts" (testCommandLifecycle settings),+      testCase "confirmed repair dispatches through the shared lifecycle" (testRepairLifecycle settings)+    ]++testCommandLifecycle :: Settings.Settings -> Assertion+testCommandLifecycle settings =+  withCleanLedger settings "pgmigrate_cli_commands" 0x70676D636C690001 $ \options -> do+    let environment = cliEnvironment settings commandPlan options++    statusBefore <- runMigrationCommand environment statusCommand+    exitClass statusBefore @?= ExitSuccess+    case payload statusBefore of+      Right (StatusPayload (StatusReport issues applied pending unknown)) -> do+        issues @?= []+        applied @?= []+        length pending @?= 1+        unknown @?= []+      other -> assertFailure ("unexpected status outcome: " <> show other)++    verifyBefore <- runMigrationCommand environment verifyCommand+    exitClass verifyBefore @?= ExitVerificationFailed+    case payload verifyBefore of+      Right (VerifyPayload (VerificationReport issues _ pending _)) -> do+        length issues @?= 1+        length pending @?= 1+      other -> assertFailure ("unexpected pre-run verify outcome: " <> show other)++    firstUp <- runMigrationCommand environment upCommand+    exitClass firstUp @?= ExitSuccess+    assertSingleOutcome AppliedNow firstUp++    verifyAfter <- runMigrationCommand environment verifyCommand+    exitClass verifyAfter @?= ExitSuccess+    case payload verifyAfter of+      Right (VerifyPayload (VerificationReport issues applied pending unknown)) -> do+        issues @?= []+        length applied @?= 1+        pending @?= []+        unknown @?= []+      other -> assertFailure ("unexpected post-run verify outcome: " <> show other)++    secondUp <- runMigrationCommand environment upCommand+    exitClass secondUp @?= ExitSuccess+    assertSingleOutcome AlreadyApplied secondUp++testRepairLifecycle :: Settings.Settings -> Assertion+testRepairLifecycle settings =+  withCleanLedger settings "pgmigrate_cli_repair" 0x70676D636C690002 $ \options -> do+    let environment = cliEnvironment settings failingPlan options++    failedUp <- runMigrationCommand environment upCommand+    exitClass failedUp @?= ExitExecutionFailed++    repaired <-+      runMigrationCommand+        environment+        ( Repair+            ( RepairOptions+                failingMigrationId+                MarkApplied+                "operator inspected the database result"+                Confirmed+                noConnectionOverride+                defaultExecution+                jsonOutput+            )+        )+    exitClass repaired @?= ExitSuccess+    case payload repaired of+      Right (RepairPayload (RepairReport identifier MarkApplied Failed Applied)) ->+        identifier @?= failingMigrationId+      other -> assertFailure ("unexpected repair outcome: " <> show other)++    verified <- runMigrationCommand environment verifyCommand+    exitClass verified @?= ExitSuccess++assertSingleOutcome :: MigrationOutcome -> CliOutcome -> Assertion+assertSingleOutcome expected outcome =+  case payload outcome of+    Right (UpPayload (MigrationReport _ _ (MigrationResult _ actual _ :| []))) ->+      actual @?= expected+    other -> assertFailure ("unexpected up outcome: " <> show other)++statusCommand :: MigrationCommand+statusCommand = Status (StatusOptions noInspection noConnectionOverride jsonOutput)++verifyCommand :: MigrationCommand+verifyCommand = Verify (VerifyOptions noInspection noConnectionOverride jsonOutput)++upCommand :: MigrationCommand+upCommand = Up (UpOptions noConnectionOverride defaultExecution jsonOutput)++noInspection :: InspectionOptions+noInspection = InspectionOptions Nothing Nothing++noConnectionOverride :: ConnectionOptions+noConnectionOverride = ConnectionOptions Nothing++defaultExecution :: ExecutionOptions+defaultExecution = ExecutionOptions WaitIndefinitely Nothing++jsonOutput :: OutputOptions+jsonOutput = OutputOptions JsonOutput++commandPlan :: MigrationPlan+commandPlan =+  expectRight+    ( migrationPlan+        ( expectRight+            ( migrationComponent+                "cli-commands"+                Set.empty+                ( expectRight+                    ( sqlMigration+                        "0001"+                        "CREATE TABLE pgmigrate_cli_commands.cli_command_probe (id bigint PRIMARY KEY)"+                    )+                    :| []+                )+            )+            :| []+        )+    )++failingPlan :: MigrationPlan+failingPlan =+  expectRight+    ( migrationPlan+        ( expectRight+            ( migrationComponent+                "cli-repair"+                Set.empty+                (failingMigration :| [])+            )+            :| []+        )+    )++failingMigration :: Migration+failingMigration =+  expectRight+    ( sessionMigration+        "0001"+        (migrationFingerprint "cli-repair-v1")+        (Session.script "SELECT * FROM pgmigrate_cli_deliberately_missing_table")+    )++failingMigrationId :: MigrationId+failingMigrationId = expectRight (migrationId "cli-repair" "0001")++withCleanLedger ::+  Settings.Settings ->+  Text.Text ->+  Int64 ->+  (RunOptions -> IO value) ->+  IO value+withCleanLedger settings schemaName lockKey action = do+  let config = expectRight (ledgerConfig schemaName lockKey)+  Exception.bracket_+    (dropSchema settings schemaName)+    (dropSchema settings schemaName)+    (action (withLedger config defaultRunOptions))++dropSchema :: Settings.Settings -> Text.Text -> IO ()+dropSchema settings schemaName = do+  acquired <- Connection.acquire settings+  case acquired of+    Left connectionError -> assertFailure ("could not acquire integration connection: " <> show connectionError)+    Right connection ->+      Exception.finally+        ( do+            result <- Connection.use connection (Session.script ("DROP SCHEMA IF EXISTS " <> schemaName <> " CASCADE"))+            case result of+              Left sessionError -> assertFailure ("could not clean integration schema: " <> show sessionError)+              Right () -> pure ()+        )+        (Connection.release connection)++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id
+ test/unit/Main.hs view
@@ -0,0 +1,17 @@+module Main (main) where++import Test.Handler qualified as Handler+import Test.Json qualified as Json+import Test.Parser qualified as Parser+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main =+  defaultMain+    ( testGroup+        "pg-migrate-cli"+        [ Parser.tests,+          Handler.tests,+          Json.tests+        ]+    )
+ test/unit/Test/Handler.hs view
@@ -0,0 +1,154 @@+module Test.Handler (tests) where++import Control.Exception qualified as Exception+import Data.ByteString qualified as ByteString+import Data.List.NonEmpty (NonEmpty (..))+import Data.Set qualified as Set+import Data.Text qualified as Text+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.CLI+import Database.PostgreSQL.Migrate.Embed (AuthoringError (ExplicitMigrationNameRequired))+import Hasql.Connection.Settings qualified as Settings+import System.Directory qualified as Directory+import System.FilePath ((</>))+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "handler"+    [ testCase "plan text is stable and preserves component order" testPlanText,+      testCase "list filters narrow output without changing plan order" testListFilter,+      testCase "check returns exact-byte checksums" testCheck,+      testCase "new creates and appends a migration without applying it" testNew,+      testCase "new reports when a nonnumeric manifest requires an explicit name" testNewRequiresName,+      testCase "manifest failures are typed usage outcomes" testCheckFailure+    ]++testPlanText :: Assertion+testPlanText = do+  outcome <-+    runMigrationCommand+      fixtureEnvironment+      (Plan (PlanOptions noInspection textOutput))+  exitClass outcome @?= ExitSuccess+  renderMigrationCommandText outcome+    @?= Text.unlines+      [ "1. accounts depends=[] migrations=1",+        "2. billing depends=[accounts] migrations=1"+      ]++testListFilter :: Assertion+testListFilter = do+  let billing = expectRight (componentName "billing")+  outcome <-+    runMigrationCommand+      fixtureEnvironment+      (List (ListOptions (InspectionOptions (Just billing) Nothing) textOutput))+  exitClass outcome @?= ExitSuccess+  let rendered = renderMigrationCommandText outcome+  assertBool "billing migration is present" ("billing/0001" `Text.isInfixOf` rendered)+  assertBool "accounts migration is filtered out" (not ("accounts/0001" `Text.isInfixOf` rendered))+  assertBool "checksums are lowercase hexadecimal" (Text.all validOutputCharacter rendered)+  where+    validOutputCharacter character = not (character >= 'A' && character <= 'F')++testCheck :: Assertion+testCheck =+  withFixtureDirectory "check" $ \directory -> do+    let manifest = directory </> "manifest"+    ByteString.writeFile (directory </> "0001.sql") "SELECT 1;\n"+    ByteString.writeFile manifest "0001.sql\n"+    outcome <-+      runMigrationCommand+        fixtureEnvironment+        (Check (CheckOptions manifest textOutput))+    exitClass outcome @?= ExitSuccess+    let rendered = renderMigrationCommandText outcome+    assertBool "manifest entry is rendered" ("0001.sql checksum=" `Text.isPrefixOf` rendered)+    Text.length (Text.takeWhileEnd (/= '=') (Text.strip rendered)) @?= 64++testNew :: Assertion+testNew =+  withFixtureDirectory "new" $ \directory -> do+    let manifest = directory </> "manifest"+    ByteString.writeFile (directory </> "0001.sql") "SELECT 1;\n"+    ByteString.writeFile manifest "0001.sql\n"+    outcome <-+      runMigrationCommand+        fixtureEnvironment+        (New (NewOptions manifest "add profile" Nothing textOutput))+    exitClass outcome @?= ExitSuccess+    renderMigrationCommandText outcome @?= "created " <> Text.pack (directory </> "0002.sql") <> "\n"+    ByteString.readFile (directory </> "0002.sql") >>= (@?= "-- add profile\n\n")+    ByteString.readFile manifest >>= (@?= "0001.sql\n0002.sql\n")++testCheckFailure :: Assertion+testCheckFailure =+  withFixtureDirectory "missing" $ \directory -> do+    outcome <-+      runMigrationCommand+        fixtureEnvironment+        (Check (CheckOptions (directory </> "missing-manifest") textOutput))+    exitClass outcome @?= ExitUsageFailed+    case payload outcome of+      Left (CliManifestError _) -> pure ()+      result -> assertFailure ("expected typed manifest error, received: " <> show result)++testNewRequiresName :: Assertion+testNewRequiresName =+  withFixtureDirectory "new-name" $ \directory -> do+    let manifest = directory </> "manifest"+    ByteString.writeFile (directory </> "baseline.sql") "SELECT 1;\n"+    ByteString.writeFile manifest "baseline.sql\n"+    outcome <-+      runMigrationCommand+        fixtureEnvironment+        (New (NewOptions manifest "add profile" Nothing textOutput))+    exitClass outcome @?= ExitUsageFailed+    case payload outcome of+      Left (CliAuthoringError ExplicitMigrationNameRequired) -> pure ()+      result -> assertFailure ("expected explicit-name usage error, received: " <> show result)++fixtureEnvironment :: CliEnvironment+fixtureEnvironment = cliEnvironment (Settings.connectionString "") fixturePlan defaultRunOptions++fixturePlan :: MigrationPlan+fixturePlan =+  expectRight+    ( migrationPlan+        ( expectRight+            ( migrationComponent+                "accounts"+                Set.empty+                (expectRight (sqlMigration "0001" "SELECT 1") :| [])+            )+            :| [ expectRight+                   ( migrationComponent+                       "billing"+                       (Set.singleton "accounts")+                       (expectRight (sqlMigration "0001" "SELECT 2") :| [])+                   )+               ]+        )+    )++noInspection :: InspectionOptions+noInspection = InspectionOptions Nothing Nothing++textOutput :: OutputOptions+textOutput = OutputOptions TextOutput++withFixtureDirectory :: String -> (FilePath -> IO value) -> IO value+withFixtureDirectory label = Exception.bracket create Directory.removePathForcibly+  where+    create = do+      temporaryDirectory <- Directory.getTemporaryDirectory+      let directory = temporaryDirectory </> ("pg-migrate-cli-" <> label)+      Directory.removePathForcibly directory+      Directory.createDirectory directory+      pure directory++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id
+ test/unit/Test/Json.hs view
@@ -0,0 +1,158 @@+module Test.Json (tests) where++import Data.Aeson qualified as Aeson+import Data.ByteString qualified as ByteString+import Data.Foldable (traverse_)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Time (UTCTime)+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.CLI+import Database.PostgreSQL.Migrate.Embed (ManifestError (EmptyManifest))+import Database.PostgreSQL.Migrate.Internal+  ( ComponentDescription (ComponentDescription),+    MigrationDescription (MigrationDescription),+    MigrationKind (..),+    TransactionMode (..),+  )+import Paths_pg_migrate_cli qualified as Paths+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "JSON schema v1"+    [ goldenCase "plan" planOutcome,+      goldenCase "status" statusOutcome,+      goldenCase "verify" verifyOutcome,+      goldenCase "up" upOutcome,+      goldenCase "repair" repairOutcome,+      goldenCase "error" errorOutcome,+      testCase "import matches its golden contract" testImportGolden,+      testCase "rendering is byte-for-byte stable" testStableRendering+    ]++goldenCase :: FilePath -> CliOutcome -> TestTree+goldenCase name outcome =+  testCase (name <> " matches its golden contract") $ do+    goldenPath <- Paths.getDataFileName ("test/golden/json/" <> name <> ".json")+    goldenBytes <- ByteString.readFile goldenPath+    expected <-+      case Aeson.eitherDecodeStrict' goldenBytes of+        Left decodeError -> assertFailure ("invalid golden JSON: " <> decodeError)+        Right value -> pure value+    renderMigrationCommandJson outcome @?= expected++testImportGolden :: Assertion+testImportGolden = do+  goldenPath <- Paths.getDataFileName "test/golden/json/import.json"+  goldenBytes <- ByteString.readFile goldenPath+  expected <-+    case Aeson.eitherDecodeStrict' goldenBytes of+      Left decodeError -> assertFailure ("invalid golden JSON: " <> decodeError)+      Right value -> pure value+  renderHistoryImportJson "codd" importReport @?= expected++testStableRendering :: Assertion+testStableRendering =+  traverse_+    ( \outcome ->+        Aeson.encode (renderMigrationCommandJson outcome)+          @?= Aeson.encode (renderMigrationCommandJson outcome)+    )+    fixtureOutcomes++fixtureOutcomes :: [CliOutcome]+fixtureOutcomes =+  [ planOutcome,+    statusOutcome,+    verifyOutcome,+    upOutcome,+    repairOutcome,+    errorOutcome+  ]++planOutcome :: CliOutcome+planOutcome =+  successful+    "plan"+    ( PlanPayload+        [ ComponentDescription+            accounts+            1+            Set.empty+            (MigrationDescription migrationIdentifier 1 emptyChecksum SqlKind Transactional :| [])+        ]+    )++statusOutcome :: CliOutcome+statusOutcome =+  successful "status" (StatusPayload (StatusReport [] [migrationIdentifier] [] []))++verifyOutcome :: CliOutcome+verifyOutcome =+  CliOutcome+    { command = "verify",+      exitClass = ExitVerificationFailed,+      payload =+        Right+          ( VerifyPayload+              (VerificationReport [PendingMigration migrationIdentifier] [] [migrationIdentifier] [])+          )+    }++upOutcome :: CliOutcome+upOutcome =+  successful+    "up"+    ( UpPayload+        ( MigrationReport+            fixtureStartedAt+            fixtureFinishedAt+            (MigrationResult migrationIdentifier AppliedNow (Just 0.125) :| [])+        )+    )++repairOutcome :: CliOutcome+repairOutcome =+  successful+    "repair"+    (RepairPayload (RepairReport migrationIdentifier MarkApplied Failed Applied))++errorOutcome :: CliOutcome+errorOutcome =+  CliOutcome+    { command = "check",+      exitClass = ExitUsageFailed,+      payload = Left (CliManifestError EmptyManifest)+    }++successful :: Text -> CliPayload -> CliOutcome+successful command payload = CliOutcome {command, exitClass = ExitSuccess, payload = Right payload}++accounts :: ComponentName+accounts = expectRight (componentName "accounts")++migrationIdentifier :: MigrationId+migrationIdentifier = expectRight (migrationId "accounts" "0001")++emptyChecksum :: MigrationChecksum+emptyChecksum = migrationFingerprint ByteString.empty++fixtureStartedAt :: UTCTime+fixtureStartedAt = read "2026-07-10 12:00:00 UTC"++fixtureFinishedAt :: UTCTime+fixtureFinishedAt = read "2026-07-10 12:00:01 UTC"++importReport :: HistoryImportReport+importReport =+  HistoryImportReport+    ( HistoryImportResult migrationIdentifier Imported+        :| [HistoryImportResult (expectRight (migrationId "accounts" "0002")) AlreadyImported]+    )++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id
+ test/unit/Test/Parser.hs view
@@ -0,0 +1,188 @@+module Test.Parser (tests) where++import Data.ByteString.Char8 qualified as ByteString+import Data.Foldable (traverse_)+import Data.List (isInfixOf)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Set qualified as Set+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.CLI+import Options.Applicative+import Paths_pg_migrate_cli qualified as Paths+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "parser"+    [ testCase "top-level help groups commands by operator intent" testGroupedHelp,+      testCase "verify help defines ledger verification narrowly" testVerifyHelp,+      testCase "up has no selective execution filters" testUpRejectsFilters,+      testCase "durations must be positive integer milliseconds" testDurationValidation,+      testCase "lock wait flags conflict" testConflictingWaitFlags,+      testCase "repair requires an operation and confirmation" testRepairConfirmation,+      testCase "repair validates the component/migration target" testRepairTarget,+      testCase "parsing does not imply database settings" testNoImplicitDatabaseSettings,+      testCase "plain completion derives all commands from the parser" testPlainCompletion,+      testCase "enriched completion derives execution flags and descriptions" testEnrichedCompletion,+      testGroup "help goldens" (uncurry goldenHelpCase <$> helpGoldens)+    ]++testGroupedHelp :: Assertion+testGroupedHelp = do+  helpText <- parseFailure ["--help"]+  assertContains "Inspection" helpText+  assertContains "plan" helpText+  assertContains "status" helpText+  assertContains "verify" helpText+  assertContains "list" helpText+  assertContains "check" helpText+  assertContains "Execution" helpText+  assertContains "up" helpText+  assertContains "repair" helpText+  assertContains "Authoring" helpText+  assertContains "new" helpText++testVerifyHelp :: Assertion+testVerifyHelp = do+  helpText <- parseFailure ["verify", "--help"]+  assertContains "declared plan" helpText+  assertContains "migration ledger" helpText+  assertContains "not live schema" helpText+  assertContains "snapshots" helpText+  assertContains "Connection" helpText+  assertContains "Output" helpText++testUpRejectsFilters :: Assertion+testUpRejectsFilters = do+  failure <- parseFailure ["up", "--component", "accounts"]+  assertContains "Invalid option" failure++testDurationValidation :: Assertion+testDurationValidation = do+  zeroFailure <- parseFailure ["up", "--lock-timeout", "0"]+  assertContains "positive integer" zeroFailure+  fractionalFailure <- parseFailure ["up", "--statement-timeout", "1.5"]+  assertContains "positive integer" fractionalFailure++testConflictingWaitFlags :: Assertion+testConflictingWaitFlags = do+  failure <- parseFailure ["up", "--no-wait", "--lock-timeout", "100"]+  assertContains "Invalid option" failure++testRepairConfirmation :: Assertion+testRepairConfirmation = do+  missingOperation <- parseFailure ["repair", "accounts/0001", "--reason", "inspected", "--confirm"]+  assertContains "mark-applied" missingOperation+  missingConfirmation <- parseFailure ["repair", "accounts/0001", "--mark-applied", "--reason", "inspected"]+  assertContains "confirm" missingConfirmation++testRepairTarget :: Assertion+testRepairTarget = do+  failure <- parseFailure ["repair", "accounts", "--mark-applied", "--reason", "inspected", "--confirm"]+  assertContains "COMPONENT/MIGRATION" failure++testNoImplicitDatabaseSettings :: Assertion+testNoImplicitDatabaseSettings =+  case parseSuccess ["status"] of+    Status StatusOptions {connection = ConnectionOptions {databaseSettings = Nothing}} -> pure ()+    result -> assertFailure ("expected status without database settings, received: " <> show result)++testPlainCompletion :: Assertion+testPlainCompletion = do+  completion <- completionOutput False 0 []+  traverse_ (\commandName -> assertContains commandName completion) expectedCommands++testEnrichedCompletion :: Assertion+testEnrichedCompletion = do+  commands <- completionOutput True 0 []+  assertContains "verify\tStrictly compare" commands+  flags <- completionOutput True 2 ["test-migrate", "up"]+  assertContains "--database-url\tPostgreSQL URI" flags+  assertContains "--lock-timeout\tWait at most" flags+  assertContains "--no-wait\tFail immediately" flags+  assertContains "--statement-timeout\tPositive PostgreSQL" flags+  assertContains "--json\tEmit JSON schema version 1" flags++completionOutput :: Bool -> Int -> [String] -> IO String+completionOutput enriched index wordsBeforeCursor =+  case execParserPure defaultPrefs commandInfo arguments of+    CompletionInvoked completion -> execCompletion completion "test-migrate"+    Failure failure -> assertFailure (fst (renderFailure failure "test-migrate"))+    Success parsedCommand -> assertFailure ("expected completion, received command: " <> show parsedCommand)+  where+    arguments =+      ["--bash-completion-enriched" | enriched]+        <> ["--bash-completion-index", show index]+        <> concatMap (\word -> ["--bash-completion-word", word]) wordsBeforeCursor++expectedCommands :: [String]+expectedCommands = ["plan", "status", "verify", "list", "check", "up", "repair", "new"]++goldenHelpCase :: FilePath -> [String] -> TestTree+goldenHelpCase name arguments =+  testCase name $ do+    goldenPath <- Paths.getDataFileName ("test/golden/help/" <> name <> ".txt")+    expected <- readFile goldenPath+    actual <- parseFailure (arguments <> ["--help"])+    normalizeHelp actual @?= expected++normalizeHelp :: String -> String+normalizeHelp = unlines . fmap (reverse . dropWhile (== ' ') . reverse) . lines++helpGoldens :: [(FilePath, [String])]+helpGoldens =+  [ ("top", []),+    ("plan", ["plan"]),+    ("status", ["status"]),+    ("verify", ["verify"]),+    ("list", ["list"]),+    ("check", ["check"]),+    ("up", ["up"]),+    ("repair", ["repair"]),+    ("new", ["new"])+  ]++commandInfo :: ParserInfo MigrationCommand+commandInfo =+  info+    (migrationCommandParser fixturePlan <**> helper)+    (fullDesc <> progDesc "Manage the fixture service migration plan")++parseSuccess :: [String] -> MigrationCommand+parseSuccess arguments =+  case execParserPure defaultPrefs commandInfo arguments of+    Success parsedCommand -> parsedCommand+    Failure failure ->+      let (message, _) = renderFailure failure "pg-migrate-cli-help-fixture"+       in error message+    CompletionInvoked _ -> error "unexpected completion"++parseFailure :: [String] -> IO String+parseFailure arguments =+  case execParserPure defaultPrefs commandInfo arguments of+    Failure failure -> pure (fst (renderFailure failure "pg-migrate-cli-help-fixture"))+    Success parsedCommand -> assertFailure ("expected parser failure, received: " <> show parsedCommand)+    CompletionInvoked _ -> assertFailure "expected parser failure, received completion"++assertContains :: String -> String -> Assertion+assertContains needle haystack =+  assertBool ("expected output to contain " <> show needle <> ", received:\n" <> haystack) (needle `isInfixOf` haystack)++fixturePlan :: MigrationPlan+fixturePlan =+  expectRight+    ( migrationPlan+        ( expectRight+            ( migrationComponent+                "accounts"+                Set.empty+                (expectRight (sqlMigration "0001" (ByteString.pack "SELECT 1")) :| [])+            )+            :| []+        )+    )++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id