Skip to content

Commit 4c22ec0

Browse files
phadejphadej
authored
Merge pull request #490 from haskell-CI/pr-488
Fix #487: enable bash-completion for file and directories
2 parents b5eb3ef + 2869708 commit 4c22ec0

File tree

5 files changed

+59
-30
lines changed

5 files changed

+59
-30
lines changed

‎src/HaskellCI/Cli.hs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -95,19 +95,19 @@ optionsP :: O.Parser Options
9595
optionsP = Options
9696
<$> O.optional outputP
9797
<*> configOptP
98-
<*> O.optional (O.strOption (O.long "cwd" <> O.metavar "Dir" <> O.help "Directory to change to"))
98+
<*> O.optional (O.strOption (O.long "cwd" <> O.metavar "Dir" <> O.action "directory" <> O.help "Directory to change to"))
9999
<*> O.optional inputTypeP
100100
<*> runOptparseGrammar configGrammar
101101

102102
configOptP :: O.Parser ConfigOpt
103103
configOptP = file <|> noconfig <|> pure ConfigOptAuto
104104
where
105-
file = ConfigOpt <$> O.strOption (O.long "config" <> O.metavar "CONFIGFILE" <> O.help "Configuration file")
105+
file = ConfigOpt <$> O.strOption (O.long "config" <> O.metavar "CONFIGFILE" <> O.action "file" <> O.help "Configuration file")
106106
noconfig = O.flag' ConfigOptNo (O.long "no-config" <> O.help "Don't read configuration file")
107107

108108
outputP :: O.Parser Output
109109
outputP =
110-
OutputFile <$> O.strOption (O.long "output" <> O.short 'o' <> O.metavar "FILE" <> O.help "Output file") <|>
110+
OutputFile <$> O.strOption (O.long "output" <> O.short 'o' <> O.metavar "FILE" <> O.action "file" <> O.help "Output file") <|>
111111
O.flag' OutputStdout (O.long "stdout" <> O.help "Use stdout output")
112112

113113
versionP :: O.Parser (a -> a)
@@ -139,13 +139,13 @@ cliParserInfo = O.info ((,) <$> cmdP <*> optionsP O.<**> versionP O.<**> O.helpe
139139
]) <|> travisP
140140

141141
travisP = CommandTravis
142-
<$> O.strArgument (O.metavar "CABAL.FILE" <> O.help "Either <pkg.cabal> or cabal.project")
142+
<$> O.strArgument (O.metavar "CABAL.FILE" <> O.action "file" <> O.help "Either <pkg.cabal> or cabal.project")
143143

144144
bashP = CommandBash
145-
<$> O.strArgument (O.metavar "CABAL.FILE" <> O.help "Either <pkg.cabal> or cabal.project")
145+
<$> O.strArgument (O.metavar "CABAL.FILE" <> O.action "file" <> O.help "Either <pkg.cabal> or cabal.project")
146146

147147
githubP = CommandGitHub
148-
<$> O.strArgument (O.metavar "CABAL.FILE" <> O.help "Either <pkg.cabal> or cabal.project")
148+
<$> O.strArgument (O.metavar "CABAL.FILE" <> O.action "file" <> O.help "Either <pkg.cabal> or cabal.project")
149149

150150
-------------------------------------------------------------------------------
151151
-- Parsing helpers

‎src/HaskellCI/Config.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -237,9 +237,9 @@ configGrammar = Config
237237
<*> C.monoidalFieldAla "apt" (alaSet' C.NoCommaFSep C.Token') (field @"cfgApt")
238238
^^^ metahelp "PKG" "Additional apt packages to install"
239239
<*> C.monoidalFieldAla "travis-patches" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgTravisPatches")
240-
^^^ metahelp "PATCH" ".patch files to apply to the generated Travis YAML file"
240+
^^^ metaActionHelp "PATCH" "file" ".patch files to apply to the generated Travis YAML file"
241241
<*> C.monoidalFieldAla "github-patches" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgGitHubPatches")
242-
^^^ metahelp "PATCH" ".patch files to apply to the generated GitHub Actions YAML file"
242+
^^^ metaActionHelp "PATCH" "file" ".patch files to apply to the generated GitHub Actions YAML file"
243243
<*> C.booleanFieldDef "insert-version" (field @"cfgInsertVersion") True
244244
^^^ help "Don't insert the haskell-ci version into the generated Travis YAML file"
245245
<*> C.optionalFieldDef "error-missing-methods" (field @"cfgErrorMissingMethods") PackageScopeLocal

‎src/HaskellCI/Config/HLint.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ hlintConfigGrammar = HLintConfig
7373
<*> C.optionalFieldDef "hlint-job" (field @"cfgHLintJob") HLintJobLatest
7474
^^^ metahelp "JOB" "Specify HLint job"
7575
<*> C.optionalFieldAla "hlint-yaml" C.FilePathNT (field @"cfgHLintYaml")
76-
^^^ metahelp "PATH" "Use specific .hlint.yaml"
76+
^^^ metaActionHelp "PATH" "file" "Use specific .hlint.yaml"
7777
<*> C.monoidalFieldAla "hlint-options" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgHLintOptions")
7878
^^^ metahelp "OPTS" "Additional HLint options"
7979
<*> C.optionalFieldDef "hlint-version" (field @"cfgHLintVersion") defaultHLintVersion

