getopt-generics 0.7.1.1 → 0.8

raw patch · 12 files changed

+415/−194 lines, 12 filesdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• README.md +104/−0
• getopt-generics.cabal +35/−28
• src/System/Console/GetOpt/Generics.hs +16/−17
• src/System/Console/GetOpt/Generics/FieldString.hs +48/−0
• src/System/Console/GetOpt/Generics/Internal.hs +0/−53
• src/System/Console/GetOpt/Generics/Modifier.hs +47/−37
• test/ModifiersSpec.hs +17/−8
• test/ModifiersSpec/RenameOptionsSpec.hs +62/−0
• test/System/Console/GetOpt/Generics/FieldStringSpec.hs +79/−0
• test/System/Console/GetOpt/Generics/InternalSpec.hs +0/−45
• test/System/Console/GetOpt/Generics/ModifierSpec.hs +7/−5
• test/System/Console/GetOpt/GenericsSpec.hs +0/−1

@@ -0,0 +1,104 @@+# getopt-generics++## Status++This library is experimental.++## Usage++`getopt-generics` tries to make it very simple to create executables that parse+command line options. All you have to do is to define a type and derive some+instances:++~~~ {.haskell}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}++module Readme where++import Data.Typeable+import GHC.Generics+import System.Console.GetOpt.Generics+import System.Environment++data Options+  = Options {+    port :: Int,+    daemonize :: Bool,+    config :: Maybe FilePath+  }+  deriving (Show, GHC.Generics.Generic)++instance System.Console.GetOpt.Generics.Generic Options+instance HasDatatypeInfo Options+~~~++Then you can use `getArguments` to create a command-line argument parser:++~~~ {.haskell}+main :: IO ()+main = do+  options <- getArguments+  print (options :: Options)+~~~++This program has++- a non-optional `--port` flag with an integer argument,+- a boolean flag `--daemonize`,+- an optional flag `--config` expecting a file argument and+- a generic `--help` option.++Here's in example of the program above in bash:+``` bash+$ program --port 8080 --config some/path+Options {port = 8080, daemonize = False, config = Just "some/path"}+$ program  --port 8080 --daemonize+Options {port = 8080, daemonize = True, config = Nothing}+$ program --port foo+not an integer: foo+$ program+missing option: --port=int+$ program --help+program+    --port=integer+    --daemonize+    --config=string (optional)+```++## Constraints++There are some constraints that the defined datatype has to fulfill:++  * It has to have only one constructor,+  * that constructor has to have field selectors (i.e. use record syntax) and+  * all fields have to be of a type that has an instance for `Option`.++(Types declared with `newtype` are allowed with the same constraints.)++## Using Custom Field Types++It is possible to use custom field types by providing an instance for `Option`.+Here's an example:++~~~ {.haskell}+data File = File FilePath+  deriving (Show, Typeable)++instance Option File where+  argumentType Proxy = "file"+  parseArgument f = Just (File f)++data FileOptions+  = FileOptions {+    file :: File+  }+  deriving (Show, GHC.Generics.Generic)++instance System.Console.GetOpt.Generics.Generic FileOptions+instance HasDatatypeInfo FileOptions++-- Returns: FileOptions {file = File "some/file"}+getFileOptions :: IO FileOptions+getFileOptions = withArgs (words "--file some/file") getArguments+~~~

