-- | A potentially too simple interface for getting candidates for search from file trees. Doesn't follow symbolic links. For a better solution to this use
-- [unix-recursive](https://hackage.haskell.org/package/unix-recursive).
module Talash.Files (-- * Types
                     Conf (..) , FindConf (..) , FindInDirs (..) , FileTree (..)
                     -- * File Collection
                    , defConf , withExts , ignoreExts , findWithExts , findFilesInDirs , executables
                     -- * Internal Details
                    , dirContentsWith , fileTreeWith , minify , flatten , ext) where

import Control.Exception
import qualified Data.ByteString.Char8 as B
import qualified Data.HashSet as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V
import qualified Data.Vector.Algorithms.Intro as V
import System.Posix.Directory.ByteString
import System.Posix.Env.ByteString
import System.Posix.Files.ByteString
import Talash.Intro

-- Configruation for the search when recursivley constructing the file tree.
data Conf = Conf {
              -- | Test for whether to include a file in the file tree. The second argument is the base name of the file.
              Conf -> FileStatus -> ByteString -> IO Bool
includeFile :: FileStatus -> ByteString -> IO Bool ,
              -- | Test used to determine whether to enter a directory to search for files.
              Conf -> ByteString -> Bool
filterPath :: ByteString -> Bool }

-- | A simple type to represent a search either for a specific set of extensions or esle for excluding a specific set of extensions. An extension here
-- is just the part of the filename after the last '.' i.e this module doesn't handle multiple extensions.
data FindConf = Find !(S.HashSet ByteString) | Ignore !(S.HashSet ByteString) deriving Int -> FindConf -> ShowS
[FindConf] -> ShowS
FindConf -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FindConf] -> ShowS
$cshowList :: [FindConf] -> ShowS
show :: FindConf -> String
$cshow :: FindConf -> String
showsPrec :: Int -> FindConf -> ShowS
$cshowsPrec :: Int -> FindConf -> ShowS
Show

data FindInDirs = FindInDirs {
                    -- | The configuration of finding or excluding the extensions for this set of directories.
                    FindInDirs -> FindConf
confLocal :: FindConf ,
                    -- | The list of directories to which this configuration should apply.
                    FindInDirs -> [ByteString]
dirsLocal :: [ByteString]}

data FileTree a = Dir { forall a. FileTree a -> a
rootDir  :: a -- ^ The root directory
                      , forall a. FileTree a -> Vector a
dirFiles :: V.Vector a -- ^ The files in the root directory that are not subdirectories
                      , forall a. FileTree a -> Vector (FileTree a)
subDirs  :: V.Vector (FileTree a)} -- ^ The vector of trees formed by subdirectories
                        deriving (FileTree a -> FileTree a -> Bool
forall a. Eq a => FileTree a -> FileTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileTree a -> FileTree a -> Bool
$c/= :: forall a. Eq a => FileTree a -> FileTree a -> Bool
== :: FileTree a -> FileTree a -> Bool
$c== :: forall a. Eq a => FileTree a -> FileTree a -> Bool
Eq , Int -> FileTree a -> ShowS
forall a. Show a => Int -> FileTree a -> ShowS
forall a. Show a => [FileTree a] -> ShowS
forall a. Show a => FileTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileTree a] -> ShowS
$cshowList :: forall a. Show a => [FileTree a] -> ShowS
show :: FileTree a -> String
$cshow :: forall a. Show a => FileTree a -> String
showsPrec :: Int -> FileTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FileTree a -> ShowS
Show)

-- | Default configuration, include every file and search directory.
defConf :: Conf
defConf :: Conf
defConf = (FileStatus -> ByteString -> IO Bool)
-> (ByteString -> Bool) -> Conf
Conf (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) (forall a b. a -> b -> a
const Bool
True)

-- | Given the configuration and a directory returns a vector where the Left elements are the files in the directory that pass the `includeFile` test while
--   the Right elements are subdirectories that pass the `filterPath` test.
{-# INLINEABLE dirContentsWith #-}
dirContentsWith :: Conf -> ByteString -> IO (V.Vector (Either ByteString ByteString))
dirContentsWith :: Conf -> ByteString -> IO (Vector (Either ByteString ByteString))
dirContentsWith Conf
c ByteString
d = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> IO DirStream
openDirStream ByteString
d) DirStream -> IO ()
closeDirStream (\DirStream
s -> forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> m (Vector a)
V.unfoldrM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ( , DirStream
s)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirStream -> IO (Maybe (Either ByteString ByteString))
go) DirStream
s)
  where
    go :: DirStream -> IO (Maybe (Either ByteString ByteString))
go DirStream
s = ByteString -> IO (Maybe (Either ByteString ByteString))
nm forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DirStream -> IO ByteString
readDirStream DirStream
s
      where
        nm :: ByteString -> IO (Maybe (Either ByteString ByteString))
