Context.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

-- | ProjectedContext layer: projection functions and AppContext actions.
-- Orchestrates file I/O (via IOFunc) with domain computation.
-- Algorithm functions are in Algorithm.hs; parser functions are in Parser.hs.
-- IO is performed only through liftIOE / the injected IOFunc; no concrete
-- IO implementations are imported here.
module AIAgent.DiffPatch.Unified.ProjectedContext.Context
  ( normalize
  , detectLineEnding
  , restoreLineEnding
  , liftIOE
  , patchPC
  , diffPC
  , applyPatchText
  , formatPatch
  -- Re-exports for backward compatibility (used by tests and other modules)
  , module AIAgent.DiffPatch.Unified.ProjectedContext.Algorithm
  , module AIAgent.DiffPatch.Unified.ProjectedContext.Parser
  ) where

import qualified Data.Text as T
import Data.Text (Text)
import AIAgent.DiffPatch.Unified.CoreModel.Type
import AIAgent.DiffPatch.Unified.CoreModel.Constant

import AIAgent.DiffPatch.Unified.ProjectedContext.Algorithm
import AIAgent.DiffPatch.Unified.ProjectedContext.Parser

-- AppContext imports
import Control.Monad.Reader
import Control.Monad.Except
import qualified Control.Exception.Safe as E
import Data.Default


-- | Normalize line endings to LF.
-- Converts CRLF (\r\n) first, then bare CR (\r), to LF (\n).
-- This order is important: handling CR before CRLF would cause \r\n -> \n\n.
normalize :: Text -> Text
normalize = T.replace _CR _LF . T.replace _CRLF _LF

-- ---------------------------------------------------------------------------
-- Line-ending domain logic (moved from Interface layer)
-- ---------------------------------------------------------------------------

-- | Detect the dominant line-ending convention in a Text value.
-- CRLF must be tested before CR to avoid misidentifying "\r\n" as bare CR.
detectLineEnding :: Text -> Text
detectLineEnding t
  | _CRLF `T.isInfixOf` t = _CRLF
  | _CR   `T.isInfixOf` t = _CR
  | otherwise              = _LF

-- | Restore the original line-ending convention in a Text value.
-- Replaces every LF with the detected line-ending sequence.
-- When the original line-ending is already LF, this is a no-op.
restoreLineEnding :: Text -> Text -> Text
restoreLineEnding le txt
  | le == _LF = txt
  | otherwise = T.intercalate le (T.splitOn _LF txt)


-- ---------------------------------------------------------------------------
-- liftIOE helper
-- ---------------------------------------------------------------------------

-- | Lift an IO action into AppContext, catching synchronous exceptions
-- and converting them to ExceptT failures.
liftIOE :: IO a -> AppContext a
liftIOE f = liftIO (E.try f) >>= either (throwError . show @E.SomeException) return


-- ---------------------------------------------------------------------------
-- formatPatch
-- ---------------------------------------------------------------------------

-- | Serialize a Patch to unified diff format Text.
-- When _headerPatch is Nothing, the "--- ..." / "+++ ..." header lines are omitted.
-- The hunk header always uses the full form "@@ -s,c +s,c @@" without omitting
-- the count field even when count == 1.
formatPatch :: Patch -> Text
formatPatch p =
  headerText <> T.concat (map formatHunk (_hunksPatch p))
  where
    headerText = case _headerPatch p of
      Nothing     -> ""
      Just header ->
        "--- " <> _oldPathFileHeader header <> "\n" <>
        "+++ " <> _newPathFileHeader header <> "\n"

    formatHunk :: Hunk -> Text
    formatHunk hunk =
      hunkHeader <> T.concat (map formatLine (_linesHunk hunk))
      where
        hunkHeader =
          "@@ -" <> T.pack (show (_oldStartHunk hunk)) <> "," <> T.pack (show (_oldCountHunk hunk)) <>
          " +"   <> T.pack (show (_newStartHunk hunk)) <> "," <> T.pack (show (_newCountHunk hunk)) <>
          " @@\n"

    formatLine :: Line -> Text
    formatLine line = case _typeLine line of
      Context -> " " <> _contentLine line <> "\n"
      Removed -> "-" <> _contentLine line <> "\n"
      Added   -> "+" <> _contentLine line <> "\n"


-- ---------------------------------------------------------------------------
-- ProjectedContext actions: orchestrate IOFunc + domain computation
-- ---------------------------------------------------------------------------

-- | Core patch action used by both runPatch' and runPatchFile.
-- Reads the original file, applies the patch text, and writes the result
-- via '_writeIOFunc' (which may target a file or stdout).
-- Line-ending detection and restoration are performed here as domain logic.
patchPC :: FilePath -> String -> AppContext ()
patchPC origFile patchText = do
  ioFunc   <- asks _ioFuncAppData
  rawText  <- liftIOE $ _readIOFunc ioFunc origFile
  let le       = detectLineEnding rawText
      origText = normalize rawText
  result   <- either throwError return $ applyPatchText origText (T.pack patchText)
  let resultRestored = restoreLineEnding le result
  liftIOE  $ _writeIOFunc ioFunc origFile resultRestored

-- | Core diff action.
-- Reads both files, normalises line endings, computes the unified diff,
-- and writes the result via '_writeIOFunc'.
diffPC :: FilePath -> FilePath -> AppContext ()
diffPC oldFile newFile = do
  ioFunc  <- asks _ioFuncAppData
  rawOld  <- liftIOE $ _readIOFunc ioFunc oldFile
  rawNew  <- liftIOE $ _readIOFunc ioFunc newFile
  let oldText = normalize rawOld
      newText = normalize rawNew
      edits   = myers (T.lines oldText) (T.lines newText)
      hunks   = buildHunks (_contextLinesDiffOptions (def :: DiffOptions)) edits
      result  = formatPatch (Patch Nothing hunks)
  liftIOE $ _writeIOFunc ioFunc oldFile result


-- ---------------------------------------------------------------------------
-- Pure helper: apply a patch text to normalised Text
-- ---------------------------------------------------------------------------

-- | Parse a unified diff string and apply it to the source Text.
-- The source Text must be LF-normalised before calling this function.
-- Returns the patched Text (LF-terminated) on success, or an error message on failure.
applyPatchText :: T.Text -> T.Text -> Either String T.Text
applyPatchText origText patchTxt
  | T.null patchTxt = Right origText
  | otherwise =
      case parsePatch patchTxt of
        Left  err -> Left (show err)
        Right p   ->
          let origLines = T.lines origText
          in  case applyAllHunks origLines (_hunksPatch p) of
                Left  err     -> Left (show err)
                Right patched -> Right patched
  where
    joinLines []  = ""
    joinLines ls  = T.intercalate _LF ls <> _LF

    applyAllHunks ls hunks = joinLines <$> go 0 1 ls hunks

    go _     _        buf []     = Right buf
    go delta hunkIdx  buf (h:hs) =
      let h'     = h { _oldStartHunk = _oldStartHunk h + delta }
          delta' = delta + (_newCountHunk h - _oldCountHunk h)
      in  case applyHunkFuzzy hunkIdx buf h' of
            Left  err  -> Left err
            Right buf' -> go delta' (hunkIdx + 1) buf' hs