Render.hs

module Seihou.CLI.Update.Render
  ( UpdateOutput (..),
    UpdatePlanView,
    UpdateResultView,
    UpdateErrorView,
    planOutput,
    resultOutput,
    errorOutput,
    renderUpdateHuman,
    encodeUpdateOutput,
  )
where

import Data.Aeson (Value, encode, object, (.=))
import Data.ByteString.Lazy (ByteString)
import Data.Generics.Labels ()
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Set qualified as Set
import Data.Text qualified as T
import Seihou.CLI.CommandExecution
  ( CommandDisposition (..),
    CommandPlan (..),
    CommandPlanSummary (..),
    PlannedCommand (..),
    summarizeCommandPlan,
  )
import Seihou.CLI.Update.Types
import Seihou.Core.Migration (MigrationPlan (..))
import Seihou.Core.Types
  ( ApplicationId (..),
    AppliedComposition (..),
    AppliedTarget (..),
    BaselineRef (..),
    CommandFingerprint (..),
    ModuleName (..),
    Operation (..),
    RecipeName (..),
    SHA256 (..),
    VarName (..),
  )
import Seihou.Engine.Reconcile
  ( DesiredFile (..),
    FileConflictChoice (..),
    FileReconciliation (..),
    OrphanChoice (..),
    ReconciliationPlan (..),
    ReconciliationSummary (..),
    ResolvedFileConflict (..),
    reconciliationSummary,
  )
import Seihou.Prelude

newtype UpdatePlanView = UpdatePlanView UpdatePlan

newtype UpdateResultView = UpdateResultView UpdateResult

newtype UpdateErrorView = UpdateErrorView UpdateError

data UpdateOutput
  = UpdatePlanOutput UpdatePlanView
  | UpdateAppliedOutput UpdateResultView
  | UpdateFailedOutput UpdateErrorView

planOutput :: UpdatePlan -> UpdateOutput
planOutput = UpdatePlanOutput . UpdatePlanView

resultOutput :: UpdateResult -> UpdateOutput
resultOutput = UpdateAppliedOutput . UpdateResultView

errorOutput :: UpdateError -> UpdateOutput
errorOutput = UpdateFailedOutput . UpdateErrorView

