Skip to content

Commit 90b848a

Browse files
committed
Unify readp and parsec flag parsing
1 parent 5e4f4d5 commit 90b848a

File tree

3 files changed

+19
-15
lines changed

3 files changed

+19
-15
lines changed

Cabal/Cabal.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ extra-source-files:
3232
-- Generated with 'misc/gen-extra-source-files.sh'
3333
-- Do NOT edit this section manually; instead, run the script.
3434
-- BEGIN gen-extra-source-files
35+
tests/ParserTests/regressions/encoding-0.8.cabal
3536
tests/ParserTests/warnings/bom.cabal
3637
tests/ParserTests/warnings/bool.cabal
3738
tests/ParserTests/warnings/deprecatedfield.cabal

Cabal/Distribution/Parsec/Class.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ import Data.Functor.Identity (Identity)
2020
import qualified Distribution.Compat.Parsec as P
2121
import Distribution.Parsec.Types.Common
2222
(PWarnType (..), PWarning (..), Position (..))
23+
import Distribution.Utils.Generic (lowercase)
2324
import qualified Text.Parsec as Parsec
2425
import qualified Text.Parsec.Language as Parsec
2526
import qualified Text.Parsec.Token as Parsec
@@ -126,12 +127,11 @@ instance Parsec ModuleName where
126127
validModuleChar c = isAlphaNum c || c == '_' || c == '\''
127128

128129
instance Parsec FlagName where
129-
parsec = mkFlagName . map toLower . intercalate "-" <$> P.sepBy1 component (P.char '-')
130+
parsec = mkFlagName . lowercase <$> parsec'
130131
where
131-
-- http://hackage.haskell.org/package/cabal-debian-4.24.8/cabal-debian.cabal
132-
-- has flag with all digit component: pretty-112
133-
component :: P.Stream s Identity Char => P.Parsec s [PWarning] String
134-
component = P.munch1 (\c -> isAlphaNum c || c `elem` "_")
132+
parsec' = (:) <$> lead <*> rest
133+
lead = P.satisfy (\c -> isAlphaNum c || c == '_')
134+
rest = P.munch (\c -> isAlphaNum c || c == '_' || c == '-')
135135

136136
instance Parsec Dependency where
137137
parsec = do

Cabal/Distribution/Types/GenericPackageDescription.hs

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ import Distribution.Package
3838
import Distribution.Version
3939
import Distribution.Compiler
4040
import Distribution.System
41+
import Distribution.Text
4142

4243
-- ---------------------------------------------------------------------------
4344
-- The GenericPackageDescription type
@@ -116,6 +117,16 @@ unFlagName (FlagName s) = fromShortText s
116117

117118
instance Binary FlagName
118119

120+
instance Text FlagName where
121+
disp = Disp.text . unFlagName
122+
-- Note: we don't check that FlagName doesn't have leading dash,
123+
-- cabal check will do that.
124+
parse = mkFlagName . lowercase <$> parse'
125+
where
126+
parse' = (:) <$> lead <*> rest
127+
lead = Parse.satisfy (\c -> isAlphaNum c || c == '_')
128+
rest = Parse.munch (\c -> isAlphaNum c || c == '_' || c == '-')
129+
119130
-- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to
120131
-- 'Bool' flag values. It represents the flags chosen by the user or
121132
-- discovered during configuration. For example @--flags=foo --flags=-bar@
@@ -138,19 +149,11 @@ parseFlagAssignment = Parse.sepBy1 parseFlagValue Parse.skipSpaces1
138149
where
139150
parseFlagValue =
140151
(do Parse.optional (Parse.char '+')
141-
f <- parseFlagName
152+
f <- parse
142153
return (f, True))
143154
+++ (do _ <- Parse.char '-'
144-
f <- parseFlagName
155+
f <- parse
145156
return (f, False))
146-
parseFlagName = liftM (mkFlagName . lowercase) ident
147-
148-
ident :: Parse.ReadP r String
149-
ident = Parse.munch1 identChar >>= \s -> check s >> return s
150-
where
151-
identChar c = isAlphaNum c || c == '_' || c == '-'
152-
check ('-':_) = Parse.pfail
153-
check _ = return ()
154157

155158
-- | A @ConfVar@ represents the variable type used.
156159
data ConfVar = OS OS

0 commit comments

Comments
 (0)