@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.3.2.+-- This file has been generated from package.yaml by hpack version 0.5.4. -- -- see: https://github.com/sol/hpack  name:           getopt-generics-version:        0.7.1.1+version:        0.8 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@@ -17,57 +17,64 @@ build-type:     Simple cabal-version:  >= 1.10 +extra-source-files:+    README.md+ source-repository head   type: git   location: https://github.com/zalora/getopt-generics  library-  hs-source-dirs: src-  exposed-modules:-      System.Console.GetOpt.Generics-  other-modules:-      System.Console.GetOpt.Generics.Internal-      System.Console.GetOpt.Generics.Modifier-      System.Console.GetOpt.Generics.Result+  hs-source-dirs:+      src+  ghc-options: -Wall -fno-warn-name-shadowing   build-depends:       base == 4.*     , base-compat >= 0.8     , base-orphans     , generics-sop     , tagged-  ghc-options: -Wall -fno-warn-name-shadowing+  exposed-modules:+      System.Console.GetOpt.Generics+  other-modules:+      System.Console.GetOpt.Generics.FieldString+      System.Console.GetOpt.Generics.Modifier+      System.Console.GetOpt.Generics.Result   default-language: Haskell2010  test-suite spec   type: exitcode-stdio-1.0-  hs-source-dirs: src, test, examples   main-is: Spec.hs+  hs-source-dirs:+      src+    , test+    , examples+  ghc-options: -Wall -fno-warn-name-shadowing -threaded -O0 -pgmL markdown-unlit+  build-depends:+      base == 4.*+    , base-compat >= 0.8+    , base-orphans+    , generics-sop+    , tagged+    , hspec >= 2.1.8+    , hspec-expectations+    , markdown-unlit+    , QuickCheck+    , silently   other-modules:-      System.Console.GetOpt.Generics.Internal+      System.Console.GetOpt.Generics+      System.Console.GetOpt.Generics.FieldString       System.Console.GetOpt.Generics.Modifier       System.Console.GetOpt.Generics.Result-      System.Console.GetOpt.Generics       ExamplesSpec-      ModifiersSpec.UseForPositionalArgumentsSpec       ModifiersSpec-      System.Console.GetOpt.Generics.InternalSpec+      ModifiersSpec.RenameOptionsSpec+      ModifiersSpec.UseForPositionalArgumentsSpec+      System.Console.GetOpt.Generics.FieldStringSpec       System.Console.GetOpt.Generics.ModifierSpec       System.Console.GetOpt.Generics.ResultSpec       System.Console.GetOpt.GenericsSpec       Util       Example       Readme-  build-depends:-      base == 4.*-    , base-compat >= 0.8-    , base-orphans-    , generics-sop-    , tagged--    , hspec-    , hspec-expectations-    , markdown-unlit-    , QuickCheck-    , silently-  ghc-options: -Wall -fno-warn-name-shadowing -threaded -O0 -pgmL markdown-unlit   default-language: Haskell2010

