diff --git a/Cabal/Distribution/FieldGrammar/Described.hs b/Cabal/Distribution/FieldGrammar/Described.hs index 8193be93bba..a2a1e7b18f2 100644 --- a/Cabal/Distribution/FieldGrammar/Described.hs +++ b/Cabal/Distribution/FieldGrammar/Described.hs @@ -22,6 +22,7 @@ module Distribution.FieldGrammar.Described ( -- * Lists reSpacedList, reCommaList, + reCommaNonEmpty, reOptCommaList, -- * Character Sets csChar, @@ -72,6 +73,9 @@ reSpacedList = REMunch RESpaces1 reCommaList :: GrammarRegex a -> GrammarRegex a reCommaList = RECommaList +reCommaNonEmpty :: GrammarRegex a -> GrammarRegex a +reCommaNonEmpty = RECommaNonEmpty + reOptCommaList :: GrammarRegex a -> GrammarRegex a reOptCommaList = REOptCommaList diff --git a/Cabal/Distribution/Parsec.hs b/Cabal/Distribution/Parsec.hs index d32aa56aab7..b7f53fc901c 100644 --- a/Cabal/Distribution/Parsec.hs +++ b/Cabal/Distribution/Parsec.hs @@ -40,6 +40,7 @@ module Distribution.Parsec ( parsecMaybeQuoted, parsecCommaList, parsecLeadingCommaList, + parsecLeadingCommaNonEmpty, parsecOptCommaList, parsecLeadingOptCommaList, parsecStandard, @@ -309,6 +310,19 @@ parsecLeadingCommaList p = do lp = p <* P.spaces comma = P.char ',' *> P.spaces P. "comma" +-- | +-- +-- @since 3.4.0.0 +parsecLeadingCommaNonEmpty :: CabalParsing m => m a -> m (NonEmpty a) +parsecLeadingCommaNonEmpty p = do + c <- P.optional comma + case c of + Nothing -> P.sepEndByNonEmpty lp comma + Just _ -> P.sepByNonEmpty lp comma + where + lp = p <* P.spaces + comma = P.char ',' *> P.spaces P. "comma" + parsecOptCommaList :: CabalParsing m => m a -> m [a] parsecOptCommaList p = P.sepBy (p <* P.spaces) (P.optional comma) where diff --git a/Cabal/Distribution/Utils/GrammarRegex.hs b/Cabal/Distribution/Utils/GrammarRegex.hs index 02b262ab93c..403842e6668 100644 --- a/Cabal/Distribution/Utils/GrammarRegex.hs +++ b/Cabal/Distribution/Utils/GrammarRegex.hs @@ -50,6 +50,7 @@ data GrammarRegex a | RESpaces -- ^ zero-or-more spaces | RESpaces1 -- ^ one-or-more spaces | RECommaList (GrammarRegex a) -- ^ comma list (note, leading or trailing commas) + | RECommaNonEmpty (GrammarRegex a) -- ^ comma non-empty list | REOptCommaList (GrammarRegex a) -- ^ opt comma list | RETodo -- ^ unspecified @@ -146,6 +147,8 @@ regexDoc = go 0 . vacuous where go _ (RECommaList r) = "\\mathrm{commalist}" <<>> go 4 r + go _ (RECommaNonEmpty r) = + "\\mathrm{commanonempty}" <<>> go 4 r go _ (REOptCommaList r) = "\\mathrm{optcommalist}" <<>> go 4 r diff --git a/Cabal/tests/UnitTests/Distribution/Described.hs b/Cabal/tests/UnitTests/Distribution/Described.hs index 979e3aacd53..a5741e8acac 100644 --- a/Cabal/tests/UnitTests/Distribution/Described.hs +++ b/Cabal/tests/UnitTests/Distribution/Described.hs @@ -136,6 +136,7 @@ convert = go id . vacuous where go _ RESpaces1 = RE.ch_ ' ' RE.\/ " " RE.\/ "\n" go f (RECommaList r) = go f (expandedCommaList r) + go f (RECommaNonEmpty r)= go f (expandedCommaNonEmpty r) go f (REOptCommaList r) = go f (expandedOptCommaList r) go _ RETodo = RE.Null @@ -143,6 +144,13 @@ convert = go id . vacuous where expandedCommaList :: GrammarRegex a -> GrammarRegex a expandedCommaList = REUnion . expandedCommaList' +expandedCommaNonEmpty :: GrammarRegex a -> GrammarRegex a +expandedCommaNonEmpty r = REUnion + [ REMunch1 reSpacedComma r + , reComma <> RESpaces <> REMunch1 reSpacedComma r + , REMunch1 reSpacedComma r <> RESpaces <> reComma + ] + expandedCommaList' :: GrammarRegex a -> [GrammarRegex a] expandedCommaList' r = [ REMunch reSpacedComma r diff --git a/cabal-install/Distribution/Client/IndexUtils/IndexState.hs b/cabal-install/Distribution/Client/IndexUtils/IndexState.hs index 1833caabf46..30eb5a33bf5 100644 --- a/cabal-install/Distribution/Client/IndexUtils/IndexState.hs +++ b/cabal-install/Distribution/Client/IndexUtils/IndexState.hs @@ -22,7 +22,7 @@ import Distribution.Client.IndexUtils.Timestamp (Timestamp) import Distribution.Client.Types.RepoName (RepoName (..)) import Distribution.FieldGrammar.Described -import Distribution.Parsec (Parsec (..), parsecLeadingCommaList) +import Distribution.Parsec (Parsec (..), parsecLeadingCommaNonEmpty) import Distribution.Pretty (Pretty (..)) import qualified Data.Map.Strict as Map @@ -60,7 +60,7 @@ instance Pretty TotalIndexState where -- Just (TIS IndexStateHead (fromList [])) -- -- >>> simpleParsec "" :: Maybe TotalIndexState --- Just (TIS IndexStateHead (fromList [])) +-- Nothing -- -- >>> simpleParsec "hackage.haskell.org HEAD" :: Maybe TotalIndexState -- Just (TIS IndexStateHead (fromList [])) @@ -72,7 +72,7 @@ instance Pretty TotalIndexState where -- Just (TIS IndexStateHead (fromList [(RepoName "hackage.haskell.org",IndexStateTime (TS 1580819696))])) -- instance Parsec TotalIndexState where - parsec = normalise . foldl' add headTotalIndexState <$> parsecLeadingCommaList single0 where + parsec = normalise . foldl' add headTotalIndexState <$> parsecLeadingCommaNonEmpty single0 where single0 = startsWithRepoName <|> TokTimestamp <$> parsec startsWithRepoName = do reponame <- parsec @@ -89,7 +89,7 @@ instance Parsec TotalIndexState where add (TIS def m) (TokRepo rn idx) = TIS def (Map.insert rn idx m) instance Described TotalIndexState where - describe _ = reCommaList $ REUnion + describe _ = reCommaNonEmpty $ REUnion [ describe (Proxy :: Proxy RepoName) <> RESpaces1 <> ris , ris ] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Described.hs b/cabal-install/tests/UnitTests/Distribution/Client/Described.hs index 21cd41c0eb2..31c4f385a20 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Described.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Described.hs @@ -132,6 +132,7 @@ convert = go id . vacuous where go _ RESpaces1 = RE.ch_ ' ' RE.\/ " " RE.\/ "\n" go f (RECommaList r) = go f (expandedCommaList r) + go f (RECommaNonEmpty r)= go f (expandedCommaNonEmpty r) go f (REOptCommaList r) = go f (expandedOptCommaList r) go _ RETodo = RE.Null @@ -139,6 +140,13 @@ convert = go id . vacuous where expandedCommaList :: GrammarRegex a -> GrammarRegex a expandedCommaList = REUnion . expandedCommaList' +expandedCommaNonEmpty :: GrammarRegex a -> GrammarRegex a +expandedCommaNonEmpty r = REUnion + [ REMunch1 reSpacedComma r + , reComma <> RESpaces <> REMunch1 reSpacedComma r + , REMunch1 reSpacedComma r <> RESpaces <> reComma + ] + expandedCommaList' :: GrammarRegex a -> [GrammarRegex a] expandedCommaList' r = [ REMunch reSpacedComma r