{-# 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  : cyborg@bionicfuzz.com
-- 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 :: [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
  Bool
fileExists <- FileReadCap -> [Char] -> ClodM Bool
safeFileExists FileReadCap
readCap [Char]
path
  if Bool -> Bool
not Bool
fileExists
    then ClodError -> ClodM Checksum
forall a. ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClodError -> ClodM Checksum) -> ClodError -> ClodM Checksum
forall a b. (a -> b) -> a -> b
$ [Char] -> IOException -> ClodError
FileSystemError [Char]
path ([Char] -> IOException
createError [Char]
"File does not exist")
    else do
      -- Check if it's a text file
      Bool
isText <- FileReadCap -> [Char] -> ClodM Bool
safeIsTextFile FileReadCap
readCap [Char]
path
      if Bool -> Bool
not Bool
isText
        then ClodError -> ClodM Checksum
forall a. ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClodError -> ClodM Checksum) -> ClodError -> ClodM Checksum
forall a b. (a -> b) -> a -> b
$ [Char] -> ClodError
ChecksumError ([Char] -> ClodError) -> [Char] -> ClodError
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot checksum binary or ineligible file: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path
        else do
          -- Read file content and calculate checksum
          ByteString
content <- FileReadCap -> [Char] -> ClodM ByteString
safeReadFile FileReadCap
readCap [Char]
path
          Checksum -> ClodM Checksum
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Checksum -> ClodM Checksum) -> Checksum -> ClodM Checksum
forall a b. (a -> b) -> a -> b
$ ByteString -> Checksum
calculateChecksum ByteString
content

-- | Initialize a new, empty database
initializeDatabase :: ClodM ClodDatabase
initializeDatabase :: ClodM ClodDatabase
initializeDatabase = do
  UTCTime
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
  ClodDatabase -> ClodM ClodDatabase
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClodDatabase -> ClodM ClodDatabase)
-> ClodDatabase -> ClodM ClodDatabase
forall a b. (a -> b) -> a -> b
$ ClodDatabase
    { dbFiles :: Map [Char] FileEntry
dbFiles = Map [Char] FileEntry
forall k a. Map k a
Map.empty
    , dbChecksums :: Map [Char] [Char]
dbChecksums = Map [Char] [Char]
forall k a. Map k a
Map.empty
    , dbLastStagingDir :: Maybe [Char]
dbLastStagingDir = Maybe [Char]
forall a. Maybe a
Nothing
    , dbLastRunTime :: UTCTime
dbLastRunTime = UTCTime
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
  Bool
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 Bool -> Bool
not Bool
fileExists
    then do
      -- If it doesn't exist, create a new database
      ClodDatabase
db <- ClodM ClodDatabase
initializeDatabase
      -- Ensure the directory exists and save
      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)
      [Char]
-> ClodDatabase -> ReaderT ClodConfig (ExceptT ClodError IO) ()
saveDatabase [Char]
dbPath 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
    else do
      -- Try to parse the database file using Dhall
      Either SomeException ClodDatabase
eitherResult <- IO (Either SomeException ClodDatabase)
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     (Either SomeException ClodDatabase)
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException ClodDatabase)
 -> ReaderT
      ClodConfig
      (ExceptT ClodError IO)
      (Either SomeException ClodDatabase))
-> IO (Either SomeException ClodDatabase)
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     (Either SomeException ClodDatabase)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (IO ClodDatabase -> IO (Either SomeException ClodDatabase))
-> IO ClodDatabase -> IO (Either SomeException ClodDatabase)
forall a b. (a -> b) -> a -> b
$ do
        -- Use Dhall.inputFile to correctly parse the database file
        SerializableClodDatabase
sdb <- Decoder SerializableClodDatabase
-> [Char] -> IO SerializableClodDatabase
forall a. Decoder a -> [Char] -> IO a
Dhall.inputFile Decoder SerializableClodDatabase
forall a. FromDhall a => Decoder a
Dhall.auto [Char]
dbPath
        -- Convert to ClodDatabase and return
        ClodDatabase -> IO ClodDatabase
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClodDatabase -> IO ClodDatabase)
-> ClodDatabase -> IO ClodDatabase
forall a b. (a -> b) -> a -> b
$ SerializableClodDatabase -> ClodDatabase
fromSerializable SerializableClodDatabase
sdb
      
      case Either SomeException ClodDatabase
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
          ClodConfig
config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
          Bool
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) (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 parse database: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
err
          
          -- Create a new database
          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
$ [Char] -> IO ()
putStrLn [Char]
"Creating a new empty database"
          ClodDatabase
db <- ClodM ClodDatabase
initializeDatabase
          -- Save it right away to ensure it's in the right format for next time
          [Char]
-> ClodDatabase -> ReaderT ClodConfig (ExceptT ClodError IO) ()
saveDatabase [Char]
dbPath 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
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      ClodConfig
config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) m ()
action