‎src/HaskellCI/OptionsGrammar.hs‎

Lines changed: 24 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,9 @@
77
module HaskellCI.OptionsGrammar (
88
OptionsGrammar (..),
99
(C.^^^),
10+
metaActionHelp,
1011
ParsecPretty,
12+
Help, MetaVar, BashCompletionAction
1113
) where
1214

1315
import HaskellCI.Prelude
@@ -19,9 +21,23 @@ import qualified Distribution.Parsec as C
1921
import qualified Distribution.Pretty as C
2022
import qualified Distribution.Types.PackageName as C
2123
import qualified Distribution.Types.VersionRange as C
24+
import qualified Options.Applicative as O
2225

2326
import HaskellCI.Newtypes
2427

28+
-- | Help text for option.
29+
type Help = String
30+
31+
-- | Meta variable for option argument.
32+
type MetaVar = String
33+
34+
-- | Bash completion action for option argument.
35+
-- Example: @"file"@ or @"directory"@.
36+
--
37+
-- See <https://github.com/pcapriotti/optparse-applicative#actions-and-completers>
38+
-- and <https://www.gnu.org/software/bash/manual/html_node/Programmable-Completion-Builtins.html>.
39+
type BashCompletionAction = String
40+
2541
class
2642
( C.FieldGrammar c p
2743
, c Range, c (Identity C.VersionRange)
@@ -35,16 +51,22 @@ class
3551
)
3652
=> OptionsGrammar c p | p -> c
3753
where
38-
metahelp :: String -> String -> p s a -> p s a
54+
metaCompleterHelp :: MetaVar -> O.Completer -> Help -> p s a -> p s a
55+
metaCompleterHelp _ _ _ = id
56+
57+
metahelp :: MetaVar -> Help -> p s a -> p s a
3958
metahelp _ _ = id
4059

41-
help :: String -> p s a -> p s a
60+
help :: Help -> p s a -> p s a
4261
help _ = id
4362

4463
-- we treat range fields specially in options
4564
rangeField :: C.FieldName -> C.ALens' s C.VersionRange -> C.VersionRange -> p s C.VersionRange
4665
rangeField fn = C.optionalFieldDefAla fn Range
4766

67+
metaActionHelp :: OptionsGrammar c p => MetaVar -> BashCompletionAction -> Help -> p s a -> p s a
68+
metaActionHelp m a = metaCompleterHelp m (O.bashCompleter a)
69+
4870
instance OptionsGrammar C.Parsec C.ParsecFieldGrammar
4971

5072
class (C.Parsec a, C.Pretty a) => ParsecPretty a

‎src/HaskellCI/OptparseGrammar.hs‎

Lines changed: 26 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -25,14 +25,14 @@ import qualified Options.Applicative as O
2525
import HaskellCI.OptionsGrammar
2626

2727
data SomeParser s where
28-
SP :: (Maybe String -> Maybe String -> O.Parser (s -> s)) -> SomeParser s
28+
SP :: (Maybe MetaVar -> Maybe O.Completer -> Maybe Help -> O.Parser (s -> s)) -> SomeParser s
2929

3030
newtype OptparseGrammar s a = OG [SomeParser s]
3131
deriving Functor
3232

