module Proteome.Files.Source where

import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TMChan (TMChan, closeTMChan, newTMChan, readTMChan, writeTMChan)
import Control.Lens.Regex.Text (match, regexing)
import qualified Data.List.NonEmpty as NonEmpty (toList, zip)
import qualified Data.Set as Set (fromList, toList)
import qualified Data.Text as Text
import Exon (exon)
import Path (
  Abs,
  Dir,
  File,
  Path,
  Rel,
  dirname,
  filename,
  isProperPrefixOf,
  parent,
  parseAbsFile,
  relfile,
  stripProperPrefix,
  toFilePath,
  )
import Path.IO (doesDirExist, findExecutable, walkDir)
import qualified Path.IO as WalkAction (WalkAction (WalkExclude))
import Ribosome (pathText)
import Ribosome.Menu (MenuItem (MenuItem))
import Ribosome.Menu.Stream.Util (takeUntilNothing)
import qualified Streamly.Prelude as Stream
import Streamly.Prelude (IsStream, SerialT)
import System.FilePattern ((?==))
import Text.Regex.PCRE.Light (Regex)

import Proteome.Data.FileScanItem (FileScanItem (FileScanItem))
import Proteome.Data.FilesConfig (FilesConfig (FilesConfig))
import Proteome.Grep.Process (processLines)
import Proteome.Path (dropSlash)

-- TODO store traversals instead of Regexes?
matchPath :: [Regex] -> Path Abs t -> Bool
matchPath :: forall t. [Regex] -> Path Abs t -> Bool
matchPath [Regex]
excludes Path Abs t
path =
  (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Regex -> Bool
check [Regex]
excludes
  where
    check :: Regex -> Bool
check Regex
rgx =
      Path Abs t -> Text
forall b t. Path b t -> Text
pathText Path Abs t
path Text -> (Text -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Getting Any Text Text -> Text -> Bool
forall s a. Getting Any s a -> s -> Bool
has (Regex -> IndexedTraversal' Int Text Match
regexing Regex
rgx ((Match -> Const Any Match) -> Text -> Const Any Text)
-> ((Text -> Const Any Text) -> Match -> Const Any Match)
-> Getting Any Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Any Text) -> Match -> Const Any Match
IndexedTraversal' [Text] Match Text
match)

hiddenFilter ::
  (Path Abs t -> Path Rel t) ->
  Bool ->
  Path Abs t ->
  Bool
hiddenFilter :: forall t. (Path Abs t -> Path Rel t) -> Bool -> Path Abs t -> Bool
hiddenFilter Path Abs t -> Path Rel t
lastSegment Bool
True =
  Text -> Text -> Bool
Text.isPrefixOf Text
"." (Text -> Bool) -> (Path Abs t -> Text) -> Path Abs t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text)
-> (Path Abs t -> FilePath) -> Path Abs t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel t -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel t -> FilePath)
-> (Path Abs t -> Path Rel t) -> Path Abs t -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs t -> Path Rel t
lastSegment
hiddenFilter Path Abs t -> Path Rel t
_ Bool
False =
  Bool -> Path Abs t -> Bool
forall a b. a -> b -> a
const Bool
False

filterFiles ::
  Bool ->
  [Regex] ->
  [String] ->
  [Path Abs File] ->
  [Path Abs File]
filterFiles :: Bool -> [Regex] -> [FilePath] -> [Path Abs File] -> [Path Abs File]
filterFiles Bool
excludeHidden [Regex]
patterns [FilePath]
wildignore =
  (Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Abs File -> Bool) -> Path Abs File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Bool
cond)
  where
    cond :: Path Abs File -> Bool
cond Path Abs File
path =
      [Regex] -> Path Abs File -> Bool
forall t. [Regex] -> Path Abs t -> Bool
matchPath [Regex]
patterns Path Abs File
path Bool -> Bool -> Bool
||
      (Path Abs File -> Path Rel File) -> Bool -> Path Abs File -> Bool
forall t. (Path Abs t -> Path Rel t) -> Bool -> Path Abs t -> Bool
hiddenFilter Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Bool
excludeHidden Path Abs File
path Bool -> Bool -> Bool
||
      (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
?== FilePath
name) [FilePath]
wildignore
      where
        name :: FilePath
name =
          Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
path)

filterDirs ::
  Bool ->
  [Regex] ->
  [Path Abs Dir] ->
  [Path Abs Dir]
