DouKaku? 57 PHO: (指定されたフォルダ以下のゴミ掃除)

Comment detail

import Control.Monad
import System
import System.Directory

main :: IO ()
main = do [root] <- getArgs
          removeBackup root

removeBackup :: FilePath -> IO ()
removeBackup dir
    = getDirectoryContents dir >>= mapM_ (removeIfBackupFile dir)
    where
      removeIfBackupFile :: FilePath -> FilePath -> IO ()
      removeIfBackupFile _ "."  = return ()
      removeIfBackupFile _ ".." = return ()
      removeIfBackupFile dir file
          = do let path = dir ++ "/" ++ file

               isDir <- doesDirectoryExist path

               if last path == '~' then
                   if isDir then
                       removeDirectoryRecursive path
                   else
                       removeFile path
                 else
                   when isDir $ removeBackup path

setCurrentDirectory を使ってパスの扱いを単純化

import System.Directory
import System.Environment

main :: IO ()
main = getArgs >>= mapM_ cleaning

cleaning :: FilePath -> IO ()
cleaning = (>> removeBackupFiles) . setCurrentDirectory

removeBackupFiles :: IO ()
removeBackupFiles = getDirectoryContents "." >>= mapM_ rmbk . drop 2

rmbk :: FilePath -> IO ()
rmbk path
 = do { dir <- doesDirectoryExist path
      ; let backup = '~'== last path
      ; if dir 
           then if backup then removeDirectoryRecursive path else cleaning path
           else if backup then removeFile path               else return ()
      }

ごめんなさいバグがありました。
ディレクトリを降りていったあとにカレントディレクトリを
もとへ戻していなかった。こちらが正しいはずのコード
です。

import System.Directory
import System.Environment

main :: IO ()
main = getArgs >>= mapM_ cleaning

cleaning :: FilePath -> IO ()
cleaning = (>> removeBackupFiles) . setCurrentDirectory

removeBackupFiles :: IO ()
removeBackupFiles
 = do { cwd <- getCurrentDirectory
      ; getDirectoryContents "." >>= mapM_ (rmbk cwd) . drop 2
      }

rmbk :: FilePath -> FilePath -> IO ()
rmbk cwd path
 = do { dir <- doesDirectoryExist path
      ; let backup = '~'== last path
      ; if dir 
           then if backup 
                   then removeDirectoryRecursive path 
                   else cleaning path >> setCurrentDirectory cwd
           else if backup 
                   then removeFile path
                   else return ()
      }

プログラム(修正版)にまだバグがあった．POSIX系のファイルシステムでは，
シンボリックリンクでディレクトリパスに循環があると停止しなくなってしまう．

module Main (main) where

import System.Directory ( setCurrentDirectory, getCurrentDirectory
                        , getDirectoryContents
                        , removeDirectoryRecursive, removeFile )
import System.Posix.Files (getSymbolicLinkStatus, isDirectory)
import System.Environment (getArgs)

main :: IO ()
main = getArgs >>= mapM_ cleaning

cleaning :: FilePath -> IO ()
cleaning = (>> removeBackupFiles) . setCurrentDirectory

removeBackupFiles :: IO ()
removeBackupFiles
 = do { cwd <- getCurrentDirectory
      ; getDirectoryContents "." >>= mapM_ (rmbk cwd) . drop 2
      }

rmbk :: FilePath -> FilePath -> IO ()
rmbk cwd path
 = do { fstat <- getSymbolicLinkStatus path
      ; let backup = '~'== last path
      ; if isDirectory fstat
           then if backup then removeDirectoryRecursive path 
                else cleaning path >> setCurrentDirectory cwd
           else if backup then removeFile path
                else return ()
      }

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq