packages feed

baikai-claude-0.5.0.0: src/Baikai/Provider/Claude/Interactive.hs

-- | Launch real interactive Claude Code sessions from Baikai's
-- provider-neutral interactive request type.
--
-- This module is intentionally separate from
-- "Baikai.Provider.Claude.Cli": that module drives @claude -p@ as a
-- batch completion provider, while this module starts the interactive
-- terminal UI and returns only after the CLI exits.
--
-- A safety policy Claude Code cannot express is refused before launch
-- rather than dropped: both the pure command builder and the launcher
-- return 'Either' 'AgentRenderError', and a 'Left' means no process was
-- started.
module Baikai.Provider.Claude.Interactive
  ( ClaudeInteractiveConfig,
    executable,
    extraArgs,
    defaultClaudeInteractiveConfig,
    claudeInteractiveCommand,
    launchClaudeInteractive,
  )
where

import Baikai.Agent (AgentProvider (..), AgentRenderError (..))
import Baikai.Interactive
  ( InteractiveLaunchRequest,
    InteractiveLaunchResult,
    InteractiveProvider (..),
    InteractiveSafety (..),
    interactiveLaunchResult,
    renderCodexApprovalPolicy,
    renderCodexSandboxMode,
  )
import Baikai.Prelude
import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel)
import Cradle (addArgs, cmd, run, setWorkingDir)
import Data.Generics.Labels ()
import Data.Text qualified as Text

-- | Configuration for the interactive @claude@ process.
data ClaudeInteractiveConfig = ClaudeInteractiveConfig
  { executable :: !FilePath,
    extraArgs :: ![Text]
  }
  deriving stock (Eq, Show, Generic)

defaultClaudeInteractiveConfig :: ClaudeInteractiveConfig
defaultClaudeInteractiveConfig =
  ClaudeInteractiveConfig
    { executable = "claude",
      extraArgs = mempty
    }

-- | Render the executable and arguments for an interactive Claude
-- Code launch. The final positional argument is the initial user
-- prompt. The prompt is preceded by @--@ because Claude's
-- @--allowedTools@ and @--add-dir@ flags are variadic.
--
-- Returns 'Left' when the request's safety policy is one Claude Code
-- cannot express, so a caller who asked to be constrained never
-- receives a command that is not.
claudeInteractiveCommand ::
  ClaudeInteractiveConfig ->
  InteractiveLaunchRequest ->
  Either AgentRenderError (FilePath, [String])
claudeInteractiveCommand cfg req = do
  safety <- safetyArgs req
  pure
    ( cfg ^. #executable,
      modelArgs req
        <> effortArgs req
        <> systemPromptArgs req
        <> extraDirArgs req
        <> safety
        <> fmap Text.unpack (cfg ^. #extraArgs)
        <> fmap Text.unpack (req ^. #extraArgs)
        <> ["--", Text.unpack (req ^. #userPrompt)]
    )

-- | Launch Claude Code with inherited stdin, stdout, and stderr so
-- the local CLI owns the interactive terminal experience.
--
-- A 'Left' result means no process was started: the requested safety
-- policy was refused before launch. A 'Right' carrying a non-zero
-- 'System.Exit.ExitCode' means the session ran and exited non-zero.
launchClaudeInteractive ::
  ClaudeInteractiveConfig ->
  InteractiveLaunchRequest ->
  IO (Either AgentRenderError InteractiveLaunchResult)
launchClaudeInteractive cfg req = case claudeInteractiveCommand cfg req of
  Left err -> pure (Left err)
  Right (exe, args) -> do
    code <-
      run $
        cmd exe
          & addArgs args
          & maybe id setWorkingDir (req ^. #workingDir)
    pure (Right (interactiveLaunchResult InteractiveClaude code))

modelArgs :: InteractiveLaunchRequest -> [String]
modelArgs req = case Text.strip <$> req ^. #modelId of
  Nothing -> []
  Just "" -> []
  Just mid -> ["--model", Text.unpack mid]

-- | Claude's @--effort@ accepts @low|medium|high|xhigh|max@, but
-- not @minimal@, so the lowest Baikai level maps up to @low@.
effortArgs :: InteractiveLaunchRequest -> [String]
effortArgs req = case req ^. #effort of
  Nothing -> []
  Just lvl -> ["--effort", Text.unpack (claudeEffortValue lvl)]

claudeEffortValue :: ThinkingLevel -> Text
claudeEffortValue ThinkingMinimal = "low"
claudeEffortValue lvl = renderThinkingLevel lvl

systemPromptArgs :: InteractiveLaunchRequest -> [String]
systemPromptArgs req = case Text.strip <$> req ^. #systemPrompt of
  Nothing -> []
  Just "" -> []
  Just prompt -> ["--system-prompt", Text.unpack prompt]

extraDirArgs :: InteractiveLaunchRequest -> [String]
extraDirArgs req =
  concatMap (\dir -> ["--add-dir", dir]) (req ^. #extraDirs)

-- | 'DefaultSafety' means the caller declined to specify a policy, so
-- rendering nothing honors it rather than downgrading it. An empty
-- allow-list restricts nothing, so it too renders nothing. Only a
-- Codex sandbox policy is a restriction Claude Code cannot express,
-- and that is refused.
safetyArgs :: InteractiveLaunchRequest -> Either AgentRenderError [String]
safetyArgs req = case req ^. #safety of
  DefaultSafety -> Right []
  ClaudeAllowedTools [] -> Right []
  ClaudeAllowedTools tools ->
    Right ["--allowedTools", Text.unpack (Text.intercalate "," tools)]
  CodexSandbox sandbox approval ->
    Left
      ( SafetyNotExpressible
          AgentClaude
          ( "Claude Code cannot express a Codex sandbox policy ("
              <> renderCodexSandboxMode sandbox
              <> ", "
              <> renderCodexApprovalPolicy approval
              <> "); use ClaudeAllowedTools, or DefaultSafety to accept Claude's own default"
          )
      )