{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Clod.FileSystem.Checksums
-- Description : Checksums-based file tracking for Clod
-- Copyright   : (c) Fuzz Leonard, 2025
-- License     : MIT
-- Maintainer  : ink@fuzz.ink
-- Stability   : experimental
--
-- This module provides functions for tracking file changes using checksums.
-- It calculates XXH3 (64-bit) hashes of file content and maintains a database of files
-- that have been processed, allowing us to detect new, modified, deleted, and renamed files.
--
-- The file checksum database is stored as a Dhall configuration file with the following structure:
--
-- @
-- { files =
--     { "path/to/file1.txt" =
--         { path = "path/to/file1.txt"
--         , checksum = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
--         , lastModified = "2025-01-01T12:00:00Z"
--         , optimizedName = "path-to-file1.txt"
--         }
--     , "path/to/file2.md" =
--         { path = "path/to/file2.md"
--         , checksum = "7d865e959b2466918c9863afca942d0fb89d7c9ac0c99bafc3749504ded97730"
--         , lastModified = "2025-01-02T14:30:00Z"
--         , optimizedName = "path-to-file2.md"
--         }
--     }
-- , checksums =
--     { "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" = "path/to/file1.txt"
--     , "7d865e959b2466918c9863afca942d0fb89d7c9ac0c99bafc3749504ded97730" = "path/to/file2.md"
--     }
-- , lastStagingDir = Some "./staging/20250101-120000"
-- , lastRunTime = "2025-01-01T12:00:00Z"
-- }
-- @
--
-- This database allows efficient lookup of files by path or checksum,
-- detection of renamed files (same content with different paths),
-- and tracking of previous staging directories.

module Clod.FileSystem.Checksums
  ( -- * Checksum operations
    calculateChecksum
  , checksumFile
    
    -- * Database operations
  , initializeDatabase
  , loadDatabase
  , saveDatabase
  , updateDatabase
  
    -- * Change detection
  , detectFileChanges
  , findChangedFiles
  , findRenamedFiles
  , getFileStatus
  , FileStatus(..)
  
    -- * Database management
  , cleanupStagingDirectories
  , flushMissingEntries
  ) where

import Control.Exception (try, IOException, SomeException)
import Control.Monad (when, forM)
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe, catMaybes)
import Data.Time (UTCTime, getCurrentTime)
import System.Directory (doesFileExist, doesDirectoryExist, getModificationTime, 
                         removeDirectoryRecursive, createDirectoryIfMissing, renameFile)
import System.FilePath ((</>), takeDirectory)
import GHC.Generics (Generic)
import Numeric (showHex)
import Clod.Types
import Clod.FileSystem.Detection (safeFileExists, safeIsTextFile)
import Clod.FileSystem.Operations (safeReadFile)

import qualified Data.Text.IO as TextIO
import qualified Dhall
import qualified Dhall.Core
import qualified Data.Digest.XXHash.FFI as XXH
import Data.Hashable (hash)

-- User error helper for IOErrors
createError :: String -> IOError
createError :: FilePath -> IOException
createError = FilePath -> IOException
Prelude.userError

-- | Data type for tracking file status
data FileStatus
  = Unchanged     -- ^ File has not changed
  | New           -- ^ New file
  | Modified      -- ^ Existing file with modified content
  | Deleted       -- ^ File no longer exists
  | Renamed FilePath  -- ^ File was renamed (new path)
  deriving (Int -> FileStatus -> ShowS
[FileStatus] -> ShowS
FileStatus -> FilePath
(Int -> FileStatus -> ShowS)
-> (FileStatus -> FilePath)
-> ([FileStatus] -> ShowS)
-> Show FileStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileStatus -> ShowS
showsPrec :: Int -> FileStatus -> ShowS
$cshow :: FileStatus -> FilePath
show :: FileStatus -> FilePath
$cshowList :: [FileStatus] -> ShowS
showList :: [FileStatus] -> ShowS
Show, FileStatus -> FileStatus -> Bool
(FileStatus -> FileStatus -> Bool)
-> (FileStatus -> FileStatus -> Bool) -> Eq FileStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileStatus -> FileStatus -> Bool
== :: FileStatus -> FileStatus -> Bool
$c/= :: FileStatus -> FileStatus -> Bool
/= :: FileStatus -> FileStatus -> Bool
Eq, (forall x. FileStatus -> Rep FileStatus x)
-> (forall x. Rep FileStatus x -> FileStatus) -> Generic FileStatus
forall x. Rep FileStatus x -> FileStatus
forall x. FileStatus -> Rep FileStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileStatus -> Rep FileStatus x
from :: forall x. FileStatus -> Rep FileStatus x
$cto :: forall x. Rep FileStatus x -> FileStatus
to :: forall x. Rep FileStatus x -> FileStatus
Generic)

