module Talash.Files (
Conf (..) , FindConf (..) , FindInDirs (..) , FileTree (..)
, defConf , withExts , ignoreExts , findWithExts , findFilesInDirs , executables
, 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
data Conf = Conf {
Conf -> FileStatus -> ByteString -> IO Bool
includeFile :: FileStatus -> ByteString -> IO Bool ,
Conf -> ByteString -> Bool
filterPath :: ByteString -> Bool }
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 {
FindInDirs -> FindConf
confLocal :: FindConf ,
FindInDirs -> [ByteString]
dirsLocal :: [ByteString]}
data FileTree a = Dir { forall a. FileTree a -> a
rootDir :: a
, forall a. FileTree a -> Vector a
dirFiles :: V.Vector a
, forall a. FileTree a -> Vector (FileTree a)
subDirs :: V.Vector (FileTree a)}
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)
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)
{-# 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
{-# 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
{-# 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
{-# 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]
-> 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]
-> 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
{-# 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
{-# 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)}
{-# 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)
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)