filterDirs :: Bool -> [Regex] -> [Path Abs Dir] -> [Path Abs Dir]
filterDirs Bool
excludeHidden [Regex]
patterns =
  (Path Abs Dir -> Bool) -> [Path Abs Dir] -> [Path Abs Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter Path Abs Dir -> Bool
pred'
  where
    pred' :: Path Abs Dir -> Bool
pred' Path Abs Dir
a =
      [Regex] -> Path Abs Dir -> Bool
forall t. [Regex] -> Path Abs t -> Bool
matchPath [Regex]
patterns Path Abs Dir
a Bool -> Bool -> Bool
|| (Path Abs Dir -> Path Rel Dir) -> Bool -> Path Abs Dir -> Bool
forall t. (Path Abs t -> Path Rel t) -> Bool -> Path Abs t -> Bool
hiddenFilter Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname Bool
excludeHidden Path Abs Dir
a

scan ::
  Member (Embed IO) r =>
  FilesConfig ->
  TMChan FileScanItem ->
  Path Abs Dir ->
  Maybe Text ->
  Sem r ()
scan :: forall (r :: EffectRow).
Member (Embed IO) r =>
FilesConfig
-> TMChan FileScanItem -> Path Abs Dir -> Maybe Text -> Sem r ()
scan (FilesConfig Bool
_ Bool
excludeHidden [Regex]
ignoreFiles [Regex]
ignoreDirs [Text]
wildignore) TMChan FileScanItem
chan Path Abs Dir
dir Maybe Text
baseIndicator =
  IO () -> Sem r ()
forall (r :: EffectRow). Member (Embed IO) r => IO () -> Sem r ()
tryAny_ do
    (Path Abs Dir
 -> [Path Abs Dir] -> [Path Abs File] -> IO (WalkAction Abs))
-> Path Abs Dir -> IO ()
forall (m :: * -> *) b.
MonadIO m =>
(Path Abs Dir
 -> [Path Abs Dir] -> [Path Abs File] -> m (WalkAction Abs))
-> Path b Dir -> m ()
walkDir Path Abs Dir
-> [Path Abs Dir] -> [Path Abs File] -> IO (WalkAction Abs)
enqueue Path Abs Dir
dir
  where
    enqueue :: Path Abs Dir
-> [Path Abs Dir] -> [Path Abs File] -> IO (WalkAction Abs)
enqueue Path Abs Dir
_ [Path Abs Dir]
dirs [Path Abs File]
files' =
      WalkAction Abs
exclude WalkAction Abs -> IO () -> IO (WalkAction Abs)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ STM () -> IO ()
forall a. STM a -> IO a
atomically ((FileScanItem -> STM ()) -> [FileScanItem] -> STM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (TMChan FileScanItem -> FileScanItem -> STM ()
forall a. TMChan a -> a -> STM ()
writeTMChan TMChan FileScanItem
chan) [FileScanItem]
filteredFiles)
      where
        filteredFiles :: [FileScanItem]
filteredFiles =
          Path Abs File -> FileScanItem
cons (Path Abs File -> FileScanItem)
-> [Path Abs File] -> [FileScanItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Regex] -> [FilePath] -> [Path Abs File] -> [Path Abs File]
filterFiles Bool
excludeHidden [Regex]
ignoreFiles (Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
wildignore) [Path Abs File]
files'
        exclude :: WalkAction Abs
exclude =
          [Path Abs Dir] -> WalkAction Abs
forall b. [Path b Dir] -> WalkAction b
WalkAction.WalkExclude (Bool -> [Regex] -> [Path Abs Dir] -> [Path Abs Dir]
filterDirs Bool
excludeHidden [Regex]
ignoreDirs [Path Abs Dir]
dirs)
    cons :: Path Abs File -> FileScanItem
cons =
      Path Abs Dir -> Maybe Text -> Path Abs File -> FileScanItem
FileScanItem Path Abs Dir
dir Maybe Text
baseIndicator

runScanners ::
  Members [Async, Embed IO] r =>
  FilesConfig ->
  TMChan FileScanItem ->
  NonEmpty (Path Abs Dir, Maybe Text) ->
  Sem r ()
runScanners :: forall (r :: EffectRow).
Members '[Async, Embed IO] r =>
FilesConfig
-> TMChan FileScanItem
-> NonEmpty (Path Abs Dir, Maybe Text)
-> Sem r ()
runScanners FilesConfig
conf TMChan FileScanItem
chan NonEmpty (Path Abs Dir, Maybe Text)
paths = do
  NonEmpty (Async (Maybe ()))
threads <- ((Path Abs Dir, Maybe Text) -> Sem r (Async (Maybe ())))
-> NonEmpty (Path Abs Dir, Maybe Text)
-> Sem r (NonEmpty (Async (Maybe ())))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Sem r () -> Sem r (Async (Maybe ()))
forall (r :: EffectRow) a.
Member Async r =>
Sem r a -> Sem r (Async (Maybe a))
async (Sem r () -> Sem r (Async (Maybe ())))
-> ((Path Abs Dir, Maybe Text) -> Sem r ())
-> (Path Abs Dir, Maybe Text)
-> Sem r (Async (Maybe ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir -> Maybe Text -> Sem r ())
-> (Path Abs Dir, Maybe Text) -> Sem r ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (FilesConfig
-> TMChan FileScanItem -> Path Abs Dir -> Maybe Text -> Sem r ()
forall (r :: EffectRow).
Member (Embed IO) r =>
FilesConfig
-> TMChan FileScanItem -> Path Abs Dir -> Maybe Text -> Sem r ()
scan FilesConfig
conf TMChan FileScanItem
chan)) NonEmpty (Path Abs Dir, Maybe Text)
paths
  (Async (Maybe ()) -> Sem r (Maybe ()))
-> NonEmpty (Async (Maybe ())) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Async (Maybe ()) -> Sem r (Maybe ())
forall (r :: EffectRow) a. Member Async r => Async a -> Sem r a
await NonEmpty (Async (Maybe ()))
threads Sem r () -> Sem r () -> Sem r ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (STM () -> IO ()
forall a. STM a -> IO a
atomically (TMChan FileScanItem -> STM ()
forall a. TMChan a -> STM ()
closeTMChan TMChan FileScanItem
chan))

withBaseIndicators ::
  NonEmpty (Path Abs Dir) ->
  NonEmpty (Path Abs Dir, Maybe Text)
withBaseIndicators :: NonEmpty (Path Abs Dir) -> NonEmpty (Path Abs Dir, Maybe Text)
withBaseIndicators bases :: NonEmpty (Path Abs Dir)
bases@(Path Abs Dir
_ :| []) =
  (, Maybe Text
forall a. Maybe a
Nothing) (Path Abs Dir -> (Path Abs Dir, Maybe Text))
-> NonEmpty (Path Abs Dir) -> NonEmpty (Path Abs Dir, Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Path Abs Dir)
bases
withBaseIndicators NonEmpty (Path Abs Dir)
bases =
  NonEmpty (Path Abs Dir)
-> NonEmpty (Maybe Text) -> NonEmpty (Path Abs Dir, Maybe Text)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip NonEmpty (Path Abs Dir)
bases (NonEmpty (Path Abs Dir) -> NonEmpty (Maybe Text)
forall {b}. NonEmpty (Path b Dir) -> NonEmpty (Maybe Text)
findSegment NonEmpty (Path Abs Dir)
bases)
  where
    findSegment :: NonEmpty (Path b Dir) -> NonEmpty (Maybe Text)
findSegment NonEmpty (Path b Dir)
paths
      | NonEmpty (Path b Dir) -> Bool
forall {b}. NonEmpty (Path b Dir) -> Bool
namesUnique NonEmpty (Path b Dir)
paths = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (Path b Dir -> Text) -> Path b Dir -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Text
forall b t. Path b t -> Text
dropSlash (Path Rel Dir -> Text)
-> (Path b Dir -> Path Rel Dir) -> Path b Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname (Path b Dir -> Maybe Text)
-> NonEmpty (Path b Dir) -> NonEmpty (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Path b Dir)
paths
      | NonEmpty (Path b Dir) -> Bool
forall {a}. Ord a => NonEmpty a -> Bool
allEqual NonEmpty (Path b Dir)
next = Maybe Text
forall a. Maybe a
Nothing Maybe Text -> NonEmpty (Path b Dir) -> NonEmpty (Maybe Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NonEmpty (Path b Dir)
paths
      | Bool
otherwise = NonEmpty (Path b Dir) -> NonEmpty (Maybe Text)
findSegment NonEmpty (Path b Dir)
next
      where
          next :: NonEmpty (Path b Dir)
next = Path b Dir -> Path b Dir
forall b t. Path b t -> Path b Dir
parent (Path b Dir -> Path b Dir)
-> NonEmpty (Path b Dir) -> NonEmpty (Path b Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Path b Dir)
paths
    namesUnique :: NonEmpty (Path b Dir) -> Bool
namesUnique NonEmpty (Path b Dir)
paths =
      NonEmpty (Path Rel Dir) -> [Path Rel Dir]
forall {a}. Ord a => NonEmpty a -> [a]
uniq NonEmpty (Path Rel Dir)
names [Path Rel Dir] -> [Path Rel Dir] -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (Path Rel Dir) -> [Path Rel Dir]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Path Rel Dir)
names
      where
        names :: NonEmpty (Path Rel Dir)
names = Path b Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname (Path b Dir -> Path Rel Dir)
-> NonEmpty (Path b Dir) -> NonEmpty (Path Rel Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Path b Dir)
paths
    allEqual :: NonEmpty a -> Bool
allEqual NonEmpty a
paths =
      [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (NonEmpty a -> [a]
forall {a}. Ord a => NonEmpty a -> [a]
uniq NonEmpty a
paths) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    uniq :: NonEmpty a -> [a]
uniq NonEmpty a
as =
      Set a -> [a]
forall a. Set a -> [a]
Set.toList ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty a
as))

