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

    -- ** Aggregate completers
    compgenCwdPathsCompleter,
    compgenCwdPathsSuffixCompleter,

    -- ** Compen
    bashCompleterQuiet,

    -- ** Pure haskell
    cwdPathsCompleter,
    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

-- | '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
<> (String -> Bool) -> Completer
cwdPathsCompleterFilter 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 = (String -> Bool) -> Completer
cwdPathsCompleterFilter (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | 'cwdPathsCompleter' that runs an additional filter.
--
-- @since 0.1
cwdPathsCompleterFilter :: (String -> Bool) -> Completer
cwdPathsCompleterFilter :: (String -> Bool) -> Completer
cwdPathsCompleterFilter String -> Bool
predFn = (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
$ do
    cwd <- IO OsPath
Dir.getCurrentDirectory
    Dir.listDirectory cwd

  let files = [OsPath] -> Either IOException [OsPath] -> [OsPath]
forall b a. b -> Either a b -> b
fromRight [] Either IOException [OsPath]
eFiles

  pure $ foldr (go word) [] files
  where
    go :: String -> OsPath -> [String] -> [String]
    go :: String -> OsPath -> [String] -> [String]
go String
word OsPath
p [String]
acc = do
      let pStr :: String
pStr = OsPath -> String
OsPath.decodeLenient OsPath
p
          matchesPat :: Bool
matchesPat = String
word String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
pStr

      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

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