-- | Calculate XXH3 checksum (64-bit) of a ByteString
-- XXH3 is a fast non-cryptographic hash function with excellent performance
calculateChecksum :: BS.ByteString -> Checksum
calculateChecksum :: ByteString -> Checksum
calculateChecksum ByteString
content =
  let -- Use the newer XXH3 implementation (faster than xxh64)
      hashVal :: Int
hashVal = XXH3 ByteString -> Int
forall a. Hashable a => a -> Int
hash (ByteString -> XXH3 ByteString
forall a. a -> XXH3 a
XXH.XXH3 ByteString
content)
      -- Convert the hash to an absolute value to handle negative hash values
      absHash :: Int
absHash = Int -> Int
forall a. Num a => a -> a
abs Int
hashVal
      -- Convert the 64-bit integer to a hex string for consistent representation
      hexStr :: FilePath
hexStr = Int -> ShowS
forall a. Integral a => a -> ShowS
showHex Int
absHash FilePath
""
  in FilePath -> Checksum
Checksum FilePath
hexStr

-- | Calculate the checksum of a file
-- Only text files are allowed to be checksummed
checksumFile :: FileReadCap -> FilePath -> ClodM Checksum
checksumFile :: FileReadCap -> FilePath -> ClodM Checksum
checksumFile FileReadCap
readCap FilePath
path = do
  -- Check if file exists
  fileExists <- FileReadCap -> FilePath -> ClodM Bool
safeFileExists FileReadCap
readCap FilePath
path
  if not fileExists
    then throwError $ FileSystemError path (createError "File does not exist")
    else do
      -- Check if it's a text file
      isText <- safeIsTextFile readCap path
      if not isText
        then throwError $ ChecksumError $ "Cannot checksum binary or ineligible file: " ++ path
        else do
          -- Read file content and calculate checksum
          content <- safeReadFile readCap path
          return $ calculateChecksum content

-- | Initialize a new, empty database
initializeDatabase :: ClodM ClodDatabase
initializeDatabase :: ClodM ClodDatabase
initializeDatabase = do
  currentTime <- IO UTCTime -> ReaderT ClodConfig (ExceptT ClodError IO) UTCTime
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  return $ ClodDatabase
    { dbFiles = Map.empty
    , dbChecksums = Map.empty
    , dbLastStagingDir = Nothing
    , dbLastRunTime = currentTime
    }

-- | Load the database from disk using Dhall
loadDatabase :: FilePath -> ClodM ClodDatabase
loadDatabase :: FilePath -> ClodM ClodDatabase
loadDatabase FilePath
dbPath = do
  -- Check if the database file exists
  fileExists <- IO Bool -> ClodM Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ClodM Bool) -> IO Bool -> ClodM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
dbPath
  if not fileExists
    then do
      -- If it doesn't exist, create a new database
      db <- initializeDatabase
      -- Ensure the directory exists and save
      liftIO $ createDirectoryIfMissing True (takeDirectory dbPath)
      saveDatabase dbPath db
      return db
    else do
      -- Try to parse the database file using Dhall
      eitherResult <- liftIO $ try @SomeException $ do
        -- Use Dhall.inputFile to correctly parse the database file
        sdb <- Dhall.inputFile Dhall.auto dbPath
        -- Convert to ClodDatabase and return
        return $ fromSerializable sdb
      
      case eitherResult of
        Right ClodDatabase
db -> ClodDatabase -> ClodM ClodDatabase
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ClodDatabase
db
        Left SomeException
