packages feed

seihou-core-0.4.0.0: src/Seihou/Engine/Conflict.hs

module Seihou.Engine.Conflict
  ( resolveConflicts,
    resolveConflictsInteractive,
  )
where

import Data.Text qualified as T
import Seihou.Core.Types (ConflictFile (..), ConflictResolution (..))
import Seihou.Effect.Console (Console, getLine, isInteractive, putText)
import Seihou.Prelude
import Prelude hiding (getLine)

-- | Resolve a list of conflicts, returning per-file resolutions.
--
-- Returns 'Just' with the list of resolutions when all conflicts are handled,
-- or 'Nothing' when the run should abort (non-interactive without force, or
-- user chose Abort).
--
-- Behavior:
--   * Empty conflict list → @Just []@.
--   * @force = True@ → all conflicts resolved as 'AcceptNew'.
--   * Non-interactive terminal → 'Nothing' (caller should print errors and exit).
--   * Interactive terminal → prompts user for each file via 'resolveConflictsInteractive'.
resolveConflicts ::
  (Console :> es) =>
  Bool ->
  [ConflictFile] ->
  Eff es (Maybe [(ConflictFile, ConflictResolution)])
resolveConflicts _ [] = pure (Just [])
resolveConflicts force conflicts
  | force = pure (Just (map (\c -> (c, AcceptNew)) conflicts))
  | otherwise = do
      interactive <- isInteractive
      if interactive
        then resolveConflictsInteractive conflicts
        else pure Nothing

-- | Interactively prompt for each conflicted file.
--
-- For each conflict, displays the file path and offers four choices:
-- accept (overwrite), keep (preserve disk copy), skip (leave untouched),
-- or abort (stop the entire run).
--
-- Returns 'Nothing' if the user chooses Abort on any file.
resolveConflictsInteractive ::
  (Console :> es) =>
  [ConflictFile] ->
  Eff es (Maybe [(ConflictFile, ConflictResolution)])
resolveConflictsInteractive = go []
  where
    go acc [] = pure (Just (reverse acc))
    go acc (c : cs) = do
      resolution <- promptConflict c
      case resolution of
        Abort -> pure Nothing
        _ -> go ((c, resolution) : acc) cs

-- | Prompt the user for a single conflict, re-prompting on invalid input.
promptConflict ::
  (Console :> es) =>
  ConflictFile ->
  Eff es ConflictResolution
promptConflict c = do
  putText $ "Conflict: " <> T.pack c.path <> " (modified since last generation)"
  promptChoice
  where
    promptChoice = do
      putText "  [a]ccept new  [k]eep current  [s]kip  [A]bort all"
      input <- getLine
      case parseChoice (T.strip input) of
        Just res -> pure res
        Nothing -> do
          putText "Invalid choice, try again."
          promptChoice

-- | Parse user input into a ConflictResolution.
parseChoice :: T.Text -> Maybe ConflictResolution
parseChoice "a" = Just AcceptNew
parseChoice "accept" = Just AcceptNew
parseChoice "k" = Just KeepCurrent
parseChoice "keep" = Just KeepCurrent
parseChoice "s" = Just Skip
parseChoice "skip" = Just Skip
parseChoice "A" = Just Abort
parseChoice "abort" = Just Abort
parseChoice _ = Nothing