Unify readp and parsec flag parsing

haskell · Aug 15, 2017 · 90b848a · 90b848a
1 parent 5e4f4d5
commit 90b848a
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 15 deletions.
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
@@ -32,6 +32,7 @@ extra-source-files:
   -- Generated with 'misc/gen-extra-source-files.sh'
   -- Do NOT edit this section manually; instead, run the script.
   -- BEGIN gen-extra-source-files
+  tests/ParserTests/regressions/encoding-0.8.cabal
   tests/ParserTests/warnings/bom.cabal
   tests/ParserTests/warnings/bool.cabal
   tests/ParserTests/warnings/deprecatedfield.cabal

diff --git a/Cabal/Distribution/Parsec/Class.hs b/Cabal/Distribution/Parsec/Class.hs
@@ -20,6 +20,7 @@ import           Data.Functor.Identity                        (Identity)
 import qualified Distribution.Compat.Parsec                   as P
 import           Distribution.Parsec.Types.Common
                  (PWarnType (..), PWarning (..), Position (..))
+import           Distribution.Utils.Generic                   (lowercase)
 import qualified Text.Parsec                                  as Parsec
 import qualified Text.Parsec.Language                         as Parsec
 import qualified Text.Parsec.Token                            as Parsec
@@ -126,12 +127,11 @@ instance Parsec ModuleName where
         validModuleChar c = isAlphaNum c || c == '_' || c == '\''
 
 instance Parsec FlagName where
-    parsec = mkFlagName . map toLower . intercalate "-" <$> P.sepBy1 component (P.char '-')
+    parsec = mkFlagName . lowercase <$> parsec'
       where
-        -- http://hackage.haskell.org/package/cabal-debian-4.24.8/cabal-debian.cabal
-        -- has flag with all digit component: pretty-112
-        component :: P.Stream s Identity Char => P.Parsec s [PWarning] String
-        component = P.munch1 (\c -> isAlphaNum c || c `elem` "_")
+        parsec' = (:) <$> lead <*> rest
+        lead = P.satisfy (\c ->  isAlphaNum c || c == '_')
+        rest = P.munch (\c -> isAlphaNum c ||  c == '_' || c == '-')
 
 instance Parsec Dependency where
     parsec = do

diff --git a/Cabal/Distribution/Types/GenericPackageDescription.hs b/Cabal/Distribution/Types/GenericPackageDescription.hs
@@ -38,6 +38,7 @@ import Distribution.Package
 import Distribution.Version
 import Distribution.Compiler
 import Distribution.System
+import Distribution.Text
 
 -- ---------------------------------------------------------------------------
 -- The GenericPackageDescription type
@@ -116,6 +117,16 @@ unFlagName (FlagName s) = fromShortText s
 
 instance Binary FlagName
 
+instance Text FlagName where
+    disp = Disp.text . unFlagName
+    -- Note:  we don't check that FlagName doesn't have leading dash,
+    -- cabal check will do that.
+    parse = mkFlagName . lowercase <$> parse'
+      where
+        parse' = (:) <$> lead <*> rest
+        lead = Parse.satisfy (\c ->  isAlphaNum c || c == '_')
+        rest = Parse.munch (\c -> isAlphaNum c ||  c == '_' || c == '-')
+
 -- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to
 -- 'Bool' flag values. It represents the flags chosen by the user or
 -- discovered during configuration. For example @--flags=foo --flags=-bar@
@@ -138,19 +149,11 @@ parseFlagAssignment = Parse.sepBy1 parseFlagValue Parse.skipSpaces1
   where
     parseFlagValue =
           (do Parse.optional (Parse.char '+')
-              f <- parseFlagName
+              f <- parse
               return (f, True))
       +++ (do _ <- Parse.char '-'
-              f <- parseFlagName
+              f <- parse
               return (f, False))
-    parseFlagName = liftM (mkFlagName . lowercase) ident
-
-    ident :: Parse.ReadP r String
-    ident = Parse.munch1 identChar >>= \s -> check s >> return s
-      where
-        identChar c   = isAlphaNum c || c == '_' || c == '-'
-        check ('-':_) = Parse.pfail
-        check _       = return ()
 
 -- | A @ConfVar@ represents the variable type used.
 data ConfVar = OS OS