{-# 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  : fuzz@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 (forM, when)
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 ((^.), (.~), (%~), (&), verbose, flushMode, dbFiles, dbChecksums,
                  entryChecksum, entryPath, previousStaging, 
                  ClodDatabase(..), FileEntry(..), 
                  Checksum(..), ClodM, FileReadCap(..), ClodError(..), OptimizedName(..),
                  DatabaseErrorType(..), -- Add the DatabaseErrorType
                  toSerializable, fromSerializable, ask, liftIO, throwError)
import Clod.FileSystem.Detection (safeFileExists, safeIsTextFile)
import Clod.FileSystem.Operations (safeReadFile)
import Clod.Output (whenVerbose)

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 :: [Char] -> IOException
createError = [Char] -> 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 -> [Char]
(Int -> FileStatus -> ShowS)
-> (FileStatus -> [Char])
-> ([FileStatus] -> ShowS)
-> Show FileStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileStatus -> ShowS
showsPrec :: Int -> FileStatus -> ShowS
$cshow :: FileStatus -> [Char]
show :: FileStatus -> [Char]
$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 :: [Char]
hexStr = Int -> ShowS
forall a. Integral a => a -> ShowS
showHex Int
absHash [Char]
""
  in [Char] -> Checksum
Checksum [Char]
hexStr

-- | Calculate the checksum of a file
-- Only text files are allowed to be checksummed
checksumFile :: FileReadCap -> FilePath -> ClodM Checksum
checksumFile :: FileReadCap -> [Char] -> ClodM Checksum
checksumFile FileReadCap
readCap [Char]
path = do
  -- Check if file exists
  fileExists <- FileReadCap -> [Char] -> ClodM Bool
safeFileExists FileReadCap
readCap [Char]
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 path "Cannot checksum binary or ineligible file"
        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 :: [Char] -> ClodM ClodDatabase
loadDatabase [Char]
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
$ [Char] -> IO Bool
doesFileExist [Char]
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 (config ^. verbose) $ do
            liftIO $ putStrLn $ "Warning: Failed to parse database: " ++ show err
            -- Log the enhanced error format for better diagnostics
            liftIO $ putStrLn $ "Database error details: " ++ 
              show (DatabaseError dbPath (DBCorrupted (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

-- | Save the database to disk using Dhall serialization
saveDatabase :: FilePath -> ClodDatabase -> ClodM ()
saveDatabase :: [Char]
-> ClodDatabase -> ReaderT ClodConfig (ExceptT ClodError IO) ()
saveDatabase [Char]
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 -> [Char] -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory [Char]
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 :: [Char]
tempPath = [Char]
dbPath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".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
    [Char] -> Text -> IO ()
TextIO.writeFile [Char]
tempPath Text
dhallText
    -- Then rename to actual path (atomic operation on most filesystems)
    [Char] -> [Char] -> IO ()
renameFile [Char]
tempPath [Char]
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
$ [Char] -> DatabaseErrorType -> ClodError
DatabaseError [Char]
dbPath ([Char] -> DatabaseErrorType
DBOtherError ([Char] -> DatabaseErrorType) -> [Char] -> DatabaseErrorType
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to save: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> [Char]
forall a. Show a => a -> [Char]
show IOException
err)
    Right ()
_ -> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Successfully saved database to: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
dbPath
      


-- | Update the database with a new file entry
updateDatabase :: ClodDatabase -> FilePath -> Checksum -> UTCTime -> OptimizedName -> ClodDatabase
updateDatabase :: ClodDatabase
-> [Char] -> Checksum -> UTCTime -> OptimizedName -> ClodDatabase
updateDatabase ClodDatabase
db [Char]
path Checksum
checksum UTCTime
modTime OptimizedName
optName =
  let 
    -- Create new file entry
    newEntry :: FileEntry
newEntry = FileEntry
      { _entryPath :: [Char]
_entryPath = [Char]
path
      , _entryChecksum :: Checksum
_entryChecksum = Checksum
checksum
      , _entryLastModified :: UTCTime
_entryLastModified = UTCTime
modTime
      , _entryOptimizedName :: OptimizedName
_entryOptimizedName = OptimizedName
optName
      }
    
    -- Update maps using lenses
    db1 :: ClodDatabase
db1 = ClodDatabase
db ClodDatabase -> (ClodDatabase -> ClodDatabase) -> ClodDatabase
forall a b. a -> (a -> b) -> b
& (Map [Char] FileEntry -> Identity (Map [Char] FileEntry))
-> ClodDatabase -> Identity ClodDatabase
Lens' ClodDatabase (Map [Char] FileEntry)
dbFiles ((Map [Char] FileEntry -> Identity (Map [Char] FileEntry))
 -> ClodDatabase -> Identity ClodDatabase)
-> (Map [Char] FileEntry -> Map [Char] FileEntry)
-> ClodDatabase
-> ClodDatabase
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [Char] -> FileEntry -> Map [Char] FileEntry -> Map [Char] FileEntry
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
path FileEntry
newEntry
    db2 :: ClodDatabase
db2 = ClodDatabase
db1 ClodDatabase -> (ClodDatabase -> ClodDatabase) -> ClodDatabase
forall a b. a -> (a -> b) -> b
& (Map [Char] [Char] -> Identity (Map [Char] [Char]))
-> ClodDatabase -> Identity ClodDatabase
Lens' ClodDatabase (Map [Char] [Char])
dbChecksums ((Map [Char] [Char] -> Identity (Map [Char] [Char]))
 -> ClodDatabase -> Identity ClodDatabase)
-> (Map [Char] [Char] -> Map [Char] [Char])
-> ClodDatabase
-> ClodDatabase
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [Char] -> [Char] -> Map [Char] [Char] -> Map [Char] [Char]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Checksum -> [Char]
unChecksum Checksum
checksum) [Char]
path
  in
    ClodDatabase
db2

-- | Detect file status by comparing against database
getFileStatus :: ClodDatabase -> FilePath -> Checksum -> ClodM FileStatus
getFileStatus :: ClodDatabase -> [Char] -> Checksum -> ClodM FileStatus
getFileStatus ClodDatabase
db [Char]
path Checksum
checksum = do
  let 
    files :: Map [Char] FileEntry
files = ClodDatabase
db ClodDatabase
-> Getting
     (Map [Char] FileEntry) ClodDatabase (Map [Char] FileEntry)
-> Map [Char] FileEntry
forall s a. s -> Getting a s a -> a
^. Getting (Map [Char] FileEntry) ClodDatabase (Map [Char] FileEntry)
Lens' ClodDatabase (Map [Char] FileEntry)
dbFiles
    checksums :: Map [Char] [Char]
checksums = ClodDatabase
db ClodDatabase
-> Getting (Map [Char] [Char]) ClodDatabase (Map [Char] [Char])
-> Map [Char] [Char]
forall s a. s -> Getting a s a -> a
^. Getting (Map [Char] [Char]) ClodDatabase (Map [Char] [Char])
Lens' ClodDatabase (Map [Char] [Char])
dbChecksums
    checksumStr :: [Char]
checksumStr = Checksum -> [Char]
unChecksum Checksum
checksum

  -- Check if file exists in database
  case [Char] -> Map [Char] FileEntry -> Maybe FileEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
path Map [Char] FileEntry
files of
    -- File doesn't exist in database
    Maybe FileEntry
Nothing -> 
      -- Check if file with same checksum exists (renamed file)
      case [Char] -> Map [Char] [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
checksumStr Map [Char] [Char]
checksums of
        Just [Char]
oldPath -> 
          -- Only consider it renamed if the old path is different
          if [Char]
oldPath [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
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
$ [Char] -> FileStatus
Renamed [Char]
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 [Char]
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
entry FileEntry -> Getting Checksum FileEntry Checksum -> Checksum
forall s a. s -> Getting a s a -> a
^. Getting Checksum FileEntry Checksum
Lens' FileEntry Checksum
entryChecksum 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
-> [([Char], Checksum, UTCTime)] -> ClodM [([Char], FileStatus)]
findChangedFiles ClodDatabase
db [([Char], Checksum, UTCTime)]
fileInfos = do
  ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Processing " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([([Char], Checksum, UTCTime)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Char], Checksum, UTCTime)]
fileInfos) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" files for change detection"
  
  -- Process each file
  [([Char], Checksum, UTCTime)]
-> (([Char], Checksum, UTCTime)
    -> ReaderT ClodConfig (ExceptT ClodError IO) ([Char], FileStatus))
-> ClodM [([Char], FileStatus)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([Char], Checksum, UTCTime)]
fileInfos ((([Char], Checksum, UTCTime)
  -> ReaderT ClodConfig (ExceptT ClodError IO) ([Char], FileStatus))
 -> ClodM [([Char], FileStatus)])
-> (([Char], Checksum, UTCTime)
    -> ReaderT ClodConfig (ExceptT ClodError IO) ([Char], FileStatus))
-> ClodM [([Char], FileStatus)]
forall a b. (a -> b) -> a -> b
$ \([Char]
path, Checksum
checksum, UTCTime
_) -> do
    status <- ClodDatabase -> [Char] -> Checksum -> ClodM FileStatus
getFileStatus ClodDatabase
db [Char]
path Checksum
checksum
    whenVerbose $ liftIO $ putStrLn $ "File status for " ++ path ++ ": " ++ show status
    return (path, status)

-- | Find files that have been renamed
findRenamedFiles :: ClodDatabase -> [(FilePath, FileStatus)] -> [(FilePath, FilePath)]
findRenamedFiles :: ClodDatabase -> [([Char], FileStatus)] -> [([Char], [Char])]
findRenamedFiles ClodDatabase
_ [([Char], FileStatus)]
fileStatuses =
  (([Char], FileStatus) -> Maybe ([Char], [Char]))
-> [([Char], FileStatus)] -> [([Char], [Char])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Char], FileStatus) -> Maybe ([Char], [Char])
forall {a}. (a, FileStatus) -> Maybe (a, [Char])
extractRename [([Char], FileStatus)]
fileStatuses
  where
    extractRename :: (a, FileStatus) -> Maybe (a, [Char])
extractRename (a
newPath, Renamed [Char]
oldPath) = (a, [Char]) -> Maybe (a, [Char])
forall a. a -> Maybe a
Just (a
newPath, [Char]
oldPath)
    extractRename (a, FileStatus)
_ = Maybe (a, [Char])
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
-> [[Char]]
-> [Char]
-> ClodM ([([Char], FileStatus)], [([Char], [Char])])
detectFileChanges FileReadCap
readCap ClodDatabase
db [[Char]]
filePaths [Char]
projectRoot = do
  ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Detecting changes for " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
filePaths) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" files"
  ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Database has " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Map [Char] FileEntry -> Int
forall k a. Map k a -> Int
Map.size (ClodDatabase
db ClodDatabase
-> Getting
     (Map [Char] FileEntry) ClodDatabase (Map [Char] FileEntry)
-> Map [Char] FileEntry
forall s a. s -> Getting a s a -> a
^. Getting (Map [Char] FileEntry) ClodDatabase (Map [Char] FileEntry)
Lens' ClodDatabase (Map [Char] FileEntry)
dbFiles)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" entries"
  
  -- For each file, calculate checksum and get modification time
  fileInfos <- [Maybe ([Char], Checksum, UTCTime)]
-> [([Char], Checksum, UTCTime)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ([Char], Checksum, UTCTime)]
 -> [([Char], Checksum, UTCTime)])
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     [Maybe ([Char], Checksum, UTCTime)]
-> ReaderT
     ClodConfig (ExceptT ClodError IO) [([Char], Checksum, UTCTime)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
-> ([Char]
    -> ReaderT
         ClodConfig
         (ExceptT ClodError IO)
         (Maybe ([Char], Checksum, UTCTime)))
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     [Maybe ([Char], Checksum, UTCTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Char]]
filePaths (\[Char]
path -> do
      let fullPath :: [Char]
fullPath = [Char]
projectRoot [Char] -> ShowS
</> [Char]
path
      
      -- Check if file exists
      fileExists <- FileReadCap -> [Char] -> ClodM Bool
safeFileExists FileReadCap
readCap [Char]
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 -> [([Char], FileStatus)] -> [([Char], [Char])]
findRenamedFiles ClodDatabase
db [([Char], FileStatus)]
changedFiles
  whenVerbose $ liftIO $ putStrLn $ "Found " ++ show (length renamedFiles) ++ " renamed files"
  
  return (changedFiles, renamedFiles)
  


-- | 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 config ^. previousStaging of
    Maybe [Char]
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 [Char]
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
$ [Char] -> IO Bool
doesDirectoryExist [Char]
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) ()
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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Warning: Failed to remove old staging directory: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> [Char]
forall a. Show a => a -> [Char]
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 ()


-- | Find and remove missing files from the database
flushMissingEntries :: FileReadCap -> ClodDatabase -> FilePath -> ClodM ClodDatabase
flushMissingEntries :: FileReadCap -> ClodDatabase -> [Char] -> ClodM ClodDatabase
flushMissingEntries FileReadCap
readCap ClodDatabase
db [Char]
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 (config ^. flushMode)
    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 [Char] FileEntry -> [([Char], FileEntry)]
forall k a. Map k a -> [(k, a)]
Map.toList (ClodDatabase
db ClodDatabase
-> Getting
     (Map [Char] FileEntry) ClodDatabase (Map [Char] FileEntry)
-> Map [Char] FileEntry
forall s a. s -> Getting a s a -> a
^. Getting (Map [Char] FileEntry) ClodDatabase (Map [Char] FileEntry)
Lens' ClodDatabase (Map [Char] FileEntry)
dbFiles)
      existingEntries <- forM files $ \([Char]
path, FileEntry
entry) -> do
        let fullPath :: [Char]
fullPath = [Char]
projectRoot [Char] -> ShowS
</> [Char]
path
        fileExists <- FileReadCap -> [Char] -> ClodM Bool
safeFileExists FileReadCap
readCap [Char]
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 = [([Char], FileEntry)] -> Map [Char] FileEntry
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [([Char]
path, FileEntry
entry) | ([Char]
path, Just FileEntry
entry) <- [([Char], Maybe FileEntry)]
existingEntries]
          missingCount = Map [Char] FileEntry -> Int
forall k a. Map k a -> Int
Map.size (ClodDatabase
db ClodDatabase
-> Getting
     (Map [Char] FileEntry) ClodDatabase (Map [Char] FileEntry)
-> Map [Char] FileEntry
forall s a. s -> Getting a s a -> a
^. Getting (Map [Char] FileEntry) ClodDatabase (Map [Char] FileEntry)
Lens' ClodDatabase (Map [Char] FileEntry)
dbFiles) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Map [Char] FileEntry -> Int
forall k a. Map k a -> Int
Map.size Map [Char] FileEntry
newFiles
          
      -- Rebuild checksums map
      let newChecksums = [([Char], [Char])] -> Map [Char] [Char]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList 
                       ([([Char], [Char])] -> Map [Char] [Char])
-> [([Char], [Char])] -> Map [Char] [Char]
forall a b. (a -> b) -> a -> b
$ (FileEntry -> ([Char], [Char]))
-> [FileEntry] -> [([Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (\FileEntry
entry -> (Checksum -> [Char]
unChecksum (FileEntry
entry FileEntry -> Getting Checksum FileEntry Checksum -> Checksum
forall s a. s -> Getting a s a -> a
^. Getting Checksum FileEntry Checksum
Lens' FileEntry Checksum
entryChecksum), FileEntry
entry FileEntry -> Getting [Char] FileEntry [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^. Getting [Char] FileEntry [Char]
Lens' FileEntry [Char]
entryPath)) 
                       ([FileEntry] -> [([Char], [Char])])
-> [FileEntry] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ Map [Char] FileEntry -> [FileEntry]
forall k a. Map k a -> [a]
Map.elems Map [Char] FileEntry
newFiles
      
      -- Report results
      whenVerbose $ liftIO $ putStrLn $ "Removed " ++ show missingCount ++ " missing files from database"
      
      -- Return updated database
      let db1 = ClodDatabase
db ClodDatabase -> (ClodDatabase -> ClodDatabase) -> ClodDatabase
forall a b. a -> (a -> b) -> b
& (Map [Char] FileEntry -> Identity (Map [Char] FileEntry))
-> ClodDatabase -> Identity ClodDatabase
Lens' ClodDatabase (Map [Char] FileEntry)
dbFiles ((Map [Char] FileEntry -> Identity (Map [Char] FileEntry))
 -> ClodDatabase -> Identity ClodDatabase)
-> Map [Char] FileEntry -> ClodDatabase -> ClodDatabase
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map [Char] FileEntry
newFiles
          db2 = ClodDatabase
db1 ClodDatabase -> (ClodDatabase -> ClodDatabase) -> ClodDatabase
forall a b. a -> (a -> b) -> b
& (Map [Char] [Char] -> Identity (Map [Char] [Char]))
-> ClodDatabase -> Identity ClodDatabase
Lens' ClodDatabase (Map [Char] [Char])
dbChecksums ((Map [Char] [Char] -> Identity (Map [Char] [Char]))
 -> ClodDatabase -> Identity ClodDatabase)
-> Map [Char] [Char] -> ClodDatabase -> ClodDatabase
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map [Char] [Char]
newChecksums
      return db2