{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
module Options.Applicative.Builder.Extra
( boolFlags
, boolFlagsNoDefault
, firstBoolFlagsNoDefault
, firstBoolFlagsTrue
, firstBoolFlagsFalse
, enableDisableFlags
, enableDisableFlagsNoDefault
, extraHelpOption
, execExtraHelp
, textOption
, textArgument
, optionalFirst
, optionalFirstTrue
, optionalFirstFalse
, absFileOption
, relFileOption
, absDirOption
, relDirOption
, eitherReader'
, fileCompleter
, fileExtCompleter
, dirCompleter
, PathCompleterOpts (..)
, defaultPathCompleterOpts
, pathCompleterWith
, unescapeBashArg
, showHelpText
) where
import Data.List ( isPrefixOf )
import qualified Data.Text as T
import Options.Applicative
( ArgumentFields, Completer, FlagFields, Mod, OptionFields
, ParseError (..), Parser, ReadM, abortOption, argument
, completer, eitherReader, execParser, flag', fullDesc, help
, hidden, idm, info, infoOption, internal, long, metavar
, mkCompleter, option, progDesc, strArgument
)
import Options.Applicative.Types ( readerAsk )
import Path ( parseAbsDir, parseAbsFile, parseRelDir, parseRelFile )
import Stack.Prelude
import System.Directory
( doesDirectoryExist, getCurrentDirectory
, getDirectoryContents
)
import System.Environment ( withArgs )
import System.FilePath
( (</>), isRelative, splitFileName, takeBaseName
, takeExtension
)
data
= FlagNotFoundBug
deriving (Int -> OptionsApplicativeExtraException -> ShowS
[OptionsApplicativeExtraException] -> ShowS
OptionsApplicativeExtraException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionsApplicativeExtraException] -> ShowS
$cshowList :: [OptionsApplicativeExtraException] -> ShowS
show :: OptionsApplicativeExtraException -> String
$cshow :: OptionsApplicativeExtraException -> String
showsPrec :: Int -> OptionsApplicativeExtraException -> ShowS
$cshowsPrec :: Int -> OptionsApplicativeExtraException -> ShowS
Show, Typeable)
instance Exception OptionsApplicativeExtraException where
displayException :: OptionsApplicativeExtraException -> String
displayException OptionsApplicativeExtraException
FlagNotFoundBug =
String
"Error: [S-2797]\n"
forall a. [a] -> [a] -> [a]
++ String
"The impossible happened! No valid flags found in \
\enableDisableFlagsNoDefault. Please report this bug at Stack's \
\repository."
boolFlags ::
Bool
-> String
-> String
-> Mod FlagFields Bool
-> Parser Bool
boolFlags :: Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
defaultValue String
name String
helpSuffix =
forall a.
a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags Bool
defaultValue Bool
True Bool
False String
name forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
helpSuffix
, String
" (default: "
, if Bool
defaultValue then String
"enabled" else String
"disabled"
, String
")"
]
boolFlagsNoDefault ::
String
-> String
-> Mod FlagFields Bool
-> Parser Bool
boolFlagsNoDefault :: String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlagsNoDefault = forall a.
a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault Bool
True Bool
False
firstBoolFlagsNoDefault ::
String
-> String
-> Mod FlagFields (Maybe Bool)
-> Parser (First Bool)
firstBoolFlagsNoDefault :: String
-> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlagsNoDefault String
name String
helpSuffix Mod FlagFields (Maybe Bool)
mod' =
forall a. Maybe a -> First a
First forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a.
a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Bool
True) (forall a. a -> Maybe a
Just Bool
False)
String
name String
helpSuffix Mod FlagFields (Maybe Bool)
mod'
firstBoolFlagsTrue ::
String
-> String
-> Mod FlagFields FirstTrue
-> Parser FirstTrue
firstBoolFlagsTrue :: String -> String -> Mod FlagFields FirstTrue -> Parser FirstTrue
firstBoolFlagsTrue String
name String
helpSuffix =
forall a.
a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags forall a. Monoid a => a
mempty (Maybe Bool -> FirstTrue
FirstTrue (forall a. a -> Maybe a
Just Bool
True)) (Maybe Bool -> FirstTrue
FirstTrue (forall a. a -> Maybe a
Just Bool
False))
String
name forall a b. (a -> b) -> a -> b
$ String
helpSuffix forall a. [a] -> [a] -> [a]
++ String
" (default: enabled)"
firstBoolFlagsFalse ::
String
-> String
-> Mod FlagFields FirstFalse
-> Parser FirstFalse
firstBoolFlagsFalse :: String -> String -> Mod FlagFields FirstFalse -> Parser FirstFalse
firstBoolFlagsFalse String
name String
helpSuffix =
forall a.
a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags forall a. Monoid a => a
mempty (Maybe Bool -> FirstFalse
FirstFalse (forall a. a -> Maybe a
Just Bool
True)) (Maybe Bool -> FirstFalse
FirstFalse (forall a. a -> Maybe a
Just Bool
False))
String
name forall a b. (a -> b) -> a -> b
$ String
helpSuffix forall a. [a] -> [a] -> [a]
++ String
" (default: disabled)"
enableDisableFlags ::
a
-> a
-> a
-> String
-> String
-> Mod FlagFields a
-> Parser a
enableDisableFlags :: forall a.
a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags a
defaultValue a
enabledValue a
disabledValue String
name String
helpSuffix
Mod FlagFields a
mods =
forall a.
a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault
a
enabledValue
a
disabledValue
String
name
String
helpSuffix
Mod FlagFields a
mods forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
defaultValue
enableDisableFlagsNoDefault ::
a
-> a
-> String
-> String
-> Mod FlagFields a
-> Parser a
enableDisableFlagsNoDefault :: forall a.
a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault a
enabledValue a
disabledValue String
name String
helpSuffix Mod FlagFields a
mods =
forall {a}. [a] -> a
last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
( forall a. a -> Mod FlagFields a -> Parser a
flag'
a
enabledValue
( forall (f :: * -> *) a. Mod f a
hidden
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
name
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
helpSuffix
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag'
a
disabledValue
( forall (f :: * -> *) a. Mod f a
hidden
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"no-" forall a. [a] -> [a] -> [a]
++ String
name)
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
helpSuffix
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag'
a
disabledValue
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"[no-]" forall a. [a] -> [a] -> [a]
++ String
name)
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help (String
"Enable/disable " forall a. [a] -> [a] -> [a]
++ String
helpSuffix)
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
)
)
where
last :: [a] -> a
last [a]
xs =
case forall a. [a] -> [a]
reverse [a]
xs of
[] -> forall e a. Exception e => e -> a
impureThrow OptionsApplicativeExtraException
FlagNotFoundBug
a
x:[a]
_ -> a
x
extraHelpOption ::
Bool
-> String
-> String
-> String
-> Parser (a -> a)
Bool
hide String
progName String
fakeName String
helpName =
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
(String
optDesc' forall a. [a] -> [a] -> [a]
++ String
".")
(forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
helpName forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
hidden forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
(String
optDesc' forall a. [a] -> [a] -> [a]
++ String
".")
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
fakeName
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
optDesc'
forall a. Semigroup a => a -> a -> a
<> (if Bool
hide then forall (f :: * -> *) a. Mod f a
hidden forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal else forall a. Monoid a => a
idm)
)
where
optDesc' :: String
optDesc' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Run '"
, ShowS
takeBaseName String
progName
, String
" --"
, String
helpName
, String
"' for details."
]
execExtraHelp ::
[String]
-> String
-> Parser a
-> String
-> IO ()
[String]
args String
helpOpt Parser a
parser String
pd =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
args forall a. Eq a => a -> a -> Bool
== [String
"--" forall a. [a] -> [a] -> [a]
++ String
helpOpt]) forall a b. (a -> b) -> a -> b
$
forall a. [String] -> IO a -> IO a
withArgs [String
"--help"] forall a b. (a -> b) -> a -> b
$ do
(a, [String])
_ <- forall a. ParserInfo a -> IO a
execParser (forall a. Parser a -> InfoMod a -> ParserInfo a
info
( forall {a}. Parser (a -> a)
hiddenHelper
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
parser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
(forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"OTHER ARGUMENTS") :: Parser String)
)
)
(forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
pd))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
hiddenHelper :: Parser (a -> a)
hiddenHelper = forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption ParseError
showHelpText (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"help" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
hidden forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal)
textOption :: Mod OptionFields Text -> Parser Text
textOption :: Mod OptionFields Text -> Parser Text
textOption = forall a. ReadM a -> Mod OptionFields a -> Parser a
option (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM String
readerAsk)
textArgument :: Mod ArgumentFields Text -> Parser Text
textArgument :: Mod ArgumentFields Text -> Parser Text
textArgument = forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM String
readerAsk)
optionalFirst :: Alternative f => f a -> f (First a)
optionalFirst :: forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
optionalFirstTrue :: Alternative f => f Bool -> f FirstTrue
optionalFirstTrue :: forall (f :: * -> *). Alternative f => f Bool -> f FirstTrue
optionalFirstTrue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Bool -> FirstTrue
FirstTrue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
optionalFirstFalse :: Alternative f => f Bool -> f FirstFalse
optionalFirstFalse :: forall (f :: * -> *). Alternative f => f Bool -> f FirstFalse
optionalFirstFalse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Bool -> FirstFalse
FirstFalse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
absFileOption :: Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
absFileOption :: Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
absFileOption Mod OptionFields (Path Abs File)
mods = forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall e a. Show e => (String -> Either e a) -> ReadM a
eitherReader' forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
(PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
defaultPathCompleterOpts { pcoRelative :: Bool
pcoRelative = Bool
False })
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Path Abs File)
mods
relFileOption :: Mod OptionFields (Path Rel File) -> Parser (Path Rel File)
relFileOption :: Mod OptionFields (Path Rel File) -> Parser (Path Rel File)
relFileOption Mod OptionFields (Path Rel File)
mods = forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall e a. Show e => (String -> Either e a) -> ReadM a
eitherReader' forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
(PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
defaultPathCompleterOpts { pcoAbsolute :: Bool
pcoAbsolute = Bool
False })
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Path Rel File)
mods
absDirOption :: Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
absDirOption :: Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
absDirOption Mod OptionFields (Path Abs Dir)
mods = forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall e a. Show e => (String -> Either e a) -> ReadM a
eitherReader' forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
( PathCompleterOpts -> Completer
pathCompleterWith
PathCompleterOpts
defaultPathCompleterOpts
{ pcoRelative :: Bool
pcoRelative = Bool
False
, pcoFileFilter :: String -> Bool
pcoFileFilter = forall a b. a -> b -> a
const Bool
False
}
)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Path Abs Dir)
mods
relDirOption :: Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir)
relDirOption :: Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir)
relDirOption Mod OptionFields (Path Rel Dir)
mods = forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall e a. Show e => (String -> Either e a) -> ReadM a
eitherReader' forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
( PathCompleterOpts -> Completer
pathCompleterWith
PathCompleterOpts
defaultPathCompleterOpts
{ pcoAbsolute :: Bool
pcoAbsolute = Bool
False
, pcoFileFilter :: String -> Bool
pcoFileFilter = forall a b. a -> b -> a
const Bool
False
}
)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Path Rel Dir)
mods
eitherReader' :: Show e => (String -> Either e a) -> ReadM a
eitherReader' :: forall e a. Show e => (String -> Either e a) -> ReadM a
eitherReader' String -> Either e a
f = forall a. (String -> Either String a) -> ReadM a
eitherReader (forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either e a
f)
data PathCompleterOpts = PathCompleterOpts
{ PathCompleterOpts -> Bool
pcoAbsolute :: Bool
, PathCompleterOpts -> Bool
pcoRelative :: Bool
, PathCompleterOpts -> Maybe String
pcoRootDir :: Maybe FilePath
, PathCompleterOpts -> String -> Bool
pcoFileFilter :: FilePath -> Bool
, PathCompleterOpts -> String -> Bool
pcoDirFilter :: FilePath -> Bool
}
defaultPathCompleterOpts :: PathCompleterOpts
defaultPathCompleterOpts :: PathCompleterOpts
defaultPathCompleterOpts = PathCompleterOpts
{ pcoAbsolute :: Bool
pcoAbsolute = Bool
True
, pcoRelative :: Bool
pcoRelative = Bool
True
, pcoRootDir :: Maybe String
pcoRootDir = forall a. Maybe a
Nothing
, pcoFileFilter :: String -> Bool
pcoFileFilter = forall a b. a -> b -> a
const Bool
True
, pcoDirFilter :: String -> Bool
pcoDirFilter = forall a b. a -> b -> a
const Bool
True
}
fileCompleter :: Completer
fileCompleter :: Completer
fileCompleter = PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
defaultPathCompleterOpts
fileExtCompleter :: [String] -> Completer
fileExtCompleter :: [String] -> Completer
fileExtCompleter [String]
exts =
PathCompleterOpts -> Completer
pathCompleterWith
PathCompleterOpts
defaultPathCompleterOpts { pcoFileFilter :: String -> Bool
pcoFileFilter = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
exts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension }
dirCompleter :: Completer
dirCompleter :: Completer
dirCompleter =
PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
defaultPathCompleterOpts { pcoFileFilter :: String -> Bool
pcoFileFilter = forall a b. a -> b -> a
const Bool
False }
pathCompleterWith :: PathCompleterOpts -> Completer
pathCompleterWith :: PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts {Bool
Maybe String
String -> Bool
pcoDirFilter :: String -> Bool
pcoFileFilter :: String -> Bool
pcoRootDir :: Maybe String
pcoRelative :: Bool
pcoAbsolute :: Bool
pcoDirFilter :: PathCompleterOpts -> String -> Bool
pcoRootDir :: PathCompleterOpts -> Maybe String
pcoFileFilter :: PathCompleterOpts -> String -> Bool
pcoAbsolute :: PathCompleterOpts -> Bool
pcoRelative :: PathCompleterOpts -> Bool
..} = (String -> IO [String]) -> Completer
mkCompleter forall a b. (a -> b) -> a -> b
$ \String
inputRaw -> do
let input :: String
input = ShowS
unescapeBashArg String
inputRaw
let (String
inputSearchDir0, String
searchPrefix) = String -> (String, String)
splitFileName String
input
inputSearchDir :: String
inputSearchDir = if String
inputSearchDir0 forall a. Eq a => a -> a -> Bool
== String
"./" then String
"" else String
inputSearchDir0
Maybe String
msearchDir <-
case (String -> Bool
isRelative String
inputSearchDir, Bool
pcoAbsolute, Bool
pcoRelative) of
(Bool
True, Bool
_, Bool
True) -> do
String
rootDir <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getCurrentDirectory forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
pcoRootDir
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (String
rootDir String -> ShowS
</> String
inputSearchDir)
(Bool
False, Bool
True, Bool
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
inputSearchDir
(Bool, Bool, Bool)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
case Maybe String
msearchDir of
Maybe String
Nothing
| String
input forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
&& Bool
pcoAbsolute -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"/"]
| Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just String
searchDir -> do
[String]
entries <-
String -> IO [String]
getDirectoryContents String
searchDir forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(IOException
_ :: IOException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
entries forall a b. (a -> b) -> a -> b
$ \String
entry ->
if String
entry forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"..", String
"."] Bool -> Bool -> Bool
&& String
searchPrefix forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"..", String
"."]
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else
if String
searchPrefix forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
entry
then do
let path :: String
path = String
searchDir String -> ShowS
</> String
entry
case (String -> Bool
pcoFileFilter String
path, String -> Bool
pcoDirFilter String
path) of
(Bool
True, Bool
True) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (String
inputSearchDir String -> ShowS
</> String
entry)
(Bool
fileAllowed, Bool
dirAllowed) -> do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
if (if Bool
isDir then Bool
dirAllowed else Bool
fileAllowed)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (String
inputSearchDir String -> ShowS
</> String
entry)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
unescapeBashArg :: String -> String
unescapeBashArg :: ShowS
unescapeBashArg (Char
'\'' : String
rest) = String
rest
unescapeBashArg (Char
'\"' : String
rest) = ShowS
go String
rest
where
special :: String
special = String
"$`\"\\\n" :: String
go :: ShowS
go [] = []
go (Char
'\\' : Char
x : String
xs)
| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
special = Char
x forall a. a -> [a] -> [a]
: String
xs
| Bool
otherwise = Char
'\\' forall a. a -> [a] -> [a]
: Char
x forall a. a -> [a] -> [a]
: ShowS
go String
xs
go (Char
x : String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
go String
xs
unescapeBashArg String
input = ShowS
go String
input
where
go :: ShowS
go [] = []
go (Char
'\\' : Char
x : String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
go String
xs
go (Char
x : String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
go String
xs
showHelpText :: ParseError
showHelpText :: ParseError
showHelpText = Maybe String -> ParseError
ShowHelpText forall a. Maybe a
Nothing