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