nm ByteString
f
          | ByteString
f forall a. Eq a => a -> a -> Bool
== ByteString
""                                         = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
          | Bool
otherwise                                       = FileStatus -> IO (Maybe (Either ByteString ByteString))
hr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> IO FileStatus
getSymbolicLinkStatus ByteString
f
          where
            hr :: FileStatus -> IO (Maybe (Either ByteString ByteString))
hr FileStatus
fs = Bool -> Bool -> IO (Maybe (Either ByteString ByteString))
det (FileStatus -> Bool
isDirectory FileStatus
fs Bool -> Bool -> Bool
&& Conf -> ByteString -> Bool
filterPath Conf
c ByteString
f Bool -> Bool -> Bool
&& ByteString
f forall a. Eq a => a -> a -> Bool
/= ByteString
"." Bool -> Bool -> Bool
&& ByteString
f forall a. Eq a => a -> a -> Bool
/= ByteString
"..") forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Conf -> FileStatus -> ByteString -> IO Bool
includeFile Conf
c FileStatus
fs ByteString
f
            det :: Bool -> Bool -> IO (Maybe (Either ByteString ByteString))
det Bool
True  Bool
_    = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString
f
            det Bool
False Bool
True = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left  forall a b. (a -> b) -> a -> b
$ ByteString
f
            det Bool
_     Bool
_    = DirStream -> IO (Maybe (Either ByteString ByteString))
go DirStream
s

-- | Constructs the file tree with the given the second argument at the root according to the given configuration.
{-# INLINEABLE fileTreeWith #-}
fileTreeWith :: Conf -> ByteString -> IO (FileTree Text)
fileTreeWith :: Conf -> ByteString -> IO (FileTree Text)
fileTreeWith Conf
c ByteString
d = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO ByteString
getWorkingDirectory ByteString -> IO ()
changeWorkingDirectory (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
changeWorkingDirectory ByteString
d forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Vector (Either ByteString ByteString) -> IO (FileTree Text)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Conf -> ByteString -> IO (Vector (Either ByteString ByteString))
dirContentsWith Conf
c ByteString
"."))
  where
    go :: Vector (Either ByteString ByteString) -> IO (FileTree Text)
go Vector (Either ByteString ByteString)
v = (\(Vector Text
a , Vector ByteString
b) -> forall a. a -> Vector a -> Vector (FileTree a) -> FileTree a
Dir (ByteString -> Text
T.decodeUtf8 ByteString
d) Vector Text
a forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (Conf -> ByteString -> IO (FileTree Text)
fileTreeWith Conf
c) Vector ByteString
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> Either b c) -> Vector a -> (Vector b, Vector c)
V.partitionWith (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> Text
T.decodeUtf8) forall a b. (a -> b) -> a -> b
$ Vector (Either ByteString ByteString)
v
    cex :: SomeException -> f (FileTree Text)
