getopt-generics 0.7 → 0.7.1

raw patch · 5 files changed

+72/−26 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• getopt-generics.cabal +1/−1
• src/System/Console/GetOpt/Generics.hs +26/−14
• src/System/Console/GetOpt/Generics/Modifier.hs +21/−9
• test/System/Console/GetOpt/Generics/ModifierSpec.hs +6/−1
• test/System/Console/GetOpt/GenericsSpec.hs +18/−1

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           getopt-generics-version:        0.7+version:        0.7.1 synopsis:       Simple command line argument parsing description:    "getopt-generics" tries to make it very simple to create command line argument parsers. An introductory example can be found in the <https://github.com/zalora/getopt-generics#getopt-generics README>. category:       Console, System

@@ -46,7 +46,7 @@ import           Prelude.Compat  import           Data.Char-import           Data.List+import           Data.List.Compat import           Data.Maybe import           Data.Proxy import           Data.Typeable@@ -126,7 +126,7 @@ processFields progName modifiers args fields = do     initialFieldStates <- mkInitialFieldStates modifiers fields -    showHelp+    showOutputInfo      let (options, arguments, parseErrors) =           getOpt Permute (mkOptDescrs modifiers fields) args@@ -140,8 +140,8 @@      to . SOP . Z <$> collectResult withPositionalArguments   where-    showHelp :: Result ()-    showHelp = helpWrapper progName modifiers args fields+    showOutputInfo :: Result ()+    showOutputInfo = outputInfo progName modifiers args fields      reportGetOptErrors :: [String] -> Result ()     reportGetOptErrors parseErrors = case parseErrors of@@ -197,26 +197,38 @@          show (typeOf (impossible "mkInitialFieldStates" :: x))]     else return $ _emptyOption name ---- * showing help?+-- * showing output information -data HelpFlag = HelpFlag+data OutputInfoFlag+  = HelpFlag+  | VersionFlag String+  deriving (Eq, Ord) --- Outputs the help if the help flag is given.-helpWrapper :: (SingI xs, All Option xs) =>+-- Outputs the help or version information if the corresponding flags are given.+outputInfo :: (SingI xs, All Option xs) =>   String -> Modifiers -> [String] -> NP (Field :.: FieldInfo) xs -> Result ()-helpWrapper progName modifiers args fields =-    case getOpt Permute [helpOption] args of+outputInfo progName modifiers args fields =+    case (\ (a, b, c) -> (sort a, b, c)) (getOpt Permute options args) of       ([], _, _) -> return ()-        -- no help flag given+        -- no help or version flag given       (HelpFlag : _, _, _) -> OutputAndExit $         stripTrailingSpaces $         usageInfo header $           toOptDescrUnit (mkOptDescrs modifiers fields) ++-          toOptDescrUnit [helpOption]+          toOptDescrUnit options+      (VersionFlag version : _, _, _) -> OutputAndExit $+        progName ++ " version " ++ version ++ "\n"   where-    helpOption :: OptDescr HelpFlag+    options :: [OptDescr OutputInfoFlag]+    options = helpOption : maybeToList versionOption++    helpOption :: OptDescr OutputInfoFlag     helpOption = Option ['h'] ["help"] (NoArg HelpFlag) "show help and exit"++    versionOption :: Maybe (OptDescr OutputInfoFlag)+    versionOption = case getVersion modifiers of+      Just version -> Just $ Option [] ["version"] (NoArg (VersionFlag version)) "show version and exit"+      Nothing -> Nothing      toOptDescrUnit :: [OptDescr a] -> [OptDescr ()]     toOptDescrUnit = map (fmap (const ()))