-- | 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
  Either IOException ()
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 Either IOException ()
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] -> ClodError
DatabaseError ([Char] -> ClodError) -> [Char] -> ClodError
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to save database: " [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) ()
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
$ [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
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      ClodConfig
config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) m ()
action
      


-- | 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
    newFiles :: Map [Char] FileEntry
newFiles = [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 (ClodDatabase -> Map [Char] FileEntry
dbFiles ClodDatabase
db)
    newChecksums :: Map [Char] [Char]
newChecksums = [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 (ClodDatabase -> Map [Char] [Char]
dbChecksums ClodDatabase
db)
  in
    ClodDatabase
db { dbFiles :: Map [Char] FileEntry
dbFiles = Map [Char] FileEntry
newFiles, dbChecksums :: Map [Char] [Char]
dbChecksums = Map [Char] [Char]
newChecksums }

-- | 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 -> Map [Char] FileEntry
dbFiles ClodDatabase
db
    checksums :: Map [Char] [Char]
checksums = ClodDatabase -> Map [Char] [Char]
dbChecksums ClodDatabase
db
    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 -> 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
-> [([Char], Checksum, UTCTime)] -> ClodM [([Char], FileStatus)]
findChangedFiles ClodDatabase
db [([Char], 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
$ [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
    FileStatus
status <- ClodDatabase -> [Char] -> Checksum -> ClodM FileStatus
getFileStatus ClodDatabase
db [Char]
path Checksum
checksum
    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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"File status for " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FileStatus -> [Char]
forall a. Show a => a -> [Char]
show FileStatus
status
    ([Char], FileStatus)
-> ReaderT ClodConfig (ExceptT ClodError IO) ([Char], FileStatus)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
path, FileStatus
status)
  
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      ClodConfig
config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) m ()
action

-- | 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) ()
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
$ [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) ()
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
$ [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 -> Map [Char] FileEntry
dbFiles ClodDatabase
db)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" entries"
  
  -- For each file, calculate checksum and get modification time
  [([Char], Checksum, UTCTime)]
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
      Bool
fileExists <- FileReadCap -> [Char] -> ClodM Bool
safeFileExists FileReadCap
readCap [Char]
fullPath
      if Bool -> Bool
not Bool
fileExists
        then 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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"File does not exist: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fullPath
          Maybe ([Char], Checksum, UTCTime)
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     (Maybe ([Char], Checksum, UTCTime))
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Char], Checksum, UTCTime)
forall a. Maybe a
Nothing
        else do
          -- Check if it's a text file
          Bool
isText <- FileReadCap -> [Char] -> ClodM Bool
safeIsTextFile FileReadCap
readCap [Char]
fullPath
          if Bool -> Bool
not Bool
isText
            then 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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Not a text file: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fullPath
              Maybe ([Char], Checksum, UTCTime)
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     (Maybe ([Char], Checksum, UTCTime))
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Char], Checksum, UTCTime)
forall a. Maybe a
Nothing
            else do
              -- Calculate checksum
              Checksum
checksum <- FileReadCap -> [Char] -> ClodM Checksum
checksumFile FileReadCap
readCap [Char]
fullPath
              -- Get modification time
              UTCTime
modTime <- 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 -> ReaderT ClodConfig (ExceptT ClodError IO) UTCTime)
-> IO UTCTime -> ReaderT ClodConfig (ExceptT ClodError IO) UTCTime
forall a b. (a -> b) -> a -> b
$ [Char] -> IO UTCTime
getModificationTime [Char]
fullPath
              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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Processed file: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" with checksum: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Checksum -> [Char]
unChecksum Checksum
checksum
              Maybe ([Char], Checksum, UTCTime)
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     (Maybe ([Char], Checksum, UTCTime))
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([Char], Checksum, UTCTime)
 -> ReaderT
      ClodConfig
      (ExceptT ClodError IO)
      (Maybe ([Char], Checksum, UTCTime)))
-> Maybe ([Char], Checksum, UTCTime)
-> ReaderT
     ClodConfig
     (ExceptT ClodError IO)
     (Maybe ([Char], Checksum, UTCTime))
forall a b. (a -> b) -> a -> b
$ ([Char], Checksum, UTCTime) -> Maybe ([Char], Checksum, UTCTime)
forall a. a -> Maybe a
Just ([Char]
path, Checksum
checksum, UTCTime
modTime)
    )
  
  -- Detect file statuses
  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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Got " [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 to check"
  [([Char], FileStatus)]
changedFiles <- ClodDatabase
-> [([Char], Checksum, UTCTime)] -> ClodM [([Char], FileStatus)]
findChangedFiles ClodDatabase
db [([Char], Checksum, UTCTime)]
fileInfos
  
  -- Find renamed files
  let renamedFiles :: [([Char], [Char])]