err -> do
          -- If parsing fails, log the error in verbose mode
          config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
          when (verbose config) $ 
            liftIO $ putStrLn $ "Warning: Failed to parse database: " ++ show err
          
          -- Create a new database
          whenVerbose $ liftIO $ putStrLn "Creating a new empty database"
          db <- initializeDatabase
          -- Save it right away to ensure it's in the right format for next time
          saveDatabase dbPath db
          return db
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      when (verbose config) action

-- | Save the database to disk using Dhall serialization
saveDatabase :: FilePath -> ClodDatabase -> ClodM ()
saveDatabase :: FilePath
-> ClodDatabase -> ReaderT ClodConfig (ExceptT ClodError IO) ()
saveDatabase FilePath
dbPath ClodDatabase
db = do
  -- Ensure the directory exists
  IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory FilePath
dbPath)
  
  -- Convert to serializable form 
  let serializedDb :: SerializableClodDatabase
serializedDb = ClodDatabase -> SerializableClodDatabase
toSerializable ClodDatabase
db
  
  -- Write to temporary file first to avoid locking issues
  let tempPath :: FilePath
tempPath = FilePath
dbPath FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".new"
  
  -- Use proper Dhall encoding
  eitherResult <- IO (Either IOException ())
-> ReaderT
     ClodConfig (ExceptT ClodError IO) (Either IOException ())
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ())
 -> ReaderT
      ClodConfig (ExceptT ClodError IO) (Either IOException ()))
-> IO (Either IOException ())
-> ReaderT
     ClodConfig (ExceptT ClodError IO) (Either IOException ())
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try @IOException (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ do
    -- Use Dhall's encoding to create a properly formatted Dhall expression
    let dhallExpr :: Expr Src Void
dhallExpr = Encoder SerializableClodDatabase
-> SerializableClodDatabase -> Expr Src Void
forall a. Encoder a -> a -> Expr Src Void
Dhall.embed Encoder SerializableClodDatabase
forall a. ToDhall a => Encoder a
Dhall.inject SerializableClodDatabase
serializedDb
    let dhallText :: Text
dhallText = Expr Src Void -> Text
forall a. Pretty a => a -> Text
Dhall.Core.pretty Expr Src Void
dhallExpr
    
    -- Write to the temp file
    FilePath -> Text -> IO ()
TextIO.writeFile FilePath
tempPath Text
dhallText
    -- Then rename to actual path (atomic operation on most filesystems)
    FilePath -> FilePath -> IO ()
renameFile FilePath
tempPath FilePath
dbPath
  
  case eitherResult of
    Left IOException
err -> ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ClodError
DatabaseError (FilePath -> ClodError) -> FilePath -> ClodError
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to save database: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
err
    Right ()
_ -> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall {m :: * -> *}. MonadReader ClodConfig m => m () -> m ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
 -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Successfully saved database to: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
dbPath
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      when (verbose config) action
      


-- | Update the database with a new file entry
updateDatabase :: ClodDatabase -> FilePath -> Checksum -> UTCTime -> OptimizedName -> ClodDatabase
updateDatabase :: ClodDatabase
-> FilePath -> Checksum -> UTCTime -> OptimizedName -> ClodDatabase
updateDatabase ClodDatabase
db FilePath
path Checksum
checksum UTCTime
modTime OptimizedName
optName =
  let 
    -- Create new file entry
    newEntry :: FileEntry
newEntry = FileEntry
      { entryPath :: FilePath
entryPath = FilePath
path
      , entryChecksum :: Checksum
entryChecksum = Checksum
checksum
      , entryLastModified :: UTCTime
entryLastModified = UTCTime
modTime
      , entryOptimizedName :: OptimizedName
entryOptimizedName = OptimizedName
optName
      }
    
    -- Update maps
    newFiles :: Map FilePath FileEntry
newFiles = FilePath
-> FileEntry -> Map FilePath FileEntry -> Map FilePath FileEntry
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
path FileEntry
newEntry (ClodDatabase -> Map FilePath FileEntry
dbFiles ClodDatabase
db)
    newChecksums :: Map FilePath FilePath
newChecksums = FilePath
-> FilePath -> Map FilePath FilePath -> Map FilePath FilePath
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Checksum -> FilePath
unChecksum Checksum
checksum) FilePath
path (ClodDatabase -> Map FilePath FilePath
dbChecksums ClodDatabase
db)
  in
    ClodDatabase
