Module.hs

module Seihou.Core.Module
  ( discoverModule,
    discoverBlueprint,
    discoverAgentPrompt,
    discoverRunnable,
    defaultSearchPaths,
    validateModule,
    loadModule,
    discoverAllModules,
    discoverAllRunnables,
    DiscoveredModule (..),
    DiscoveredRunnable (..),
    RunnableKind (..),
    ModuleSource (..),

    -- * Individual check functions (for structured reports)
    checkNameFormat,
    checkVersionPresent,
    checkUniqueVars,
    checkPromptRefs,
    checkFileExistence,
    checkExportRefs,
    checkDependencyNames,
    checkDependencyVarBindings,
    checkSafeDestinations,
    checkDestVarRefs,
    checkCommandSafety,
    isValidModuleName,
    extractPlaceholders,
    validateProjectRelativePath,
  )
where

import Data.Generics.Labels ()
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as T
import Seihou.Core.Path (validateProjectRelativePath)
import Seihou.Core.Types
import Seihou.Dhall.Eval (evalAgentPromptFromFile, evalBlueprintFromFile, evalModuleFromFile, evalRecipeFromFile)
import Seihou.Prelude
import System.Directory (XdgDirectory (..), doesDirectoryExist, doesFileExist, getCurrentDirectory, getXdgDirectory, listDirectory)

