Browse.hs

module Seihou.CLI.Browse
  ( handleBrowse,
  )
where

import Data.Generics.Labels ()
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Seihou.CLI.BrowseFormat (formatBrowseRegistry, formatBrowseSingleBlueprint, formatBrowseSingleJudgement, formatBrowseSingleModule, formatBrowseSinglePrompt)
import Seihou.CLI.Commands (BrowseOpts (..))
import Seihou.CLI.Registry.Sync (checkRegistryVersionDrift)
import Seihou.CLI.Shared (logIO)
import Seihou.Core.Install (parseModuleName)
import Seihou.Core.Registry (EntryKind (..), Registry (..), RegistryEntry (..), RepoContents (..), discoverRepoContents)
import Seihou.Core.Types
import Seihou.Dhall.Eval (evalAgentPromptFromFile, evalBlueprintFromFile, evalJudgementFromFile, evalModuleFromFile, evalRecipeFromFile, evalRegistryFromFile)
import Seihou.Effect.Logger (logError, logWarn)
import Seihou.Prelude
import System.Exit (ExitCode (..), exitFailure)
import System.IO.Temp (withSystemTempDirectory)
import System.Process (readProcessWithExitCode)

handleBrowse :: BrowseOpts -> IO ()
handleBrowse bopts = do
  let source = (bopts ^. #source)

  withSystemTempDirectory "seihou-browse" $ \tmpDir -> do
    let repoName = parseModuleName source
        cloneDir = tmpDir </> repoName

    -- Shallow clone
    (exitCode, _stdout, stderr) <- readProcessWithExitCode "git" ["clone", "--depth", "1", T.unpack source, cloneDir] ""
    case exitCode of
      ExitFailure _ -> do
        logIO LogNormal $ do
          logError $ "git clone failed for '" <> source <> "'."
          logError $ "  " <> T.pack stderr
        exitFailure
      ExitSuccess -> pure ()

    contents <- discoverRepoContents evalRegistryFromFile cloneDir
    let wanted k = null (bopts ^. #kinds) || k `elem` bopts ^. #kinds
        single k label act
          | wanted k = act
          | otherwise = TIO.putStrLn (source <> " provides a single " <> label <> ", which the kind filter excludes.")
    case contents of
      EmptyRepo -> do
        logIO LogNormal (logError "repository contains neither seihou-registry.dhall nor module.dhall.")
        exitFailure
      SingleModule rootDir -> single ModuleEntry "module" $ do
        let dhallFile = rootDir </> "module.dhall"
        decoded <- evalModuleFromFile dhallFile
        case decoded of
          Left err -> do
            logIO LogNormal (logError $ "failed to load module: " <> T.pack (show err))
            exitFailure
          Right m ->
            TIO.putStr $ formatBrowseSingleModule source (m ^. #name . #unModuleName) (m ^. #description)
      SingleRecipe rootDir -> single RecipeEntry "recipe" $ do
        let dhallFile = rootDir </> "recipe.dhall"
        decoded <- evalRecipeFromFile dhallFile
        case decoded of
          Left err -> do
            logIO LogNormal (logError $ "failed to load recipe: " <> T.pack (show err))
            exitFailure
          Right r ->
            TIO.putStr $ formatBrowseSingleModule source (r ^. #name . #unRecipeName) (r ^. #description)
      SingleBlueprint rootDir -> single BlueprintEntry "blueprint" $ do
        let dhallFile = rootDir </> "blueprint.dhall"
        decoded <- evalBlueprintFromFile dhallFile
        case decoded of
          Left err -> do
            logIO LogNormal (logError $ "failed to load blueprint: " <> T.pack (show err))
            exitFailure
          Right b -> do
            TIO.putStr $ formatBrowseSingleBlueprint source (b ^. #name . #unModuleName) (b ^. #description)
      SinglePrompt rootDir -> single PromptEntry "prompt" $ do
        let dhallFile = rootDir </> "prompt.dhall"
        decoded <- evalAgentPromptFromFile dhallFile
        case decoded of
          Left err -> do
            logIO LogNormal (logError $ "failed to load prompt: " <> T.pack (show err))
            exitFailure
          Right p ->
            TIO.putStr $ formatBrowseSinglePrompt source (p ^. #name . #unModuleName) (p ^. #description)
      SingleJudgement rootDir -> single JudgementEntry "judgement" $ do
        decoded <- evalJudgementFromFile (rootDir </> "judgement.dhall")
        case decoded of
          Left err -> do
            logIO LogNormal (logError $ "failed to load judgement: " <> T.pack (show err))
            exitFailure
          Right j ->
            TIO.putStr $ formatBrowseSingleJudgement source (j ^. #name) (j ^. #description)
      MultiModule registry -> do
        driftWarnings <- checkRegistryVersionDrift cloneDir registry
        logIO LogNormal (mapM_ logWarn driftWarnings)
        let matchTag e = case bopts ^. #tag of
              Nothing -> True
              Just tag -> tag `elem` (e ^. #tags)
            tagged =
              [(ModuleEntry, e) | e <- registry ^. #modules, matchTag e]
                ++ [(RecipeEntry, e) | e <- registry ^. #recipes, matchTag e]
                ++ [(BlueprintEntry, e) | e <- registry ^. #blueprints, matchTag e]
                ++ [(PromptEntry, e) | e <- registry ^. #prompts, matchTag e]
                ++ [(JudgementEntry, e) | e <- registry ^. #judgements, matchTag e]
            shown = filter (wanted . fst) tagged
        if null shown && not (null tagged)
          then TIO.putStrLn (registry ^. #repoName <> ": no entries of the selected kinds" <> maybe "" (\t -> " with tag '" <> t <> "'") (bopts ^. #tag) <> ".")
          else TIO.putStr $ formatBrowseRegistry source registry shown (bopts ^. #tag)