{-# LANGUAGE LambdaCase #-}

module OptEnvConf.Completer
  ( Completer (..),
    mkCompleter,
    listCompleter,
    listIOCompleter,
    filePath,
    directoryPath,
  )
where

import Data.List
import Data.Maybe
import Path
import Path.IO
import Path.Internal.Posix (Path (..))

newtype Completer = Completer {Completer -> FilePath -> IO [FilePath]
unCompleter :: String -> IO [String]}

-- Forward-compatible synonym for the 'Completer' constructor
mkCompleter :: (String -> IO [String]) -> Completer
mkCompleter :: (FilePath -> IO [FilePath]) -> Completer
mkCompleter = (FilePath -> IO [FilePath]) -> Completer
Completer

listCompleter :: [String] -> Completer
listCompleter :: [FilePath] -> Completer
listCompleter [FilePath]
ss = IO [FilePath] -> Completer
listIOCompleter (IO [FilePath] -> Completer) -> IO [FilePath] -> Completer
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
ss

listIOCompleter :: IO [String] -> Completer
listIOCompleter :: IO [FilePath] -> Completer
listIOCompleter IO [FilePath]
act = (FilePath -> IO [FilePath]) -> Completer
Completer ((FilePath -> IO [FilePath]) -> Completer)
-> (FilePath -> IO [FilePath]) -> Completer
forall a b. (a -> b) -> a -> b
$ \FilePath
s -> FilePath -> [FilePath] -> [FilePath]
filterPrefix FilePath
s ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
act

filePath :: Completer
filePath :: Completer
filePath = (FilePath -> IO [FilePath]) -> Completer
Completer ((FilePath -> IO [FilePath]) -> Completer)
-> (FilePath -> IO [FilePath]) -> Completer
forall a b. (a -> b) -> a -> b
$ \FilePath
fp' -> do
  Path Abs Dir
here <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir

  -- An empty string is not a valid relative file or dir, but it is the most
  -- common option so we special case it here
  let (FilePath
prefix, FilePath
fp) = FilePath -> (FilePath, FilePath)
stripCurDir FilePath
fp'
  ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> [FilePath] -> [FilePath]
filterPrefix FilePath
fp' ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
prefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>)) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
    let listDirForgiving :: Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path b Dir
d = ([Path Rel Dir], [Path Rel File])
-> Maybe ([Path Rel Dir], [Path Rel File])
-> ([Path Rel Dir], [Path Rel File])
forall a. a -> Maybe a -> a
fromMaybe ([], []) (Maybe ([Path Rel Dir], [Path Rel File])
 -> ([Path Rel Dir], [Path Rel File]))
-> f (Maybe ([Path Rel Dir], [Path Rel File]))
-> f ([Path Rel Dir], [Path Rel File])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ([Path Rel Dir], [Path Rel File])
-> f (Maybe ([Path Rel Dir], [Path Rel File]))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path b Dir -> f ([Path Rel Dir], [Path Rel File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
listDirRel Path b Dir
d)
    ([FilePath]
dirsFromParentListing, [FilePath]
filesFromParentListing) <- case FilePath -> Maybe (SomeBase Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (SomeBase Dir)
parseSomeDir FilePath
fp of
      Maybe (SomeBase Dir)
Nothing -> case FilePath
fp of
        [] -> do
          -- This is not a valid rel dir but still a prefix of a valid rel dir:
          -- the current dir
          ([Path Rel Dir]
ds, [Path Rel File]
fs) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
listDirRel Path Abs Dir
here
          ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( (Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel Dir -> FilePath
fromRelDir ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel Dir -> Bool) -> Path Rel Dir -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel Dir]
ds,
              (Path Rel File -> FilePath) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel File -> FilePath
fromRelFile ([Path Rel File] -> [FilePath]) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel File -> Bool) -> [Path Rel File] -> [Path Rel File]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel File -> Bool) -> Path Rel File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel File]
fs
            )
        FilePath
_ -> ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
      Just (Abs Path Abs Dir
ad) -> do
        ([Path Rel Dir]
ds, [Path Rel File]
fs) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall {f :: * -> *} {b}.
(MonadIO f, MonadCatch f) =>
Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path Abs Dir
ad
        ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( (Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir -> FilePath
fromAbsDir (Path Abs Dir -> FilePath)
-> (Path Rel Dir -> Path Abs Dir) -> Path Rel Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir
ad Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel Dir -> Bool) -> Path Rel Dir -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel Dir]
ds,
            (Path Rel File -> FilePath) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs File -> FilePath