-- | Search for a module by name in the given directories.
-- Returns the path to the directory containing @module.dhall@, or
-- 'ModuleNotFound' listing the directories that were searched.
discoverModule :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath)
discoverModule searchPaths name = go searchPaths
  where
    nameStr = T.unpack (name ^. #unModuleName)
    go [] = pure $ Left (ModuleNotFound name searchPaths)
    go (dir : rest) = do
      let candidate = dir </> nameStr
      let dhallFile = candidate </> "module.dhall"
      exists <- doesFileExist dhallFile
      if exists
        then pure (Right candidate)
        else go rest

-- | Search for a runnable (module, recipe, blueprint, or prompt) by name in the
-- given directories. For each search path, checks @module.dhall@ first
-- (returning 'RunnableModule'), then @recipe.dhall@
-- (returning 'RunnableRecipe'), then @blueprint.dhall@
-- (returning 'RunnableBlueprint'), then @prompt.dhall@
-- (returning 'RunnableAgentPrompt'). Within a single candidate directory
-- the priority is module > recipe > blueprint > prompt, so a stray
-- @module.dhall@ next to a @blueprint.dhall@ silently surfaces the
-- module — the more specific, deterministic artifact. Returns
-- 'ModuleNotFound' if none is found in any search path.
discoverRunnable :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError Runnable)
discoverRunnable searchPaths name = go searchPaths
  where
    nameStr = T.unpack (name ^. #unModuleName)
    go [] = pure $ Left (ModuleNotFound name searchPaths)
    go (dir : rest) = do
      let candidate = dir </> nameStr
          moduleDhall = candidate </> "module.dhall"
          recipeDhall = candidate </> "recipe.dhall"
          blueprintDhall = candidate </> "blueprint.dhall"
          promptDhall = candidate </> "prompt.dhall"
      isModule <- doesFileExist moduleDhall
      if isModule
        then do
          result <- evalModuleFromFile moduleDhall
          case result of
            Left err -> pure (Left err)
            Right m -> pure (Right (RunnableModule m candidate))
        else do
          isRecipe <- doesFileExist recipeDhall
          if isRecipe
            then do
              result <- evalRecipeFromFile recipeDhall
              case result of
                Left err -> pure (Left err)
                Right r -> pure (Right (RunnableRecipe r candidate))
            else do
              isBlueprint <- doesFileExist blueprintDhall
              if isBlueprint
                then do
                  result <- evalBlueprintFromFile blueprintDhall
                  case result of
                    Left err -> pure (Left err)
                    Right b -> pure (Right (RunnableBlueprint b candidate))
                else do
                  isPrompt <- doesFileExist promptDhall
                  if isPrompt
                    then do
                      result <- evalAgentPromptFromFile promptDhall
                      case result of
                        Left err -> pure (Left err)
                        Right p -> pure (Right (RunnableAgentPrompt p candidate))
                    else go rest

-- | Search for a blueprint by name in the given directories. Returns
-- the path to the directory containing @blueprint.dhall@, or
-- 'ModuleNotFound' listing the directories that were searched. Mirrors
-- 'discoverModule' for callers that only care about discovering a
-- blueprint by name.
discoverBlueprint :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath)
discoverBlueprint searchPaths name = go searchPaths
  where
    nameStr = T.unpack (name ^. #unModuleName)
    go [] = pure $ Left (ModuleNotFound name searchPaths)
    go (dir : rest) = do
      let candidate = dir </> nameStr
      let dhallFile = candidate </> "blueprint.dhall"
      exists <- doesFileExist dhallFile
      if exists
        then pure (Right candidate)
        else go rest

-- | Search for an agent prompt by name in the given directories. Returns
-- the path to the directory containing @prompt.dhall@, or 'ModuleNotFound'
-- listing the directories that were searched.
discoverAgentPrompt :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath)
discoverAgentPrompt searchPaths name = go searchPaths
  where
    nameStr = T.unpack (name ^. #unModuleName)
    go [] = pure $ Left (ModuleNotFound name searchPaths)
    go (dir : rest) = do
      let candidate = dir </> nameStr
      let dhallFile = candidate </> "prompt.dhall"
      exists <- doesFileExist dhallFile
      if exists
        then pure (Right candidate)
        else go rest

-- | The three standard module search paths, in priority order:
-- 1. @.seihou/modules/@ relative to the current directory
-- 2. @~/.config/seihou/modules/@
-- 3. @~/.config/seihou/installed/@
defaultSearchPaths :: IO [FilePath]
defaultSearchPaths = do
  cwd <- getCurrentDirectory
  xdgConfig <- getXdgDirectory XdgConfig "seihou"
  pure
    [ cwd </> ".seihou" </> "modules",
      xdgConfig </> "modules",
      xdgConfig </> "installed"
    ]

-- | Validate a decoded 'Module' against the nine validation rules.
-- The 'FilePath' is the module's base directory (containing @module.dhall@).
-- Returns 'Right' with the module if all rules pass, or 'Left' with a
-- 'ValidationError' listing all violations.
validateModule :: FilePath -> Module -> IO (Either ModuleLoadError Module)
validateModule baseDir m = do
  fileErrors <- checkFileExistence baseDir m
  let pureErrors =
        checkNameFormat m
          <> checkVersionPresent m
          <> checkUniqueVars m
          <> checkPromptRefs m
          <> checkExportRefs m
          <> checkDependencyNames m
          <> checkDependencyVarBindings m
          <> checkSafeDestinations m
          <> checkDestVarRefs m
          <> checkCommandSafety m
      allErrors = pureErrors <> fileErrors
  pure $
    if null allErrors
      then Right m
      else Left (ValidationError (m ^. #name) allErrors)

-- Rule 1: Module name must be non-empty and match [a-z][a-z0-9-]*
checkNameFormat :: Module -> [Text]
checkNameFormat m =
  let n = (m ^. #name . #unModuleName)
   in if T.null n || not (isValidModuleName n)
        then ["module name must match [a-z][a-z0-9-]*, got: " <> n]
        else []

isValidModuleName :: Text -> Bool
isValidModuleName t = case T.uncons t of
  Nothing -> False
  Just (c, rest) ->
    (c >= 'a' && c <= 'z')
      && T.all (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-') rest

-- Rule 1b: Module must declare a version
checkVersionPresent :: Module -> [Text]
checkVersionPresent m = case m ^. #version of
  Nothing -> ["module must declare a version"]
  Just v
    | T.null (T.strip v) -> ["module must declare a version"]
    | otherwise -> []

-- Rule 2: All variable names must be unique
checkUniqueVars :: Module -> [Text]
checkUniqueVars m =
  let names = map (\d -> d ^. #name . #unVarName) (m ^. #vars)
   in map (\n -> "duplicate variable name: " <> n) (findDupes Set.empty Set.empty names)

findDupes :: Set.Set Text -> Set.Set Text -> [Text] -> [Text]
findDupes _ _ [] = []
findDupes seen reported (x : xs)
  | Set.member x seen && not (Set.member x reported) = x : findDupes seen (Set.insert x reported) xs
  | otherwise = findDupes (Set.insert x seen) reported xs

-- Rule 3: Every prompt must reference a declared variable
checkPromptRefs :: Module -> [Text]
checkPromptRefs m =
  let varNames = Set.fromList (map (^. #name) (m ^. #vars))
   in concatMap
        ( \p ->
            if Set.member (p ^. #var) varNames
              then []
              else ["prompt references undeclared variable: " <> p ^. #var . #unVarName]
        )
        (m ^. #prompts)

-- Rule 4: Every step source file must exist in the module's files/ directory
checkFileExistence :: FilePath -> Module -> IO [Text]
checkFileExistence baseDir m =
  concat
    <$> mapM
      ( \s -> do
          let p = baseDir </> "files" </> (s ^. #src)
          exists <- doesFileExist p
          pure $
            if exists
              then []
              else ["step source file not found: " <> T.pack (s ^. #src)]
      )
      (m ^. #steps)

-- Rule 5: Every export must reference a declared variable
checkExportRefs :: Module -> [Text]
checkExportRefs m =
  let varNames = Set.fromList (map (^. #name) (m ^. #vars))
   in concatMap
        ( \e ->
            if Set.member (e ^. #var) varNames
              then []
              else ["export references undeclared variable: " <> e ^. #var . #unVarName]
        )
        (m ^. #exports)

-- Rule 6: Every dependency name must be well-formed
checkDependencyNames :: Module -> [Text]
checkDependencyNames m =
  concatMap
    ( \dep ->
        let n = (dep ^. #module_ . #unModuleName)
         in if isValidModuleName n
              then []
              else ["invalid dependency name: " <> n]
    )
    (m ^. #dependencies)

-- Rule 6b: Dependency var binding names must be non-empty
checkDependencyVarBindings :: Module -> [Text]
checkDependencyVarBindings m =
  concatMap
    ( \dep ->
        concatMap
          ( \(VarName vn) ->
              if T.null vn
                then ["dependency '" <> dep ^. #module_ . #unModuleName <> "' has empty var binding name"]
                else []
          )
          (Map.keys (dep ^. #vars))
    )
    (m ^. #dependencies)

-- Rule 7: Every step destination must be a safe relative path
checkSafeDestinations :: Module -> [Text]
checkSafeDestinations m = concatMap checkDest (m ^. #steps)
  where
    checkDest s =
      case validateProjectRelativePath (s ^. #dest) of
        Left err -> ["step destination " <> err]
        Right _ -> []

-- Rule 8: Variables referenced in step dest placeholders must be declared
checkDestVarRefs :: Module -> [Text]
checkDestVarRefs m =
  let varNames = Set.fromList (map (\d -> d ^. #name . #unVarName) (m ^. #vars))
   in concatMap (checkStep varNames) (m ^. #steps)
  where
    checkStep varNames s =
      [ "step destination references undeclared variable: " <> ref
      | ref <- extractPlaceholders (s ^. #dest),
        not (Set.member ref varNames)
      ]

-- Rule 9: Command text must be non-empty and workDir must be safe
checkCommandSafety :: Module -> [Text]
checkCommandSafety m = concatMap checkCmd (m ^. #commands)
  where
    checkCmd c = checkEmptyRun c <> checkWorkDir (c ^. #workDir)

    checkEmptyRun c
      | T.null (T.strip (c ^. #run)) = ["command text must not be empty"]
      | otherwise = []

    checkWorkDir Nothing = []
    checkWorkDir (Just wd) =
      case validateProjectRelativePath wd of
        Left err -> ["command workDir " <> err]
        Right _ -> []

-- | Extract placeholder variable references from a text like @"src/{{project.name}}/Main.hs"@.
extractPlaceholders :: Text -> [Text]
extractPlaceholders t = case T.breakOn "{{" t of
  (_, rest)
    | T.null rest -> []
    | otherwise ->
        let afterOpen = T.drop 2 rest
         in case T.breakOn "}}" afterOpen of
              (ref, rest')
                | T.null rest' -> []
                | otherwise -> T.strip ref : extractPlaceholders (T.drop 2 rest')

-- | Load a module by name: discover, evaluate, decode, and validate.
loadModule :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError Module)
loadModule searchPaths name = do
  discovered <- discoverModule searchPaths name
  case discovered of
    Left err -> pure (Left err)
    Right moduleDir -> do
      let dhallFile = moduleDir </> "module.dhall"
      decoded <- evalModuleFromFile dhallFile
      case decoded of
        Left err -> pure (Left err)
        Right m -> validateModule moduleDir m

-- | Which search path category a module was found in.
data ModuleSource = SourceProject | SourceUser | SourceInstalled
  deriving stock (Eq, Show, Generic)

-- | A module discovered during enumeration, with its load result and source.
data DiscoveredModule = DiscoveredModule
  { result :: !(Either ModuleLoadError Module),
    source :: !ModuleSource,
    dir :: !FilePath
  }
  deriving stock (Generic, Show)

-- | Enumerate all modules across the given search paths.
-- The search paths must be in the same order as 'defaultSearchPaths':
-- project-local, user, installed. Each subdirectory containing a
-- @module.dhall@ file is loaded; failures are captured in 'discoveredResult'.
discoverAllModules :: [FilePath] -> IO [DiscoveredModule]
discoverAllModules searchPaths = do
  let tagged = zip searchPaths (sources ++ repeat SourceInstalled)
  concat <$> mapM (uncurry scanPath) tagged
  where
    sources = [SourceProject, SourceUser, SourceInstalled]

    scanPath :: FilePath -> ModuleSource -> IO [DiscoveredModule]
    scanPath dir src = do
      exists <- doesDirectoryExist dir
      if not exists
        then pure []
        else do
          entries <- listDirectory dir
          candidates <- filterM (isModuleDir dir) entries
          mapM (loadOne dir src) candidates

    isModuleDir :: FilePath -> FilePath -> IO Bool
    isModuleDir parent entry = do
      let candidate = parent </> entry </> "module.dhall"
      doesFileExist candidate

    filterM :: (a -> IO Bool) -> [a] -> IO [a]
    filterM _ [] = pure []
    filterM p (x : xs) = do
      keep <- p x
      rest <- filterM p xs
      pure (if keep then x : rest else rest)

    loadOne :: FilePath -> ModuleSource -> FilePath -> IO DiscoveredModule
    loadOne dir src entry = do
      let moduleDir = dir </> entry
          dhallFile = moduleDir </> "module.dhall"
      decoded <- evalModuleFromFile dhallFile
      result <- case decoded of
        Left err -> pure (Left err)
        Right m -> validateModule moduleDir m
      pure DiscoveredModule {result = result, source = src, dir = moduleDir}

-- | Whether a discovered item is a module, recipe, blueprint, or prompt.
data RunnableKind = KindModule | KindRecipe | KindBlueprint | KindPrompt
  deriving stock (Eq, Show, Generic)

-- | A runnable discovered during enumeration, with its load result, kind, and source.
data DiscoveredRunnable = DiscoveredRunnable
  { name :: !Text,
    description :: !(Maybe Text),
    kind :: !RunnableKind,
    source :: !ModuleSource,
    dir :: !FilePath,
    isError :: !Bool,
    error :: !(Maybe Text)
  }
  deriving stock (Generic, Show)

-- | Enumerate all modules, recipes, blueprints, and prompts across the given search paths.
-- Returns a unified list of discovered items, each tagged with its kind.
discoverAllRunnables :: [FilePath] -> IO [DiscoveredRunnable]
discoverAllRunnables searchPaths = do
  let tagged = zip searchPaths (sources ++ repeat SourceInstalled)
  concat <$> mapM (uncurry scanRunnablePath) tagged
  where
    sources = [SourceProject, SourceUser, SourceInstalled]

    scanRunnablePath :: FilePath -> ModuleSource -> IO [DiscoveredRunnable]
    scanRunnablePath dir src = do
      exists <- doesDirectoryExist dir
      if not exists
        then pure []
        else do
          entries <- listDirectory dir
          concat <$> mapM (loadRunnable dir src) entries

    loadRunnable :: FilePath -> ModuleSource -> FilePath -> IO [DiscoveredRunnable]
    loadRunnable dir src entry = do
      let entryDir = dir </> entry
          moduleDhall = entryDir </> "module.dhall"
          recipeDhall = entryDir </> "recipe.dhall"
          blueprintDhall = entryDir </> "blueprint.dhall"
          promptDhall = entryDir </> "prompt.dhall"
      isModule <- doesFileExist moduleDhall
      isRecipe <- doesFileExist recipeDhall
      isBlueprint <- doesFileExist blueprintDhall
      isPrompt <- doesFileExist promptDhall
      if isModule
        then do
          decoded <- evalModuleFromFile moduleDhall
          pure
            [ case decoded of
                Left err ->
                  DiscoveredRunnable
                    { name = T.pack entry,
                      description = Nothing,
                      kind = KindModule,
                      source = src,
                      dir = entryDir,
                      isError = True,
                      error = Just (briefLoadError err)
                    }
                Right m ->
                  DiscoveredRunnable
                    { name = m ^. #name . #unModuleName,
                      description = m ^. #description,
                      kind = KindModule,
                      source = src,
                      dir = entryDir,
                      isError = False,
                      error = Nothing
                    }
            ]
        else
          if isRecipe
            then do
              decoded <- evalRecipeFromFile recipeDhall
              pure
                [ case decoded of
                    Left err ->
                      DiscoveredRunnable
                        { name = T.pack entry,
                          description = Nothing,
                          kind = KindRecipe,
                          source = src,
                          dir = entryDir,
                          isError = True,
                          error = Just (briefLoadError err)
                        }
                    Right r ->
                      DiscoveredRunnable
                        { name = r ^. #name . #unRecipeName,
                          description = r ^. #description,
                          kind = KindRecipe,
                          source = src,
                          dir = entryDir,
                          isError = False,
                          error = Nothing
                        }
                ]
            else
              if isBlueprint
                then do
                  decoded <- evalBlueprintFromFile blueprintDhall
                  pure
                    [ case decoded of
                        Left err ->
                          DiscoveredRunnable
                            { name = T.pack entry,
                              description = Nothing,
                              kind = KindBlueprint,
                              source = src,
                              dir = entryDir,
                              isError = True,
                              error = Just (briefLoadError err)
                            }
                        Right b ->
                          DiscoveredRunnable
                            { name = b ^. #name . #unModuleName,
                              description = b ^. #description,
                              kind = KindBlueprint,
                              source = src,
                              dir = entryDir,
                              isError = False,
                              error = Nothing
                            }
                    ]
                else
                  if isPrompt
                    then do
                      decoded <- evalAgentPromptFromFile promptDhall
                      pure
                        [ case decoded of
                            Left err ->
                              DiscoveredRunnable
                                { name = T.pack entry,
                                  description = Nothing,
                                  kind = KindPrompt,
                                  source = src,
                                  dir = entryDir,
                                  isError = True,
                                  error = Just (briefLoadError err)
                                }
                            Right p ->
                              DiscoveredRunnable
                                { name = p ^. #name . #unModuleName,
                                  description = p ^. #description,
                                  kind = KindPrompt,
                                  source = src,
                                  dir = entryDir,
                                  isError = False,
                                  error = Nothing
                                }
                        ]
                    else pure []

    briefLoadError :: ModuleLoadError -> Text
    briefLoadError (DhallEvalError _ _) = "Dhall evaluation failed"
    briefLoadError (DhallDecodeError _ _) = "Dhall decode failed"
    briefLoadError (ValidationError _ _) = "validation failed"
    briefLoadError (ModuleNotFound _ _) = "not found"
    briefLoadError (MissingSourceFile _ _) = "missing source file"
    briefLoadError (CircularDependency _) = "circular dependency"
    briefLoadError (RegistryEvalError _ _) = "registry eval failed"