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