{-# 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.Output (whenVerbose)
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
ClodConfig
config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
let patterns :: [IgnorePattern]
patterns = ClodConfig
config ClodConfig
-> Getting [IgnorePattern] ClodConfig [IgnorePattern]
-> [IgnorePattern]
forall s a. s -> Getting a s a -> a
^. Getting [IgnorePattern] ClodConfig [IgnorePattern]
Lens' ClodConfig [IgnorePattern]
ignorePatterns
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
ClodConfig
config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
let stagingPath :: FilePath
stagingPath = ClodConfig
config ClodConfig -> Getting FilePath ClodConfig FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath ClodConfig FilePath
Lens' ClodConfig FilePath
currentStaging
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
Bool
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig
config ClodConfig -> Getting Bool ClodConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool ClodConfig Bool
Lens' ClodConfig 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
"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 ClodConfig -> (ClodConfig -> ClodConfig) -> ClodConfig
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> ClodConfig -> Identity ClodConfig
Lens' ClodConfig Bool
verbose ((Bool -> Identity Bool) -> ClodConfig -> Identity ClodConfig)
-> Bool -> ClodConfig -> ClodConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
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
ClodConfig
config <- ReaderT ClodConfig (ExceptT ClodError IO) ClodConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
let configDir' :: FilePath
configDir' = ClodConfig -> FilePath
_configDir ClodConfig
config
stagingDir' :: FilePath
stagingDir' = ClodConfig -> FilePath
_stagingDir ClodConfig
config
projectPath' :: FilePath
projectPath' = ClodConfig -> FilePath
_projectPath ClodConfig
config
databaseFile' :: FilePath
databaseFile' = ClodConfig -> FilePath
_databaseFile ClodConfig
config
isFlushMode :: Bool
isFlushMode = ClodConfig -> Bool
_flushMode ClodConfig
config
isLastMode :: Bool
isLastMode = ClodConfig -> Bool
_lastMode ClodConfig
config
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'
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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 ClodConfig -> (ClodConfig -> ClodConfig) -> ClodConfig
forall a b. a -> (a -> b) -> b
& ([IgnorePattern] -> Identity [IgnorePattern])
-> ClodConfig -> Identity ClodConfig
Lens' ClodConfig [IgnorePattern]
ignorePatterns (([IgnorePattern] -> Identity [IgnorePattern])
-> ClodConfig -> Identity ClodConfig)
-> [IgnorePattern] -> ClodConfig -> ClodConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [IgnorePattern]
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
isLastMode (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
database ClodDatabase
-> Getting (Maybe FilePath) ClodDatabase (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe FilePath) ClodDatabase (Maybe FilePath)
Lens' ClodDatabase (Maybe FilePath)
dbLastStagingDir of
Just FilePath
prevStaging -> do
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> IO () -> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
isLastMode (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
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
isFlushMode
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
databaseUpdated ClodDatabase
-> Getting
(Map FilePath FileEntry) ClodDatabase (Map FilePath FileEntry)
-> Map FilePath FileEntry
forall s a. s -> Getting a s a -> a
^. Getting
(Map FilePath FileEntry) ClodDatabase (Map FilePath FileEntry)
Lens' ClodDatabase (Map FilePath FileEntry)
dbFiles
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
databaseUpdated ClodDatabase
-> Getting
(Map FilePath FileEntry) ClodDatabase (Map FilePath FileEntry)
-> Map FilePath FileEntry
forall s a. s -> Getting a s a -> a
^. Getting
(Map FilePath FileEntry) ClodDatabase (Map FilePath FileEntry)
Lens' ClodDatabase (Map FilePath FileEntry)
dbFiles)
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
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
databaseUpdated ClodDatabase
-> Getting
(Map FilePath FileEntry) ClodDatabase (Map FilePath FileEntry)
-> Map FilePath FileEntry
forall s a. s -> Getting a s a -> a
^. Getting
(Map FilePath FileEntry) ClodDatabase (Map FilePath FileEntry)
Lens' ClodDatabase (Map FilePath FileEntry)
dbFiles)
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
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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 ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ 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"
ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
whenVerbose (ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ())
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall a b. (a -> b) -> a -> b
$ Bool
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
-> ReaderT ClodConfig (ExceptT ClodError IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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
ClodDatabase -> (ClodDatabase -> ClodDatabase) -> ClodDatabase
forall a b. a -> (a -> b) -> b
& (Maybe FilePath -> Identity (Maybe FilePath))
-> ClodDatabase -> Identity ClodDatabase
Lens' ClodDatabase (Maybe FilePath)
dbLastStagingDir ((Maybe FilePath -> Identity (Maybe FilePath))
-> ClodDatabase -> Identity ClodDatabase)
-> Maybe FilePath -> ClodDatabase -> ClodDatabase
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
stagingDir'
ClodDatabase -> (ClodDatabase -> ClodDatabase) -> ClodDatabase
forall a b. a -> (a -> b) -> b
& (UTCTime -> Identity UTCTime)
-> ClodDatabase -> Identity ClodDatabase
Lens' ClodDatabase UTCTime
dbLastRunTime ((UTCTime -> Identity UTCTime)
-> ClodDatabase -> Identity ClodDatabase)
-> UTCTime -> ClodDatabase -> ClodDatabase
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (ClodDatabase
finalDatabase ClodDatabase -> Getting UTCTime ClodDatabase UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime ClodDatabase UTCTime
Lens' ClodDatabase UTCTime
dbLastRunTime)
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'