cex (SomeException
_ :: SomeException) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Vector a -> Vector (FileTree a) -> FileTree a
Dir (ByteString -> Text
T.decodeUtf8 ByteString
d) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- | Collapses the directories with only subdirectory and no other files.
{-# INLINEABLE minify #-}
minify :: FileTree Text -> FileTree Text
minify :: FileTree Text -> FileTree Text
minify (Dir Text
d Vector Text
f Vector (FileTree Text)
t)
  | Vector Text
f forall a. Eq a => a -> a -> Bool
== forall a. Vector a
V.empty Bool -> Bool -> Bool
&& forall a. Vector a -> Int
V.length Vector (FileTree Text)
t forall a. Eq a => a -> a -> Bool
== Int
1  = (\(Dir Text
d' Vector Text
f' Vector (FileTree Text)
t') -> forall a. a -> Vector a -> Vector (FileTree a) -> FileTree a
Dir (Text
d forall a. Semigroup a => a -> a -> a
<> Text
d') Vector Text
f' Vector (FileTree Text)
t') (forall a. Vector a -> a
V.unsafeHead Vector (FileTree Text)
t)
  | Bool
otherwise                        = forall a. a -> Vector a -> Vector (FileTree a) -> FileTree a
Dir Text
d Vector Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map FileTree Text -> FileTree Text
minify forall a b. (a -> b) -> a -> b
$ Vector (FileTree Text)
t

-- | Flattens the fileTree by completing the paths of the file relative to that of root directory.
{-# INLINEABLE flatten #-}
flatten :: FileTree Text -> V.Vector Text
flatten :: FileTree Text -> Vector Text
flatten (Dir Text
d Vector Text
f Vector (FileTree Text)
t) = forall a b. (a -> Vector b) -> Vector a -> Vector b
V.concatMap FileTree Text -> Vector Text
go Vector (FileTree Text)
t forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Text
d forall a. Semigroup a => a -> a -> a
<> Text
"/") forall a. Semigroup a => a -> a -> a
<>) Vector Text
f
  where
    go :: FileTree Text -> Vector Text
go (Dir Text
d' !Vector Text
f' Vector (FileTree Text)
t') = FileTree Text -> Vector Text
flatten (forall a. a -> Vector a -> Vector (FileTree a) -> FileTree a
Dir (Text
d forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
d') Vector Text
f' Vector (FileTree Text)
t')

{-# INLINABLE withExts #-}
withExts :: [ByteString] -- ^ The set of extensions to search for
  -> FindConf
withExts :: [ByteString] -> FindConf
withExts = HashSet ByteString -> FindConf
Find forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList

{-# INLINABLE ignoreExts #-}
ignoreExts :: [ByteString] -- ^ The set of extensions to ignore.
  -> FindConf
ignoreExts :: [ByteString] -> FindConf
ignoreExts = HashSet ByteString -> FindConf
Ignore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList

-- | The last extension of a file. Returns empty bytestring if there is none.
{-# INLINABLE ext #-}
ext :: ByteString -> ByteString
ext :: ByteString -> ByteString
ext ByteString
c = if ByteString
e forall a. Eq a => a -> a -> Bool
== ByteString
c then forall a. Monoid a => a
mempty else ByteString
e
  where
    e :: ByteString
e = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B.spanEnd (forall a. Eq a => a -> a -> Bool
/= Char
'.') forall a b. (a -> b) -> a -> b
$ ByteString
c

-- | Find files in the given set of directories that either have a specific extension (`Find` case) or else excluding a certain set of extensiosn (`Ignore` case).
{-# INLINE findWithExts #-}
findWithExts :: FindInDirs -> IO (V.Vector (FileTree Text))
findWithExts :: FindInDirs -> IO (Vector (FileTree Text))
findWithExts (FindInDirs FindConf
c [ByteString]
d) = forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (Conf -> ByteString -> IO (FileTree Text)
fileTreeWith Conf
ch) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ [ByteString]
d
  where
    ch :: Conf
ch
      | Find   HashSet ByteString
es <- FindConf
c     = Conf
defConf {includeFile :: FileStatus -> ByteString -> IO Bool
includeFile = \ !FileStatus
s !ByteString
n -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FileStatus -> Bool
isRegularFile FileStatus
s Bool -> Bool -> Bool
&& forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member (ByteString -> ByteString
ext ByteString
n) HashSet ByteString
es}
      | Ignore HashSet ByteString
es <- FindConf
c     = Conf
defConf {includeFile :: FileStatus -> ByteString -> IO Bool
includeFile = \ !FileStatus
s !ByteString
n -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FileStatus -> Bool
isRegularFile FileStatus
s Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member (ByteString -> ByteString
ext ByteString
n) HashSet ByteString
es)}

-- | Like `findWithExts` but applied to mutliple lists of directories each with their own configuration of extensions.
{-# INLINABLE findFilesInDirs #-}
findFilesInDirs :: [FindInDirs] -> IO (V.Vector (FileTree Text))
findFilesInDirs :: [FindInDirs] -> IO (Vector (FileTree Text))
findFilesInDirs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\FindInDirs
a IO (Vector (FileTree Text))
t -> IO (Vector (FileTree Text))
t forall a. Semigroup a => a -> a -> a
<> FindInDirs -> IO (Vector (FileTree Text))
findWithExts FindInDirs
a) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)

-- | Find all the executables in PATH
executables :: IO (V.Vector Text)
executables :: IO (Vector Text)
executables = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall a. Eq a => Vector a -> Vector a
V.uniq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
V.modify forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m ()
V.sort) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> IO (Vector Text) -> IO (Vector Text)
merge (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Vector a
V.empty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
B.split Char
':' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ByteString -> IO ByteString
getEnvDefault ByteString
"PATH" ByteString
""
  where
    cl :: Conf
cl = Conf
defConf { filterPath :: ByteString -> Bool
filterPath = forall a b. a -> b -> a
const Bool
False , includeFile :: FileStatus -> ByteString -> IO Bool
includeFile = \ FileStatus
s ByteString
_ ->  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$    (FileStatus -> Bool
isRegularFile FileStatus
s Bool -> Bool -> Bool
|| FileStatus -> Bool
isSymbolicLink FileStatus
s)
                                                                             Bool -> Bool -> Bool
&& (FileMode
ownerExecuteMode forall a. Eq a => a -> a -> Bool
== FileMode -> FileMode -> FileMode
intersectFileModes (FileStatus -> FileMode
fileMode FileStatus
s) FileMode
ownerExecuteMode)}
    merge :: ByteString -> IO (Vector Text) -> IO (Vector Text)
merge ByteString
a IO (Vector Text)
t = IO (Vector Text)
t forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/= Char
'/')) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileTree Text -> Vector Text
flatten) (Conf -> ByteString -> IO (FileTree Text)
fileTreeWith Conf
cl ByteString
a)