fromAbsFile (Path Abs File -> FilePath)
-> (Path Rel File -> Path Abs File) -> Path Rel File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir
ad Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel File] -> [FilePath]) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel File -> Bool) -> [Path Rel File] -> [Path Rel File]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel File -> Bool) -> Path Rel File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel File]
fs
          )
      Just (Rel Path Rel Dir
rd) -> do
        ([Path Rel Dir]
ds, [Path Rel File]
fs) <- Path Rel Dir -> IO ([Path Rel Dir], [Path Rel File])
forall {f :: * -> *} {b}.
(MonadIO f, MonadCatch f) =>
Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path Rel Dir
rd
        ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( (Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel Dir -> FilePath
fromRelDir (Path Rel Dir -> FilePath)
-> (Path Rel Dir -> Path Rel Dir) -> Path Rel Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel Dir
rd Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel Dir -> Bool) -> Path Rel Dir -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel Dir]
ds,
            (Path Rel File -> FilePath) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel File -> FilePath
fromRelFile (Path Rel File -> FilePath)
-> (Path Rel File -> Path Rel File) -> Path Rel File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel Dir
rd Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel File] -> [FilePath]) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel File -> Bool) -> [Path Rel File] -> [Path Rel File]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel File -> Bool) -> Path Rel File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel File]
fs
          )

    ([FilePath]
dirsFromPartialListing, [FilePath]
filesFromPartialListing) <- case FilePath -> Maybe (SomeBase File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (SomeBase File)
parseSomeFile FilePath
fp of
      Maybe (SomeBase File)
Nothing ->
        -- This is not a valid rel file but still a prefix of a valid
        -- (hidden) rel file.
        if FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"."
          then do
            ([Path Rel Dir]
ds, [Path Rel File]
fs) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
listDirRel Path Abs Dir
here
            ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              ( (Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel Dir -> FilePath
fromRelDir [Path Rel Dir]
ds,
                (Path Rel File -> FilePath) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel File -> FilePath
fromRelFile [Path Rel File]
fs
              )
          else ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
      Just (Abs Path Abs File
af) -> do
        let dir :: Path Abs Dir
dir = Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
af
        let filterHidden :: [Path Rel f] -> [Path Rel f]
filterHidden = if Path Rel File -> Bool
forall f. Path Rel f -> Bool
hiddenRel (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
af) then [Path Rel f] -> [Path Rel f]
forall a. a -> a
id else (Path Rel f -> Bool) -> [Path Rel f] -> [Path Rel f]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel f -> Bool) -> Path Rel f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel f -> Bool
forall f. Path Rel f -> Bool
hiddenRel)
        ([Path Rel Dir]
ds, [Path Rel File]
fs) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall {f :: * -> *} {b}.
(MonadIO f, MonadCatch f) =>
Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path Abs Dir
dir
        ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( (Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir -> FilePath
fromAbsDir (Path Abs Dir -> FilePath)
-> (Path Rel Dir -> Path Abs Dir) -> Path Rel Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Path Rel Dir] -> [Path Rel Dir]
forall {f}. [Path Rel f] -> [Path Rel f]
filterHidden [Path Rel Dir]
ds,
            (Path Rel File -> FilePath) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs File -> FilePath
fromAbsFile (Path Abs File -> FilePath)
-> (Path Rel File -> Path Abs File) -> Path Rel File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir
dir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel File] -> [FilePath]) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Path Rel File] -> [Path Rel File]
forall {f}. [Path Rel f] -> [Path Rel f]
filterHidden [Path Rel File]
fs
          )
      Just (Rel Path Rel File
rf) -> do
        let dir :: Path Rel Dir
dir = Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent Path Rel File
rf
        let filterHidden :: [Path Rel f] -> [Path Rel f]
