module Data.Prune.File where

import Prelude

import Data.Set (Set)
import Data.Traversable (for)
import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)
import System.FilePath.Posix ((</>))
import qualified Data.Set as Set

-- |Recursively list files in a directory, ignoring symlinks.
listFilesRecursive :: FilePath -> IO (Set FilePath)
listFilesRecursive :: FilePath -> IO (Set FilePath)
listFilesRecursive FilePath
dir = do
  [FilePath]
dirs <- FilePath -> IO [FilePath]
listDirectory FilePath
dir
  ([Set FilePath] -> Set FilePath)
-> IO [Set FilePath] -> IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Set FilePath] -> Set FilePath
forall a. Monoid a => [a] -> a
mconcat (IO [Set FilePath] -> IO (Set FilePath))
-> ((FilePath -> IO (Set FilePath)) -> IO [Set FilePath])
-> (FilePath -> IO (Set FilePath))
-> IO (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO (Set FilePath)) -> IO [Set FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FilePath]
dirs ((FilePath -> IO (Set FilePath)) -> IO (Set FilePath))
-> (FilePath -> IO (Set FilePath)) -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ \case
    -- don't include "hidden" directories, i.e. those that start with a '.'
    Char
'.' : FilePath
_ -> Set FilePath -> IO (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set FilePath
forall a. Monoid a => a
mempty
    FilePath
fn -> do
      let
        path :: FilePath
path = if FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"." then FilePath
fn else FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fn
      Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
      Bool
isSymlink <- FilePath -> IO Bool
pathIsSymbolicLink FilePath
path
      case (Bool
isSymlink, Bool
isDir) of
        (Bool
True, Bool
True) -> Set FilePath -> IO (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set FilePath
forall a. Monoid a => a
mempty
        (Bool
_, Bool
True) -> FilePath -> IO (Set FilePath)
listFilesRecursive FilePath
path
        (Bool, Bool)
_ -> Set FilePath -> IO (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set FilePath -> IO (Set FilePath))
-> Set FilePath -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Set FilePath
forall a. a -> Set a
Set.singleton FilePath
path