db { dbFiles = newFiles, dbChecksums = newChecksums }

-- | Detect file status by comparing against database
getFileStatus :: ClodDatabase -> FilePath -> Checksum -> ClodM FileStatus
getFileStatus :: ClodDatabase -> FilePath -> Checksum -> ClodM FileStatus
getFileStatus ClodDatabase
db FilePath
path Checksum
checksum = do
  let 
    files :: Map FilePath FileEntry
files = ClodDatabase -> Map FilePath FileEntry
dbFiles ClodDatabase
db
    checksums :: Map FilePath FilePath
checksums = ClodDatabase -> Map FilePath FilePath
dbChecksums ClodDatabase
db
    checksumStr :: FilePath
checksumStr = Checksum -> FilePath
unChecksum Checksum
checksum

  -- Check if file exists in database
  case FilePath -> Map FilePath FileEntry -> Maybe FileEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
path Map FilePath FileEntry
files of
    -- File doesn't exist in database
    Maybe FileEntry
Nothing -> 
      -- Check if file with same checksum exists (renamed file)
      case FilePath -> Map FilePath FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
checksumStr Map FilePath FilePath
checksums of
        Just FilePath
oldPath -> 
          -- Only consider it renamed if the old path is different
          if FilePath
oldPath FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
path 
            then FileStatus -> ClodM FileStatus
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileStatus -> ClodM FileStatus) -> FileStatus -> ClodM FileStatus
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStatus
Renamed FilePath
oldPath
            else FileStatus -> ClodM FileStatus
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return FileStatus
New
        Maybe FilePath
Nothing -> FileStatus -> ClodM FileStatus
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return FileStatus
New

    -- File exists in database
    Just FileEntry
entry ->
      -- Check if checksum matches
      if FileEntry -> Checksum
entryChecksum FileEntry
entry Checksum -> Checksum -> Bool
forall a. Eq a => a -> a -> Bool
== Checksum
checksum
        then FileStatus -> ClodM FileStatus
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return FileStatus
Unchanged
        else FileStatus -> ClodM FileStatus
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return FileStatus
Modified

-- | Find files that need processing (new, modified, renamed)
findChangedFiles :: ClodDatabase -> [(FilePath, Checksum, UTCTime)] -> ClodM [(FilePath, FileStatus)]
findChangedFiles :: ClodDatabase
-> [(FilePath, Checksum, UTCTime)]
-> ClodM [(FilePath, FileStatus)]
findChangedFiles ClodDatabase
db [(FilePath, Checksum, UTCTime)]
fileInfos = do
  ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall {m :: * -> *}. MonadReader ClodConfig m => m () -> m ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
 -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Processing " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([(FilePath, Checksum, UTCTime)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, Checksum, UTCTime)]
fileInfos) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" files for change detection"
  
  -- Process each file
  [(FilePath, Checksum, UTCTime)]
-> ((FilePath, Checksum, UTCTime)
    -> ReaderT
         ClodConfig (ExceptT ClodError IO) (FilePath, FileStatus))
-> ClodM [(FilePath, FileStatus)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(FilePath, Checksum, UTCTime)]
fileInfos (((FilePath, Checksum, UTCTime)
  -> ReaderT
       ClodConfig (ExceptT ClodError IO) (FilePath, FileStatus))
 -> ClodM [(FilePath, FileStatus)])
-> ((FilePath, Checksum, UTCTime)
    -> ReaderT
         ClodConfig (ExceptT ClodError IO) (FilePath, FileStatus))
-> ClodM [(FilePath, FileStatus)]
forall a b. (a -> b) -> a -> b
$ \(FilePath
path, Checksum
checksum, UTCTime
_) -> do
    status <- ClodDatabase -> FilePath -> Checksum -> ClodM FileStatus
getFileStatus ClodDatabase
db FilePath
path Checksum
checksum
    whenVerbose $ liftIO $ putStrLn $ "File status for " ++ path ++ ": " ++ show status
    return (path, status)
  
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      when (verbose config) action