@@ -57,7 +57,7 @@ import           System.Environment import           Text.Read.Compat -import           System.Console.GetOpt.Generics.Internal+import           System.Console.GetOpt.Generics.FieldString import           System.Console.GetOpt.Generics.Modifier import           System.Console.GetOpt.Generics.Result @@ -92,10 +92,8 @@   -> [String] -- ^ List of command line arguments to parse (e.g. from 'getArgs').   -> Result a parseArguments progName modifiersList args = do-    (modifiers, datatypeInfo) <- (,) <$>-      mkModifiers modifiersList <*>-      normalizedDatatypeInfo (Proxy :: Proxy a)-    case datatypeInfo of+    let modifiers = mkModifiers modifiersList+    case datatypeInfo (Proxy :: Proxy a) of       ADT typeName _ (constructorInfo :* Nil) ->         case constructorInfo of           (Record _ fields) -> processFields progName modifiers args@@ -161,7 +159,7 @@  mkOptDescr :: forall a . Option a => Modifiers -> (Field :.: FieldInfo) a -> OptDescrE a mkOptDescr _modifiers (Comp NoSelector) = OptDescrE Nothing-mkOptDescr modifiers (Comp (Selector (FieldInfo name))) = OptDescrE $+mkOptDescr modifiers (Comp (Selector (FieldInfo (mkFieldString -> name)))) = OptDescrE $   if isPositionalArgumentsField modifiers name     then Nothing     else Just $ Option@@ -181,14 +179,14 @@   Modifiers -> NP (Field :.: FieldInfo) xs -> Result (NP FieldState xs) mkInitialFieldStates modifiers fields = case (sing :: Sing xs, fields) of   (SNil, Nil) -> return Nil-  (SCons, Comp (Selector (FieldInfo name)) :* r) ->+  (SCons, Comp (Selector (FieldInfo (mkFieldString -> name))) :* r) ->     (:*) <$> inner name <*> mkInitialFieldStates modifiers r   (SCons, Comp NoSelector :* r) ->     (:*) <$> Success PositionalArgument <*> mkInitialFieldStates modifiers r   _ -> uninhabited "mkInitialFieldStates"   where-  inner :: forall x . Option x => String -> Result (FieldState x)+  inner :: forall x . Option x => FieldString -> Result (FieldState x)   inner name = if isPositionalArgumentsField modifiers name     then case cast (id :: FieldState x -> FieldState x) of       (Just id' :: Maybe (FieldState [String] -> FieldState x)) ->@@ -197,7 +195,7 @@         ["UseForPositionalArguments can only be used " ++          "for fields of type [String] not " ++          show (typeOf (impossible "mkInitialFieldStates" :: x))]-    else return $ _emptyOption name+    else return $ _emptyOption modifiers name  -- * showing output information @@ -261,8 +259,8 @@     inner :: All Option xs =>       Maybe [String] -> NP FieldState xs -> (NP FieldState xs, Either [String] ())     inner arguments fields = case (arguments, fields) of--      (Just arguments, PositionalArguments :* r) -> FieldSuccess arguments `cons` inner Nothing r+      (Just arguments, PositionalArguments :* r) ->+        FieldSuccess arguments `cons` inner Nothing r       (Nothing, PositionalArguments :* r) ->         FieldErrors ["UseForPositionalArguments can only be used once"] `cons` inner Nothing r @@ -351,9 +349,10 @@   _toOption = ReqArg parseAsFieldState (argumentType (Proxy :: Proxy a))    -- | This is meant to be an internal function.-  _emptyOption :: String -> FieldState a-  _emptyOption flagName = Unset-    ("missing option: --" ++ flagName ++ "=" ++ argumentType (Proxy :: Proxy a))+  _emptyOption :: Modifiers -> FieldString -> FieldState a+  _emptyOption modifiers flagName = Unset+    ("missing option: --" ++ mkLongOption modifiers flagName +++     "=" ++ argumentType (Proxy :: Proxy a))    -- | This is meant to be an internal function.   _accumulate :: a -> a -> a@@ -389,7 +388,7 @@   parseArgument x = case parseArgument x of     Just (x :: a) -> Just [x]     Nothing -> Nothing-  _emptyOption _ = FieldSuccess []+  _emptyOption _ _ = FieldSuccess []   _accumulate = (++)  instance Option a => Option (Maybe a) where@@ -397,7 +396,7 @@   parseArgument x = case parseArgument x of     Just (x :: a) -> Just (Just x)     Nothing -> Nothing-  _emptyOption _ = FieldSuccess Nothing+  _emptyOption _ _ = FieldSuccess Nothing  instance Option Bool where   argumentType _ = "BOOL"@@ -411,7 +410,7 @@       Nothing -> Nothing    _toOption = NoArg (FieldSuccess True)-  _emptyOption _ = FieldSuccess False+  _emptyOption _ _ = FieldSuccess False  instance Option String where   argumentType Proxy = "STRING"

@@ -0,0 +1,48 @@++module System.Console.GetOpt.Generics.FieldString (+  FieldString,+  mkFieldString,+  normalized,+  matches,+  renameUnnormalized,+ ) where++import           Data.Char++data FieldString = FieldString String+  deriving (Show)++normalized :: FieldString -> String+normalized (FieldString s) = normalize s++mkFieldString :: String -> FieldString+mkFieldString = FieldString++matches :: String -> FieldString -> Bool+matches s field =+  normalize s == normalized field++renameUnnormalized :: (String -> Maybe String) -> (FieldString -> FieldString)+renameUnnormalized f input@(FieldString unnormalized) =+  maybe input FieldString (f unnormalized)++normalize :: String -> String+normalize s =+  if all (not . isAllowedChar) s+    then s+    else+      slugify $+      dropWhile (== '-') $+      filter isAllowedChar $+      map (\ c -> if c == '_' then '-' else c) $+      s+  where+    slugify (a : r)+      | isUpper a = slugify (toLower a : r)+    slugify (a : b : r)+      | isUpper b = a : '-' : slugify (toLower b : r)+      | otherwise = a : slugify (b : r)+    slugify x = x++isAllowedChar :: Char -> Bool+isAllowedChar c = (isAscii c && isAlphaNum c) || (c `elem` "-_")

@@ -1,53 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE GADTs           #-}-{-# LANGUAGE RankNTypes      #-}-{-# LANGUAGE TypeFamilies    #-}--module System.Console.GetOpt.Generics.Internal where--import           Prelude ()-import           Prelude.Compat--import           Data.Char-import           Generics.SOP--import           System.Console.GetOpt.Generics.Result--normalizedDatatypeInfo :: (HasDatatypeInfo a, Code a ~ xss, SingI xss) =>-  Proxy a -> Result (DatatypeInfo xss)-normalizedDatatypeInfo p =-  mapFieldInfoM-    (\ (FieldInfo s) -> FieldInfo <$> normalizeFieldName s)-    (datatypeInfo p)--mapFieldInfoM :: (SingI xss, Applicative m) =>-     (forall a . FieldInfo a -> m (FieldInfo a))-  -> DatatypeInfo xss -> m (DatatypeInfo xss)-mapFieldInfoM f info = case info of-    (ADT mod name constructors) ->-      ADT mod name <$> hsequence' (hliftA (Comp . mapSingleCons f) constructors)-    (Newtype mod name constructor) ->-      Newtype mod name <$> (mapSingleCons f constructor)-  where-    mapSingleCons :: forall m xs . (Applicative m) =>-         (forall a . FieldInfo a -> m (FieldInfo a))-      -> ConstructorInfo xs -> m (ConstructorInfo xs)-    mapSingleCons f c = case c of-      (Record name fields) -> Record name <$> hsequence' (hliftA (Comp . f) fields)-      cons@Infix{} -> pure cons-      cons@Constructor{} -> pure cons--normalizeFieldName :: String -> Result String-normalizeFieldName s =-    let normalized = dropWhile (== '-') $-          filter (\ c -> (isAscii c && isAlpha c) || (c == '-')) s-    in case normalized of-      "" -> Errors ["unsupported field name: " ++ s]-      x -> Success $ slugify x-  where-    slugify (a : r)-      | isUpper a = slugify (toLower a : r)-    slugify (a : b : r)-      | isUpper b = a : '-' : slugify (toLower b : r)-      | otherwise = a : slugify (b : r)-    slugify x = x

@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs            #-} {-# LANGUAGE TupleSections    #-}+{-# LANGUAGE ViewPatterns     #-}  module System.Console.GetOpt.Generics.Modifier (   Modifier(..),@@ -24,13 +25,12 @@ import           Prelude () import           Prelude.Compat -import           Control.Monad import           Data.Char+import           Data.List (find, foldl') import           Data.Maybe import           Generics.SOP -import           System.Console.GetOpt.Generics.Internal-import           System.Console.GetOpt.Generics.Result+import           System.Console.GetOpt.Generics.FieldString  -- | 'Modifier's can be used to customize the command line parser. data Modifier@@ -40,6 +40,11 @@   | RenameOption String String     -- ^ @RenameOption fieldName customName@ renames the option generated     --   through the @fieldName@ by @customName@.+  | RenameOptions (String -> Maybe String)+    -- ^ @RenameOptions f@ renames all options with the given functions. In case+    --   the function returns @Nothing@ the original field name is used.+    --+    --   Can be used together with 'Data.List.stripPrefix'.   | UseForPositionalArguments String String     -- ^ @UseForPositionalArguments fieldName argumentType@ fills the field     --   addressed by @fieldName@ with the positional arguments (i.e. arguments@@ -53,62 +58,67 @@     --   @fieldName@.   | AddVersionFlag String     -- ^ @AddVersionFlag version@ adds a @--version@ flag.-  deriving (Show, Eq, Ord)  data Modifiers = Modifiers {   _shortOptions :: [(String, [Char])],-  _renamings :: [(String, String)],+  _renaming :: FieldString -> FieldString,   positionalArgumentsField :: [(String, String)],   helpTexts :: [(String, String)],   version :: Maybe String  }- deriving (Show, Eq, Ord) -mkModifiers :: [Modifier] -> Result Modifiers-mkModifiers = foldM inner empty+mkModifiers :: [Modifier] -> Modifiers+mkModifiers = foldl' inner empty   where     empty :: Modifiers-    empty = Modifiers [] [] [] [] Nothing+    empty = Modifiers [] id [] [] Nothing -    inner :: Modifiers -> Modifier -> Result Modifiers-    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 version-      (RenameOption from to) -> do-        fromNormalized <- normalizeFieldName from-        return $ Modifiers shorts (insert fromNormalized to renamings) args help version-      (UseForPositionalArguments option typ) -> do-        normalized <- normalizeFieldName option-        return $ Modifiers shorts renamings ((normalized, map toUpper typ) : args) help version-      (AddOptionHelp option helpText) -> do-        normalized <- normalizeFieldName option-        return $ Modifiers shorts renamings args (insert normalized helpText help) version-      (AddVersionFlag v) -> do-        return $ Modifiers shorts renamings args help (Just v)+    inner :: Modifiers -> Modifier -> Modifiers+    inner (Modifiers shorts renaming args help version) modifier = case modifier of+      (AddShortOption option short) ->+        Modifiers (insertWith (++) option [short] shorts) renaming args help version+      (RenameOption from to) ->+        let newRenaming :: FieldString -> FieldString+            newRenaming option = if from `matches` option+              then mkFieldString to+              else option+        in Modifiers shorts (renaming . newRenaming) args help version+      (RenameOptions newRenaming) ->+        Modifiers shorts (renaming `combineRenamings` newRenaming) args help version+      (UseForPositionalArguments option typ) ->+        Modifiers shorts renaming ((option, map toUpper typ) : args) help version+      (AddOptionHelp option helpText) ->+        Modifiers shorts renaming args (insert option helpText help) version+      (AddVersionFlag v) ->+        Modifiers shorts renaming args help (Just v) -mkShortOptions :: Modifiers -> String -> [Char]-mkShortOptions (Modifiers shortMap _ _ _ _) option =-    fromMaybe [] (lookup option shortMap)+    combineRenamings :: (FieldString -> FieldString) -> (String -> Maybe String)+      -> FieldString -> FieldString+    combineRenamings old new fieldString =+      (old . renameUnnormalized new) fieldString -mkLongOption :: Modifiers -> String -> String-mkLongOption (Modifiers _ renamings _ _ _) option =-  fromMaybe option (lookup option renamings)+lookupMatching :: [(String, a)] -> FieldString -> Maybe a+lookupMatching list option = fmap snd $ find (\ (from, _) -> from `matches` option) list +mkShortOptions :: Modifiers -> FieldString -> [Char]+mkShortOptions (Modifiers shortMap _ _ _ _) option = fromMaybe [] (lookupMatching shortMap option)++mkLongOption :: Modifiers -> FieldString -> String+mkLongOption (Modifiers _ renaming _ _ _) option =+  normalized (renaming option)+ hasPositionalArgumentsField :: Modifiers -> Bool hasPositionalArgumentsField = not . null . positionalArgumentsField -isPositionalArgumentsField :: Modifiers -> String -> Bool+isPositionalArgumentsField :: Modifiers -> FieldString -> Bool isPositionalArgumentsField modifiers field =-  any (field ==) (map fst (positionalArgumentsField modifiers))+  any (`matches` field) (map fst (positionalArgumentsField modifiers))  getPositionalArgumentType :: Modifiers -> Maybe String getPositionalArgumentType = fmap snd . listToMaybe . positionalArgumentsField -getHelpText :: Modifiers -> String -> String-getHelpText modifiers field = fromMaybe "" (lookup field (helpTexts modifiers))+getHelpText :: Modifiers -> FieldString -> String+getHelpText modifiers field = fromMaybe "" $ lookupMatching (helpTexts modifiers) field  getVersion :: Modifiers -> Maybe String getVersion modifiers = version modifiers

@@ -4,7 +4,6 @@  import           Data.List import           Test.Hspec-import           Test.Hspec.Expectations.Contrib  import           System.Console.GetOpt.Generics import           System.Console.GetOpt.GenericsSpec@@ -32,20 +31,30 @@       modsParse [RenameOption "camelCase" "bla"] "--bla foo"         `shouldBe` Success (CamelCaseOptions "foo") -    let parse' = modsParse [RenameOption "camelCase" "foo", RenameOption "camelCase" "bar"]-    it "allows to shadow earlier modifiers with later modifiers" $ do-      parse' "--bar foo" `shouldBe` Success (CamelCaseOptions "foo")-      let Errors errs = parse' "--foo foo"-      show errs `shouldContain` "unknown argument: foo"+    context "when shadowing earlier modifiers with later modifiers" $ do+      let parse' = modsParse+            [RenameOption "camelCase" "foo", RenameOption "camelCase" "bar"]+      it "uses the later renaming" $ do+        parse' "--bar foo" `shouldBe` Success (CamelCaseOptions "foo") +      it "disregards the earlier renaming" $ do+        let Errors errs = parse' "--foo foo"+        errs `shouldContain` ["unrecognized option `--foo'"]+     it "contains renamed options in error messages" $ do-      let Errors errs = parse' []+      let Errors errs = modsParse+            [RenameOption "camelCase" "foo"]+            "" :: Result CamelCaseOptions       show errs `shouldNotContain` "camelCase"-      show errs `shouldContain` "camel-case"+      show errs `shouldContain` "foo"      it "allows to address fields in Modifiers in slugified form" $ do       modsParse [RenameOption "camel-case" "foo"] "--foo bar"         `shouldBe` Success (CamelCaseOptions "bar")++    it "" $ do+      modsParse [RenameOption "bar" "one", RenameOption "baz" "two"] "--one 1 --two foo"+        `shouldBe` Success (Foo (Just 1) "foo" False)    describe "AddVersionFlag" $ do     it "implements --version" $ do

@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveGeneric #-}++module ModifiersSpec.RenameOptionsSpec where++import           Data.Char+import           Data.List+import qualified GHC.Generics+import           Test.Hspec++import           System.Console.GetOpt.Generics+import           Util++data Foo+  = Foo {+    foo :: Int,+    bar :: Int+  }+  deriving (Eq, Show, GHC.Generics.Generic)++instance Generic Foo+instance HasDatatypeInfo Foo++data CommonPrefixes+  = CP {+    prefixFoo :: Int,+    prefixBar :: Int,+    notPrefixBaz :: Int+  }+  deriving (Eq, Show, GHC.Generics.Generic)++instance Generic CommonPrefixes+instance HasDatatypeInfo CommonPrefixes++spec :: Spec+spec = do+  describe "RenameOptions" $ do+    it "allows to rename all flags" $ do+      modsParse [RenameOptions (Just . reverse)] "--oof 1 --rab 2"+        `shouldBe` Success (Foo 1 2)++    it "works on camelCase field names" $ do+      modsParse+          [RenameOptions (Just . map toLower)]+          "--prefixfoo 1 --prefixbar 2 --notprefixbaz 3"+        `shouldBe` Success (CP 1 2 3)++    it "missing options messages show renamed options" $ do+      let Errors errs = modsParse+            [RenameOptions (Just . map toLower)] "" :: Result CommonPrefixes+      errs `shouldSatisfy` ("missing option: --prefixfoo=INTEGER" `elem`)++    it "can be used to rename a single field" $ do+      let rename f = case f of+            "foo" -> Just "renamed"+            _ -> Nothing+      modsParse [RenameOptions rename] "--renamed 1 --bar 2"+        `shouldBe` Success (Foo 1 2)++    it "allows to strip a common prefix" $ do+      modsParse [RenameOptions (stripPrefix "prefix")]+          "--foo 1 --bar 2 --not-prefix-baz 3"+        `shouldBe` Success (CP 1 2 3)

@@ -0,0 +1,79 @@+{-# LANGUAGE ViewPatterns #-}++module System.Console.GetOpt.Generics.FieldStringSpec where++import           Data.Char+import           Test.Hspec+import           Test.QuickCheck hiding (Success)++import           System.Console.GetOpt.Generics.FieldString++normalize :: String -> String+normalize = normalized . mkFieldString++isValidInputChar :: Char -> Bool+isValidInputChar c = c `elem` ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['0' .. '9'] ++ "-_"++isAllowedOutputChar :: Char -> Bool+isAllowedOutputChar c = c `elem` ['a' .. 'z'] ++ ['0' .. '9'] ++ "-"++upperCaseChar :: Gen Char+upperCaseChar = elements ['A' .. 'Z']++spec :: Spec+spec = do+  describe "normalized" $ do+    it "is idempotent" $ do+      property $ \ x -> do+        let once = normalize x+            twice = normalize once+        once `shouldBe` twice++    it "replaces underscores with dashes" $ do+      normalize "foo_bar" `shouldBe` "foo-bar"++    it "doesn't modify digits" $ do+      normalize "foo2bar" `shouldBe` "foo2bar"++    it "when there's one valid character it returns only dashes and lower case characters" $ do+      property $ \ x ->+        any isValidInputChar x ==>+        normalize x `shouldSatisfy`+          (\ s -> all isAllowedOutputChar s)++    it "when there are no valid characters it returns its input" $ do+      property $ forAll (listOf (arbitrary `suchThat` (not . isValidInputChar))) $ \ x ->+        normalize x `shouldBe` x++    it "replaces camelCase with dashes" $ do+      let isValidPrefixChar c = c `elem` ['A' .. 'Z'] ++ ['a' .. 'z']+      property $+        \ prefix suffix ->+        (any isValidPrefixChar prefix) ==>+        forAll upperCaseChar $ \ upper ->+        counterexample (prefix ++ [upper] ++ suffix) $+        normalize (prefix ++ [upper] ++ suffix)+          `shouldBe`+            normalize prefix ++ "-" ++ normalize (toLower upper : suffix)++  describe "matches" $ do+    it "matches normalized strings" $ do+      property $ \ s ->+        normalize s `matches` mkFieldString s++    it "matches unnormalized strings" $ do+      property $ \ s ->+        s `matches` mkFieldString s++  describe "renameUnnormalized" $ do+    it "allows to rename the unnormalized field names" $ do+      let f "camelCaseFoo" = Just "caseFoo"+          f _ = Nothing+      normalized (renameUnnormalized f (mkFieldString "camelCaseFoo")) `shouldBe`+        "case-foo"++    it "doesn't allow to rename normalized field names" $ do+      let f "camel-case-foo" = Just "case-foo"+          f _ = Nothing+      normalized (renameUnnormalized f (mkFieldString "camelCaseFoo")) `shouldBe`+        "camel-case-foo"

@@ -1,45 +0,0 @@--module System.Console.GetOpt.Generics.InternalSpec where--import           Data.Char-import           Test.Hspec-import           Test.QuickCheck hiding (Success)--import           System.Console.GetOpt.Generics.Internal-import           System.Console.GetOpt.Generics.Result--spec :: Spec-spec = do-  describe "normalizeFieldName" $ do-    it "is idempotent" $ do-      property $ \ x ->-        (normalizeFieldName =<< normalizeFieldName x)-          `shouldBe` normalizeFieldName x--    it "contains only valid characters" $ do-      property $ \ x ->-        case normalizeFieldName x of-          Success s -> s `shouldSatisfy`-            (\ s -> all (\ c -> c `elem` ['a' .. 'z'] || c == '-') s)-          _ -> return ()--    it "complains on field names without alphabetic characters" $ do-      property $-        forAll (listOf (elements "-_$/|\\#~_[]")) $ \ s ->-        normalizeFieldName s `shouldBe`-          Errors [("unsupported field name: " ++ s)]--    it "replaces camelCase with dashes" $-      property $-        \ prefix suffix ->-        (fmap (not . null) (normalizeFieldName prefix) == Success True) ==>-        forAll upperCaseChar $ \ upper ->-        counterexample (prefix ++ [upper] ++ suffix) $-        normalizeFieldName (prefix ++ [upper] ++ suffix)-          `shouldBe` do-            normalizedPrefix <- normalizeFieldName prefix-            normalizedRest <- normalizeFieldName (toLower upper : suffix)-            return $ normalizedPrefix ++ "-" ++ normalizedRest--upperCaseChar :: Gen Char-upperCaseChar = elements ['A' .. 'Z']

@@ -15,16 +15,18 @@ spec = do   describe "deriveShortOptions" $ do     it "includes modifiers for short options" $ do-      deriveShortOptions (Proxy :: Proxy Foo) `shouldBe` [AddShortOption "bar" 'b']+      let [AddShortOption long short] = deriveShortOptions (Proxy :: Proxy Foo)+      (long, short) `shouldBe` ("bar", 'b')      it "doesn't include modifiers for short options in case of overlaps" $ do-      deriveShortOptions (Proxy :: Proxy Overlap) `shouldBe` []+      null (deriveShortOptions (Proxy :: Proxy Overlap))    describe "mkShortModifiers" $ do     it "returns only lower-case ascii alpha characters as short options" $ do       property $ \ strings ->-        mkShortModifiers strings `shouldSatisfy` all (\ (AddShortOption _ c) ->-          isLower c && isAscii c && isAlpha c)+        all+          (\ (AddShortOption _ c) -> isLower c && isAscii c && isAlpha c)+          (mkShortModifiers strings)    describe "insertWith" $ do     it "combines existing values with the given function" $ do@@ -33,7 +35,7 @@    describe "getVersion" $ do     it "returns the version" $ do-      let Success modifiers = mkModifiers [AddVersionFlag "1.0.0"]+      let modifiers = mkModifiers [AddVersionFlag "1.0.0"]       getVersion modifiers `shouldBe` Just "1.0.0"    context "when used with Modifiers" $ do

@@ -14,7 +14,6 @@ import qualified GHC.Generics as GHC import           System.Environment import           Test.Hspec-import           Test.Hspec.Expectations.Contrib import           Test.QuickCheck hiding (Result(..))  import           System.Console.GetOpt.Generics