diff --git a/getopt-generics.cabal b/getopt-generics.cabal --- a/getopt-generics.cabal +++ b/getopt-generics.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2. +-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack -- --- hash: 7569f6c1eafe060f3285fa68df5dfe8814e101dc3a65a5b63a5c95e6d274791a +-- hash: 251a5d030ebc9eea59324ffde893d6818c2c6ec2ca38e5153ce983daebb1ef13 name: getopt-generics -version: 0.13.0.4 +version: 0.13.1.0 synopsis: Create command line interfaces with ease description: Create command line interfaces with ease category: Console, System diff --git a/src/WithCli.hs b/src/WithCli.hs --- a/src/WithCli.hs +++ b/src/WithCli.hs @@ -86,7 +86,7 @@ withCli :: WithCli main => main -> IO () withCli = withCliModified [] --- | This is a variant of 'withCli' that allows to tweak the generated +-- | This is a variant of 'withCli' that allows tweaking the generated -- command line interface by providing a list of 'Modifier's. withCliModified :: WithCli main => [Modifier] -> main -> IO () withCliModified mods main = do diff --git a/src/WithCli/Modifier.hs b/src/WithCli/Modifier.hs --- a/src/WithCli/Modifier.hs +++ b/src/WithCli/Modifier.hs @@ -108,30 +108,35 @@ -- * transforming Parsers +applyModifiersLong :: Modifiers -> String -> String +applyModifiersLong modifiers long = (renaming modifiers) long + applyModifiers :: Modifiers -> Parser Unnormalized a -> Parser Unnormalized a applyModifiers modifiers = - addShortOptions >>> - renameOptions + modParserOptions $ map $ + addShortOptions >>> + addOptionHelp modifiers >>> + renameOptions modifiers where - addShortOptions = modParserOptions $ map $ - \ option -> - case filter (\ (needle, _) -> needle `elem` longs option) (shortOptions modifiers) of - [] -> option - (concat . map snd -> newShorts) -> - foldl' (flip addShort) option newShorts - renameOptions = - modParserOptions $ map $ modLongs $ renaming modifiers - -applyModifiersLong :: Modifiers -> String -> String -applyModifiersLong modifiers long = (renaming modifiers) long + addShortOptions :: OptDescr a -> OptDescr a + addShortOptions = \ option@(Option _ longs _ _) -> + case filter (\ (needle, _) -> needle `elem` longs) (shortOptions modifiers) of + [] -> option + (concat . map snd -> newShorts) -> + foldl' (flip addShort) option newShorts -longs :: OptDescr a -> [String] -longs (Option _ ls _ _) = ls + addShort :: Char -> OptDescr a -> OptDescr a + addShort short (Option shorts longs argDescrs help) = + Option (shorts ++ [short]) longs argDescrs help -addShort :: Char -> OptDescr a -> OptDescr a -addShort short (Option shorts longs argDescrs help) = - Option (shorts ++ [short]) longs argDescrs help + renameOptions :: Modifiers -> OptDescr a -> OptDescr a + renameOptions modifiers (Option shorts longs descrs help) = + Option shorts (map (renaming modifiers) longs) descrs help -modLongs :: (String -> String) -> OptDescr a -> OptDescr a -modLongs f (Option shorts longs descrs help) = - Option shorts (map f longs) descrs help + addOptionHelp :: Modifiers -> OptDescr x -> OptDescr x + addOptionHelp modifiers (Option shorts longs argDescr help) = + Option shorts longs argDescr newHelp + where + newHelp = case mapMaybe (\ long -> lookup long (helpTexts modifiers)) longs of + [] -> help + h : _ -> h diff --git a/src/WithCli/Modifier/Types.hs b/src/WithCli/Modifier/Types.hs --- a/src/WithCli/Modifier/Types.hs +++ b/src/WithCli/Modifier/Types.hs @@ -5,7 +5,7 @@ shortOptions :: [(String, [Char])], renaming :: String -> String, positionalArgumentsField :: Maybe (String, String), - _helpTexts :: [(String, String)], + helpTexts :: [(String, String)], version :: Maybe String } diff --git a/test/ModifiersSpec.hs b/test/ModifiersSpec.hs --- a/test/ModifiersSpec.hs +++ b/test/ModifiersSpec.hs @@ -2,6 +2,7 @@ module ModifiersSpec where +import Data.Char import Data.List import Test.Hspec @@ -27,7 +28,7 @@ output `shouldContain` "-x STRING" describe "RenameOption" $ do - it "allows to rename options" $ do + it "allows renaming options" $ do modsParse [RenameOption "camelCase" "bla"] "--bla foo" `shouldBe` Success (CamelCaseOptions "foo") @@ -45,7 +46,6 @@ let Errors errs = modsParse [RenameOption "camelCase" "foo"] "" :: Result CamelCaseOptions - -- _ <- error $ show errs show errs `shouldNotContain` "camelCase" show errs `shouldNotContain` "camel-case" show errs `shouldContain` "foo" @@ -66,3 +66,25 @@ it "--version shows up in help output" $ do let OutputAndExit output = modsParse [AddVersionFlag "1.0.0"] "--help" :: Result Foo output `shouldSatisfy` ("show version and exit" `isInfixOf`) + + describe "AddOptionHelp" $ do + it "allows specifying a flag specific help" $ do + let mods = [AddOptionHelp "baz" "baz help text"] + OutputAndExit output = + modsParse mods "--help" :: Result Foo + barLine = + map (dropWhile isSpace) $ + filter ("--baz" `isInfixOf`) $ lines output + barLine `shouldBe` ["--baz=STRING baz help text"] + + it "uses the last AddOptionHelp if multiple are given" $ do + let mods = + AddOptionHelp "baz" "baz help text" : + AddOptionHelp "baz" "later baz help text" : + [] + OutputAndExit output = + modsParse mods "--help" :: Result Foo + barLine = + map (dropWhile isSpace) $ + filter ("--baz" `isInfixOf`) $ lines output + barLine `shouldBe` ["--baz=STRING later baz help text"] diff --git a/test/ModifiersSpec/RenameOptionsSpec.hs b/test/ModifiersSpec/RenameOptionsSpec.hs --- a/test/ModifiersSpec/RenameOptionsSpec.hs +++ b/test/ModifiersSpec/RenameOptionsSpec.hs @@ -31,7 +31,7 @@ spec :: Spec spec = do describe "RenameOptions" $ do - it "allows to rename all flags" $ do + it "allows renaming all flags" $ do modsParse [RenameOptions (Just . reverse)] "--oof 1 --rab 2" `shouldBe` Success (Foo 1 2) @@ -53,7 +53,7 @@ modsParse [RenameOptions rename] "--renamed 1 --bar 2" `shouldBe` Success (Foo 1 2) - it "allows to strip a common prefix" $ do + it "allows stripping a common prefix" $ do modsParse [RenameOptions (stripPrefix "prefix")] "--foo 1 --bar 2 --not-prefix-baz 3" `shouldBe` Success (CP 1 2 3) diff --git a/test/ModifiersSpec/UseForPositionalArgumentsSpec.hs b/test/ModifiersSpec/UseForPositionalArgumentsSpec.hs --- a/test/ModifiersSpec/UseForPositionalArgumentsSpec.hs +++ b/test/ModifiersSpec/UseForPositionalArgumentsSpec.hs @@ -38,7 +38,7 @@ "foo bar --some-flag" `shouldBe` Success (WithPositionalArguments ["foo", "bar"] True) - it "disallows to specify the option used for positional arguments" $ do + it "disallows specifying the option used for positional arguments" $ do modsParse [UseForPositionalArguments "positionalArguments" "type"] "--positional-arguments foo" diff --git a/test/WithCli/Pure/RecordSpec.hs b/test/WithCli/Pure/RecordSpec.hs --- a/test/WithCli/Pure/RecordSpec.hs +++ b/test/WithCli/Pure/RecordSpec.hs @@ -55,7 +55,7 @@ parse "--bool --baz foo" `shouldBe` Success (Foo Nothing "foo" True) - it "allows to overwrite String options" $ do + it "allows overwriting String options" $ do parse "--baz one --baz two" `shouldBe` Success (Foo Nothing "two" False) @@ -123,7 +123,7 @@ part2 :: Spec part2 = do describe "parseArguments" $ do - it "allows to interpret multiple uses of the same option as lists" $ do + it "allows interpreting multiple uses of the same option as lists" $ do parse "--multiple 23 --multiple 42" `shouldBe` Success (ListOptions [23, 42]) @@ -201,6 +201,6 @@ (parse "foo true 5 bar" :: Result WithoutSelectors) `shouldBe` Errors "unknown argument: bar\n" - it "allows to use tuples" $ do + it "allows using tuples" $ do (parse "42 bar" :: Result (Int, String)) `shouldBe` Success (42, "bar")