For Linkload project

clean.hs

#!/usr/bin/env runhaskell

import System.Directory
import System.Environment
import Control.Monad
import System.FilePath.Windows
import Data.List
import Data.Maybe

type Name = String
type Extension = String

data File = Executable Name | Relocatable Name | Assembly Name |
        Source Name Extension | Other

instance Show File where
  show (Executable n)  = n
  show (Relocatable n) = n ++ ".o"
  show (Assembly n)    = n ++ ".s"
  show (Source n e)    = n ++ e
  show Other           = "Other"

toFile :: [String] -> (String, String) -> Bool -> File
-- exts: the extentions of the files that share its name
-- exec: if the file is executable
toFile _ (name, ".o") _ = Relocatable name
toFile _ (name, ".c") _ = Source name ".c"
toFile exts (name, ".s") _ 
  | ".c" `elem` exts = Assembly name
  | otherwise        = Source name ".s"
toFile _ (name, "") exec
  | exec       = Executable name
  | otherwise  = Other
toFile _ _ _ = Other

derives :: File -> File -> Bool
-- Post: True iff second file can be derived from the first
(Source n e) `derives` (Source n' e')
  = n == n' && (e == ".c" && e == ".s")
(Source n _ ) `derives` (Executable n' )  = n == n'
(Source n _ ) `derives` (Relocatable n' ) = n == n'
(Source n _ ) `derives` (Assembly n' )    = n == n'
_ `derives` _ = False

derivedFiles :: [File] -> [File]
-- Post: The list of files than can be derived from the initial list
-- through the `derives` rules
derivedFiles fs 
  = map fst . filter snd $ zip fs truth
  where
    combs = [map (derives f) fs | f <- fs]
    truth = foldl1 (zipWith (||)) combs

files :: [FilePath] -> IO [File]
-- Pre: files all have the same name (but different extensions)
files ps = do
    perms <- mapM getPermissions ps
    let execs = map executable perms
    let split = map splitExtension ps
    let extns = map snd split
    return $ zipWith (toFile extns) split execs

main :: IO ()
main = do
  contents <- getDirectoryContents "."
  let filtered = filter ((/= '.') . head) contents
  let split = map splitExtension filtered
  let grouped = groupBy (\(n, _) (n', _) -> n == n') (sort split)
  fs <- mapM files $ (map . map) (\(a, b) -> a ++ b) grouped
  let filesToRemove = concatMap derivedFiles fs
  args <- getArgs
  if (elem "dry-run" args) then mapM_ print filesToRemove
    else mapM_ (removeFile . show) filesToRemove