filterHidden = if Path Rel File -> Bool
forall f. Path Rel f -> Bool
hiddenRel Path Rel File
rf then [Path Rel f] -> [Path Rel f]
forall a. a -> a
id else (Path Rel f -> Bool) -> [Path Rel f] -> [Path Rel f]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel f -> Bool) -> Path Rel f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel f -> Bool
forall f. Path Rel f -> Bool
hiddenRel)
        ([Path Rel Dir]
ds, [Path Rel File]
fs) <- Path Rel Dir -> IO ([Path Rel Dir], [Path Rel File])
forall {f :: * -> *} {b}.
(MonadIO f, MonadCatch f) =>
Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path Rel Dir
dir
        ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( (Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel Dir -> FilePath
fromRelDir (Path Rel Dir -> FilePath)
-> (Path Rel Dir -> Path Rel Dir) -> Path Rel Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel Dir
dir Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Path Rel Dir] -> [Path Rel Dir]
forall {f}. [Path Rel f] -> [Path Rel f]
filterHidden [Path Rel Dir]
ds,
            (Path Rel File -> FilePath) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel File -> FilePath
fromRelFile (Path Rel File -> FilePath)
-> (Path Rel File -> Path Rel File) -> Path Rel File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel Dir
dir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel File] -> [FilePath]) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Path Rel File] -> [Path Rel File]
forall {f}. [Path Rel f] -> [Path Rel f]
filterHidden [Path Rel File]
fs
          )

    [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
      [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [FilePath]
filesFromPartialListing,
          [FilePath]
filesFromParentListing,
          [FilePath]
dirsFromPartialListing,
          [FilePath]
dirsFromParentListing
        ]

directoryPath :: Completer
directoryPath :: Completer
directoryPath = (FilePath -> IO [FilePath]) -> Completer
Completer ((FilePath -> IO [FilePath]) -> Completer)
-> (FilePath -> IO [FilePath]) -> Completer
forall a b. (a -> b) -> a -> b
$ \FilePath
fp' -> do
  Path Abs Dir
here <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir

  -- An empty string is not a valid relative file or dir, but it is the most
  -- common option so we special case it here
  let (FilePath
prefix, FilePath
fp) = FilePath -> (FilePath, FilePath)
stripCurDir FilePath
fp'
  ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> [FilePath] -> [FilePath]
filterPrefix FilePath
fp' ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
prefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>)) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
    let listDirForgiving :: Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path b Dir
d = ([Path Rel Dir], [Path Rel File])
-> Maybe ([Path Rel Dir], [Path Rel File])
-> ([Path Rel Dir], [Path Rel File])
forall a. a -> Maybe a -> a
fromMaybe ([], []) (Maybe ([Path Rel Dir], [Path Rel File])
 -> ([Path Rel Dir], [Path Rel File]))
-> f (Maybe ([Path Rel Dir], [Path Rel File]))
-> f ([Path Rel Dir], [Path Rel File])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ([Path Rel Dir], [Path Rel File])
-> f (Maybe ([Path Rel Dir], [Path Rel File]))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path b Dir -> f ([Path Rel Dir], [Path Rel File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
listDirRel Path b Dir
d)
    [FilePath]
dirsFromParentListing <- case FilePath -> Maybe (SomeBase Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (SomeBase Dir)
parseSomeDir FilePath
fp of
      Maybe (SomeBase Dir)
Nothing -> case FilePath
fp of
        [] -> do
          -- This is not a valid rel dir but still a prefix of a valid rel dir:
          -- the current dir
          ([Path Rel Dir]
ds, [Path Rel File]
_) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
listDirRel Path Abs Dir
here
          [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel Dir -> FilePath
fromRelDir ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel Dir -> Bool) -> Path Rel Dir -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel Dir]
ds)
        FilePath
_ -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just (Abs Path Abs Dir
ad) -> do
        ([Path Rel Dir]
ds, [Path Rel File]
_) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall {f :: * -> *} {b}.
(MonadIO f, MonadCatch f) =>
Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path Abs Dir
ad
        [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir -> FilePath
fromAbsDir (Path Abs Dir -> FilePath)
-> (Path Rel Dir -> Path Abs Dir) -> Path Rel Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir
ad Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel Dir -> Bool) -> Path Rel Dir -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel Dir]
ds)
      Just (Rel Path Rel Dir
rd) -> do
        ([Path Rel Dir]
ds, [Path Rel File]
_) <- Path Rel Dir -> IO ([Path Rel Dir], [Path Rel File])
forall {f :: * -> *} {b}.
(MonadIO f, MonadCatch f) =>
Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path Rel Dir
rd
        [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel Dir -> FilePath
fromRelDir (Path Rel Dir -> FilePath)
-> (Path Rel Dir -> Path Rel Dir) -> Path Rel Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel Dir
rd Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel Dir -> Bool) -> Path Rel Dir -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Bool
forall f. Path Rel f -> Bool
hiddenRel) [Path Rel Dir]
ds)

    [FilePath]