renamedFiles = ClodDatabase -> [([Char], FileStatus)] -> [([Char], [Char])]
findRenamedFiles ClodDatabase
db [([Char], FileStatus)]
changedFiles
  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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Found " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([([Char], [Char])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Char], [Char])]
renamedFiles) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" renamed files"
  
  ([([Char], FileStatus)], [([Char], [Char])])
-> ClodM ([([Char], FileStatus)], [([Char], [Char])])
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char], FileStatus)]
changedFiles, [([Char], [Char])]
renamedFiles)
  
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      ClodConfig
config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) m ()
action


-- | Clean up old staging directories
cleanupStagingDirectories :: ClodM ()
cleanupStagingDirectories :: ReaderT ClodConfig (ExceptT ClodError IO) ()
cleanupStagingDirectories = do
  ClodConfig
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 ClodConfig -> Maybe [Char]
previousStaging ClodConfig
config 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
      Bool
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
      Bool
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
dirExists (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
$ do
        -- Remove the directory if it exists
        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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Cleaning up previous staging directory: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
oldDir
        Either IOException ()
result <- 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
$ IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeDirectoryRecursive [Char]
oldDir :: ClodM (Either IOException ())
        case Either IOException ()
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
$ [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 ()
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      ClodConfig
config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) m ()
action

-- | 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
  ClodConfig
config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  
  -- Don't proceed unless in flush mode
  if Bool -> Bool
not (ClodConfig -> Bool
flushMode ClodConfig
config)
    then ClodDatabase -> ClodM ClodDatabase
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ClodDatabase
db
    else 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
$ [Char] -> IO ()
putStrLn [Char]
"Checking for missing files to flush from database..."
      
      -- Check each file in database to see if it still exists
      let files :: [([Char], FileEntry)]
files = Map [Char] FileEntry -> [([Char], FileEntry)]
forall k a. Map k a -> [(k, a)]
Map.toList (ClodDatabase -> Map [Char] FileEntry
dbFiles ClodDatabase
db)
      [([Char], Maybe FileEntry)]
existingEntries <- [([Char], FileEntry)]
-> (([Char], FileEntry)
    -> ReaderT
         ClodConfig (ExceptT ClodError IO) ([Char], Maybe FileEntry))
-> ReaderT
     ClodConfig (ExceptT ClodError IO) [([Char], Maybe FileEntry)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([Char], FileEntry)]
files ((([Char], FileEntry)
  -> ReaderT
       ClodConfig (ExceptT ClodError IO) ([Char], Maybe FileEntry))
 -> ReaderT
      ClodConfig (ExceptT ClodError IO) [([Char], Maybe FileEntry)])
-> (([Char], FileEntry)
    -> ReaderT
         ClodConfig (ExceptT ClodError IO) ([Char], Maybe FileEntry))
-> ReaderT
     ClodConfig (ExceptT ClodError IO) [([Char], Maybe FileEntry)]
forall a b. (a -> b) -> a -> b
$ \([Char]
path, FileEntry
entry) -> do
        let fullPath :: [Char]
fullPath = [Char]
projectRoot [Char] -> ShowS
</> [Char]
path
        Bool
fileExists <- FileReadCap -> [Char] -> ClodM Bool
safeFileExists FileReadCap
readCap [Char]
fullPath
        
        if Bool
fileExists
          then ([Char], Maybe FileEntry)
-> ReaderT
     ClodConfig (ExceptT ClodError IO) ([Char], Maybe FileEntry)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
path, FileEntry -> Maybe FileEntry
forall a. a -> Maybe a
Just FileEntry
entry)
          else 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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"File no longer exists: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path
            ([Char], Maybe FileEntry)
-> ReaderT
     ClodConfig (ExceptT ClodError IO) ([Char], Maybe FileEntry)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
path, Maybe FileEntry
forall a. Maybe a
Nothing)
      
      -- Filter out missing files
      let newFiles :: Map [Char] FileEntry
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 :: Int
missingCount = Map [Char] FileEntry -> Int
forall a. Map [Char] a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClodDatabase -> Map [Char] FileEntry
dbFiles ClodDatabase
db) 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 :: Map [Char] [Char]
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 -> Checksum
entryChecksum FileEntry
entry), FileEntry -> [Char]
entryPath FileEntry
entry)) 
                       ([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
      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
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Removed " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
missingCount [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" missing files from database"
      
      -- Return updated database
      ClodDatabase -> ClodM ClodDatabase
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ClodDatabase
db { dbFiles :: Map [Char] FileEntry
dbFiles = Map [Char] FileEntry
newFiles, dbChecksums :: Map [Char] [Char]
dbChecksums = Map [Char] [Char]
newChecksums }
  where
    whenVerbose :: m () -> m ()
whenVerbose m ()
action = do
      ClodConfig
config <- m ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) m ()
action