fileMenuItem ::
  Path Abs Dir ->
  Maybe Text ->
  Path Abs File ->
  MenuItem (Path Abs File)
fileMenuItem :: Path Abs Dir
-> Maybe Text -> Path Abs File -> MenuItem (Path Abs File)
fileMenuItem Path Abs Dir
base Maybe Text
baseIndicator Path Abs File
path =
  Path Abs File -> Text -> Text -> MenuItem (Path Abs File)
forall a. a -> Text -> Text -> MenuItem a
MenuItem Path Abs File
path Text
text Text
display
  where
    display :: Text
display =
      Text
" * " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
indicator Maybe Text
baseIndicator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
    text :: Text
text =
      FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath
-> (Path Rel File -> FilePath) -> Maybe (Path Rel File) -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
path) Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Maybe (Path Rel File)
relativePath)
    relativePath :: Maybe (Path Rel File)
relativePath =
      Path Abs Dir -> Path Abs File -> Maybe (Path Rel File)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
base Path Abs File
path
    indicator :: a -> a
indicator a
name =
      a
"[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
name a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"] "

chanStream ::
  IsStream t =>
  Functor (t IO) =>
  TMChan a ->
  t IO a
chanStream :: forall (t :: (* -> *) -> * -> *) a.
(IsStream t, Functor (t IO)) =>
TMChan a -> t IO a
chanStream TMChan a
chan =
  t IO (Maybe a) -> t IO a
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, IsStream t, Functor (t m)) =>
t m (Maybe a) -> t m a
takeUntilNothing (IO (Maybe a) -> t IO (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadAsync m) =>
m a -> t m a
Stream.repeatM (IO (Maybe a) -> IO (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (STM (Maybe a) -> IO (Maybe a)
forall a. STM a -> IO a
atomically (TMChan a -> STM (Maybe a)
forall a. TMChan a -> STM (Maybe a)
readTMChan TMChan a
chan))))

filesNative ::
  Members [Async, Embed IO] r =>
  FilesConfig ->
  NonEmpty (Path Abs Dir) ->
  Sem r (SerialT IO (MenuItem (Path Abs File)))
filesNative :: forall (r :: EffectRow).
Members '[Async, Embed IO] r =>
FilesConfig
-> NonEmpty (Path Abs Dir)
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
filesNative FilesConfig
conf NonEmpty (Path Abs Dir)
paths = do
  TMChan FileScanItem
chan <- IO (TMChan FileScanItem) -> Sem r (TMChan FileScanItem)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (STM (TMChan FileScanItem) -> IO (TMChan FileScanItem)
forall a. STM a -> IO a
atomically STM (TMChan FileScanItem)
forall a. STM (TMChan a)
newTMChan)
  Sem r (Async (Maybe ())) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Async (Maybe ())) -> Sem r ())