3333
runOptparseGrammar :: OptparseGrammar s a -> O.Parser (s -> s)
3434
runOptparseGrammar (OG ps) = fmap (foldr (flip (.)) id) $ many $ asum
35-
[ p Nothing Nothing
35+
[ p Nothing Nothing Nothing
3636
| SP p <- ps
3737
]
3838

@@ -42,7 +42,7 @@ instance Applicative (OptparseGrammar s) where
4242

4343
instance C.FieldGrammar ParsecPretty OptparseGrammar where
4444
blurFieldGrammar l (OG ps) = OG
45-
[ SP $ \v h -> fmap (l C.#%~) (p v h)
45+
[ SP $ \v c h -> fmap (l C.#%~) (p v c h)
4646
| SP p <- ps
4747
]
4848

@@ -51,23 +51,23 @@ instance C.FieldGrammar ParsecPretty OptparseGrammar where
5151

5252
-- the non default flag has help entry
5353
booleanFieldDef fn l def = OG
54-
[ SP $ \_m h -> setOG l $ O.flag' True $ flagMods fn (th h)
55-
, SP $ \_m h -> setOG l $ O.flag' False $ flagMods ("no-" <> fn) (fh h)
54+
[ SP $ \_m _c h -> setOG l $ O.flag' True $ flagMods fn (th h)
55+
, SP $ \_m _c h -> setOG l $ O.flag' False $ flagMods ("no-" <> fn) (fh h)
5656
]
5757
where
5858
th h = if def then Nothing else h
5959
fh h = if def then h else Nothing
6060

6161
optionalFieldAla fn c l = OG
62-
[ SP $ \m h -> setOptionalOG l $ O.option (C.unpack' c <$> readMParsec) $ optionMods fn m h ]
62+
[ SP $ \m cpl h -> setOptionalOG l $ O.option (C.unpack' c <$> readMParsec) $ optionMods fn m cpl h ]
6363

6464
optionalFieldDefAla fn c l def = OG
65-
[ SP $ \m h -> setOG l $ O.option (C.unpack' c <$> readMParsec) $ optionMods fn m (fmap hdef h) ]
65+
[ SP $ \m cpl h -> setOG l $ O.option (C.unpack' c <$> readMParsec) $ optionMods fn m cpl (fmap hdef h) ]
6666
where
6767
hdef h = h ++ " (Default: " ++ C.prettyShow (C.pack' c def) ++ ")"
6868

6969
monoidalFieldAla fn c l = OG
70-
[ SP $ \m h -> monoidOG l $ O.option (C.unpack' c <$> readMParsec) $ optionMods fn m h ]
70+
[ SP $ \m cpl h -> monoidOG l $ O.option (C.unpack' c <$> readMParsec) $ optionMods fn m cpl h ]
7171

7272
prefixedFields _ _ = pure []
7373
knownField _ = pure ()
@@ -77,22 +77,27 @@ instance C.FieldGrammar ParsecPretty OptparseGrammar where
7777
hiddenField = id
7878

7979
freeTextField fn l = OG
80-
[ SP $ \m h -> setOptionalOG l $ O.strOption $ optionMods fn m h ]
80+
[ SP $ \m c h -> setOptionalOG l $ O.strOption $ optionMods fn m c h ]
8181

8282
freeTextFieldDef fn l = OG
83-
[ SP $ \m h -> setOG l $ O.strOption $ optionMods fn m h ]
83+
[ SP $ \m c h -> setOG l $ O.strOption $ optionMods fn m c h ]
8484

8585
freeTextFieldDefST fn l = OG
86-
[ SP $ \m h -> setOG l $ O.strOption $ optionMods fn m h ]
86+
[ SP $ \m c h -> setOG l $ O.strOption $ optionMods fn m c h ]
8787

8888
instance OptionsGrammar ParsecPretty OptparseGrammar where
8989
help h (OG ps) = OG
90-
[ SP $ \m _h -> p m (Just h)
90+
[ SP $ \m c _h -> p m c (Just h)
9191
| SP p <- ps
9292
]
9393

9494
metahelp m h (OG ps) = OG
95-
[ SP $ \_m _h -> p (Just m) (Just h)
95+
[ SP $ \_m c _h -> p (Just m) c (Just h)
96+
| SP p <- ps
97+
]
98+
99+
metaCompleterHelp m c h (OG ps) = OG
100+
[ SP $ \_m _c _h -> p (Just m) (Just c) (Just h)
96101
| SP p <- ps
97102
]
98103

@@ -105,19 +110,21 @@ instance OptionsGrammar ParsecPretty OptparseGrammar where
105110
-- where the --no-tests has help, because it's not default.
106111
--
107112
rangeField fn l def = OG
108-
[ SP $ \_m h -> setOG l $ O.flag' C.anyVersion $ flagMods fn (th h)
109-
, SP $ \_m h -> setOG l $ O.flag' C.noVersion $ flagMods ("no-" <> fn) (fh h)
110-
, SP $ \_m _h -> setOG l $ O.option readMParsec $ O.long (fromUTF8BS $ fn <> "-jobs") <> O.metavar "RANGE"
113+
[ SP $ \_m _c h -> setOG l $ O.flag' C.anyVersion $ flagMods fn (th h)
114+
, SP $ \_m _c h -> setOG l $ O.flag' C.noVersion $ flagMods ("no-" <> fn) (fh h)
115+
, SP $ \_m _c _h -> setOG l $ O.option readMParsec $ O.long (fromUTF8BS $ fn <> "-jobs") <> O.metavar "RANGE"
111116
]
112117
where
113118
th h = if equivVersionRanges def C.anyVersion then Nothing else h
114119
fh h = if equivVersionRanges def C.anyVersion then h else Nothing
115120

116-
optionMods :: (O.HasName mods, O.HasMetavar mods) => C.FieldName -> Maybe String -> Maybe String -> O.Mod mods a
117-
optionMods fn mmetavar mhelp = flagMods fn mhelp
121+
optionMods :: (O.HasName mods, O.HasCompleter mods, O.HasMetavar mods)
122+
=> C.FieldName -> Maybe MetaVar -> Maybe O.Completer -> Maybe Help -> O.Mod mods a
123+
optionMods fn mmetavar mcompl mhelp = flagMods fn mhelp
118124
<> maybe mempty O.metavar mmetavar
125+
<> maybe mempty O.completer mcompl
119126

120-
flagMods :: O.HasName mods => C.FieldName -> Maybe String -> O.Mod mods a
127+
flagMods :: O.HasName mods => C.FieldName -> Maybe Help -> O.Mod mods a
121128
flagMods fn mhelp = O.long (fromUTF8BS fn)
122129
<> maybe mempty O.help mhelp
123130

0 commit comments

Comments
 (0)