hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

factor out getDirectoryContentsRecursive function in GHCup.Utils.Prelude

Browse Source
This commit is contained in:
Arjun Kathuria 2021-06-26 21:53:14 +05:30
parent 2277013c76
commit 6379a26afb
1 changed files with 23 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
lib/GHCup/Utils/Prelude.hs
View File

@ -340,31 +340,31 @@ copyDirectoryRecursive srcDir destDir = do
-- parent directories. The list is generated lazily so is not well defined if -- parent directories. The list is generated lazily so is not well defined if
-- the source directory structure changes before the list is used. -- the source directory structure changes before the list is used.
-- --
getDirectoryContentsRecursive :: FilePath -> IO [FilePath] getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive topdir = recurseDirectories [""] getDirectoryContentsRecursive topdir = recurseDirectories [""]
where
recurseDirectories :: [FilePath] -> IO [FilePath]
recurseDirectories [] = return []
recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do
(files, dirs') <- collect [] [] =<< getDirectoryContents (topdir </> dir)
files' <- recurseDirectories (dirs' ++ dirs)
return (files ++ files')
where where
recurseDirectories :: [FilePath] -> IO [FilePath] collect files dirs' [] = return (reverse files
recurseDirectories [] = return [] ,reverse dirs')
recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do collect files dirs' (entry:entries) | ignore entry
(files, dirs') <- collect [] [] =<< getDirectoryContents (topdir </> dir) = collect files dirs' entries
files' <- recurseDirectories (dirs' ++ dirs) collect files dirs' (entry:entries) = do
return (files ++ files') let dirEntry = dir </> entry
isDirectory <- doesDirectoryExist (topdir </> dirEntry)
if isDirectory
then collect files (dirEntry:dirs') entries
else collect (dirEntry:files) dirs' entries
where ignore ['.'] = True
collect files dirs' [] = return (reverse files ignore ['.', '.'] = True
,reverse dirs') ignore _ = False
collect files dirs' (entry:entries) | ignore entry
= collect files dirs' entries
collect files dirs' (entry:entries) = do
let dirEntry = dir </> entry
isDirectory <- doesDirectoryExist (topdir </> dirEntry)
if isDirectory
then collect files (dirEntry:dirs') entries
else collect (dirEntry:files) dirs' entries
ignore ['.'] = True
ignore ['.', '.'] = True
ignore _ = False
-- https://github.com/haskell/directory/issues/110 -- https://github.com/haskell/directory/issues/110
-- https://github.com/haskell/directory/issues/96 -- https://github.com/haskell/directory/issues/96