dirsFromPartialListing <- case FilePath -> Maybe (SomeBase Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (SomeBase Dir)
parseSomeDir FilePath
fp of
      Maybe (SomeBase Dir)
Nothing -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just (Abs Path Abs Dir
af) -> do
        let dir :: Path Abs Dir
dir = Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
af
        let filterHidden :: [Path Rel f] -> [Path Rel f]
filterHidden = if Path Rel Dir -> Bool
forall f. Path Rel f -> Bool
hiddenRel (Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname Path Abs Dir
af) then [Path Rel f] -> [Path Rel f]
forall a. a -> a
id else (Path Rel f -> Bool) -> [Path Rel f] -> [Path Rel f]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel f -> Bool) -> Path Rel f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel f -> Bool
forall f. Path Rel f -> Bool
hiddenRel)
        ([Path Rel Dir]
ds, [Path Rel File]
_) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall {f :: * -> *} {b}.
(MonadIO f, MonadCatch f) =>
Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path Abs Dir
dir
        [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir -> FilePath
fromAbsDir (Path Abs Dir -> FilePath)
-> (Path Rel Dir -> Path Abs Dir) -> Path Rel Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Path Rel Dir] -> [Path Rel Dir]
forall {f}. [Path Rel f] -> [Path Rel f]
filterHidden [Path Rel Dir]
ds)
      Just (Rel Path Rel Dir
rf) ->
        -- This is not a valid rel dir but still a prefix of a valid
        -- (hidden) rel dir.
        if FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"."
          then do
            ([Path Rel Dir]
ds, [Path Rel File]
_) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
listDirRel Path Abs Dir
here
            [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel Dir -> FilePath
fromRelDir [Path Rel Dir]
ds)
          else do
            let dir :: Path Rel Dir
dir = Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent Path Rel Dir
rf
            let filterHidden :: [Path Rel f] -> [Path Rel f]
filterHidden = if Path Rel Dir -> Bool
forall f. Path Rel f -> Bool
hiddenRel Path Rel Dir
rf then [Path Rel f] -> [Path Rel f]
forall a. a -> a
id else (Path Rel f -> Bool) -> [Path Rel f] -> [Path Rel f]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel f -> Bool) -> Path Rel f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel f -> Bool
forall f. Path Rel f -> Bool
hiddenRel)
            ([Path Rel Dir]
ds, [Path Rel File]
_) <- Path Rel Dir -> IO ([Path Rel Dir], [Path Rel File])
forall {f :: * -> *} {b}.
(MonadIO f, MonadCatch f) =>
Path b Dir -> f ([Path Rel Dir], [Path Rel File])
listDirForgiving Path Rel Dir
dir
            [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Path Rel Dir -> FilePath) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel Dir -> FilePath
fromRelDir (Path Rel Dir -> FilePath)
-> (Path Rel Dir -> Path Rel Dir) -> Path Rel Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel Dir
dir Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) ([Path Rel Dir] -> [FilePath]) -> [Path Rel Dir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Path Rel Dir] -> [Path Rel Dir]
forall {f}. [Path Rel f] -> [Path Rel f]
filterHidden [Path Rel Dir]
ds)

    [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
      [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [FilePath]
dirsFromPartialListing,
          [FilePath]
dirsFromParentListing
        ]

hiddenRel :: Path Rel f -> Bool
hiddenRel :: forall f. Path Rel f -> Bool
hiddenRel (Path FilePath
s) = case FilePath
s of
  (Char
'.' : FilePath
_) -> Bool
True
  FilePath
_ -> Bool
False

stripCurDir :: FilePath -> (FilePath, FilePath)
stripCurDir :: FilePath -> (FilePath, FilePath)
stripCurDir = \case
  Char
'.' : Char
'/' : FilePath
rest' ->
    let (FilePath
pf, FilePath
rest) = FilePath -> (FilePath, FilePath)
stripCurDir FilePath
rest'
     in (FilePath
"./" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
pf, FilePath
rest)
  FilePath
p -> (FilePath
"", FilePath
p)

filterPrefix :: String -> [String] -> [String]
filterPrefix :: FilePath -> [FilePath] -> [FilePath]
filterPrefix FilePath
s = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)