os-ai-pr-bot/src/Bot/Review.hs

module Bot.Review
  ( handleEvent
  ) where

import Control.Exception (SomeException, catch)
import Data.Text (Text)
import Data.Text qualified as T
import System.IO (hPutStrLn, stderr)

import Bot.Claude
import Bot.Config (Config (..))
import Bot.Event
import Bot.Gitea
import Bot.Prompt
import Bot.Trigger

handleEvent :: Config -> Event -> IO ()
handleEvent cfg event = do
  client <- newGiteaClient cfg

  -- Auto-detect bot username for loop prevention
  botUser <- getCurrentUser client
  let cfg' = cfg { cfgBotUser = botUser }
  putStrLn $ "Bot user: " <> T.unpack botUser

  -- Check trigger
  case checkTrigger cfg' event of
    NotTriggered -> putStrLn "No trigger found, exiting."
    Triggered prNum -> do
      -- Loop prevention: skip events from bot itself
      let sender = eventSender event
      if sender == cfgBotUser cfg'
        then putStrLn $ "Skipping event from bot user: " <> T.unpack sender
        else dispatch cfg' client event prNum

dispatch :: Config -> GiteaClient -> Event -> Int -> IO ()
dispatch cfg client event prNum = do
  -- Create tracking comment
  commentId <- createComment client prNum "\x23F3 Thinking..."
  putStrLn $ "Created tracking comment: " <> show commentId

  -- Ensure tracking comment is updated even on error
  let jobUrl = cfgGiteaUrl cfg <> "/" <> cfgRepoOwner cfg <> "/" <> cfgRepoName cfg
             <> "/actions/runs/" <> cfgRunId cfg

  let onError :: SomeException -> IO ()
      onError ex = do
        let errMsg = T.pack (show ex)
        hPutStrLn stderr $ "Error: " <> T.unpack errMsg
        let body = T.unlines
              [ "**Claude** encountered an error \x2014 [View job run](" <> jobUrl <> ")"
              , ""
              , T.take 2000 errMsg
              ]
        updateComment client commentId body
          `catch` \(_ :: SomeException) -> pure ()

  let run = do
        -- Gather PR context
        ctx <- gatherContext client prNum

        case event of
          EvPullRequest _ -> do
            handleReview cfg client event prNum commentId jobUrl ctx

          EvIssueComment _ -> do
            handleReview cfg client event prNum commentId jobUrl ctx

          EvPRReview prre -> do
            handleReply cfg client (prreReviewBody prre) prNum commentId jobUrl ctx

          EvPRReviewComment prrce -> do
            handleReply cfg client (prrceCommentBody prrce) prNum commentId jobUrl ctx

  run `catch` onError

gatherContext :: GiteaClient -> Int -> IO PRContext
gatherContext client prNum = do
  prInfo   <- getPrInfo client prNum
  diff     <- getPrDiff client prNum
  comments <- getIssueComments client prNum
  reviews  <- getPrReviews client prNum
  pure PRContext
    { ctxPrInfo   = prInfo
    , ctxDiff     = diff
    , ctxComments = comments
    , ctxReviews  = reviews
    }

handleReview :: Config -> GiteaClient -> Event -> Int -> Int -> Text -> PRContext -> IO ()
handleReview cfg client event prNum commentId jobUrl ctx = do
  let prompt = buildReviewPrompt cfg event ctx
  result <- invokeClaudeReview prompt
  case result of
    Left err -> do
      hPutStrLn stderr $ "Claude review error: " <> err
      let body = T.unlines
            [ "**Claude** encountered an error \x2014 [View job run](" <> jobUrl <> ")"
            , ""
            , T.pack err
            ]
      updateComment client commentId body

    Right review -> do
      -- Update tracking comment with summary
      let sender = eventSender event
          body = T.unlines
            [ "**Claude** reviewed @" <> sender <> "'s PR \x2014 [View job run](" <> jobUrl <> ")"
            , ""
            , "---"
            , ""
            , roSummary review
            ]
      updateComment client commentId body

      -- Post review with inline comments if any
      let inlineComments = map toInlineComment (roComments review)
      if null inlineComments
        then pure ()
        else postReviewWithFallback client prNum (roSummary review) inlineComments

handleReply :: Config -> GiteaClient -> Text -> Int -> Int -> Text -> PRContext -> IO ()
handleReply cfg client triggerBody _prNum commentId jobUrl ctx = do
  let prompt = buildReplyPrompt cfg triggerBody ctx
  result <- invokeClaudeReply prompt
  case result of
    Left err -> do
      hPutStrLn stderr $ "Claude reply error: " <> err
      let body = T.unlines
            [ "**Claude** encountered an error \x2014 [View job run](" <> jobUrl <> ")"
            , ""
            , T.pack err
            ]
      updateComment client commentId body

    Right replyText -> do
      let body = T.unlines
            [ "**Claude** responded \x2014 [View job run](" <> jobUrl <> ")"
            , ""
            , "---"
            , ""
            , replyText
            ]
      updateComment client commentId body

toInlineComment :: ClaudeComment -> InlineComment
toInlineComment cc = InlineComment
  { icPath        = ccPath cc
  , icNewPosition = ccLine cc
  , icBody        = ccComment cc
  }

-- Try posting review with inline comments; on failure, retry with summary only
postReviewWithFallback :: GiteaClient -> Int -> Text -> [InlineComment] -> IO ()
postReviewWithFallback client prNum summary comments = do
  postReview client prNum summary comments
    `catch` \(_ :: SomeException) -> do
      hPutStrLn stderr "Failed to post review with inline comments, retrying without..."
      postReview client prNum summary []
        `catch` \(_ :: SomeException) ->
          hPutStrLn stderr "Failed to post summary-only review as well."

eventSender :: Event -> Text
eventSender = \case
  EvPullRequest pre       -> preSender pre
  EvIssueComment ice      -> iceSender ice
  EvPRReview prre         -> prreSender prre
  EvPRReviewComment prrce -> prrceSender prrce