#include "gadts.h"
module Darcs.Commands.Util ( announceFiles, filterExistingFiles ) where
import Darcs.Arguments ( DarcsFlag(LookForAdds) )
import Darcs.Patch ( RepoPatch )
import Darcs.RepoPath ( SubPath, toFilePath )
import Darcs.Repository ( Repository, extractOptions, readRecorded,
readUnrecorded )
import Darcs.Repository.State ( applyTreeFilter, restrictBoring )
import Darcs.Patch.Apply ( ApplyState )
import Storage.Hashed( floatPath, readPlainTree )
import Storage.Hashed.Tree( Tree )
import Storage.Hashed.Monad ( virtualTreeIO, exists )
announceFiles :: Maybe [SubPath] -> String -> IO ()
announceFiles Nothing _ = return ()
announceFiles (Just files) message = putStrLn $ message ++ " " ++
unwords (map show files) ++ ":\n"
filterExistingFiles :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository p C(r u t) -> [SubPath] -> IO [SubPath]
filterExistingFiles repo files = do
pristine <- readRecorded repo
index <- readUnrecorded repo $ Just files
nonboring <- restrictBoring index
working <- applyTreeFilter nonboring `fmap` readPlainTree "."
let paths = map toFilePath files
check = virtualTreeIO (mapM exists $ map floatPath paths)
(in_working, _) <- check working
(in_pristine, _) <- check pristine
mapM_ maybe_warn $ zip3 paths in_working in_pristine
return [ path | (path, True) <- zip files (zipWith (||) in_working in_pristine) ]
where maybe_warn (file, False, False) =
putStrLn $ "WARNING: File '"++file++"' does not exist!"
maybe_warn (file, True, False) | LookForAdds `notElem` extractOptions repo =
putStrLn $ "WARNING: File '" ++ file ++ "' not in repository!"
maybe_warn _ = return ()