renderUpdateHuman :: Bool -> UpdateOutput -> Text
renderUpdateHuman _ (UpdatePlanOutput (UpdatePlanView plan)) =
  T.unlines $
    versionLines plan
      <> [ renderInputs (plan ^. #inputChanges),
           "Migrations:  " <> count (length (plan ^. #migrations)) <> migrationCaveat plan,
           renderFiles (reconciliationSummary (plan ^. #reconciliation)),
           renderCommands (summarizeCommandPlan (plan ^. #commandPlan))
         ]
      <> conflictLines (plan ^. #reconciliation)
      <> warningLines (plan ^. #warnings)
renderUpdateHuman _ (UpdateAppliedOutput (UpdateResultView result)) =
  T.unlines $
    [ "Updated " <> count (length (result ^. #updatedApplications)) <> " application(s).",
      renderFiles (result ^. #fileSummary),
      "Commands:    "
        <> count (result ^. #commandSummary . #executed)
        <> " executed; "
        <> count (result ^. #commandSummary . #skippedUnchanged)
        <> " unchanged skipped; "
        <> count (result ^. #commandSummary . #skippedDisabled)
        <> " disabled"
    ]
      <> warningLines (result ^. #warnings)
renderUpdateHuman _ (UpdateFailedOutput (UpdateErrorView err)) =
  "Update failed [" <> errorCode err <> "]: " <> errorMessage err <> "\n"

encodeUpdateOutput :: UpdateOutput -> ByteString
encodeUpdateOutput = encode . outputValue

outputValue :: UpdateOutput -> Value
outputValue (UpdatePlanOutput (UpdatePlanView plan)) =
  object
    [ "schemaVersion" .= (1 :: Int),
      "outcome" .= ("plan" :: Text),
      "alreadyUpToDate" .= planLooksUnchanged plan,
      "applications" .= map applicationIdText (plan ^. #applications),
      "versions" .= map versionValue (plan ^. #versionChanges),
      "inputs" .= inputValue (plan ^. #inputChanges),
      "migrations" .= map migrationValue (plan ^. #migrations),
      "files" .= map fileValue (Map.toAscList (plan ^. #reconciliation . #files)),
      "commands" .= map commandValue (plan ^. #commandPlan . #commands),
      "warnings" .= map warningText (plan ^. #warnings)
    ]
outputValue (UpdateAppliedOutput (UpdateResultView result)) =
  object
    [ "schemaVersion" .= (1 :: Int),
      "outcome" .= ("applied" :: Text),
      "applications" .= map (^. #unApplicationId) (result ^. #updatedApplications),
      "versions" .= map versionValue (result ^. #versions),
      "files" .= summaryValue (result ^. #fileSummary),
      "commands"
        .= object
          [ "executed" .= (result ^. #commandSummary . #executed),
            "skippedUnchanged" .= (result ^. #commandSummary . #skippedUnchanged),
            "skippedDisabled" .= (result ^. #commandSummary . #skippedDisabled)
          ],
      "touchedPaths" .= Set.toAscList (result ^. #touchedPaths),
      "warnings" .= map warningText (result ^. #warnings)
    ]
outputValue (UpdateFailedOutput (UpdateErrorView err)) =
  object
    [ "schemaVersion" .= (1 :: Int),
      "outcome" .= ("error" :: Text),
      "error" .= object ["code" .= errorCode err, "message" .= errorMessage err]
    ]

versionLines :: UpdatePlan -> [Text]
versionLines plan
  | null (plan ^. #versionChanges) = ["Versions:    unchanged"]
  | otherwise = map renderVersionChange (plan ^. #versionChanges)

renderVersionChange :: VersionChange -> Text
renderVersionChange change =
  change ^. #name
    <> "  "
    <> fromMaybe "unversioned" (change ^. #fromVersion)
    <> " -> "
    <> fromMaybe "unversioned" (change ^. #toVersion)
    <> if change ^. #sameVersionContentChanged then " (content changed at same version)" else ""

renderInputs :: InputChangeSummary -> Text
renderInputs summary =
  "Inputs:      "
    <> count (summary ^. #reused)
    <> " reused; "
    <> count (summary ^. #overridden)
    <> " overridden; "
    <> count (summary ^. #newlyResolved)
    <> " newly resolved; "
    <> count (summary ^. #removed)
    <> " removed"

renderFiles :: ReconciliationSummary -> Text
renderFiles summary =
  "Files:       "
    <> count (summary ^. #creates)
    <> " created; "
    <> count (summary ^. #updates)
    <> " updated; "
    <> count (summary ^. #merged)
    <> " merged; "
    <> count (summary ^. #unchanged)
    <> " unchanged; "
    <> count (summary ^. #conflicts)
    <> " conflicts; "
    <> count (summary ^. #safeDeletes)
    <> " deleted; "
    <> count (summary ^. #editedOrphans)
    <> " edited orphans"

renderCommands summary =
  "Commands:    "
    <> count (summary ^. #willRun)
    <> " will run; "
    <> count (summary ^. #skippedUnchanged)
    <> " unchanged skipped; "
    <> count (summary ^. #skippedDisabled)
    <> " disabled"

migrationCaveat plan
  | any (^. #containsCommands) (plan ^. #migrations) = " (includes non-simulatable commands)"
  | otherwise = ""

conflictLines :: ReconciliationPlan -> [Text]
conflictLines reconciliation = concatMap renderOne (Map.toAscList (reconciliation ^. #files))
  where
    renderOne (path, FileConflict _ _ _ reason _ _ resolution) =
      [ "Conflict:    "
          <> T.pack path
          <> " ("
          <> T.pack (show reason)
          <> maybe "; unresolved" (("; " <>) . resolutionText . (^. #choice)) resolution
          <> ")"
      ]
    renderOne (path, FileOrphanEdited _ _ _ _ choice) =
      [ "Orphan:      "
          <> T.pack path
          <> maybe " (unresolved)" ((" (" <>) . (<> ")") . orphanChoiceText) choice
      ]
    renderOne _ = []

warningLines :: [UpdateWarning] -> [Text]
warningLines = map (("Warning:     " <>) . warningText)

versionValue :: VersionChange -> Value
versionValue change =
  object
    [ "name" .= (change ^. #name),
      "from" .= (change ^. #fromVersion),
      "to" .= (change ^. #toVersion),
      "sameVersionContentChanged" .= (change ^. #sameVersionContentChanged)
    ]

inputValue :: InputChangeSummary -> Value
inputValue summary =
  object
    [ "reused" .= (summary ^. #reused),
      "overridden" .= (summary ^. #overridden),
      "newlyResolved" .= (summary ^. #newlyResolved),
      "removed" .= (summary ^. #removed),
      "ambiguousLegacy" .= map (^. #unVarName) (summary ^. #ambiguousLegacy)
    ]

migrationValue :: PlannedUpdateMigration -> Value
migrationValue migration =
  object
    [ "module" .= (migration ^. #moduleName . #unModuleName),
      "from" .= showText (migration ^. #sourcePlan . #from),
      "to" .= showText (migration ^. #sourcePlan . #to),
      "steps" .= length (migration ^. #sourcePlan . #steps),
      "containsCommands" .= (migration ^. #containsCommands)
    ]

fileValue :: (FilePath, FileReconciliation) -> Value
fileValue (path, reconciliation) =
  object
    [ "path" .= path,
      "classification" .= classification reconciliation,
      "resolution" .= resolutionFor reconciliation
    ]

classification :: FileReconciliation -> Text
classification FileCreate {} = "create"
classification FileUpdate {} = "update"
classification FileAutoMerge {} = "autoMerge"
classification FileUnchanged {} = "unchanged"
classification FileConflict {} = "conflict"
classification FileDeleteSafe {} = "safeDelete"
classification FileOrphanEdited {} = "editedOrphan"
classification FileReleaseSharedOwnership {} = "releaseSharedOwnership"
classification FileAlreadyAbsent {} = "alreadyAbsent"

resolutionFor :: FileReconciliation -> Maybe Text
resolutionFor (FileConflict _ _ _ _ _ _ resolution) = resolutionText . (^. #choice) <$> resolution
resolutionFor (FileOrphanEdited _ _ _ _ choice) = orphanChoiceText <$> choice
resolutionFor _ = Nothing

commandValue :: PlannedCommand -> Value
commandValue planned =
  object
    [ "fingerprint" .= fingerprintText (planned ^. #fingerprint),
      "status" .= dispositionText (planned ^. #disposition),
      "module" .= commandModule (planned ^. #operation),
      "command" .= commandText (planned ^. #operation)
    ]

commandModule :: Operation -> Maybe Text
commandModule RunCommandOp {moduleName} = Just (moduleName ^. #unModuleName)
commandModule _ = Nothing

commandText :: Operation -> Maybe Text
commandText RunCommandOp {command} = Just command
commandText _ = Nothing

dispositionText :: CommandDisposition -> Text
dispositionText CommandWillRun = "willRun"
dispositionText CommandSkippedUnchanged = "skippedUnchanged"
dispositionText CommandSkippedDisabled = "skippedDisabled"

resolutionText :: FileConflictChoice -> Text
resolutionText AcceptGenerated = "useGenerated"
resolutionText KeepCurrent = "keepCurrent"
resolutionText WriteConflictMarkers = "writeConflictMarkers"
resolutionText AbortUpdate = "abort"

orphanChoiceText :: OrphanChoice -> Text
orphanChoiceText DeleteEditedOrphan = "delete"
orphanChoiceText RetainTrackedOrphan = "retainTracked"
orphanChoiceText DetachAndKeepOrphan = "detachAndKeep"
orphanChoiceText AbortOrphanUpdate = "abort"

summaryValue :: ReconciliationSummary -> Value
summaryValue summary =
  object
    [ "created" .= (summary ^. #creates),
      "updated" .= (summary ^. #updates),
      "merged" .= (summary ^. #merged),
      "unchanged" .= (summary ^. #unchanged),
      "conflicts" .= (summary ^. #conflicts),
      "safeDeletes" .= (summary ^. #safeDeletes),
      "editedOrphans" .= (summary ^. #editedOrphans),
      "sharedOwnership" .= (summary ^. #sharedOwnership)
    ]

applicationIdText :: AppliedComposition -> Text
applicationIdText application = (application ^. #applicationId . #unApplicationId)

fingerprintText :: CommandFingerprint -> Text
fingerprintText (CommandFingerprint (SHA256 value)) = value

warningText :: UpdateWarning -> Text
warningText = T.pack . show

errorCode :: UpdateError -> Text
errorCode UpdateManifestMissing {} = "manifest_missing"
errorCode UpdateManifestUnreadable {} = "manifest_unreadable"
errorCode NoRecordedApplications = "no_recorded_applications"
errorCode LegacyUpdateRequiresOneTarget = "legacy_update_requires_one_target"
errorCode UpdateTargetNotFound {} = "target_not_found"
errorCode SharedPathRequiresApplications {} = "shared_path_requires_applications"
errorCode CandidateCloneFailed {} = "candidate_clone_failed"
errorCode CandidateRepositoryInvalid {} = "candidate_repository_invalid"
errorCode CandidateArtifactMissing {} = "candidate_artifact_missing"
errorCode CandidateArtifactUnresolved {} = "candidate_artifact_unresolved"
errorCode CandidateArtifactAmbiguous {} = "candidate_artifact_ambiguous"
errorCode CandidateLoadFailed {} = "candidate_load_failed"
errorCode CandidateDowngrade {} = "candidate_downgrade"
errorCode CandidateVersionInvalid {} = "candidate_version_invalid"
errorCode UpdateConflictingPriorVersions {} = "conflicting_prior_versions"
errorCode UpdateVariableErrors {} = "variable_errors"
errorCode UpdateConfigurationFailed {} = "configuration_failed"
errorCode UpdateMigrationPlanFailed {} = "migration_plan_failed"
errorCode UpdateMigrationStageFailed {} = "migration_stage_failed"
errorCode UpdateCompositionFailed {} = "composition_failed"
errorCode UpdateReconciliationFailed {} = "reconciliation_failed"
errorCode UpdateHasUnresolvedPaths {} = "unresolved_paths"
errorCode UpdateRecoveryFailed {} = "recovery_failed"
errorCode UpdatePlanStale {} = "plan_stale"
errorCode UpdateTransactionFailed {} = "transaction_failed"
errorCode UpdateMigrationFailed {} = "migration_failed"
errorCode UpdateChangedAfterMigrationCommand {} = "changed_after_migration_command"
errorCode UpdateCommandFailed {} = "command_failed"
errorCode UpdateCachePublicationFailed {} = "cache_publication_failed"
errorCode UpdateManifestWriteFailed {} = "manifest_write_failed"

errorMessage :: UpdateError -> Text
errorMessage (UpdateManifestMissing path) =
  "No Seihou manifest was found at " <> T.pack path <> ". Run seihou run first."
errorMessage (UpdateTargetNotFound target available) =
  "No recorded application matches '"
    <> target
    <> "'. Available targets: "
    <> T.intercalate ", " available
errorMessage (SharedPathRequiresApplications path selected required) =
  "Path "
    <> T.pack path
    <> " is also owned by application(s) "
    <> T.intercalate ", " (map (^. #unApplicationId) (Set.toAscList required))
    <> ". Select every owner or run seihou update with no targets. Selected: "
    <> T.intercalate ", " (map (^. #unApplicationId) (Set.toAscList selected))
errorMessage (UpdateHasUnresolvedPaths paths) =
  "Resolve these paths before apply: " <> T.intercalate ", " (map T.pack (Set.toAscList paths))
errorMessage (UpdatePlanStale paths) =
  "The project changed after planning: " <> T.intercalate ", " (map T.pack (Set.toAscList paths))
errorMessage err = T.pack (show err)

planLooksUnchanged :: UpdatePlan -> Bool
planLooksUnchanged plan =
  null (plan ^. #versionChanges)
    && null (plan ^. #migrations)
    && plan ^. #inputChanges . #overridden == 0
    && plan ^. #inputChanges . #newlyResolved == 0
    && plan ^. #inputChanges . #removed == 0
    && (summarizeCommandPlan (plan ^. #commandPlan)) ^. #willRun == 0
    && all isUnchanged (Map.elems (plan ^. #reconciliation . #files))
  where
    isUnchanged FileUnchanged {} = True
    isUnchanged _ = False

count :: Int -> Text
count = T.pack . show

showText :: (Show a) => a -> Text
showText = T.pack . show