Core.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE LambdaCase #-}

-- |
-- Module      : Clod.Core
-- Description : Core functionality for the Clod application
-- Copyright   : (c) Fuzz Leonard, 2025
-- License     : MIT
-- Maintainer  : fuzz@fuzz.ink
-- Stability   : experimental
--
-- This module provides the core functionality for the Clod application,
-- implemented using a traditional monad stack with capability-based security.
--
-- Clod (Claude Loader) is a utility for preparing and uploading files to
-- Claude AI's Project Knowledge feature. It tracks file changes, respects
-- .gitignore and .clodignore patterns, and optimizes filenames for Claude's UI.
--
-- === Main Features
--
-- * Track modified files using a checksum database
-- * Respect .gitignore and .clodignore patterns
-- * Handle binary vs. text files
-- * Optimize filenames for Claude's UI
-- * Generate a path manifest for mapping optimized names back to original paths
-- * Capability-based security for file operations

module Clod.Core
  ( -- * Main application entry point
    runClodApp
    
    -- * File processing with capabilities
  , processFile
  , findAllFiles
  ) where

import System.Directory (createDirectoryIfMissing, getModificationTime)
import System.FilePath ((</>), takeFileName)
import System.IO (stdout, stderr, hPutStrLn)
import Data.Version (showVersion)
import Control.Monad (when, unless, filterM, forM_)

import Clod.Types
import Clod.IgnorePatterns (matchesIgnorePattern, readClodIgnore, readGitIgnore)
import Clod.FileSystem.Detection (safeFileExists, safeIsTextFile)
import Clod.FileSystem.Operations (safeCopyFile, findAllFiles)
import Clod.FileSystem.Processing (processFiles, writeManifestFile, createOptimizedName)
import Clod.Output (whenVerbose)
import Clod.FileSystem.Checksums (FileStatus(Unchanged, Modified, New, Renamed), detectFileChanges,
                              loadDatabase, saveDatabase, updateDatabase, 
                              cleanupStagingDirectories, flushMissingEntries,
                              checksumFile)
import qualified Paths_clod as Meta

-- | Check if a file should be ignored based on ignore patterns
checkIgnorePatterns :: FilePath -> FilePath -> ClodM (Either String FileResult)
checkIgnorePatterns _ relPath = do
  config <- ask
  let patterns = config ^. ignorePatterns
  if not (null patterns) && matchesIgnorePattern patterns relPath
    then pure $ Left "matched .clodignore pattern"
    else pure $ Right Success

-- | Check if a file exists
checkFileExists :: FileReadCap -> FilePath -> FilePath -> ClodM (Either String FileResult)
checkFileExists readCap fullPath _ = do
  exists <- safeFileExists readCap fullPath
  if exists
    then pure $ Right Success
    else pure $ Left "file does not exist"

-- | Check if a file is text
checkIsTextFile :: FileReadCap -> FilePath -> FilePath -> ClodM (Either String FileResult)
checkIsTextFile readCap fullPath _ = do
  -- First check if file exists
  exists <- safeFileExists readCap fullPath
  if not exists
    then pure $ Left "file does not exist"
    else do
      -- Then check if it's a text file
      isText <- safeIsTextFile readCap fullPath
      if isText
        then pure $ Right Success
        else pure $ Left "binary file"

-- | Copy a file to the staging directory
copyToStaging :: FileReadCap -> FileWriteCap -> FilePath -> FilePath -> ClodM (Either String FileResult)
copyToStaging readCap writeCap fullPath relPath = do
  config <- ask
  let stagingPath = config ^. currentStaging
  
  -- In Core.processFile, use the file's basename directly for test compatibility
  -- In production, the Core.mainLogic function uses createOptimizedName correctly
  let fileName = takeFileName relPath
      destPath = stagingPath </> fileName
  
  -- Copy file using capability
  safeCopyFile readCap writeCap fullPath destPath
  
  -- Only output if verbose mode is enabled
  when (config ^. verbose) $ do
    liftIO $ hPutStrLn stderr $ "Copied: " ++ relPath ++ " → " ++ fileName
  pure $ Right Success

-- | Process a file using capability-based security
--
-- This function runs a file through a pipeline of processing steps, with each step
-- using capability tokens to ensure secure access. The steps are:
--
-- 1. Check against ignore patterns
-- 2. Verify the file exists (using FileReadCap)
-- 3. Verify the file is a text file (using FileReadCap)
-- 4. Copy to staging directory (using both FileReadCap and FileWriteCap)
--
-- Each step must succeed for the file to be processed. If any step fails,
-- processing stops and the reason is returned.
--
-- >>> -- Process a text file that exists and isn't ignored
-- >>> processFile readCap writeCap "/project/src/main.hs" "src/main.hs"
-- Success
--
-- >>> -- Process a binary file (skipped)
-- >>> processFile readCap writeCap "/project/img/logo.png" "img/logo.png"
-- Skipped "binary file"
--
-- >>> -- Process an ignored file
-- >>> processFile readCap writeCap "/project/node_modules/package.json" "node_modules/package.json"
-- Skipped "matched .clodignore pattern"
processFile :: FileReadCap      -- ^ Capability for reading files
            -> FileWriteCap     -- ^ Capability for writing files
            -> FilePath         -- ^ Full path to the file
            -> FilePath         -- ^ Relative path from project root
            -> ClodM FileResult -- ^ Result of processing (Success or Skipped)
