module Pier.Core.Directory
( forFileRecursive_
, FileItem(..)
, getRegularContents
, createParentIfMissing
, copyDirectory
, parentDirectory
) where
import Control.Monad.IO.Class
import Development.Shake.FilePath
import System.Directory
import qualified System.Posix.Files as Posix
createParentIfMissing :: MonadIO m => FilePath -> m ()
createParentIfMissing
= liftIO . createDirectoryIfMissing True . parentDirectory
parentDirectory :: FilePath -> FilePath
parentDirectory = fixPeriod . takeDirectory . dropTrailingPathSeparator
where
fixPeriod "." = ""
fixPeriod x = x
data FileItem = RegularFile | DirectoryStart | DirectoryEnd | SymbolicLink
forFileRecursive_ :: (FileItem -> FilePath -> IO ()) -> FilePath -> IO ()
forFileRecursive_ act f = do
isSymLink <- pathIsSymbolicLink f
if isSymLink
then act SymbolicLink f
else do
isDir <- doesDirectoryExist f
if not isDir
then act RegularFile f
else do
act DirectoryStart f
getRegularContents f
>>= mapM_ (forFileRecursive_ act . (f </>))
act DirectoryEnd f
getRegularContents :: FilePath -> IO [FilePath]
getRegularContents f =
filter (not . specialFile) <$> getDirectoryContents f
where
specialFile "." = True
specialFile ".." = True
specialFile _ = False
copyDirectory :: FilePath -> FilePath -> IO ()
copyDirectory src dest = do
createParentIfMissing dest
forFileRecursive_ act src
where
act RegularFile f = Posix.createLink f $ dest </> makeRelative src f
act SymbolicLink f = do
target <- getSymbolicLinkTarget f
let g = dest </> makeRelative src f
createParentIfMissing g
createFileLink target g
act DirectoryStart f = createDirectoryIfMissing False (dest </> makeRelative src f)
act DirectoryEnd _ = return ()