-- | Provides additional 'Completer's.
--
-- @since 0.1
module Effectful.Optparse.Completer
  ( -- * Bash completion

    -- ** Aggregate completers
    compgenCwdPathsCompleter,
    compgenCwdDirsCompleter,
    compgenCwdPathsSuffixCompleter,

    -- ** Compen
    bashCompleterQuiet,

    -- ** Pure haskell
    cwdPathsCompleter,
    cwdDirsCompleter,
    cwdPathsCompleterFilter,

    -- * Misc
    OAC.requote,
  )
where

import Control.Exception (IOException)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Catch qualified as C
import Data.Either (fromRight)
import Data.List qualified as L
import FileSystem.OsPath (OsPath)
import FileSystem.OsPath qualified as OsPath
import GHC.IO.Exception (ExitCode (ExitFailure, ExitSuccess))
import Options.Applicative.Builder.Completer (Completer)
import Options.Applicative.Builder.Completer qualified as OAC
import System.Directory.OsPath qualified as Dir
import System.Process qualified as P

-- | Completer for cwd paths that first tries compgen via 'bashCompleterQuiet',
-- then falls back to 'cwdPathsCompleter'.
--
-- @since 0.1
compgenCwdPathsCompleter :: Completer
compgenCwdPathsCompleter :: Completer
compgenCwdPathsCompleter = String -> Completer
bashCompleterQuiet String
"file" Completer -> Completer -> Completer
forall a. Semigroup a => a -> a -> a
<> Completer
cwdPathsCompleter

-- | Like 'compgenCwdPathsCompleter' but returns directories only.
--
-- @since 0.1
compgenCwdDirsCompleter :: Completer
compgenCwdDirsCompleter :: Completer
compgenCwdDirsCompleter = String -> Completer
bashCompleterQuiet String
"directory" Completer -> Completer -> Completer
forall a. Semigroup a => a -> a -> a
<> Completer
cwdDirsCompleter

-- | 'compgenCwdPathsCompleter' that filters on the given suffix.
--
-- @since -.1
compgenCwdPathsSuffixCompleter :: String -> Completer
compgenCwdPathsSuffixCompleter :: String -> Completer
compgenCwdPathsSuffixCompleter String
sfx =
  String -> Completer
bashCompleterQuiet String
compgenFilter
    Completer -> Completer -> Completer
forall a. Semigroup a => a -> a -> a
<> PathFilter -> Completer
cwdPathsCompleterFilter ((String -> Bool) -> PathFilter
PathFilterStr String -> Bool
strFilter)
  where
    compgenFilter :: String
compgenFilter =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"file -X '!*",
          String
sfx,
          String
"'"
        ]
    strFilter :: String -> Bool
strFilter = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isSuffixOf String
sfx

-- | Like 'OAC.bashCompleter', except any compgen stderrs are swallowed.
-- This can be nicer when completion errors make the output messy.
--
-- @since 0.1
bashCompleterQuiet :: String -> Completer
bashCompleterQuiet :: String -> Completer
bashCompleterQuiet String
action = (String -> IO [String]) -> Completer
OAC.mkCompleter ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \String
word -> do
  let cmd :: String
cmd = [String] -> String
L.unwords [String
"compgen", String
"-A", String
action, String
"--", String -> String
OAC.requote String
word]
  (ec, out, _err) <- CreateProcess -> String -> IO (ExitCode, String, String)
P.readCreateProcessWithExitCode (String -> CreateProcess
P.shell String
cmd) String
""
  pure $ case ec of
    ExitFailure Int
_ -> []
    ExitCode
ExitSuccess -> String -> [String]
L.lines String
out