-> (Sem r () -> Sem r (Async (Maybe ()))) -> Sem r () -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r () -> Sem r (Async (Maybe ()))
forall (r :: EffectRow) a.
Member Async r =>
Sem r a -> Sem r (Async (Maybe a))
async (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ FilesConfig
-> TMChan FileScanItem
-> NonEmpty (Path Abs Dir, Maybe Text)
-> Sem r ()
forall (r :: EffectRow).
Members '[Async, Embed IO] r =>
FilesConfig
-> TMChan FileScanItem
-> NonEmpty (Path Abs Dir, Maybe Text)
-> Sem r ()
runScanners FilesConfig
conf TMChan FileScanItem
chan (NonEmpty (Path Abs Dir) -> NonEmpty (Path Abs Dir, Maybe Text)
withBaseIndicators NonEmpty (Path Abs Dir)
paths)
  pure (FileScanItem -> MenuItem (Path Abs File)
menuItem (FileScanItem -> MenuItem (Path Abs File))
-> SerialT IO FileScanItem -> SerialT IO (MenuItem (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMChan FileScanItem -> SerialT IO FileScanItem
forall (t :: (* -> *) -> * -> *) a.
(IsStream t, Functor (t IO)) =>
TMChan a -> t IO a
chanStream TMChan FileScanItem
chan)
  where
    menuItem :: FileScanItem -> MenuItem (Path Abs File)
menuItem (FileScanItem Path Abs Dir
base Maybe Text
baseIndicator Path Abs File
path) =
      Path Abs Dir
-> Maybe Text -> Path Abs File -> MenuItem (Path Abs File)
fileMenuItem Path Abs Dir
base Maybe Text
baseIndicator Path Abs File
path

rgExcludes :: FilesConfig -> [Text]
rgExcludes :: FilesConfig -> [Text]
rgExcludes (FilesConfig Bool
_ Bool
_ [Regex]
_ [Regex]
_ [Text]
wilds) =
  [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Text -> [Text]
forall {l} {builder}.
(IsList l, IsString (Item l), ExonAppend (Item l) builder,
 ExonString (Item l) builder, ExonBuilder (Item l) builder) =>
Item l -> l
wild (Text -> [Text]) -> [Text] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
wilds)
  where
    wild :: Item l -> l
wild Item l
i =
      [Item l
"--glob", [exon|!#{i}|]]

findBase ::
  Path Abs File ->
  NonEmpty (Path Abs Dir, Maybe Text) ->
  Maybe (Path Abs Dir, Maybe Text)
findBase :: Path Abs File
-> NonEmpty (Path Abs Dir, Maybe Text)
-> Maybe (Path Abs Dir, Maybe Text)
findBase Path Abs File
file =
  ((Path Abs Dir, Maybe Text) -> Bool)
-> NonEmpty (Path Abs Dir, Maybe Text)
-> Maybe (Path Abs Dir, Maybe Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Path Abs Dir -> Path Abs File -> Bool
forall b t. Path b Dir -> Path b t -> Bool
`isProperPrefixOf` Path Abs File
file) (Path Abs Dir -> Bool)
-> ((Path Abs Dir, Maybe Text) -> Path Abs Dir)
-> (Path Abs Dir, Maybe Text)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir, Maybe Text) -> Path Abs Dir
forall a b. (a, b) -> a
fst)

rgMenuItem ::
  NonEmpty (Path Abs Dir, Maybe Text) ->
  Text ->
  Maybe (MenuItem (Path Abs File))
rgMenuItem :: NonEmpty (Path Abs Dir, Maybe Text)
-> Text -> Maybe (MenuItem (Path Abs File))
rgMenuItem NonEmpty (Path Abs Dir, Maybe Text)
bases Text
file = do
  Path Abs File
path <- FilePath -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
file)
  (Path Abs Dir
base, Maybe Text
baseIndicator) <- Path Abs File
-> NonEmpty (Path Abs Dir, Maybe Text)
-> Maybe (Path Abs Dir, Maybe Text)
findBase Path Abs File
path NonEmpty (Path Abs Dir, Maybe Text)
bases
  MenuItem (Path Abs File) -> Maybe (MenuItem (Path Abs File))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir
-> Maybe Text -> Path Abs File -> MenuItem (Path Abs File)
fileMenuItem Path Abs Dir
base Maybe Text
baseIndicator Path Abs File
path)

filesRg ::
  Path Abs File ->
  FilesConfig ->
  NonEmpty (Path Abs Dir) ->
  SerialT IO (MenuItem (Path Abs File))
filesRg :: Path Abs File
-> FilesConfig
-> NonEmpty (Path Abs Dir)
-> SerialT IO (MenuItem (Path Abs File))
filesRg Path Abs File
rgExe FilesConfig
conf NonEmpty (Path Abs Dir)
paths =
  (Text -> Maybe (MenuItem (Path Abs File)))
-> SerialT IO Text -> SerialT IO (MenuItem (Path Abs File))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> Maybe b) -> t m a -> t m b
Stream.mapMaybe Text -> Maybe (MenuItem (Path Abs File))
item (SerialT IO Text -> SerialT IO (MenuItem (Path Abs File)))
-> SerialT IO Text -> SerialT IO (MenuItem (Path Abs File))
forall a b. (a -> b) -> a -> b
$
  Path Abs File -> [Text] -> SerialT IO Text