processFile readCap writeCap fullPath relPath = do
  let steps = [ checkIgnorePatterns fullPath relPath
              , checkFileExists readCap fullPath relPath
              , checkIsTextFile readCap fullPath relPath
              , copyToStaging readCap writeCap fullPath relPath
              ]

  -- Process steps sequentially, stopping on first error
  let processSteps [] = pure $ Right Success
      processSteps (step:remaining) = do
        result <- step
        case result of
          Left reason -> pure $ Left reason
          Right _ -> processSteps remaining

  -- Run the processing pipeline and convert result
  result <- processSteps steps
  pure $ case result of
    Left reason -> Skipped reason
    Right _ -> Success

-- | Run the main Clod application
runClodApp :: ClodConfig -> FilePath -> Bool -> Bool -> IO (Either ClodError ())
runClodApp config _ verboseFlag optAllFiles = 
  let configWithVerbose = config & verbose .~ verboseFlag
  in runClodM configWithVerbose $ do
    when verboseFlag $ do
      -- Print version information only in verbose mode
      liftIO $ hPutStrLn stderr $ "clod version " ++ showVersion Meta.version ++ " (Haskell)"
    
    -- Execute main logic with capabilities
    mainLogic optAllFiles
    
-- | Main application logic
mainLogic :: Bool -> ClodM ()
mainLogic optAllFiles = do
  config <- ask
  -- Access record fields directly with underscore prefix to avoid recursive definitions
  let configDir' = _configDir config
      stagingDir' = _stagingDir config
      projectPath' = _projectPath config
      databaseFile' = _databaseFile config
      isFlushMode = _flushMode config
      isLastMode = _lastMode config
  
  -- Create directories
  liftIO $ createDirectoryIfMissing True configDir'
  liftIO $ createDirectoryIfMissing True stagingDir'
  
  -- Only show additional info in verbose mode
  whenVerbose $ do
    liftIO $ hPutStrLn stderr $ "Running with capabilities, safely restricting operations to: " ++ projectPath'
    liftIO $ hPutStrLn stderr $ "Safe staging directory: " ++ stagingDir'
    liftIO $ hPutStrLn stderr "AI safety guardrails active with capability-based security"
  
  -- Load .gitignore and .clodignore patterns
  gitIgnorePatterns <- readGitIgnore projectPath'
  clodIgnorePatterns <- readClodIgnore projectPath'
  let allPatterns = gitIgnorePatterns ++ clodIgnorePatterns
  
  -- Create a new config with the loaded patterns
  let configWithPatterns = config & ignorePatterns .~ allPatterns
  
  -- Load or initialize the checksums database
  database <- loadDatabase databaseFile'

  -- Handle the --last flag
  when isLastMode $ do
    -- If we're in "last mode", use the previous staging directory
    case database ^. dbLastStagingDir of
      Just prevStaging -> do
        whenVerbose $ liftIO $ hPutStrLn stderr $ "Using previous staging directory: " ++ prevStaging
        -- Output the previous staging directory path and exit
        liftIO $ hPutStrLn stdout prevStaging
        -- Exit early since we're just reusing the last staging directory
        throwError $ ConfigError "Using last staging directory as requested"
        
      Nothing -> do
        -- If no previous staging directory is available, warn and continue normally
        whenVerbose $ liftIO $ hPutStrLn stderr "No previous staging directory available, proceeding with new staging"
  
  -- Clean up previous staging directory if needed (and not in last mode)
  unless isLastMode $ cleanupStagingDirectories
  
  -- Find all eligible files in the project
  allFiles <- findAllFiles projectPath' [""]  -- Use empty string to avoid "./" prefix
  
  -- Create capabilities for file operations
  let readCap = fileReadCap [projectPath']
      writeCap = fileWriteCap [stagingDir']

  -- First filter out files that match ignore patterns BEFORE any other processing
  let filteredFiles = filter (\path -> not (matchesIgnorePattern allPatterns path)) allFiles
  
  whenVerbose $ do
    liftIO $ hPutStrLn stderr $ "Total files: " ++ show (length allFiles)
    liftIO $ hPutStrLn stderr $ "Filtered files (after ignore patterns): " ++ show (length filteredFiles)
  
  -- Flush missing files from database if in flush mode
  databaseUpdated <- if isFlushMode
                     then flushMissingEntries readCap database projectPath'
                     else return database
  
  -- Prepare to create the _path_manifest.dhall file
  let manifestPath = stagingDir' </> "_path_manifest.dhall"
  
  -- Detect file changes by comparing checksums with database (using filtered files)
  (changedFiles, renamedFiles) <- detectFileChanges readCap databaseUpdated filteredFiles projectPath'
  
  -- Filter files based on database existence
  let dbExists = not $ null $ databaseUpdated ^. dbFiles
  
  -- Debug output for database existence
  whenVerbose $ do
    liftIO $ hPutStrLn stderr $ "Database exists: " ++ show dbExists
    liftIO $ hPutStrLn stderr $ "Database entries: " ++ show (length $ databaseUpdated ^. dbFiles)
  
  -- Find unchanged files for debugging
  let unchangedFiles = filter (\(_, status) -> status == Unchanged) changedFiles
  whenVerbose $ do
    liftIO $ hPutStrLn stderr $ "Unchanged files: " ++ show (length unchangedFiles) ++ " of " ++ show (length changedFiles)
    
  -- Get paths of changed files
  -- This logic determines which files to actually copy to the staging directory
  -- First run (empty database) or --all flag: process all filtered files
  -- Subsequent runs: process only modified/new/renamed files
  let changedPaths = if not dbExists || optAllFiles
                  then filteredFiles
                  else map fst $ filter (\(_, status) -> status /= Unchanged) changedFiles

  -- Determine which files to process
  -- First run (no database): process all files
  -- Subsequent runs: process only modified files
  let filesToProcess = changedPaths
  
  -- Log detailed information about file processing
  whenVerbose $ do
    let unchangedCount = length $ filter (\(_, status) -> status == Unchanged) changedFiles
    let newCount = length $ filter (\(_, status) -> status == New) changedFiles
    let modifiedCount = length $ filter (\(_, status) -> status == Modified) changedFiles
    let renamedCount = length $ filter (\(_, status) -> 
                                case status of 
                                  Renamed _ -> True
                                  _ -> False) changedFiles
    
    liftIO $ hPutStrLn stderr $ "Database entries: " ++ show (length $ databaseUpdated ^. dbFiles)
    liftIO $ hPutStrLn stderr $ "Files to process: " ++ show (length filesToProcess)
    liftIO $ hPutStrLn stderr $ "  - Unchanged: " ++ show unchangedCount
    liftIO $ hPutStrLn stderr $ "  - New: " ++ show newCount
    liftIO $ hPutStrLn stderr $ "  - Modified: " ++ show modifiedCount
    liftIO $ hPutStrLn stderr $ "  - Renamed: " ++ show renamedCount
  
  -- First pass: Add all files to the manifest
  -- Create database entries for all files
  let processFile' path = do
        let fullPath = projectPath' </> path
        checksum <- checksumFile readCap fullPath
        modTime <- liftIO $ getModificationTime fullPath
        let optName = createOptimizedName path
        return (path, checksum, modTime, optName)
  
  -- Create entries only for already filtered files (just need to check if they're text files)
  -- This ensures consistency with the filtering we already did earlier
  entries <- filterM (\path -> do
                -- Check if it's a text file
                isText <- safeIsTextFile readCap (projectPath' </> path)
                return isText
             ) filteredFiles >>= 
             mapM processFile'
  
  -- Create entries for the _path_manifest.dhall file
  let manifestEntries = map (\(path, _, _, optName) -> 
                        (optName, OriginalPath path)) entries
  
  -- Write the _path_manifest.dhall file
  _ <- writeManifestFile writeCap manifestPath manifestEntries
  
  whenVerbose $ do
    liftIO $ hPutStrLn stderr $ "Added " ++ show (length entries) ++ " files to _path_manifest.dhall"
  
  -- Second pass: Only copy changed files to staging
  if null filesToProcess
    then whenVerbose $ do
      liftIO $ hPutStrLn stderr "No files changed since last run"
    else do
      -- Process files that have changed (copy to staging)
      whenVerbose $ do
        liftIO $ hPutStrLn stderr $ "Files to process: " ++ show (length filesToProcess)
      (processed, skipped) <- processFiles configWithPatterns manifestPath filesToProcess False
      
      whenVerbose $ do
        liftIO $ hPutStrLn stderr $ "Processed " ++ show processed ++ " files, skipped " ++ show skipped ++ " files"
      
      -- Report renamed files if verbose
      whenVerbose $ when (not (null renamedFiles)) $ do
        liftIO $ hPutStrLn stderr "Detected renamed files:"
        forM_ renamedFiles $ \(newPath, oldPath) -> do
          liftIO $ hPutStrLn stderr $ "  " ++ oldPath ++ " → " ++ newPath
  
  -- Update database with all processed files
  let 
    -- Create updated database from entries
    finalDatabase = foldr 
      (\(path, checksum, modTime, optName) db -> 
        updateDatabase db path checksum modTime optName) 
      databaseUpdated entries
      
    -- Set the last staging directory
    databaseWithStaging = finalDatabase 
      & dbLastStagingDir .~ Just stagingDir'
      & dbLastRunTime .~ (finalDatabase ^. dbLastRunTime)
  
  -- Save the updated database with the current staging directory path
  saveDatabase databaseFile' databaseWithStaging
  
  -- Output ONLY the staging directory path to stdout for piping to other tools
  -- This follows Unix principles - single line of output for easy piping
  liftIO $ hPutStrLn stdout stagingDir'