packages feed

baikai-kit-0.4.0.0: src/Baikai/Kit/Config.hs

module Baikai.Kit.Config
  ( KitConfig (..),
    KitScope (..),
    kitConfig,
    findProjectRoot,
    projectRootByMarkers,
    kitCacheDir,
    userAgentsDir,
    projectAgentsDir,
    resolveAgentsBase,
    providerAgentsBase,
    sharedClaudeBase,
    providerLabel,
    sidecarFileName,
    scopeLabel,
  )
where

import Baikai.AgentAssets (AgentAssetProvider)
import Baikai.Interactive (InteractiveProvider (..))
import Baikai.Kit.Manifest (KitItem, KitManifest)
import Baikai.Prelude
import Data.Maybe (fromMaybe)
import Data.Text qualified as Text
import System.Directory (doesPathExist, getCurrentDirectory, getHomeDirectory, makeAbsolute)
import System.FilePath (takeDirectory, (</>))

-- | How a tool configures the kit engine. Build one with 'kitConfig' and
--   override optional fields with record update syntax; a record literal
--   must set every field.
data KitConfig = KitConfig
  { toolName :: !Text,
    repoUrl :: !Text,
    providers :: ![AgentAssetProvider],
    -- | The directory project scope lives under. It is run once per
    --   project-scope path lookup, so install, status, update, uninstall,
    --   and 'Baikai.Kit.Session.agentDirsForSession' all agree on it. The
    --   default ('kitConfig') is the current directory; 'projectRootByMarkers'
    --   walks up to the nearest marker such as @.git@. An exception thrown
    --   by this action propagates to the caller.
    projectRoot :: !(IO FilePath),
    -- | Called by @kit install@ when no name is given, with the whole
    --   manifest. 'Just' a name installs that item (a name the manifest
    --   does not list fails with 'Baikai.Kit.Error.KitItemNotFound');
    --   'Nothing' means the user cancelled, and nothing is installed. When
    --   this field is 'Nothing', @kit install@ without a name fails with
    --   'Baikai.Kit.Error.KitItemNameRequired'. The engine ships no picker:
    --   the tool owns presentation. An exception thrown by the chooser
    --   propagates to the caller.
    chooseItem :: !(Maybe (KitManifest -> IO (Maybe Text))),
    -- | Confirmation for a tool-only agent whose Codex copy must be shared.
    confirmSharedCodex :: !(Maybe (KitItem -> IO Bool))
  }
  deriving stock (Generic)

instance Show KitConfig where
  showsPrec d config =
    showParen (d > 10) $
      showString "KitConfig {toolName = "
        . shows (config ^. #toolName)
        . showString ", repoUrl = "
        . shows (config ^. #repoUrl)
        . showString ", providers = "
        . shows (config ^. #providers)
        . showString ", projectRoot = <IO FilePath>, chooseItem = "
        . showString (maybe "Nothing" (const "Just <chooser>") (config ^. #chooseItem))
        . showString ", confirmSharedCodex = "
        . showString (maybe "Nothing" (const "Just <confirmation>") (config ^. #confirmSharedCodex))
        . showString "}"

-- | A configuration with every optional behaviour at its default:
--   project scope is the current directory, and @kit install@ requires a
--   name (no chooser).
kitConfig :: Text -> Text -> [AgentAssetProvider] -> KitConfig
kitConfig toolName repoUrl providers =
  KitConfig
    { toolName,
      repoUrl,
      providers,
      projectRoot = getCurrentDirectory,
      chooseItem = Nothing,
      confirmSharedCodex = Nothing
    }

-- | The nearest directory, starting at @start@ and walking towards the
--   filesystem root, that contains any of @markers@ (a file or a
--   directory, e.g. @.git@ or @.mytool@). 'Nothing' if none does.
findProjectRoot :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findProjectRoot markers start = makeAbsolute start >>= go
  where
    go dir = do
      found <- or <$> traverse (doesPathExist . (dir </>)) markers
      if found
        then pure (Just dir)
        else
          let parent = takeDirectory dir
           in if parent == dir then pure Nothing else go parent

-- | A ready-made 'projectRoot': the nearest ancestor of the current
--   directory holding one of @markers@, or the current directory itself
--   when there is none.
projectRootByMarkers :: [FilePath] -> IO FilePath
projectRootByMarkers markers = do
  cwd <- getCurrentDirectory
  fromMaybe cwd <$> findProjectRoot markers cwd

data KitScope
  = UserScope
  | ProjectScope
  deriving stock (Eq, Ord, Show)

kitCacheDir :: KitConfig -> IO FilePath
kitCacheDir config = do
  home <- getHomeDirectory
  pure (home </> ".cache" </> Text.unpack (config ^. #toolName) </> "kit")

userAgentsDir :: KitConfig -> IO FilePath
userAgentsDir config = do
  home <- getHomeDirectory
  pure (home </> ".config" </> Text.unpack (config ^. #toolName) </> "agents")

-- | Every project-scope path derives from 'projectRoot' through this
--   function, 'resolveAgentsBase', or 'providerAgentsBase'.
projectAgentsDir :: KitConfig -> IO FilePath
projectAgentsDir config = do
  root <- config ^. #projectRoot
  pure (root </> "." <> Text.unpack (config ^. #toolName) </> "agents")

resolveAgentsBase :: KitConfig -> KitScope -> IO FilePath
resolveAgentsBase config UserScope = userAgentsDir config
resolveAgentsBase config ProjectScope = projectAgentsDir config

providerAgentsBase :: KitConfig -> AgentAssetProvider -> KitScope -> IO FilePath
providerAgentsBase config InteractiveClaude scope = resolveAgentsBase config scope
providerAgentsBase _config InteractiveCodex UserScope = getHomeDirectory
providerAgentsBase config InteractiveCodex ProjectScope = config ^. #projectRoot

providerLabel :: AgentAssetProvider -> Text
providerLabel InteractiveClaude = "claude"
providerLabel InteractiveCodex = "codex"

sidecarFileName :: KitConfig -> Text
sidecarFileName config = "." <> (config ^. #toolName) <> "-kit.json"

scopeLabel :: KitScope -> Text
scopeLabel UserScope = "user"
scopeLabel ProjectScope = "project"

-- | The provider-native shared root; project scope uses the configured root.
sharedClaudeBase :: KitConfig -> KitScope -> IO FilePath
sharedClaudeBase _ UserScope = getHomeDirectory
sharedClaudeBase config ProjectScope = config ^. #projectRoot