packages feed

seihou-cli-0.4.0.0: src/Seihou/CLI/CommitMessage.hs

module Seihou.CLI.CommitMessage
  ( generateCommitMessage,
    stripCodeFence,
  )
where

import Control.Exception (SomeException, try)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Seihou.Core.Types (ModuleName (..))
import System.Directory (findExecutable)
import System.Exit (ExitCode (..))
import System.IO (hClose)
import System.Process (CreateProcess (..), StdStream (..), createProcess, proc, waitForProcess)

-- | Generate a commit message using Claude Code CLI.
-- Takes the module names applied and the staged diff.
-- Returns the AI-generated message, or a fallback if claude is unavailable.
generateCommitMessage :: [ModuleName] -> T.Text -> IO T.Text
generateCommitMessage modNames diffText = do
  claudePath <- findExecutable "claude"
  case claudePath of
    Nothing -> pure (fallbackMessage modNames)
    Just _ -> do
      result <- callClaude modNames diffText
      case result of
        Nothing -> pure (fallbackMessage modNames)
        Just msg
          | T.null (T.strip msg) -> pure (fallbackMessage modNames)
          | otherwise -> pure (stripCodeFence (T.strip msg))

callClaude :: [ModuleName] -> T.Text -> IO (Maybe T.Text)
callClaude modNames diffText = do
  let prompt = buildPrompt modNames diffText
      cp =
        (proc "claude" ["-p", T.unpack prompt])
          { std_out = CreatePipe,
            std_err = CreatePipe,
            std_in = NoStream
          }
  result <- try @SomeException $ do
    (_, Just hOut, Just hErr, ph) <- createProcess cp
    output <- TIO.hGetContents hOut
    _ <- TIO.hGetContents hErr
    exitCode <- waitForProcess ph
    hClose hOut
    hClose hErr
    pure (exitCode, output)
  case result of
    Left _ -> pure Nothing
    Right (ExitSuccess, output) -> pure (Just output)
    Right (ExitFailure _, _) -> pure Nothing

buildPrompt :: [ModuleName] -> T.Text -> T.Text
buildPrompt modNames diffText =
  T.unlines
    [ "Generate a concise git commit message for seihou scaffolding changes.",
      "",
      "Modules applied: " <> moduleList,
      "",
      "Staged changes:",
      diffText,
      "",
      "Rules:",
      "- Use conventional commit style (e.g., \"feat: ...\", \"chore: ...\")",
      "- Keep the subject line under 72 characters",
      "- Mention which seihou module(s) were applied",
      "- Output ONLY the commit message, nothing else",
      "- Do not wrap the output in backticks or code fences"
    ]
  where
    moduleList = T.intercalate ", " (map (.unModuleName) modNames)

-- | Strip markdown code-fence wrapping (``` ... ```) from text.
-- Handles optional language tags (e.g., ```text).
stripCodeFence :: T.Text -> T.Text
stripCodeFence txt =
  let ls = T.lines txt
      nonEmpty = filter (not . T.null . T.strip) ls
   in case nonEmpty of
        (first : rest)
          | "```" `T.isPrefixOf` first,
            not (null rest),
            T.strip (last rest) == "```" ->
              let -- Drop the opening fence line and closing fence line
                  body = drop 1 (take (length ls - 1) ls)
               in T.strip (T.unlines body)
        _ -> txt

fallbackMessage :: [ModuleName] -> T.Text
fallbackMessage [] = "seihou: apply modules"
fallbackMessage [m] = "seihou: apply module " <> m.unModuleName
fallbackMessage ms = "seihou: apply modules " <> T.intercalate ", " (map (.unModuleName) ms)