utils/testremove/checkremove.hs

   1
   2 module Main (main) where
   3
   4 import Control.Monad
   5 import Data.List
   6 import qualified Data.Set as Set
   7 import Data.Set (Set)
   8 import System.Environment
   9 import System.Exit
  10 import System.FilePath
  11 import System.IO
  12
  13 data CleanWhat = CleanFile FilePath
  14                | CleanRec  FilePath
  15     deriving (Read, Show)
  16
  17 main :: IO ()
  18 main = do args <- getArgs
  19           case args of
  20               [contentsBeforeFile, contentsAfterFile, wouldBeCleanedFile] ->
  21                   doit contentsBeforeFile contentsAfterFile wouldBeCleanedFile
  22               _ ->
  23                   error "Bad args"
  24
  25 readSet :: FilePath -> IO (Set FilePath)
  26 readSet fp = liftM (Set.fromList . lines) $ readFile fp
  27
  28 doit :: FilePath -> FilePath -> FilePath -> IO ()
  29 doit contentsBeforeFile contentsAfterFile wouldBeCleanedFile
  30  = do contentsBefore <- readSet contentsBeforeFile
  31       contentsAfter  <- readSet contentsAfterFile
  32       wouldBeCleaned <- liftM (map read . lines) $ readFile wouldBeCleanedFile
  33       let newContentsAfter = contentsAfter `Set.difference` contentsBefore
  34       let cleanedAfter = simulateCleans newContentsAfter wouldBeCleaned
  35       unless (Set.null cleanedAfter) $ do
  36           hPutStrLn stderr "Files not cleaned:"
  37           mapM_ (hPutStrLn stderr . show) (Set.toList cleanedAfter)
  38           exitWith (ExitFailure 1)
  39
  40 simulateCleans :: Set FilePath -> [CleanWhat] -> Set FilePath
  41 simulateCleans fs cws = Set.filter (not . cleaned) fs
  42     where cleaned f = any (`willClean` f) cws
  43
  44 willClean :: CleanWhat -> FilePath -> Bool
  45 CleanFile fp `willClean` f = fp `equalFilePath` f
  46 CleanRec fp `willClean` f
  47     = any (fp `equalFilePath`) (map joinPath $ inits $ splitPath f)
  48