@@ -12,6 +12,7 @@   isPositionalArgumentsField,   getPositionalArgumentType,   getHelpText,+  getVersion,    deriveShortOptions, @@ -50,42 +51,50 @@   | AddOptionHelp String String     -- ^ @AddOptionHelp fieldName helpText@ adds a help text for the option     --   @fieldName@.+  | AddVersionFlag String+    -- ^ @AddVersionFlag version@ adds a @--version@ flag.   deriving (Show, Eq, Ord)  data Modifiers = Modifiers {   _shortOptions :: [(String, [Char])],   _renamings :: [(String, String)],   positionalArgumentsField :: Maybe (String, String),-  helpTexts :: [(String, String)]+  helpTexts :: [(String, String)],+  version :: Maybe String  }  deriving (Show, Eq, Ord)  mkModifiers :: [Modifier] -> Result Modifiers-mkModifiers = foldM inner (Modifiers [] [] Nothing [])+mkModifiers = foldM inner empty   where+    empty :: Modifiers+    empty = Modifiers [] [] Nothing [] Nothing+     inner :: Modifiers -> Modifier -> Result Modifiers-    inner (Modifiers shorts renamings args help) modifier = case modifier of+    inner (Modifiers shorts renamings args help version) modifier = case modifier of       (AddShortOption option short) ->  do         normalized <- normalizeFieldName option         return $ Modifiers           (insertWith (++) normalized [short] shorts)-          renamings args help+          renamings args help version       (RenameOption from to) -> do         fromNormalized <- normalizeFieldName from-        return $ Modifiers shorts (insert fromNormalized to renamings) args help+        return $ Modifiers shorts (insert fromNormalized to renamings) args help version       (UseForPositionalArguments option typ) -> do         normalized <- normalizeFieldName option-        return $ Modifiers shorts renamings (Just (normalized, map toUpper typ)) help+        return $ Modifiers shorts renamings (Just (normalized, map toUpper typ)) help version       (AddOptionHelp option helpText) -> do         normalized <- normalizeFieldName option-        return $ Modifiers shorts renamings args (insert normalized helpText help)+        return $ Modifiers shorts renamings args (insert normalized helpText help) version+      (AddVersionFlag v) -> do+        return $ Modifiers shorts renamings args help (Just v)  mkShortOptions :: Modifiers -> String -> [Char]-mkShortOptions (Modifiers shortMap _ _ _) option =+mkShortOptions (Modifiers shortMap _ _ _ _) option =     fromMaybe [] (lookup option shortMap)  mkLongOption :: Modifiers -> String -> String-mkLongOption (Modifiers _ renamings _ _) option =+mkLongOption (Modifiers _ renamings _ _ _) option =   fromMaybe option (lookup option renamings)  hasPositionalArgumentsField :: Modifiers -> Bool@@ -100,6 +109,9 @@  getHelpText :: Modifiers -> String -> String getHelpText modifiers field = fromMaybe "" (lookup field (helpTexts modifiers))++getVersion :: Modifiers -> Maybe String+getVersion modifiers = version modifiers  -- * deriving Modifiers 

@@ -6,7 +6,7 @@ import           Data.Proxy import qualified GHC.Generics import           Test.Hspec-import           Test.QuickCheck hiding (Result)+import           Test.QuickCheck hiding (Result(..))  import           System.Console.GetOpt.Generics import           System.Console.GetOpt.Generics.Modifier@@ -30,6 +30,11 @@     it "combines existing values with the given function" $ do       insertWith (++) (1 :: Integer) "bar" [(1, "foo")]         `shouldBe` [(1, "foobar")]++  describe "getVersion" $ do+    it "returns the version" $ do+      let Success modifiers = mkModifiers [AddVersionFlag "1.0.0"]+      getVersion modifiers `shouldBe` Just "1.0.0"    context "when used with Modifiers" $ do     describe "parseArguments" $ do

@@ -9,7 +9,7 @@  import           Control.Exception import           Data.Foldable (forM_)-import           Data.List (isPrefixOf, isSuffixOf)+import           Data.List (isInfixOf, isPrefixOf, isSuffixOf) import           Data.Typeable import qualified GHC.Generics as GHC import           System.Environment@@ -31,6 +31,7 @@   part5   part6   part7+  part8  data Foo   = Foo {@@ -432,3 +433,19 @@      it "renders as NUMBER in help and error output" $ do       argumentType (Proxy :: Proxy Float) `shouldBe` "NUMBER"++part8 :: Spec+part8 = do+  describe "parseArgument" $ do+    context "--version" $ do+      it "implements --version" $ do+        let OutputAndExit output = parseArguments "foo" [AddVersionFlag "1.0.0"] (words "--version") :: Result Foo+        output `shouldBe` "foo version 1.0.0\n"++      it "--help takes precedence over --version" $ do+        let OutputAndExit output = parseArguments "foo" [AddVersionFlag "1.0.0"] (words "--version --help") :: Result Foo+        output `shouldSatisfy` ("show help and exit" `isInfixOf`)++      it "--version shows up in help output" $ do+        let OutputAndExit output = parseArguments "foo" [AddVersionFlag "1.0.0"] (words "--help") :: Result Foo+        output `shouldSatisfy` ("show version and exit" `isInfixOf`)