{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE LambdaCase #-}
module Clod.Core
(
runClodApp
, processFile
, findAllFiles
) where
import System.Directory (createDirectoryIfMissing, getModificationTime)
import System.FilePath ((</>), takeFileName)
import System.IO (stdout, stderr, hPutStrLn)
import Data.Version (showVersion)
import Control.Monad (when, unless, filterM, forM_)
import Clod.Types
import Clod.IgnorePatterns (matchesIgnorePattern, readClodIgnore, readGitIgnore)
import Clod.FileSystem.Detection (safeFileExists, safeIsTextFile)
import Clod.FileSystem.Operations (safeCopyFile, findAllFiles)
import Clod.FileSystem.Processing (processFiles, writeManifestFile, createOptimizedName)
import Clod.FileSystem.Checksums (FileStatus(Unchanged, Modified, New, Renamed), detectFileChanges,
loadDatabase, saveDatabase, updateDatabase,
cleanupStagingDirectories, flushMissingEntries,
checksumFile)
import qualified Paths_clod as Meta
checkIgnorePatterns :: FilePath -> FilePath -> ClodM (Either String FileResult)
checkIgnorePatterns :: [Char] -> [Char] -> ClodM (Either [Char] FileResult)
checkIgnorePatterns [Char]
_ [Char]
relPath = do
[IgnorePattern]
patterns <- ClodConfig -> [IgnorePattern]
ignorePatterns (ClodConfig -> [IgnorePattern])
-> ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
-> ReaderT ClodConfig (ExceptT ClodError IO) [IgnorePattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
if Bool -> Bool
not ([IgnorePattern] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IgnorePattern]
patterns) Bool -> Bool -> Bool
&& [IgnorePattern] -> [Char] -> Bool
matchesIgnorePattern [IgnorePattern]
patterns [Char]
relPath
then Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] FileResult -> ClodM (Either [Char] FileResult))
-> Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] FileResult
forall a b. a -> Either a b
Left [Char]
"matched .clodignore pattern"
else Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] FileResult -> ClodM (Either [Char] FileResult))
-> Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a b. (a -> b) -> a -> b
$ FileResult -> Either [Char] FileResult
forall a b. b -> Either a b
Right FileResult
Success
checkFileExists :: FileReadCap -> FilePath -> FilePath -> ClodM (Either String FileResult)
checkFileExists :: FileReadCap -> [Char] -> [Char] -> ClodM (Either [Char] FileResult)
checkFileExists FileReadCap
readCap [Char]
fullPath [Char]
_ = do
Bool
exists <- FileReadCap -> [Char] -> ClodM Bool
safeFileExists FileReadCap
readCap [Char]
fullPath
if Bool
exists
then Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] FileResult -> ClodM (Either [Char] FileResult))
-> Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a b. (a -> b) -> a -> b
$ FileResult -> Either [Char] FileResult
forall a b. b -> Either a b
Right FileResult
Success
else Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] FileResult -> ClodM (Either [Char] FileResult))
-> Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] FileResult
forall a b. a -> Either a b
Left [Char]
"file does not exist"
checkIsTextFile :: FileReadCap -> FilePath -> FilePath -> ClodM (Either String FileResult)
checkIsTextFile :: FileReadCap -> [Char] -> [Char] -> ClodM (Either [Char] FileResult)
checkIsTextFile FileReadCap
readCap [Char]
fullPath [Char]
_ = do
Bool
exists <- FileReadCap -> [Char] -> ClodM Bool
safeFileExists FileReadCap
readCap [Char]
fullPath
if Bool -> Bool
not Bool
exists
then Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] FileResult -> ClodM (Either [Char] FileResult))
-> Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] FileResult
forall a b. a -> Either a b
Left [Char]
"file does not exist"
else do
Bool
isText <- FileReadCap -> [Char] -> ClodM Bool
safeIsTextFile FileReadCap
readCap [Char]
fullPath
if Bool
isText
then Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] FileResult -> ClodM (Either [Char] FileResult))
-> Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a b. (a -> b) -> a -> b
$ FileResult -> Either [Char] FileResult
forall a b. b -> Either a b
Right FileResult
Success
else Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] FileResult -> ClodM (Either [Char] FileResult))
-> Either [Char] FileResult -> ClodM (Either [Char] FileResult)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] FileResult
forall a b. a -> Either a b
Left [Char]
"binary file"
copyToStaging :: FileReadCap -> FileWriteCap -> FilePath -> FilePath -> ClodM (Either String FileResult)
copyToStaging :: FileReadCap
-> FileWriteCap
-> [Char]
-> [Char]
-> ClodM (Either [Char] FileResult)
copyToStaging FileReadCap
readCap FileWriteCap
writeCap [Char]
fullPath [Char]
relPath = do
[Char]
stagingPath <- ClodConfig -> [Char]
currentStaging (ClodConfig -> [Char])
-> ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
-> ReaderT ClodConfig (ExceptT ClodError IO) [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
let fileName :: [Char]
fileName = [Char] -> [Char]
takeFileName [Char]
relPath
destPath :: [Char]
destPath = [Char]
stagingPath [Char] -> [Char] -> [Char]
</> [Char]
fileName
FileReadCap -> FileWriteCap -> [Char] -> [Char] -> ClodM ()
safeCopyFile FileReadCap
readCap FileWriteCap
writeCap [Char]
fullPath [Char]
destPath
ClodConfig
config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Copied: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
relPath [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" → " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fileName
pure $ FileResult -> Either [Char] FileResult
forall a b. b -> Either a b
Right FileResult
Success
processFile :: FileReadCap
-> FileWriteCap
-> FilePath
-> FilePath
-> ClodM FileResult
processFile :: FileReadCap -> FileWriteCap -> [Char] -> [Char] -> ClodM FileResult
processFile FileReadCap
readCap FileWriteCap
writeCap [Char]
fullPath [Char]
relPath = do
let steps :: [ClodM (Either [Char] FileResult)]
steps = [ [Char] -> [Char] -> ClodM (Either [Char] FileResult)
checkIgnorePatterns [Char]
fullPath [Char]
relPath
, FileReadCap -> [Char] -> [Char] -> ClodM (Either [Char] FileResult)
checkFileExists FileReadCap
readCap [Char]
fullPath [Char]
relPath
, FileReadCap -> [Char] -> [Char] -> ClodM (Either [Char] FileResult)
checkIsTextFile FileReadCap
readCap [Char]
fullPath [Char]
relPath
, FileReadCap
-> FileWriteCap
-> [Char]
-> [Char]
-> ClodM (Either [Char] FileResult)
copyToStaging FileReadCap
readCap FileWriteCap
writeCap [Char]
fullPath [Char]
relPath
]
let processSteps :: [f (Either a b)] -> f (Either a FileResult)
processSteps [] = Either a FileResult -> f (Either a FileResult)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a FileResult -> f (Either a FileResult))
-> Either a FileResult -> f (Either a FileResult)
forall a b. (a -> b) -> a -> b
$ FileResult -> Either a FileResult
forall a b. b -> Either a b
Right FileResult
Success
processSteps (f (Either a b)
step:[f (Either a b)]
remaining) = do
Either a b
result <- f (Either a b)
step
case Either a b
result of
Left a
reason -> Either a FileResult -> f (Either a FileResult)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a FileResult -> f (Either a FileResult))
-> Either a FileResult -> f (Either a FileResult)
forall a b. (a -> b) -> a -> b
$ a -> Either a FileResult
forall a b. a -> Either a b
Left a
reason
Right b
_ -> [f (Either a b)] -> f (Either a FileResult)
processSteps [f (Either a b)]
remaining
Either [Char] FileResult
result <- [ClodM (Either [Char] FileResult)]
-> ClodM (Either [Char] FileResult)
forall {f :: * -> *} {a} {b}.
Monad f =>
[f (Either a b)] -> f (Either a FileResult)
processSteps [ClodM (Either [Char] FileResult)]
steps
pure $ case Either [Char] FileResult
result of
Left [Char]
reason -> [Char] -> FileResult
Skipped [Char]
reason
Right FileResult
_ -> FileResult
Success
runClodApp :: ClodConfig -> FilePath -> Bool -> Bool -> IO (Either ClodError ())
runClodApp :: ClodConfig -> [Char] -> Bool -> Bool -> IO (Either ClodError ())
runClodApp ClodConfig
config [Char]
_ Bool
verboseFlag Bool
optAllFiles =
let configWithVerbose :: ClodConfig
configWithVerbose = ClodConfig
config { verbose :: Bool
verbose = Bool
verboseFlag }
in ClodConfig -> ClodM () -> IO (Either ClodError ())
forall a. ClodConfig -> ClodM a -> IO (Either ClodError a)
runClodM ClodConfig
configWithVerbose (ClodM () -> IO (Either ClodError ()))
-> ClodM () -> IO (Either ClodError ())
forall a b. (a -> b) -> a -> b
$ do
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verboseFlag (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"clod version " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
showVersion Version
Meta.version [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (Haskell)"
Bool -> ClodM ()
mainLogic Bool
optAllFiles
mainLogic :: Bool -> ClodM ()
mainLogic :: Bool -> ClodM ()
mainLogic Bool
optAllFiles = do
config :: ClodConfig
config@ClodConfig{[Char]
configDir :: [Char]
configDir :: ClodConfig -> [Char]
configDir, [Char]
stagingDir :: [Char]
stagingDir :: ClodConfig -> [Char]
stagingDir, [Char]
projectPath :: [Char]
projectPath :: ClodConfig -> [Char]
projectPath, [Char]
databaseFile :: [Char]
databaseFile :: ClodConfig -> [Char]
databaseFile, Bool
verbose :: ClodConfig -> Bool
verbose :: Bool
verbose, Bool
flushMode :: Bool
flushMode :: ClodConfig -> Bool
flushMode, Bool
lastMode :: Bool
lastMode :: ClodConfig -> Bool
lastMode} <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
configDir
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
stagingDir
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Running with capabilities, safely restricting operations to: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
projectPath
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Safe staging directory: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
stagingDir
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"AI safety guardrails active with capability-based security"
[IgnorePattern]
gitIgnorePatterns <- [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [IgnorePattern]
readGitIgnore [Char]
projectPath
[IgnorePattern]
clodIgnorePatterns <- [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [IgnorePattern]
readClodIgnore [Char]
projectPath
let allPatterns :: [IgnorePattern]
allPatterns = [IgnorePattern]
gitIgnorePatterns [IgnorePattern] -> [IgnorePattern] -> [IgnorePattern]
forall a. [a] -> [a] -> [a]
++ [IgnorePattern]
clodIgnorePatterns
let configWithPatterns :: ClodConfig
configWithPatterns = ClodConfig
config { ignorePatterns :: [IgnorePattern]
ignorePatterns = [IgnorePattern]
allPatterns }
ClodDatabase
database <- [Char] -> ClodM ClodDatabase
loadDatabase [Char]
databaseFile
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
lastMode (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
case ClodDatabase -> Maybe [Char]
dbLastStagingDir ClodDatabase
database of
Just [Char]
prevStaging -> do
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Using previous staging directory: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
prevStaging
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stdout [Char]
prevStaging
ClodError -> ClodM ()
forall a. ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClodError -> ClodM ()) -> ClodError -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ClodError
ConfigError [Char]
"Using last staging directory as requested"
Maybe [Char]
Nothing -> do
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"No previous staging directory available, proceeding with new staging"
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
lastMode (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ ClodM ()
cleanupStagingDirectories
[[Char]]
allFiles <- [Char] -> [[Char]] -> ClodM [[Char]]
findAllFiles [Char]
projectPath [[Char]
""]
let readCap :: FileReadCap
readCap = [[Char]] -> FileReadCap
fileReadCap [[Char]
projectPath]
writeCap :: FileWriteCap
writeCap = [[Char]] -> FileWriteCap
fileWriteCap [[Char]
stagingDir]
let filteredFiles :: [[Char]]
filteredFiles = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
path -> Bool -> Bool
not ([IgnorePattern] -> [Char] -> Bool
matchesIgnorePattern [IgnorePattern]
allPatterns [Char]
path)) [[Char]]
allFiles
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Total files: " [Char] -> [Char] -> [Char]
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]]
allFiles)
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Filtered files (after ignore patterns): " [Char] -> [Char] -> [Char]
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]]
filteredFiles)
ClodDatabase
databaseUpdated <- if Bool
flushMode
then FileReadCap -> ClodDatabase -> [Char] -> ClodM ClodDatabase
flushMissingEntries FileReadCap
readCap ClodDatabase
database [Char]
projectPath
else ClodDatabase -> ClodM ClodDatabase
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ClodDatabase
database
let manifestPath :: [Char]
manifestPath = [Char]
stagingDir [Char] -> [Char] -> [Char]
</> [Char]
"_path_manifest.dhall"
([([Char], FileStatus)]
changedFiles, [([Char], [Char])]
renamedFiles) <- FileReadCap
-> ClodDatabase
-> [[Char]]
-> [Char]
-> ClodM ([([Char], FileStatus)], [([Char], [Char])])
detectFileChanges FileReadCap
readCap ClodDatabase
databaseUpdated [[Char]]
filteredFiles [Char]
projectPath
let dbExists :: Bool
dbExists = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map [Char] FileEntry -> Bool
forall a. Map [Char] a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map [Char] FileEntry -> Bool) -> Map [Char] FileEntry -> Bool
forall a b. (a -> b) -> a -> b
$ ClodDatabase -> Map [Char] FileEntry
dbFiles ClodDatabase
databaseUpdated
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Database exists: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
dbExists
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Database entries: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Map [Char] FileEntry -> Int
forall a. Map [Char] a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map [Char] FileEntry -> Int) -> Map [Char] FileEntry -> Int
forall a b. (a -> b) -> a -> b
$ ClodDatabase -> Map [Char] FileEntry
dbFiles ClodDatabase
databaseUpdated)
let unchangedFiles :: [([Char], FileStatus)]
unchangedFiles = (([Char], FileStatus) -> Bool)
-> [([Char], FileStatus)] -> [([Char], FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
_, FileStatus
status) -> FileStatus
status FileStatus -> FileStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus
Unchanged) [([Char], FileStatus)]
changedFiles
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Unchanged files: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([([Char], FileStatus)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Char], FileStatus)]
unchangedFiles) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([([Char], FileStatus)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Char], FileStatus)]
changedFiles)
let changedPaths :: [[Char]]
changedPaths = if Bool -> Bool
not Bool
dbExists Bool -> Bool -> Bool
|| Bool
optAllFiles
then [[Char]]
filteredFiles
else (([Char], FileStatus) -> [Char])
-> [([Char], FileStatus)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], FileStatus) -> [Char]
forall a b. (a, b) -> a
fst ([([Char], FileStatus)] -> [[Char]])
-> [([Char], FileStatus)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (([Char], FileStatus) -> Bool)
-> [([Char], FileStatus)] -> [([Char], FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
_, FileStatus
status) -> FileStatus
status FileStatus -> FileStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= FileStatus
Unchanged) [([Char], FileStatus)]
changedFiles
let filesToProcess :: [[Char]]
filesToProcess = [[Char]]
changedPaths
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
let unchangedCount :: Int
unchangedCount = [([Char], FileStatus)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([([Char], FileStatus)] -> Int) -> [([Char], FileStatus)] -> Int
forall a b. (a -> b) -> a -> b
$ (([Char], FileStatus) -> Bool)
-> [([Char], FileStatus)] -> [([Char], FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
_, FileStatus
status) -> FileStatus
status FileStatus -> FileStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus
Unchanged) [([Char], FileStatus)]
changedFiles
let newCount :: Int
newCount = [([Char], FileStatus)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([([Char], FileStatus)] -> Int) -> [([Char], FileStatus)] -> Int
forall a b. (a -> b) -> a -> b
$ (([Char], FileStatus) -> Bool)
-> [([Char], FileStatus)] -> [([Char], FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
_, FileStatus
status) -> FileStatus
status FileStatus -> FileStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus
New) [([Char], FileStatus)]
changedFiles
let modifiedCount :: Int
modifiedCount = [([Char], FileStatus)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([([Char], FileStatus)] -> Int) -> [([Char], FileStatus)] -> Int
forall a b. (a -> b) -> a -> b
$ (([Char], FileStatus) -> Bool)
-> [([Char], FileStatus)] -> [([Char], FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
_, FileStatus
status) -> FileStatus
status FileStatus -> FileStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus
Modified) [([Char], FileStatus)]
changedFiles
let renamedCount :: Int
renamedCount = [([Char], FileStatus)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([([Char], FileStatus)] -> Int) -> [([Char], FileStatus)] -> Int
forall a b. (a -> b) -> a -> b
$ (([Char], FileStatus) -> Bool)
-> [([Char], FileStatus)] -> [([Char], FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
_, FileStatus
status) ->
case FileStatus
status of
Renamed [Char]
_ -> Bool
True
FileStatus
_ -> Bool
False) [([Char], FileStatus)]
changedFiles
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Database entries: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Map [Char] FileEntry -> Int
forall a. Map [Char] a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map [Char] FileEntry -> Int) -> Map [Char] FileEntry -> Int
forall a b. (a -> b) -> a -> b
$ ClodDatabase -> Map [Char] FileEntry
dbFiles ClodDatabase
databaseUpdated)
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Files to process: " [Char] -> [Char] -> [Char]
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]]
filesToProcess)
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" - Unchanged: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
unchangedCount
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" - New: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
newCount
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" - Modified: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
modifiedCount
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" - Renamed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
renamedCount
let processFile' :: [Char]
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
([Char], Checksum, UTCTime, OptimizedName)
processFile' [Char]
path = do
let fullPath :: [Char]
fullPath = [Char]
projectPath [Char] -> [Char] -> [Char]
</> [Char]
path
Checksum
checksum <- FileReadCap -> [Char] -> ClodM Checksum
checksumFile FileReadCap
readCap [Char]
fullPath
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
let optName :: OptimizedName
optName = [Char] -> OptimizedName
createOptimizedName [Char]
path
return ([Char]
path, Checksum
checksum, UTCTime
modTime, OptimizedName
optName)
[([Char], Checksum, UTCTime, OptimizedName)]
entries <- ([Char] -> ClodM Bool) -> [[Char]] -> ClodM [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\[Char]
path -> do
Bool
isText <- FileReadCap -> [Char] -> ClodM Bool
safeIsTextFile FileReadCap
readCap ([Char]
projectPath [Char] -> [Char] -> [Char]
</> [Char]
path)
return Bool
isText
) [[Char]]
filteredFiles ClodM [[Char]]
-> ([[Char]]
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
[([Char], Checksum, UTCTime, OptimizedName)])
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
[([Char], Checksum, UTCTime, OptimizedName)]
forall a b.
ReaderT ClodConfig (ExceptT ClodError IO) a
-> (a -> ReaderT ClodConfig (ExceptT ClodError IO) b)
-> ReaderT ClodConfig (ExceptT ClodError IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
([Char]
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
([Char], Checksum, UTCTime, OptimizedName))
-> [[Char]]
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
[([Char], Checksum, UTCTime, OptimizedName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char]
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
([Char], Checksum, UTCTime, OptimizedName)
processFile'
let manifestEntries :: [(OptimizedName, OriginalPath)]
manifestEntries = (([Char], Checksum, UTCTime, OptimizedName)
-> (OptimizedName, OriginalPath))
-> [([Char], Checksum, UTCTime, OptimizedName)]
-> [(OptimizedName, OriginalPath)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
path, Checksum
_, UTCTime
_, OptimizedName
optName) ->
(OptimizedName
optName, [Char] -> OriginalPath
OriginalPath [Char]
path)) [([Char], Checksum, UTCTime, OptimizedName)]
entries
()
_ <- FileWriteCap
-> [Char] -> [(OptimizedName, OriginalPath)] -> ClodM ()
writeManifestFile FileWriteCap
writeCap [Char]
manifestPath [(OptimizedName, OriginalPath)]
manifestEntries
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Added " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([([Char], Checksum, UTCTime, OptimizedName)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Char], Checksum, UTCTime, OptimizedName)]
entries) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" files to _path_manifest.dhall"
if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
filesToProcess
then Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"No files changed since last run"
else do
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Files to process: " [Char] -> [Char] -> [Char]
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]]
filesToProcess)
(Int
processed, Int
skipped) <- ClodConfig -> [Char] -> [[Char]] -> Bool -> ClodM (Int, Int)
processFiles ClodConfig
configWithPatterns [Char]
manifestPath [[Char]]
filesToProcess Bool
False
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Processed " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
processed [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" files, skipped " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
skipped [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" files"
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
verbose Bool -> Bool -> Bool
&& Bool -> Bool
not ([([Char], [Char])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], [Char])]
renamedFiles)) (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"Detected renamed files:"
[([Char], [Char])] -> (([Char], [Char]) -> ClodM ()) -> ClodM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [([Char], [Char])]
renamedFiles ((([Char], [Char]) -> ClodM ()) -> ClodM ())
-> (([Char], [Char]) -> ClodM ()) -> ClodM ()
forall a b. (a -> b) -> a -> b
$ \([Char]
newPath, [Char]
oldPath) -> do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
oldPath [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" → " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newPath
let
finalDatabase :: ClodDatabase
finalDatabase = (([Char], Checksum, UTCTime, OptimizedName)
-> ClodDatabase -> ClodDatabase)
-> ClodDatabase
-> [([Char], Checksum, UTCTime, OptimizedName)]
-> ClodDatabase
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\([Char]
path, Checksum
checksum, UTCTime
modTime, OptimizedName
optName) ClodDatabase
db ->
ClodDatabase
-> [Char] -> Checksum -> UTCTime -> OptimizedName -> ClodDatabase
updateDatabase ClodDatabase
db [Char]
path Checksum
checksum UTCTime
modTime OptimizedName
optName)
ClodDatabase
databaseUpdated [([Char], Checksum, UTCTime, OptimizedName)]
entries
databaseWithStaging :: ClodDatabase
databaseWithStaging = ClodDatabase
finalDatabase {
dbLastStagingDir :: Maybe [Char]
dbLastStagingDir = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
stagingDir,
dbLastRunTime :: UTCTime
dbLastRunTime = ClodDatabase -> UTCTime
dbLastRunTime ClodDatabase
finalDatabase
}
[Char] -> ClodDatabase -> ClodM ()
saveDatabase [Char]
databaseFile ClodDatabase
databaseWithStaging
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stdout [Char]
stagingDir