-- | Completer based on paths in the current directory. Does not require
-- external programs like compgen.
--
-- @since 0.1
cwdPathsCompleter :: Completer
cwdPathsCompleter :: Completer
cwdPathsCompleter = PathFilter -> Completer
cwdPathsCompleterFilter ((String -> Bool) -> PathFilter
PathFilterStr ((String -> Bool) -> PathFilter) -> (String -> Bool) -> PathFilter
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Like 'cwdPathsCompleter' but returns directories only.
--
-- @since 0.1
cwdDirsCompleter :: Completer
cwdDirsCompleter :: Completer
cwdDirsCompleter = PathFilter -> Completer
cwdPathsCompleterFilter (PathFilter -> Completer) -> PathFilter -> Completer
forall a b. (a -> b) -> a -> b
$ (OsPath -> IO Bool) -> PathFilter
PathFilterOsPIO OsPath -> IO Bool
Dir.doesDirectoryExist

-- | Filters paths.
data PathFilter
  = -- | Simple predicate on the path's lenient decode to 'String'.
    --
    -- @since 0.1
    PathFilterStr (String -> Bool)
  | -- | Simple predicate on the path.
    --
    -- @since 0.1
    PathfilterOsP (OsPath -> Bool)
  | -- | Effectful predicate on the path's lenient decode to 'String'.
    --
    -- @since 0.1
    PathFilterStrIO (String -> IO Bool)
  | -- | Effectful predicate on the path.
    --
    -- @since 0.1
    PathFilterOsPIO (OsPath -> IO Bool)

-- | 'cwdPathsCompleter' that runs an additional filter on paths.
--
-- @since 0.1
cwdPathsCompleterFilter :: PathFilter -> Completer
cwdPathsCompleterFilter :: PathFilter -> Completer
cwdPathsCompleterFilter PathFilter
pfilter = (String -> IO [String]) -> Completer
OAC.mkCompleter ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \String
word -> do
  eFiles <- IO [OsPath] -> IO (Either IOException [OsPath])
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO [OsPath] -> IO (Either IOException [OsPath]))
-> IO [OsPath] -> IO (Either IOException [OsPath])
forall a b. (a -> b) -> a -> b
$ IO OsPath
Dir.getCurrentDirectory IO OsPath -> (OsPath -> IO [OsPath]) -> IO [OsPath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= OsPath -> IO [OsPath]
Dir.listDirectory

  let files = [OsPath] -> Either IOException [OsPath] -> [OsPath]
forall b a. b -> Either a b -> b
fromRight [] Either IOException [OsPath]
eFiles
      myFoldr :: forall a. a -> (String -> OsPath -> a -> a) -> a
      myFoldr a
initial String -> OsPath -> a -> a
p = (OsPath -> a -> a) -> a -> [OsPath] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> OsPath -> a -> a
p String
word) a
initial [OsPath]
files

  case pfilter of
    PathFilterStr String -> Bool
predFn -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> (String -> OsPath -> [String] -> [String]) -> [String]
forall a. a -> (String -> OsPath -> a -> a) -> a
myFoldr [] ((String -> OsPath -> [String] -> [String]) -> [String])
-> (String -> OsPath -> [String] -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \String
wd OsPath
p [String]
acc ->
      let pStr :: String
pStr = OsPath -> String
OsPath.decodeLenient OsPath
p
          matchesPat :: Bool
matchesPat = String
wd String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
pStr
       in if Bool
matchesPat Bool -> Bool -> Bool
&& String -> Bool
predFn String
pStr
            then String
pStr String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc
            else [String]
acc
    PathfilterOsP OsPath -> Bool
predFn -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> (String -> OsPath -> [String] -> [String]) -> [String]
forall a. a -> (String -> OsPath -> a -> a) -> a
myFoldr [] ((String -> OsPath -> [String] -> [String]) -> [String])
-> (String -> OsPath -> [String] -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \String
wd OsPath
p [String]
acc ->
      let pStr :: String
pStr = OsPath -> String
OsPath.decodeLenient OsPath
p
          matchesPat :: Bool
matchesPat = String
wd String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
pStr
       in if Bool
matchesPat Bool -> Bool -> Bool
&& OsPath -> Bool
predFn OsPath
p
            then String
pStr String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc
            else [String]
acc
    PathFilterStrIO String -> IO Bool
predFn -> IO [String]
-> (String -> OsPath -> IO [String] -> IO [String]) -> IO [String]
forall a. a -> (String -> OsPath -> a -> a) -> a
myFoldr ([String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ((String -> OsPath -> IO [String] -> IO [String]) -> IO [String])
-> (String -> OsPath -> IO [String] -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \String
wd OsPath
p IO [String]
acc -> do
      let pStr :: String
pStr = OsPath -> String
OsPath.decodeLenient OsPath
p
          matchesPat :: Bool
matchesPat = String
wd String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
pStr

      if Bool
matchesPat
        then do
          c <- String -> IO Bool
predFn String
pStr
          if c
            then (pStr :) <$> acc
            else acc
        else IO [String]
acc
    PathFilterOsPIO OsPath -> IO Bool
predFn -> IO [String]
-> (String -> OsPath -> IO [String] -> IO [String]) -> IO [String]
forall a. a -> (String -> OsPath -> a -> a) -> a
myFoldr ([String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ((String -> OsPath -> IO [String] -> IO [String]) -> IO [String])
-> (String -> OsPath -> IO [String] -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \String
wd OsPath
p IO [String]
acc -> do
      let pStr :: String
pStr = OsPath -> String
OsPath.decodeLenient OsPath
p
          matchesPat :: Bool
matchesPat = String
wd String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
pStr

      if Bool
matchesPat
        then do
          c <- OsPath -> IO Bool
predFn OsPath
p
          if c
            then (pStr :) <$> acc
            else acc
        else IO [String]
acc

tryIO :: (MonadCatch m) => m a -> m (Either IOException a)
tryIO :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO = m a -> m (Either IOException a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try