pg-migrate-cli-1.1.0.0: src/Database/PostgreSQL/Migrate/CLI/Text.hs

module Database.PostgreSQL.Migrate.CLI.Text
  ( renderMigrationCommandText,
  )
where

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.CLI.Types (checksumText)
import Database.PostgreSQL.Migrate.Internal
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
    CliInputError err -> err
    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, cleanupIssues} =
  Text.unlines
    ( [ "started=" <> Text.pack (show startedAt),
        "finished=" <> Text.pack (show finishedAt)
      ]
        <> (renderMigrationResult <$> NonEmpty.toList results)
        <> (renderCleanupIssue <$> cleanupIssues)
    )

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 {repairedMigration, operation, oldStatus, newStatus, cleanupIssues} =
  Text.unlines
    ( Text.intercalate
        " "
        [ renderMigrationId repairedMigration,
          "operation=" <> renderRepairOperation operation,
          "old_status=" <> renderStatusName oldStatus,
          "new_status=" <> renderStatusName newStatus
        ]
        : (renderCleanupIssue <$> cleanupIssues)
    )

renderCleanupIssue :: CleanupIssue -> Text
renderCleanupIssue cleanupIssue = "cleanup_issue=" <> Text.pack (show cleanupIssue)

renderStoredMigrationId :: StoredMigration -> Text
renderStoredMigrationId StoredMigration {storedMigrationId} = renderMigrationId storedMigrationId

renderMigrationId :: MigrationId -> Text
renderMigrationId identifier =
  componentNameText (migrationIdComponent identifier)
    <> "/"
    <> migrationNameText (migrationIdName identifier)

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