forall (t :: (* -> *) -> * -> *).
IsStream t =>
Path Abs File -> [Text] -> t IO Text
processLines Path Abs File
rgExe (Text
"--files" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
excludes [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
patterns)
  where
    patterns :: [Text]
patterns =
      FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text)
-> (Path Abs Dir -> FilePath) -> Path Abs Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs Dir -> Text) -> [Path Abs Dir] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Path Abs Dir) -> [Path Abs Dir]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Path Abs Dir)
paths
    excludes :: [Text]
excludes =
      FilesConfig -> [Text]
rgExcludes FilesConfig
conf
    item :: Text -> Maybe (MenuItem (Path Abs File))
item =
      NonEmpty (Path Abs Dir, Maybe Text)
-> Text -> Maybe (MenuItem (Path Abs File))
rgMenuItem (NonEmpty (Path Abs Dir) -> NonEmpty (Path Abs Dir, Maybe Text)
withBaseIndicators NonEmpty (Path Abs Dir)
paths)

files ::
  Members [Async, Embed IO] r =>
  FilesConfig ->
  NonEmpty (Path Abs Dir) ->
  Sem r (SerialT IO (MenuItem (Path Abs File)))
files :: forall (r :: EffectRow).
Members '[Async, Embed IO] r =>
FilesConfig
-> NonEmpty (Path Abs Dir)
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
files conf :: FilesConfig
conf@(FilesConfig Bool
useRg Bool
_ [Regex]
_ [Regex]
_ [Text]
_) NonEmpty (Path Abs Dir)
paths =
  (Path Abs Dir -> Sem r Bool)
