{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Hakyll.Core.Util.File
( makeDirectories
, getRecursiveContents
, removeDirectory
) where
import Control.Concurrent (threadDelay)
import Control.Exception (SomeException, catch)
import Control.Monad (filterM, forM, when)
import System.Directory (createDirectoryIfMissing,
doesDirectoryExist, getDirectoryContents,
removeDirectoryRecursive, removePathForcibly)
import System.FilePath (takeDirectory, (</>))
makeDirectories :: FilePath -> IO ()
makeDirectories = createDirectoryIfMissing True . takeDirectory
getRecursiveContents :: (FilePath -> IO Bool)
-> FilePath
-> IO [FilePath]
getRecursiveContents ignore top = go ""
where
isProper x
| x `elem` [".", ".."] = return False
| otherwise = not <$> ignore x
go dir = do
dirExists <- doesDirectoryExist (top </> dir)
if not dirExists
then return []
else do
names <- filterM isProper =<< getDirectoryContents (top </> dir)
paths <- forM names $ \name -> do
let rel = dir </> name
isDirectory <- doesDirectoryExist (top </> rel)
if isDirectory
then go rel
else return [rel]
return $ concat paths
removeDirectory :: FilePath -> IO ()
#ifndef mingw32_HOST_OS
removeDirectory fp = do
e <- doesDirectoryExist fp
when e $ removeDirectoryRecursive fp
#else
removeDirectory = retryWithDelay 10 . removePathForcibly
#endif
retryWithDelay :: Int -> IO a -> IO a
retryWithDelay i x
| i <= 0 = error "Hakyll.Core.Util.File.retry: retry count must be 1 or more"
| i == 1 = x
| otherwise = catch x $ \(_::SomeException) -> threadDelay 100 >> retryWithDelay (i-1) x