{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
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 -> FilePath
(Int -> OptionsApplicativeExtraException -> ShowS)
-> (OptionsApplicativeExtraException -> FilePath)
-> ([OptionsApplicativeExtraException] -> ShowS)
-> Show OptionsApplicativeExtraException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionsApplicativeExtraException -> ShowS
showsPrec :: Int -> OptionsApplicativeExtraException -> ShowS
$cshow :: OptionsApplicativeExtraException -> FilePath
show :: OptionsApplicativeExtraException -> FilePath
$cshowList :: [OptionsApplicativeExtraException] -> ShowS
showList :: [OptionsApplicativeExtraException] -> ShowS
Show, Typeable)
instance Exception OptionsApplicativeExtraException where
displayException :: OptionsApplicativeExtraException -> FilePath
displayException OptionsApplicativeExtraException
FlagNotFoundBug =
FilePath
"Error: [S-2797]\n"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"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 -> FilePath -> FilePath -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
defaultValue FilePath
name FilePath
helpSuffix =
Bool
-> Bool
-> Bool
-> FilePath
-> FilePath
-> Mod FlagFields Bool
-> Parser Bool
forall a.
a -> a -> a -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
enableDisableFlags Bool
defaultValue Bool
True Bool
False FilePath
name (FilePath -> Mod FlagFields Bool -> Parser Bool)
-> FilePath -> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath
helpSuffix
, FilePath
" (default: "
, if Bool
defaultValue then FilePath
"enabled" else FilePath
"disabled"
, FilePath
")"
]
boolFlagsNoDefault ::
String
-> String
-> Mod FlagFields Bool
-> Parser Bool
boolFlagsNoDefault :: FilePath -> FilePath -> Mod FlagFields Bool -> Parser Bool
boolFlagsNoDefault = Bool
-> Bool
-> FilePath
-> FilePath
-> Mod FlagFields Bool
-> Parser Bool
forall a.
a -> a -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault Bool
True Bool
False
firstBoolFlagsNoDefault ::
String
-> String
-> Mod FlagFields (Maybe Bool)
-> Parser (First Bool)
firstBoolFlagsNoDefault :: FilePath
-> FilePath -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlagsNoDefault FilePath
name FilePath
helpSuffix Mod FlagFields (Maybe Bool)
mod' =
Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> Parser (Maybe Bool) -> Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> FilePath
-> FilePath
-> Mod FlagFields (Maybe Bool)
-> Parser (Maybe Bool)
forall a.
a -> a -> a -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
enableDisableFlags Maybe Bool
forall a. Maybe a
Nothing (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
FilePath
name FilePath
helpSuffix Mod FlagFields (Maybe Bool)
mod'
firstBoolFlagsTrue ::
String
-> String
-> Mod FlagFields FirstTrue
-> Parser FirstTrue
firstBoolFlagsTrue :: FilePath
-> FilePath -> Mod FlagFields FirstTrue -> Parser FirstTrue
firstBoolFlagsTrue FilePath
name FilePath
helpSuffix =
FirstTrue
-> FirstTrue
-> FirstTrue
-> FilePath
-> FilePath
-> Mod FlagFields FirstTrue
-> Parser FirstTrue
forall a.
a -> a -> a -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
enableDisableFlags FirstTrue
forall a. Monoid a => a
mempty (Maybe Bool -> FirstTrue
FirstTrue (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)) (Maybe Bool -> FirstTrue
FirstTrue (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False))
FilePath
name (FilePath -> Mod FlagFields FirstTrue -> Parser FirstTrue)
-> FilePath -> Mod FlagFields FirstTrue -> Parser FirstTrue
forall a b. (a -> b) -> a -> b
$ FilePath
helpSuffix FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" (default: enabled)"
firstBoolFlagsFalse ::
String
-> String
-> Mod FlagFields FirstFalse
-> Parser FirstFalse
firstBoolFlagsFalse :: FilePath
-> FilePath -> Mod FlagFields FirstFalse -> Parser FirstFalse
firstBoolFlagsFalse FilePath
name FilePath
helpSuffix =
FirstFalse
-> FirstFalse
-> FirstFalse
-> FilePath
-> FilePath
-> Mod FlagFields FirstFalse
-> Parser FirstFalse
forall a.
a -> a -> a -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
enableDisableFlags FirstFalse
forall a. Monoid a => a
mempty (Maybe Bool -> FirstFalse
FirstFalse (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)) (Maybe Bool -> FirstFalse
FirstFalse (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False))
FilePath
name (FilePath -> Mod FlagFields FirstFalse -> Parser FirstFalse)
-> FilePath -> Mod FlagFields FirstFalse -> Parser FirstFalse
forall a b. (a -> b) -> a -> b
$ FilePath
helpSuffix FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" (default: disabled)"
enableDisableFlags ::
a
-> a
-> a
-> String
-> String
-> Mod FlagFields a
-> Parser a
enableDisableFlags :: forall a.
a -> a -> a -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
enableDisableFlags a
defaultValue a
enabledValue a
disabledValue FilePath
name FilePath
helpSuffix
Mod FlagFields a
mods =
a -> a -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
forall a.
a -> a -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault
a
enabledValue
a
disabledValue
FilePath
name
FilePath
helpSuffix
Mod FlagFields a
mods Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser a
forall a. a -> Parser 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 -> FilePath -> FilePath -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault a
enabledValue a
disabledValue FilePath
name FilePath
helpSuffix Mod FlagFields a
mods =
[a] -> a
forall {a}. [a] -> a
last ([a] -> a) -> Parser [a] -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
( a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
flag'
a
enabledValue
( Mod FlagFields a
forall (f :: * -> *) a. Mod f a
hidden
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
forall (f :: * -> *) a. Mod f a
internal
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
name
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields a
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
helpSuffix
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
)
Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
flag'
a
disabledValue
( Mod FlagFields a
forall (f :: * -> *) a. Mod f a
hidden
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
forall (f :: * -> *) a. Mod f a
internal
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long (FilePath
"no-" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name)
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields a
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
helpSuffix
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
)
Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
flag'
a
disabledValue
( FilePath -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long (FilePath
"[no-]" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name)
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields a
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
"Enable/disable " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
helpSuffix)
Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
)
)
where
last :: [a] -> a
last [a]
xs =
case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs of
[] -> OptionsApplicativeExtraException -> a
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 FilePath
progName FilePath
fakeName FilePath
helpName =
FilePath
-> Mod OptionFields ((a -> a) -> a -> a)
-> Parser ((a -> a) -> a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
(FilePath
optDesc' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".")
(FilePath -> Mod OptionFields ((a -> a) -> a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
helpName Mod OptionFields ((a -> a) -> a -> a)
-> Mod OptionFields ((a -> a) -> a -> a)
-> Mod OptionFields ((a -> a) -> a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields ((a -> a) -> a -> a)
forall (f :: * -> *) a. Mod f a
hidden Mod OptionFields ((a -> a) -> a -> a)
-> Mod OptionFields ((a -> a) -> a -> a)
-> Mod OptionFields ((a -> a) -> a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields ((a -> a) -> a -> a)
forall (f :: * -> *) a. Mod f a
internal)
Parser ((a -> a) -> a -> a) -> Parser (a -> a) -> Parser (a -> a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
(FilePath
optDesc' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".")
( FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
fakeName
Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
optDesc'
Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> (if Bool
hide then Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
hidden Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
internal else Mod OptionFields (a -> a)
forall a. Monoid a => a
idm)
)
where
optDesc' :: FilePath
optDesc' = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath
"Run '"
, ShowS
takeBaseName FilePath
progName
, FilePath
" --"
, FilePath
helpName
, FilePath
"' for details."
]
execExtraHelp ::
[String]
-> String
-> Parser a
-> String
-> IO ()
[FilePath]
args FilePath
helpOpt Parser a
parser FilePath
pd =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath]
args [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath
"--" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
helpOpt]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[FilePath] -> IO () -> IO ()
forall a. [FilePath] -> IO a -> IO a
withArgs [FilePath
"--help"] (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(a, [FilePath])
_ <- ParserInfo (a, [FilePath]) -> IO (a, [FilePath])
forall a. ParserInfo a -> IO a
execParser (Parser (a, [FilePath])
-> InfoMod (a, [FilePath]) -> ParserInfo (a, [FilePath])
forall a. Parser a -> InfoMod a -> ParserInfo a
info
( Parser ((a, [FilePath]) -> (a, [FilePath]))
forall {a}. Parser (a -> a)
hiddenHelper
Parser ((a, [FilePath]) -> (a, [FilePath]))
-> Parser (a, [FilePath]) -> Parser (a, [FilePath])
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (,)
(a -> [FilePath] -> (a, [FilePath]))
-> Parser a -> Parser ([FilePath] -> (a, [FilePath]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
parser
Parser ([FilePath] -> (a, [FilePath]))
-> Parser [FilePath] -> Parser (a, [FilePath])
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
(FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"OTHER ARGUMENTS") :: Parser String)
)
)
(InfoMod (a, [FilePath])
forall a. InfoMod a
fullDesc InfoMod (a, [FilePath])
-> InfoMod (a, [FilePath]) -> InfoMod (a, [FilePath])
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod (a, [FilePath])
forall a. FilePath -> InfoMod a
progDesc FilePath
pd))
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
hiddenHelper :: Parser (a -> a)
hiddenHelper = ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption ParseError
showHelpText (FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"help" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
hidden Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
internal)
textOption :: Mod OptionFields Text -> Parser Text
textOption :: Mod OptionFields Text -> Parser Text
textOption = ReadM Text -> Mod OptionFields Text -> Parser Text
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (FilePath -> Text
T.pack (FilePath -> Text) -> ReadM FilePath -> ReadM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath
readerAsk)
textArgument :: Mod ArgumentFields Text -> Parser Text
textArgument :: Mod ArgumentFields Text -> Parser Text
textArgument = ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (FilePath -> Text
T.pack (FilePath -> Text) -> ReadM FilePath -> ReadM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath
readerAsk)
optionalFirst :: Alternative f => f a -> f (First a)
optionalFirst :: forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst = (Maybe a -> First a) -> f (Maybe a) -> f (First a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> First a
forall a. Maybe a -> First a
First (f (Maybe a) -> f (First a))
-> (f a -> f (Maybe a)) -> f a -> f (First a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f (Maybe a)
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 = (Maybe Bool -> FirstTrue) -> f (Maybe Bool) -> f FirstTrue
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Bool -> FirstTrue
FirstTrue (f (Maybe Bool) -> f FirstTrue)
-> (f Bool -> f (Maybe Bool)) -> f Bool -> f FirstTrue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Bool -> f (Maybe Bool)
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 = (Maybe Bool -> FirstFalse) -> f (Maybe Bool) -> f FirstFalse
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Bool -> FirstFalse
FirstFalse (f (Maybe Bool) -> f FirstFalse)
-> (f Bool -> f (Maybe Bool)) -> f Bool -> f FirstFalse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Bool -> f (Maybe Bool)
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 = ReadM (Path Abs File)
-> Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((FilePath -> Either SomeException (Path Abs File))
-> ReadM (Path Abs File)
forall e a. Show e => (FilePath -> Either e a) -> ReadM a
eitherReader' FilePath -> Either SomeException (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile) (Mod OptionFields (Path Abs File) -> Parser (Path Abs File))
-> Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
forall a b. (a -> b) -> a -> b
$
Completer -> Mod OptionFields (Path Abs File)
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
(PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
defaultPathCompleterOpts { relative = False })
Mod OptionFields (Path Abs File)
-> Mod OptionFields (Path Abs File)
-> Mod OptionFields (Path Abs File)
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 = ReadM (Path Rel File)
-> Mod OptionFields (Path Rel File) -> Parser (Path Rel File)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((FilePath -> Either SomeException (Path Rel File))
-> ReadM (Path Rel File)
forall e a. Show e => (FilePath -> Either e a) -> ReadM a
eitherReader' FilePath -> Either SomeException (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile) (Mod OptionFields (Path Rel File) -> Parser (Path Rel File))
-> Mod OptionFields (Path Rel File) -> Parser (Path Rel File)
forall a b. (a -> b) -> a -> b
$
Completer -> Mod OptionFields (Path Rel File)
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
(PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
defaultPathCompleterOpts { absolute = False })
Mod OptionFields (Path Rel File)
-> Mod OptionFields (Path Rel File)
-> Mod OptionFields (Path Rel File)
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 = ReadM (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((FilePath -> Either SomeException (Path Abs Dir))
-> ReadM (Path Abs Dir)
forall e a. Show e => (FilePath -> Either e a) -> ReadM a
eitherReader' FilePath -> Either SomeException (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir) (Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir))
-> Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$
Completer -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
( PathCompleterOpts -> Completer
pathCompleterWith
PathCompleterOpts
defaultPathCompleterOpts
{ relative = False
, fileFilter = const False
}
)
Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
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 = ReadM (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((FilePath -> Either SomeException (Path Rel Dir))
-> ReadM (Path Rel Dir)
forall e a. Show e => (FilePath -> Either e a) -> ReadM a
eitherReader' FilePath -> Either SomeException (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir) (Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir))
-> Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$
Completer -> Mod OptionFields (Path Rel Dir)
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
( PathCompleterOpts -> Completer
pathCompleterWith
PathCompleterOpts
defaultPathCompleterOpts
{ absolute = False
, fileFilter = const False
}
)
Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
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 => (FilePath -> Either e a) -> ReadM a
eitherReader' FilePath -> Either e a
f = (FilePath -> Either FilePath a) -> ReadM a
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader ((e -> FilePath) -> Either e a -> Either FilePath a
forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft e -> FilePath
forall a. Show a => a -> FilePath
show (Either e a -> Either FilePath a)
-> (FilePath -> Either e a) -> FilePath -> Either FilePath a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either e a
f)
data PathCompleterOpts = PathCompleterOpts
{ PathCompleterOpts -> Bool
absolute :: Bool
, PathCompleterOpts -> Bool
relative :: Bool
, PathCompleterOpts -> Maybe FilePath
rootDir :: Maybe FilePath
, PathCompleterOpts -> FilePath -> Bool
fileFilter :: FilePath -> Bool
, PathCompleterOpts -> FilePath -> Bool
dirFilter :: FilePath -> Bool
}
defaultPathCompleterOpts :: PathCompleterOpts
defaultPathCompleterOpts :: PathCompleterOpts
defaultPathCompleterOpts = PathCompleterOpts
{ $sel:absolute:PathCompleterOpts :: Bool
absolute = Bool
True
, $sel:relative:PathCompleterOpts :: Bool
relative = Bool
True
, $sel:rootDir:PathCompleterOpts :: Maybe FilePath
rootDir = Maybe FilePath
forall a. Maybe a
Nothing
, $sel:fileFilter:PathCompleterOpts :: FilePath -> Bool
fileFilter = Bool -> FilePath -> Bool
forall a b. a -> b -> a
const Bool
True
, $sel:dirFilter:PathCompleterOpts :: FilePath -> Bool
dirFilter = Bool -> FilePath -> Bool
forall a b. a -> b -> a
const Bool
True
}
fileCompleter :: Completer
fileCompleter :: Completer
fileCompleter = PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
defaultPathCompleterOpts
fileExtCompleter :: [String] -> Completer
fileExtCompleter :: [FilePath] -> Completer
fileExtCompleter [FilePath]
exts =
PathCompleterOpts -> Completer
pathCompleterWith
PathCompleterOpts
defaultPathCompleterOpts { fileFilter = (`elem` exts) . takeExtension }
dirCompleter :: Completer
dirCompleter :: Completer
dirCompleter =
PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
defaultPathCompleterOpts { fileFilter = const False }
pathCompleterWith :: PathCompleterOpts -> Completer
pathCompleterWith :: PathCompleterOpts -> Completer
pathCompleterWith PathCompleterOpts
pco = (FilePath -> IO [FilePath]) -> Completer
mkCompleter ((FilePath -> IO [FilePath]) -> Completer)
-> (FilePath -> IO [FilePath]) -> Completer
forall a b. (a -> b) -> a -> b
$ \FilePath
inputRaw -> do
let input :: FilePath
input = ShowS
unescapeBashArg FilePath
inputRaw
let (FilePath
inputSearchDir0, FilePath
searchPrefix) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
input
inputSearchDir :: FilePath
inputSearchDir = if FilePath
inputSearchDir0 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"./" then FilePath
"" else FilePath
inputSearchDir0
Maybe FilePath
msearchDir <-
case (FilePath -> Bool
isRelative FilePath
inputSearchDir, PathCompleterOpts
pco.absolute, PathCompleterOpts
pco.relative) of
(Bool
True, Bool
_, Bool
True) -> do
FilePath
rootDir <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
getCurrentDirectory FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathCompleterOpts
pco.rootDir
Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
rootDir FilePath -> ShowS
</> FilePath
inputSearchDir)
(Bool
False, Bool
True, Bool
_) -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
inputSearchDir
(Bool, Bool, Bool)
_ -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
case Maybe FilePath
msearchDir of
Maybe FilePath
Nothing
| FilePath
input FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"" Bool -> Bool -> Bool
&& PathCompleterOpts
pco.absolute -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
"/"]
| Bool
otherwise -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just FilePath
searchDir -> do
[FilePath]
entries <-
FilePath -> IO [FilePath]
getDirectoryContents FilePath
searchDir IO [FilePath] -> (IOException -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(IOException
_ :: IOException) -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
([Maybe FilePath] -> [FilePath])
-> IO [Maybe 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 [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe FilePath] -> IO [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> (FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
entries ((FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath])
-> (FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
entry ->
if FilePath
entry FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"..", FilePath
"."] Bool -> Bool -> Bool
&& FilePath
searchPrefix FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
"..", FilePath
"."]
then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
else
if FilePath
searchPrefix FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
entry
then do
let path :: FilePath
path = FilePath
searchDir FilePath -> ShowS
</> FilePath
entry
case (PathCompleterOpts
pco.fileFilter FilePath
path, PathCompleterOpts
pco.dirFilter FilePath
path) of
(Bool
True, Bool
True) -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
inputSearchDir FilePath -> ShowS
</> FilePath
entry)
(Bool
fileAllowed, Bool
dirAllowed) -> do
Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
if (if Bool
isDir then Bool
dirAllowed else Bool
fileAllowed)
then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
inputSearchDir FilePath -> ShowS
</> FilePath
entry)
else Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
else Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
unescapeBashArg :: String -> String
unescapeBashArg :: ShowS
unescapeBashArg (Char
'\'' : FilePath
rest) = FilePath
rest
unescapeBashArg (Char
'\"' : FilePath
rest) = ShowS
go FilePath
rest
where
special :: FilePath
special = FilePath
"$`\"\\\n" :: String
go :: ShowS
go [] = []
go (Char
'\\' : Char
x : FilePath
xs)
| Char
x Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
special = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
xs
| Bool
otherwise = Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go FilePath
xs
go (Char
x : FilePath
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go FilePath
xs
unescapeBashArg FilePath
input = ShowS
go FilePath
input
where
go :: ShowS
go [] = []
go (Char
'\\' : Char
x : FilePath
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go FilePath
xs
go (Char
x : FilePath
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go FilePath
xs
showHelpText :: ParseError
showHelpText :: ParseError
showHelpText = Maybe FilePath -> ParseError
ShowHelpText Maybe FilePath
forall a. Maybe a
Nothing