-> [Path Abs Dir] -> Sem r [Path Abs Dir]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Path Abs Dir -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist (NonEmpty (Path Abs Dir) -> [Path Abs Dir]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Path Abs Dir)
paths) Sem r [Path Abs Dir]
-> ([Path Abs Dir]
    -> Sem r (SerialT IO (MenuItem (Path Abs File))))
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [] ->
      SerialT IO (MenuItem (Path Abs File))
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure SerialT IO (MenuItem (Path Abs File))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
Stream.nil
    Path Abs Dir
p : [Path Abs Dir]
ps ->
      Path Rel File -> Sem r (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Rel File -> m (Maybe (Path Abs File))
findExecutable [relfile|rg|] Sem r (Maybe (Path Abs File))
-> (Maybe (Path Abs File)
    -> Sem r (SerialT IO (MenuItem (Path Abs File))))
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Path Abs File
rgExe | Bool
useRg ->
          SerialT IO (MenuItem (Path Abs File))
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File
-> FilesConfig
-> NonEmpty (Path Abs Dir)
-> SerialT IO (MenuItem (Path Abs File))
filesRg Path Abs File
rgExe FilesConfig
conf (Path Abs Dir
p Path Abs Dir -> [Path Abs Dir] -> NonEmpty (Path Abs Dir)
forall a. a -> [a] -> NonEmpty a
:| [Path Abs Dir]
ps))
        Maybe (Path Abs File)
_ ->
          FilesConfig
-> NonEmpty (Path Abs Dir)
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
forall (r :: EffectRow).
Members '[Async, Embed IO] r =>
FilesConfig
-> NonEmpty (Path Abs Dir)
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
filesNative FilesConfig
conf (Path Abs Dir
p Path Abs Dir -> [Path Abs Dir] -> NonEmpty (Path Abs Dir)
forall a. a -> [a] -> NonEmpty a
:| [Path Abs Dir]
ps)