-- | Find files that have been renamed
findRenamedFiles :: ClodDatabase -> [(FilePath, FileStatus)] -> [(FilePath, FilePath)]
findRenamedFiles :: ClodDatabase -> [(FilePath, FileStatus)] -> [(FilePath, FilePath)]
findRenamedFiles ClodDatabase
_ [(FilePath, FileStatus)]
fileStatuses =
  ((FilePath, FileStatus) -> Maybe (FilePath, FilePath))
-> [(FilePath, FileStatus)] -> [(FilePath, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FilePath, FileStatus) -> Maybe (FilePath, FilePath)
forall {a}. (a, FileStatus) -> Maybe (a, FilePath)
extractRename [(FilePath, FileStatus)]
fileStatuses
  where
    extractRename :: (a, FileStatus) -> Maybe (a, FilePath)
extractRename (a
newPath, Renamed FilePath
oldPath) = (a, FilePath) -> Maybe (a, FilePath)
forall a. a -> Maybe a
Just (a
newPath, FilePath
oldPath)
    extractRename (a, FileStatus)
_ = Maybe (a, FilePath)
forall a. Maybe a
Nothing

-- | Detect changes by comparing current files with database
detectFileChanges :: FileReadCap -> ClodDatabase -> [FilePath] -> FilePath -> ClodM ([(FilePath, FileStatus)], [(FilePath, FilePath)])
detectFileChanges :: FileReadCap
-> ClodDatabase
-> [FilePath]
-> FilePath
-> ClodM ([(FilePath, FileStatus)], [(FilePath, FilePath)])
detectFileChanges FileReadCap
readCap ClodDatabase
db [FilePath]
filePaths FilePath
projectRoot = do
  ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall {m :: * -> *}. MonadReader ClodConfig m => m () -> m ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
 -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Detecting changes for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
filePaths) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" files"
  ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall {m :: * -> *}. MonadReader ClodConfig m => m () -> m ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
 -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Database has " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Map FilePath FileEntry -> Int
forall k a. Map k a -> Int
Map.size (ClodDatabase -> Map FilePath FileEntry
dbFiles ClodDatabase
db)) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" entries"
  
  -- For each file, calculate checksum and get modification time
  fileInfos <- [Maybe (FilePath, Checksum, UTCTime)]
