Merge pull request #6733 from phadej/issue-6728-non-empty-string-tis

Resolve #6728: TotalIndexState cannot be empty string

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
 

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

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
 

Cabal/tests/UnitTests/Distribution/Described.hs

@@ -136,13 +136,21 @@ 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
 
 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

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
         ]

cabal-install/tests/UnitTests/Distribution/Client/Described.hs

@@ -132,13 +132,21 @@ 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
 
 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