-> [(FilePath, Checksum, UTCTime)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (FilePath, Checksum, UTCTime)]
 -> [(FilePath, Checksum, UTCTime)])
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     [Maybe (FilePath, Checksum, UTCTime)]
-> ReaderT
     ClodConfig (ExceptT ClodError IO) [(FilePath, Checksum, UTCTime)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
-> (FilePath
    -> ReaderT
         ClodConfig
         (ExceptT ClodError IO)
         (Maybe (FilePath, Checksum, UTCTime)))
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     [Maybe (FilePath, Checksum, UTCTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
filePaths (\FilePath
path -> do
      let fullPath :: FilePath
fullPath = FilePath
projectRoot FilePath -> ShowS
</> FilePath
path
      
      -- Check if file exists
      fileExists <- FileReadCap -> FilePath -> ClodM Bool
safeFileExists FileReadCap
readCap FilePath
fullPath
      if not fileExists
        then do
          whenVerbose $ liftIO $ putStrLn $ "File does not exist: " ++ fullPath
          return Nothing
        else do
          -- Check if it's a text file
          isText <- safeIsTextFile readCap fullPath
          if not isText
            then do
              whenVerbose $ liftIO $ putStrLn $ "Not a text file: " ++ fullPath
              return Nothing
            else do
              -- Calculate checksum
              checksum <- checksumFile readCap fullPath
              -- Get modification time
              modTime <- liftIO $ getModificationTime fullPath
              whenVerbose $ liftIO $ putStrLn $ "Processed file: " ++ path ++ " with checksum: " ++ unChecksum checksum
              return $ Just (path, checksum, modTime)
    )
  
  -- Detect file statuses
  whenVerbose $ liftIO $ putStrLn $ "Got " ++ show (length fileInfos) ++ " files to check"
  changedFiles <- findChangedFiles db fileInfos
  
  -- Find renamed files
  let renamedFiles = ClodDatabase -> [(FilePath, FileStatus)] -> [(FilePath, FilePath)]
findRenamedFiles ClodDatabase
db [(FilePath, FileStatus)]
changedFiles
  whenVerbose $ liftIO $ putStrLn $ "Found " ++ show (length renamedFiles) ++ " renamed files"
  
  return (changedFiles, renamedFiles)
  
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      when (verbose config) action


-- | Clean up old staging directories
cleanupStagingDirectories :: ClodM ()
cleanupStagingDirectories :: ReaderT ClodConfig (ExceptT ClodError IO) ()
cleanupStagingDirectories = do
  config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  
  -- Check if there's a previous staging directory to clean up
  case previousStaging config of
    Maybe FilePath
Nothing -> () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just FilePath
oldDir -> do
      -- Check if directory exists
      dirExists <- IO Bool -> ClodM Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ClodM Bool) -> IO Bool -> ClodM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
oldDir
      when dirExists $ do
        -- Remove the directory if it exists
        whenVerbose $ liftIO $ putStrLn $ "Cleaning up previous staging directory: " ++ oldDir
        result <- liftIO $ try $ removeDirectoryRecursive oldDir :: ClodM (Either IOException ())
        case result of
          Left IOException
err -> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall {m :: * -> *}. MonadReader ClodConfig m => m () -> m ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
 -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Warning: Failed to remove old staging directory: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
err
          Right ()
_ -> () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      when (verbose config) action

-- | Find and remove missing files from the database
flushMissingEntries :: FileReadCap -> ClodDatabase -> FilePath -> ClodM ClodDatabase
flushMissingEntries :: FileReadCap -> ClodDatabase -> FilePath -> ClodM ClodDatabase
flushMissingEntries FileReadCap
readCap ClodDatabase
db FilePath
projectRoot = do
  config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  
  -- Don't proceed unless in flush mode
  if not (flushMode config)
    then return db
    else do
      whenVerbose $ liftIO $ putStrLn "Checking for missing files to flush from database..."
      
      -- Check each file in database to see if it still exists
      let files = Map FilePath FileEntry -> [(FilePath, FileEntry)]
forall k a. Map k a -> [(k, a)]
Map.toList (ClodDatabase -> Map FilePath FileEntry
dbFiles ClodDatabase
db)
      existingEntries <- forM files $ \(FilePath
path, FileEntry
entry) -> do
        let fullPath :: FilePath
fullPath = FilePath
projectRoot FilePath -> ShowS
</> FilePath
path
        fileExists <- FileReadCap -> FilePath -> ClodM Bool
safeFileExists FileReadCap
readCap FilePath
fullPath
        
        if fileExists
          then return (path, Just entry)
          else do
            whenVerbose $ liftIO $ putStrLn $ "File no longer exists: " ++ path
            return (path, Nothing)
      
      -- Filter out missing files
      let newFiles = [(FilePath, FileEntry)] -> Map FilePath FileEntry
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(FilePath
path, FileEntry
entry) | (FilePath
path, Just FileEntry
entry) <- [(FilePath, Maybe FileEntry)]
existingEntries]
          missingCount = Map FilePath FileEntry -> Int
forall a. Map FilePath a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClodDatabase -> Map FilePath FileEntry
dbFiles ClodDatabase
db) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Map FilePath FileEntry -> Int
forall k a. Map k a -> Int
Map.size Map FilePath FileEntry
newFiles
          
      -- Rebuild checksums map
      let newChecksums = [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList 
                       ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)] -> Map FilePath FilePath
forall a b. (a -> b) -> a -> b
$ (FileEntry -> (FilePath, FilePath))
-> [FileEntry] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\FileEntry
entry -> (Checksum -> FilePath
unChecksum (FileEntry -> Checksum
entryChecksum FileEntry
entry), FileEntry -> FilePath
entryPath FileEntry
entry)) 
                       ([FileEntry] -> [(FilePath, FilePath)])
-> [FileEntry] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ Map FilePath FileEntry -> [FileEntry]
forall k a. Map k a -> [a]
Map.elems Map FilePath FileEntry
newFiles
      
      -- Report results
      whenVerbose $ liftIO $ putStrLn $ "Removed " ++ show missingCount ++ " missing files from database"
      
      -- Return updated database
      return db { dbFiles = newFiles, dbChecksums = newChecksums }
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      when (verbose config) action