From 4e8ba546b584dc6284d2571a454f586131c0d07f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 25 Sep 2025 18:58:39 +0800 Subject: [PATCH 01/83] add lexer tokens and rules --- Cabal-syntax/src/Distribution/Fields/Field.hs | 7 ++++++ Cabal-syntax/src/Distribution/Fields/Lexer.x | 24 ++++++++++++++++++- .../src/Distribution/Fields/Parser.hs | 16 ++++++++++--- 3 files changed, 43 insertions(+), 4 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index 496e847b1d0..d8dde3dda97 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -8,6 +8,7 @@ module Distribution.Fields.Field ( -- * Cabal file Field (..) + , MetaField(..) , fieldName , fieldAnn , fieldUniverse @@ -48,8 +49,14 @@ import qualified Data.Foldable1 as F1 data Field ann = Field !(Name ann) [FieldLine ann] | Section !(Name ann) [SectionArg ann] [Field ann] + | Meta !(MetaField ann) deriving (Eq, Show, Functor, Foldable, Traversable) +data MetaField ann + = MetaWhitespace ByteString ann + | MetaComment ByteString ann + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + -- | @since 3.12.0.0 deriving instance Ord ann => Ord (Field ann) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index b9b8ad54c4e..40e2a404f6c 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -86,6 +86,15 @@ tokens :- -- no @nl here to allow for comments on last line of the file with no trailing \n $spacetab* "--" $comment* ; -- TODO: check the lack of @nl works here -- including counting line numbers + + -- -- Exact print + -- @nbspspacetab* @nl { \pos len inp -> do + -- _ <- checkWhitespace pos len inp + -- adjustPos retPos + -- toki Whitespace pos len inp } + -- -- no @nl here to allow for comments on last line of the file with no trailing \n + -- $spacetab* "--" $comment* { toki Comment } -- TODO: check the lack of @nl works here + -- -- including counting line numbers } { @@ -100,15 +109,20 @@ tokens :- when (len' /= len) $ adjustPos (incPos (len' - len)) setStartCode in_section return (L pos (Indent len')) } + + -- TODO: maybe preserve the space here? $spacetab* \{ { tok OpenBrace } $spacetab* \} { tok CloseBrace } } { $spacetab+ ; --TODO: don't allow tab as leading space - "--" $comment* ; + -- -- Exact print + -- $spacetab+ { toki Whitespace } -- TODO: don't allow tab as leading space + -- "--" $comment* { toki Comment } + @name { toki TokSym } @string { \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp))) } @oplike { toki TokOther } @@ -134,6 +148,9 @@ tokens :- { $spacetab+; + -- -- Exact print + -- $spacetab+ { toki Whitespace } + $field_layout' $field_layout* { toki TokFieldLine } @nl { \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken } } @@ -144,6 +161,9 @@ tokens :- { $spacetab+; + -- Exact print + -- $spacetab+ { toki Whitespace } + $field_braces' $field_braces* { toki TokFieldLine } \{ { tok OpenBrace } \} { tok CloseBrace } @@ -161,6 +181,8 @@ data Token = TokSym !ByteString -- ^ Haskell-like identifier, number or | Colon | OpenBrace | CloseBrace + | Whitespace !ByteString + | Comment !ByteString | EOF | LexicalError InputStream --TODO: add separate string lexical error deriving Show diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 8d04dfba260..3d83aa0b76f 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -73,10 +73,11 @@ mkLexState' st = type Parser a = ParsecT LexState' () Identity a instance Stream LexState' Identity LToken where + -- DEBUG: remove tracing uncons (LexState' _ (tok, st')) = case tok of - L _ EOF -> return Nothing - _ -> return (Just (tok, st')) + L _ EOF -> return $ trace "[i] Got token EOF" Nothing + _ -> return (trace ("[i] Got token tok " ++ show tok) $ Just (tok, st')) -- | Get lexer warnings accumulated so far getLexerWarnings :: Parser [LexWarning] @@ -114,6 +115,8 @@ describeToken t = case t of Colon -> "\":\"" OpenBrace -> "\"{\"" CloseBrace -> "\"}\"" + Whitespace sp -> B8.unpack sp + Comment c -> B8.unpack c -- SemiColon -> "\";\"" EOF -> "end of file" LexicalError is -> "character in input " ++ show (B8.head is) @@ -134,6 +137,11 @@ tokOpenBrace = getTokenWithPos $ \t -> case t of L pos OpenBrace -> Just pos; _ tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing +tokMeta, tokComment, tokWhitespace :: Parser (Field Position) +tokMeta = tokComment <|> tokWhitespace +tokComment = getTokenWithPos $ \t -> case t of L pos (Comment c) -> Just (Meta $ MetaComment c pos); _ -> Nothing +tokWhitespace = getTokenWithPos $ \t -> case t of L pos (Whitespace c) -> Just (Meta $ MetaWhitespace c pos); _ -> Nothing + colon, openBrace, closeBrace :: Parser () sectionArg :: Parser (SectionArg Position) sectionArg = tokSym' <|> tokStr <|> tokOther "section parameter" @@ -227,9 +235,10 @@ inLexerMode (LexerMode mode) p = -- cabalStyleFile :: Parser [Field Position] cabalStyleFile = do + meta <- many tokMeta es <- elements zeroIndentLevel eof - return es + return $ meta <> es -- Elements that live at the top level or inside a section, i.e. fields -- and sections content @@ -339,6 +348,7 @@ fieldInlineOrBraces name = ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent)) return (Field name ls) ) + -- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST. -- From df715b00e605b400c41b6364d51d28912c5f47bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 29 Sep 2025 16:07:14 +0800 Subject: [PATCH 02/83] remove lexer "Whitespace" token This token is not needed, we will later use the position information to pad each token. --- Cabal-syntax/src/Distribution/Fields/Lexer.x | 1 - Cabal-syntax/src/Distribution/Fields/Parser.hs | 7 ++----- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index 40e2a404f6c..65343281ee0 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -181,7 +181,6 @@ data Token = TokSym !ByteString -- ^ Haskell-like identifier, number or | Colon | OpenBrace | CloseBrace - | Whitespace !ByteString | Comment !ByteString | EOF | LexicalError InputStream --TODO: add separate string lexical error diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 3d83aa0b76f..75362270e82 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -115,7 +115,6 @@ describeToken t = case t of Colon -> "\":\"" OpenBrace -> "\"{\"" CloseBrace -> "\"}\"" - Whitespace sp -> B8.unpack sp Comment c -> B8.unpack c -- SemiColon -> "\";\"" EOF -> "end of file" @@ -137,10 +136,8 @@ tokOpenBrace = getTokenWithPos $ \t -> case t of L pos OpenBrace -> Just pos; _ tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing -tokMeta, tokComment, tokWhitespace :: Parser (Field Position) -tokMeta = tokComment <|> tokWhitespace +tokComment :: Parser (Field Position) tokComment = getTokenWithPos $ \t -> case t of L pos (Comment c) -> Just (Meta $ MetaComment c pos); _ -> Nothing -tokWhitespace = getTokenWithPos $ \t -> case t of L pos (Whitespace c) -> Just (Meta $ MetaWhitespace c pos); _ -> Nothing colon, openBrace, closeBrace :: Parser () sectionArg :: Parser (SectionArg Position) @@ -235,7 +232,7 @@ inLexerMode (LexerMode mode) p = -- cabalStyleFile :: Parser [Field Position] cabalStyleFile = do - meta <- many tokMeta + meta <- many tokComment es <- elements zeroIndentLevel eof return $ meta <> es From c67466b88d7611db1129d2c78a9ca2399766daae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 29 Sep 2025 18:51:47 +0800 Subject: [PATCH 03/83] implement "Comment" handling ... which is not handling at all for the time being --- Cabal-syntax/src/Distribution/FieldGrammar.hs | 1 + Cabal-syntax/src/Distribution/Fields/Field.hs | 12 +++++++---- Cabal-syntax/src/Distribution/Fields/Lexer.x | 14 +++---------- .../src/Distribution/Fields/Parser.hs | 21 ++++++++++++++----- .../Distribution/PackageDescription/Parsec.hs | 1 + 5 files changed, 29 insertions(+), 20 deletions(-) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index 78739a37cfa..1439537b97b 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -97,6 +97,7 @@ partitionFields = finalize . foldl' f (PS mempty mempty mempty) | otherwise = reverse s : ss f (PS fs s ss) (Section name sargs sfields) = PS fs (MkSection name sargs sfields : s) ss + f ps (Meta _) = ps -- | Take all fields from the front. takeFields :: [Field ann] -> (Fields ann, [Field ann]) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index d8dde3dda97..04706348c7a 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -8,7 +8,6 @@ module Distribution.Fields.Field ( -- * Cabal file Field (..) - , MetaField(..) , fieldName , fieldAnn , fieldUniverse @@ -18,6 +17,10 @@ module Distribution.Fields.Field , SectionArg (..) , sectionArgAnn + -- * Meta annotations + , MetaField(..) + , metaFieldAnn + -- * Name , FieldName , Name (..) @@ -52,11 +55,12 @@ data Field ann | Meta !(MetaField ann) deriving (Eq, Show, Functor, Foldable, Traversable) -data MetaField ann - = MetaWhitespace ByteString ann - | MetaComment ByteString ann +data MetaField ann = MetaComment ByteString ann deriving (Eq, Ord, Show, Functor, Foldable, Traversable) +metaFieldAnn :: MetaField ann -> ann +metaFieldAnn (MetaComment _ ann) = ann + -- | @since 3.12.0.0 deriving instance Ord ann => Ord (Field ann) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index 65343281ee0..ae1b34269dc 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -84,17 +84,9 @@ tokens :- { @nbspspacetab* @nl { \pos len inp -> checkWhitespace pos len inp >> adjustPos retPos >> lexToken } -- no @nl here to allow for comments on last line of the file with no trailing \n - $spacetab* "--" $comment* ; -- TODO: check the lack of @nl works here - -- including counting line numbers - - -- -- Exact print - -- @nbspspacetab* @nl { \pos len inp -> do - -- _ <- checkWhitespace pos len inp - -- adjustPos retPos - -- toki Whitespace pos len inp } - -- -- no @nl here to allow for comments on last line of the file with no trailing \n - -- $spacetab* "--" $comment* { toki Comment } -- TODO: check the lack of @nl works here - -- -- including counting line numbers + $spacetab* "--" $comment* { toki Comment } + -- TODO: check the lack of @nl works here + -- including counting line numbers } { diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 75362270e82..c941affed2a 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -136,8 +136,8 @@ tokOpenBrace = getTokenWithPos $ \t -> case t of L pos OpenBrace -> Just pos; _ tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing -tokComment :: Parser (Field Position) -tokComment = getTokenWithPos $ \t -> case t of L pos (Comment c) -> Just (Meta $ MetaComment c pos); _ -> Nothing +tokComment :: Parser (MetaField Position) +tokComment = getTokenWithPos $ \t -> case t of L pos (Comment c) -> Just (MetaComment c pos); _ -> Nothing colon, openBrace, closeBrace :: Parser () sectionArg :: Parser (SectionArg Position) @@ -232,17 +232,26 @@ inLexerMode (LexerMode mode) p = -- cabalStyleFile :: Parser [Field Position] cabalStyleFile = do - meta <- many tokComment es <- elements zeroIndentLevel eof - return $ meta <> es + return es + +commentsAround :: (a -> [Field Position]) -> Parser a -> Parser [Field Position] +commentsAround f p = do + pre <- many tokComment + res <- p + post <- many tokComment + pure $ map Meta pre <> f res <> map Meta post -- Elements that live at the top level or inside a section, i.e. fields -- and sections content -- -- elements ::= element* elements :: IndentLevel -> Parser [Field Position] -elements ilevel = many (element ilevel) +elements ilevel = do + -- TODO: check if syntaxically any element can be surrounded by cabal + groups <- many (commentsAround (\f -> [f]) $ element ilevel) + pure $ mconcat groups -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on @@ -400,12 +409,14 @@ checkIndentation :: [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation [] = id checkIndentation (Field name _ : fs') = checkIndentation' (nameAnn name) fs' checkIndentation (Section name _ fs : fs') = checkIndentation fs . checkIndentation' (nameAnn name) fs' +checkIndentation (Meta meta : fs') = checkIndentation' (metaFieldAnn meta) fs' -- | We compare adjacent fields to reduce the amount of reported indentation warnings. checkIndentation' :: Position -> [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation' _ [] = id checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation' (nameAnn name) fs' checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation fs . checkIndentation' (nameAnn name) fs' +checkIndentation' pos (Meta meta : fs') = checkIndentation'' pos (metaFieldAnn meta) . checkIndentation' (metaFieldAnn meta) fs' -- | Check that positions' columns are the same. checkIndentation'' :: Position -> Position -> [LexWarning] -> [LexWarning] diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index c7e327ddb7f..963a79280b5 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -249,6 +249,7 @@ goSections specVer = traverse_ process "Ignoring trailing fields after sections: " ++ show name process (Section name args secFields) = parseSection name args secFields + process (Meta _) = pure () snoc x xs = xs ++ [x] From 14e384c6f034d2dbfd6c20f038d232f2c21b1737 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 29 Sep 2025 21:49:49 +0800 Subject: [PATCH 04/83] temporary fix by dropping comments before parseGenericPackageDescription --- Cabal-syntax/src/Distribution/FieldGrammar.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index 1439537b97b..94af17e151c 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -101,9 +101,13 @@ partitionFields = finalize . foldl' f (PS mempty mempty mempty) -- | Take all fields from the front. takeFields :: [Field ann] -> (Fields ann, [Field ann]) -takeFields = finalize . spanMaybe match +-- TODO(leana8959): find a way to inject comment into the output +-- parseGenericPackageDescription uses this +takeFields = finalize . spanMaybe match . dropMeta where finalize (fs, rest) = (Map.fromListWith (flip (++)) fs, rest) match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs]) match _ = Nothing + + dropMeta = filter (\x -> case x of { Meta _ -> False; _ -> True }) From 6503ce88ecf140b2d14065735930d09a5af33800 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 1 Oct 2025 12:06:25 +0800 Subject: [PATCH 05/83] make metaFields a map of positions --- Cabal-syntax/src/Distribution/FieldGrammar.hs | 16 +++++++++++----- .../src/Distribution/FieldGrammar/Parsec.hs | 2 ++ Cabal-syntax/src/Distribution/Fields/Field.hs | 2 +- .../Distribution/PackageDescription/Parsec.hs | 2 +- 4 files changed, 15 insertions(+), 7 deletions(-) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index 94af17e151c..6409c6b5f72 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -38,6 +38,7 @@ module Distribution.FieldGrammar import Distribution.Compat.Prelude import Prelude () +import qualified Data.Bifunctor as Bi import qualified Data.Map.Strict as Map import Distribution.FieldGrammar.Class @@ -100,14 +101,19 @@ partitionFields = finalize . foldl' f (PS mempty mempty mempty) f ps (Meta _) = ps -- | Take all fields from the front. -takeFields :: [Field ann] -> (Fields ann, [Field ann]) --- TODO(leana8959): find a way to inject comment into the output --- parseGenericPackageDescription uses this -takeFields = finalize . spanMaybe match . dropMeta +takeFields :: Ord ann => [Field ann] -> (MetaFields ann, (Fields ann, [Field ann])) +takeFields = + Bi.bimap metaFieldToMap (finalize . spanMaybe match) + . splitMeta where finalize (fs, rest) = (Map.fromListWith (flip (++)) fs, rest) match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs]) match _ = Nothing - dropMeta = filter (\x -> case x of { Meta _ -> False; _ -> True }) + metaFieldToMap = Map.fromList . map (\mField -> (metaFieldAnn mField, mField)) + + splitMeta = partitionEithers . map f + where + f (Meta mField) = Left mField + f field = Right field diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs index 461a76cdd44..4aafb1df9b8 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs @@ -60,6 +60,7 @@ module Distribution.FieldGrammar.Parsec -- * Auxiliary , Fields + , MetaFields , NamelessField (..) , namelessFieldAnn , Section (..) @@ -95,6 +96,7 @@ import Distribution.Parsec.Position (positionCol, positionRow) ------------------------------------------------------------------------------- type Fields ann = Map FieldName [NamelessField ann] +type MetaFields ann = Map ann (MetaField ann) -- | Single field, without name, but with its annotation. data NamelessField ann = MkNamelessField !ann [FieldLine ann] diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index 04706348c7a..bf49d91ef30 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -18,7 +18,7 @@ module Distribution.Fields.Field , sectionArgAnn -- * Meta annotations - , MetaField(..) + , MetaField (..) , metaFieldAnn -- * Name diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 963a79280b5..5ee1b630019 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -158,7 +158,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do for_ utf8WarnPos $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos let (syntax, fs') = sectionizeFields fs - let (fields, sectionFields) = takeFields fs' + let (metaFields, (fields, sectionFields)) = takeFields fs' -- cabal-version specVer <- case scannedVer of From 58ad099a60ed5615691b0f7456ea0e4da0790b21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 1 Oct 2025 20:59:31 +0800 Subject: [PATCH 06/83] rearrange and simplify field --- Cabal-syntax/Cabal-syntax.cabal | 1 + Cabal-syntax/src/Distribution/FieldGrammar.hs | 16 ++++++++-------- .../src/Distribution/FieldGrammar/Parsec.hs | 2 -- Cabal-syntax/src/Distribution/Fields/Field.hs | 12 +----------- Cabal-syntax/src/Distribution/Fields/Lexer.x | 4 ++-- Cabal-syntax/src/Distribution/Fields/Parser.hs | 12 ++++++------ .../PackageDescription/Configuration.hs | 4 ++-- .../Distribution/PackageDescription/Parsec.hs | 5 +++-- Cabal-syntax/src/Distribution/Parsec/Position.hs | 7 ++++++- .../Types/GenericPackageDescription.hs | 12 ++++++++++-- .../Types/GenericPackageDescription/Lens.hs | 3 ++- .../src/Distribution/PackageDescription/Check.hs | 1 + 12 files changed, 42 insertions(+), 37 deletions(-) diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal index 85137dc147c..9d0bdfbf27d 100644 --- a/Cabal-syntax/Cabal-syntax.cabal +++ b/Cabal-syntax/Cabal-syntax.cabal @@ -44,6 +44,7 @@ library -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity -- See also https://github.com/ekmett/transformers-compat/issues/35 , transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.7) + , tree-diff ghc-options: -Wall diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index 6409c6b5f72..690226fe049 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -38,6 +38,7 @@ module Distribution.FieldGrammar import Distribution.Compat.Prelude import Prelude () +import Data.ByteString (ByteString) import qualified Data.Bifunctor as Bi import qualified Data.Map.Strict as Map @@ -98,22 +99,21 @@ partitionFields = finalize . foldl' f (PS mempty mempty mempty) | otherwise = reverse s : ss f (PS fs s ss) (Section name sargs sfields) = PS fs (MkSection name sargs sfields : s) ss - f ps (Meta _) = ps + f ps (Comment {}) = ps -- | Take all fields from the front. -takeFields :: Ord ann => [Field ann] -> (MetaFields ann, (Fields ann, [Field ann])) +-- Returns a tuple containing the comments, nameless fields, and sections +takeFields :: Ord ann => [Field ann] -> (Map ann ByteString, (Fields ann, [Field ann])) takeFields = - Bi.bimap metaFieldToMap (finalize . spanMaybe match) - . splitMeta + Bi.bimap Map.fromList (finalize . spanMaybe match) + . splitComments where finalize (fs, rest) = (Map.fromListWith (flip (++)) fs, rest) match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs]) match _ = Nothing - metaFieldToMap = Map.fromList . map (\mField -> (metaFieldAnn mField, mField)) - - splitMeta = partitionEithers . map f + splitComments = partitionEithers . map f where - f (Meta mField) = Left mField + f (Comment cmt ann) = Left (ann, cmt) f field = Right field diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs index 4aafb1df9b8..461a76cdd44 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs @@ -60,7 +60,6 @@ module Distribution.FieldGrammar.Parsec -- * Auxiliary , Fields - , MetaFields , NamelessField (..) , namelessFieldAnn , Section (..) @@ -96,7 +95,6 @@ import Distribution.Parsec.Position (positionCol, positionRow) ------------------------------------------------------------------------------- type Fields ann = Map FieldName [NamelessField ann] -type MetaFields ann = Map ann (MetaField ann) -- | Single field, without name, but with its annotation. data NamelessField ann = MkNamelessField !ann [FieldLine ann] diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index bf49d91ef30..fc0045ec586 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -17,10 +17,6 @@ module Distribution.Fields.Field , SectionArg (..) , sectionArgAnn - -- * Meta annotations - , MetaField (..) - , metaFieldAnn - -- * Name , FieldName , Name (..) @@ -52,15 +48,9 @@ import qualified Data.Foldable1 as F1 data Field ann = Field !(Name ann) [FieldLine ann] | Section !(Name ann) [SectionArg ann] [Field ann] - | Meta !(MetaField ann) + | Comment !ByteString ann deriving (Eq, Show, Functor, Foldable, Traversable) -data MetaField ann = MetaComment ByteString ann - deriving (Eq, Ord, Show, Functor, Foldable, Traversable) - -metaFieldAnn :: MetaField ann -> ann -metaFieldAnn (MetaComment _ ann) = ann - -- | @since 3.12.0.0 deriving instance Ord ann => Ord (Field ann) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index ae1b34269dc..ec6e0baaf9c 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -84,7 +84,7 @@ tokens :- { @nbspspacetab* @nl { \pos len inp -> checkWhitespace pos len inp >> adjustPos retPos >> lexToken } -- no @nl here to allow for comments on last line of the file with no trailing \n - $spacetab* "--" $comment* { toki Comment } + $spacetab* "--" $comment* { toki TokComment } -- TODO: check the lack of @nl works here -- including counting line numbers } @@ -173,7 +173,7 @@ data Token = TokSym !ByteString -- ^ Haskell-like identifier, number or | Colon | OpenBrace | CloseBrace - | Comment !ByteString + | TokComment !ByteString | EOF | LexicalError InputStream --TODO: add separate string lexical error deriving Show diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index c941affed2a..70a87d335d5 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -115,7 +115,7 @@ describeToken t = case t of Colon -> "\":\"" OpenBrace -> "\"{\"" CloseBrace -> "\"}\"" - Comment c -> B8.unpack c + TokComment c -> B8.unpack c -- SemiColon -> "\";\"" EOF -> "end of file" LexicalError is -> "character in input " ++ show (B8.head is) @@ -136,8 +136,8 @@ tokOpenBrace = getTokenWithPos $ \t -> case t of L pos OpenBrace -> Just pos; _ tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing -tokComment :: Parser (MetaField Position) -tokComment = getTokenWithPos $ \t -> case t of L pos (Comment c) -> Just (MetaComment c pos); _ -> Nothing +tokComment :: Parser (Field Position) +tokComment = getTokenWithPos $ \t -> case t of L pos (TokComment c) -> Just (Comment c pos); _ -> Nothing colon, openBrace, closeBrace :: Parser () sectionArg :: Parser (SectionArg Position) @@ -241,7 +241,7 @@ commentsAround f p = do pre <- many tokComment res <- p post <- many tokComment - pure $ map Meta pre <> f res <> map Meta post + pure $ pre <> f res <> post -- Elements that live at the top level or inside a section, i.e. fields -- and sections content @@ -409,14 +409,14 @@ checkIndentation :: [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation [] = id checkIndentation (Field name _ : fs') = checkIndentation' (nameAnn name) fs' checkIndentation (Section name _ fs : fs') = checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation (Meta meta : fs') = checkIndentation' (metaFieldAnn meta) fs' +checkIndentation (Comment _ ann : fs') = checkIndentation' ann fs' -- | We compare adjacent fields to reduce the amount of reported indentation warnings. checkIndentation' :: Position -> [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation' _ [] = id checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation' (nameAnn name) fs' checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation' pos (Meta meta : fs') = checkIndentation'' pos (metaFieldAnn meta) . checkIndentation' (metaFieldAnn meta) fs' +checkIndentation' pos (Comment _ ann : fs') = checkIndentation'' pos ann . checkIndentation' ann fs' -- | Check that positions' columns are the same. checkIndentation'' :: Position -> Position -> [LexWarning] -> [LexWarning] diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs index d23ac5cbf51..5b5b24d6b91 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs @@ -458,7 +458,7 @@ finalizePD (Platform arch os) impl constraints - (GenericPackageDescription pkg _ver flags mb_lib0 sub_libs0 flibs0 exes0 tests0 bms0) = do + (GenericPackageDescription pkg _ver flags mb_lib0 sub_libs0 flibs0 exes0 tests0 bms0 _exactComments) = do (targetSet, flagVals) <- resolveWithFlags flagChoices enabled os arch impl constraints condTrees check let @@ -542,7 +542,7 @@ resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribu -- function. flattenPackageDescription :: GenericPackageDescription -> PackageDescription flattenPackageDescription - (GenericPackageDescription pkg _ _ mlib0 sub_libs0 flibs0 exes0 tests0 bms0) = + (GenericPackageDescription pkg _ _ mlib0 sub_libs0 flibs0 exes0 tests0 bms0 _exactComments) = pkg { library = mlib , subLibraries = reverse sub_libs diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 5ee1b630019..f3cb96cf1f1 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -158,7 +158,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do for_ utf8WarnPos $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos let (syntax, fs') = sectionizeFields fs - let (metaFields, (fields, sectionFields)) = takeFields fs' + let (comments, (fields, sectionFields)) = takeFields fs' -- cabal-version specVer <- case scannedVer of @@ -202,6 +202,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do -- Sections let gpd = emptyGenericPackageDescription + { exactComments = comments } & L.packageDescription .~ pd gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty) @@ -249,7 +250,7 @@ goSections specVer = traverse_ process "Ignoring trailing fields after sections: " ++ show name process (Section name args secFields) = parseSection name args secFields - process (Meta _) = pure () + process (Comment _ _) = pure () snoc x xs = xs ++ [x] diff --git a/Cabal-syntax/src/Distribution/Parsec/Position.hs b/Cabal-syntax/src/Distribution/Parsec/Position.hs index 892fc8b8fda..76ba444ab84 100644 --- a/Cabal-syntax/src/Distribution/Parsec/Position.hs +++ b/Cabal-syntax/src/Distribution/Parsec/Position.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveAnyClass #-} module Distribution.Parsec.Position ( Position (..) @@ -10,6 +12,7 @@ module Distribution.Parsec.Position , positionRow ) where +import Data.TreeDiff.Class import Distribution.Compat.Prelude import Prelude () @@ -18,9 +21,11 @@ data Position = Position {-# UNPACK #-} !Int -- row {-# UNPACK #-} !Int -- column - deriving (Eq, Ord, Show, Generic) + deriving (Eq, Ord, Show, Generic, Data) instance Binary Position +instance Structured Position +instance ToExpr Position instance NFData Position where rnf = genericRnf -- | Shift position by n columns to the right. diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index 97f4ed8cccb..58ce6b65c88 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} module Distribution.Types.GenericPackageDescription ( GenericPackageDescription (..) @@ -11,6 +12,9 @@ module Distribution.Types.GenericPackageDescription import Distribution.Compat.Prelude import Prelude () +import Distribution.Parsec.Position (Position) +import Data.ByteString + -- lens import Distribution.Compat.Lens as L import qualified Distribution.Types.BuildInfo.Lens as L @@ -70,9 +74,12 @@ data GenericPackageDescription = GenericPackageDescription , CondTree ConfVar [Dependency] Benchmark ) ] + , exactComments :: ExactComments Position } deriving (Show, Eq, Data, Generic) +type ExactComments ann = Map ann ByteString + instance Package GenericPackageDescription where packageId = packageId . packageDescription @@ -81,13 +88,13 @@ instance Structured GenericPackageDescription instance NFData GenericPackageDescription where rnf = genericRnf emptyGenericPackageDescription :: GenericPackageDescription -emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing [] [] [] [] [] +emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing [] [] [] [] [] mempty -- ----------------------------------------------------------------------------- -- Traversal Instances instance L.HasBuildInfos GenericPackageDescription where - traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) = + traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 mFields) = GenericPackageDescription <$> L.traverseBuildInfos f p <*> pure v @@ -98,6 +105,7 @@ instance L.HasBuildInfos GenericPackageDescription where <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x4 <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x5 <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x6 + <*> pure mFields -- We use this traversal to keep [Dependency] field in CondTree up to date. traverseCondTreeBuildInfo diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs index 213c97128f9..10a32feda68 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs @@ -81,7 +81,7 @@ allCondTrees ) -> GenericPackageDescription -> f GenericPackageDescription -allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) = +allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 exactComments) = GenericPackageDescription <$> pure p <*> pure v @@ -92,6 +92,7 @@ allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) = <*> (traverse . _2) f x4 <*> (traverse . _2) f x5 <*> (traverse . _2) f x6 + <*> pure exactComments ------------------------------------------------------------------------------- -- Flag diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 0593ce8d905..3432567ffe3 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -232,6 +232,7 @@ checkGenericPackageDescription condExecutables_ condTestSuites_ condBenchmarks_ + _exactComments ) = do -- § Description and names. From fa23509dcb2529c95d943d00a5a10f889bfa40ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 1 Oct 2025 21:03:48 +0800 Subject: [PATCH 07/83] make lexer emit comment wherever they would occur --- Cabal-syntax/src/Distribution/Fields/Lexer.x | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index ec6e0baaf9c..770155b6dac 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -108,12 +108,8 @@ tokens :- } { - $spacetab+ ; --TODO: don't allow tab as leading space - "--" $comment* ; - - -- -- Exact print - -- $spacetab+ { toki Whitespace } -- TODO: don't allow tab as leading space - -- "--" $comment* { toki Comment } + $spacetab+ ; --TODO: don't allow tab as leading space + "--" $comment* { toki TokComment } @name { toki TokSym } @string { \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp))) } @@ -140,8 +136,6 @@ tokens :- { $spacetab+; - -- -- Exact print - -- $spacetab+ { toki Whitespace } $field_layout' $field_layout* { toki TokFieldLine } @nl { \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken } @@ -153,8 +147,6 @@ tokens :- { $spacetab+; - -- Exact print - -- $spacetab+ { toki Whitespace } $field_braces' $field_braces* { toki TokFieldLine } \{ { tok OpenBrace } From 9d09bb5318eddc507ebee259d6b7c7cc378832cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 1 Oct 2025 21:10:47 +0800 Subject: [PATCH 08/83] stop parser from emitting indentation warning for comments --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 70a87d335d5..5dc501ed0ba 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -407,16 +407,16 @@ readFields' s = do -- and then parse the following ones (softly) requiring the exactly the same indentation. checkIndentation :: [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation [] = id -checkIndentation (Field name _ : fs') = checkIndentation' (nameAnn name) fs' +checkIndentation (Field name _ : fs') = checkIndentation fs' checkIndentation (Section name _ fs : fs') = checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation (Comment _ ann : fs') = checkIndentation' ann fs' +checkIndentation (Comment {} : fs') = checkIndentation fs' -- | We compare adjacent fields to reduce the amount of reported indentation warnings. checkIndentation' :: Position -> [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation' _ [] = id checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation' (nameAnn name) fs' checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation' pos (Comment _ ann : fs') = checkIndentation'' pos ann . checkIndentation' ann fs' +checkIndentation' _ (Comment {} : fs') = id -- | Check that positions' columns are the same. checkIndentation'' :: Position -> Position -> [LexWarning] -> [LexWarning] From 9a7d6643df28371ba4b272a7074b5a56f1b2633b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 3 Oct 2025 15:26:27 +0800 Subject: [PATCH 09/83] fix: restore checkIndentation behaviour for Field --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 5dc501ed0ba..827f06d699f 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -407,7 +407,7 @@ readFields' s = do -- and then parse the following ones (softly) requiring the exactly the same indentation. checkIndentation :: [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation [] = id -checkIndentation (Field name _ : fs') = checkIndentation fs' +checkIndentation (Field name _ : fs') = checkIndentation' (nameAnn name) fs' checkIndentation (Section name _ fs : fs') = checkIndentation fs . checkIndentation' (nameAnn name) fs' checkIndentation (Comment {} : fs') = checkIndentation fs' From f5dca105054cf164beaeffaca545e0225924eaa9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 3 Oct 2025 15:26:21 +0800 Subject: [PATCH 10/83] test: add dummy tests --- .../src/Distribution/Fields/Parser.hs | 5 ++- .../Types/GenericPackageDescription.hs | 1 + Cabal-tests/tests/ParserTests.hs | 32 +++++++++++++++++-- .../comments/nosections-after.cabal | 4 +++ .../comments/nosections-before.cabal | 4 +++ .../comments/nosections-mixed.cabal | 11 +++++++ 6 files changed, 52 insertions(+), 5 deletions(-) create mode 100644 Cabal-tests/tests/ParserTests/comments/nosections-after.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/nosections-before.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/nosections-mixed.cabal diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 827f06d699f..78ff4fcf38e 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -73,11 +73,10 @@ mkLexState' st = type Parser a = ParsecT LexState' () Identity a instance Stream LexState' Identity LToken where - -- DEBUG: remove tracing uncons (LexState' _ (tok, st')) = case tok of - L _ EOF -> return $ trace "[i] Got token EOF" Nothing - _ -> return (trace ("[i] Got token tok " ++ show tok) $ Just (tok, st')) + L _ EOF -> return Nothing + _ -> return $ Just (tok, st') -- | Get lexer warnings accumulated so far getLexerWarnings :: Parser [LexWarning] diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index 58ce6b65c88..f55567b1620 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -6,6 +6,7 @@ module Distribution.Types.GenericPackageDescription ( GenericPackageDescription (..) + , ExactComments , emptyGenericPackageDescription ) where diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 8368ed19451..b24508f127b 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -10,11 +10,13 @@ import Test.Tasty import Test.Tasty.Golden.Advanced (goldenTest) import Test.Tasty.HUnit -import Control.Monad (unless, void) +import Control.Monad (unless, void, when) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) import Data.Maybe (isNothing) import Distribution.Fields (pwarning) -import Distribution.PackageDescription (GenericPackageDescription) +import Distribution.PackageDescription (GenericPackageDescription(exactComments)) +import Distribution.Types.GenericPackageDescription(ExactComments) +import Distribution.Parsec.Position (Position) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.Parsec (PWarnType (..), PWarning (..), showPErrorWithSource, showPWarningWithSource) @@ -42,6 +44,7 @@ tests :: TestTree tests = testGroup "parsec tests" [ regressionTests , warningTests + , commentTests , errorTests , ipiTests ] @@ -94,6 +97,31 @@ warningTest wt fp = testCase (show wt) $ do isRight (Right _) = True isRight _ = False + +------------------------------------------------------------------------------- +-- comment +------------------------------------------------------------------------------- + +-- Verify that comments are parsed correctly +commentTests :: TestTree +commentTests = testGroup "warnings triggered" + [ commentTest "nosections-before" mempty + , commentTest "nosections-after" mempty + , commentTest "nosections-mixed" mempty + ] + +commentTest :: FilePath -> ExactComments Position -> TestTree +commentTest fp expected = testCase fp $ do + contents <- BS.readFile $ "tests" "ParserTests" "comments" fp + + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents + let (warns, x) = runParseResult res + + when (not $ null warns) (assertFailure $ "got warning: " ++ show warns) + case x of + Right output -> assertEqual "exact comments" (exactComments output) expected + Left _ -> assertFailure "parser failed." + ------------------------------------------------------------------------------- -- Errors ------------------------------------------------------------------------------- diff --git a/Cabal-tests/tests/ParserTests/comments/nosections-after.cabal b/Cabal-tests/tests/ParserTests/comments/nosections-after.cabal new file mode 100644 index 00000000000..6a1fc5402f9 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/nosections-after.cabal @@ -0,0 +1,4 @@ +name: bom +version: 1 +cabal-version: >= 1.8 +-- comment after diff --git a/Cabal-tests/tests/ParserTests/comments/nosections-before.cabal b/Cabal-tests/tests/ParserTests/comments/nosections-before.cabal new file mode 100644 index 00000000000..c482b210316 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/nosections-before.cabal @@ -0,0 +1,4 @@ +-- comment before +name: bom +version: 1 +cabal-version: >= 1.8 diff --git a/Cabal-tests/tests/ParserTests/comments/nosections-mixed.cabal b/Cabal-tests/tests/ParserTests/comments/nosections-mixed.cabal new file mode 100644 index 00000000000..3002fc3ceb3 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/nosections-mixed.cabal @@ -0,0 +1,11 @@ + +-- comment before +name: bom + +-- comment within surrounded by blanks + +version: 1 + -- comment within +cabal-version: >= 1.8 + +-- comment after From c32946457075c340c94e9639d09ba92708285360 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 3 Oct 2025 15:57:40 +0800 Subject: [PATCH 11/83] test: accept new golden expressions --- .../ParserTests/regressions/Octree-0.5.expr | 9 ++-- .../ParserTests/regressions/anynone.expr | 5 ++- .../regressions/common-conditional.expr | 19 ++++---- .../ParserTests/regressions/common2.expr | 19 ++++---- .../tests/ParserTests/regressions/elif.expr | 7 +-- .../tests/ParserTests/regressions/elif2.expr | 13 +++--- .../regressions/hidden-main-lib.expr | 5 ++- .../ParserTests/regressions/indentation.expr | 5 ++- .../ParserTests/regressions/indentation2.expr | 5 ++- .../ParserTests/regressions/indentation3.expr | 5 ++- .../ParserTests/regressions/issue-5055.expr | 9 ++-- .../ParserTests/regressions/issue-5846.expr | 5 ++- .../ParserTests/regressions/issue-6083-a.expr | 11 ++--- .../ParserTests/regressions/issue-6083-b.expr | 11 ++--- .../ParserTests/regressions/issue-6083-c.expr | 7 +-- .../regressions/issue-6083-pkg-pkg.expr | 5 ++- .../regressions/jaeger-flamegraph.expr | 9 ++-- .../regressions/leading-comma-2.expr | 5 ++- .../regressions/leading-comma.expr | 5 ++- .../tests/ParserTests/regressions/libpq1.expr | 19 ++++---- .../tests/ParserTests/regressions/libpq2.expr | 19 ++++---- .../ParserTests/regressions/mixin-1.expr | 5 ++- .../ParserTests/regressions/monad-param.expr | 5 ++- .../regressions/multiple-libs-2.expr | 7 +-- .../ParserTests/regressions/noVersion.expr | 5 ++- .../regressions/nothing-unicode.expr | 7 +-- .../tests/ParserTests/regressions/shake.expr | 45 ++++++++++--------- .../tests/ParserTests/regressions/spdx-1.expr | 5 ++- .../tests/ParserTests/regressions/spdx-2.expr | 5 ++- .../tests/ParserTests/regressions/spdx-3.expr | 5 ++- .../regressions/th-lift-instances.expr | 11 ++--- .../ParserTests/regressions/version-sets.expr | 5 ++- .../regressions/wl-pprint-indef.expr | 7 +-- 33 files changed, 171 insertions(+), 138 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr index 634b27b8828..2145b4817c0 100644 --- a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr +++ b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr @@ -86,11 +86,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -199,11 +199,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -303,11 +303,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -401,4 +401,5 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/anynone.expr b/Cabal-tests/tests/ParserTests/regressions/anynone.expr index 927605d6058..08dfe7c2068 100644 --- a/Cabal-tests/tests/ParserTests/regressions/anynone.expr +++ b/Cabal-tests/tests/ParserTests/regressions/anynone.expr @@ -52,11 +52,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -118,4 +118,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr index 41e0fd5377a..6574797f6ed 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr @@ -69,11 +69,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -148,11 +148,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -242,11 +242,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -323,11 +323,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -402,11 +402,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -474,11 +474,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -569,11 +569,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -649,11 +649,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -713,4 +713,5 @@ GenericPackageDescription { condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/common2.expr b/Cabal-tests/tests/ParserTests/regressions/common2.expr index af882207fc4..a44fe3289b4 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common2.expr @@ -63,11 +63,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -166,11 +166,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -248,11 +248,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -353,11 +353,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -432,11 +432,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -535,11 +535,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -615,11 +615,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -695,11 +695,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -750,4 +750,5 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/elif.expr b/Cabal-tests/tests/ParserTests/regressions/elif.expr index e04821eaaef..9b73557514a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/elif.expr +++ b/Cabal-tests/tests/ParserTests/regressions/elif.expr @@ -62,11 +62,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -133,11 +133,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -199,4 +199,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/elif2.expr b/Cabal-tests/tests/ParserTests/regressions/elif2.expr index 88eb02d59d7..1adda5b8df8 100644 --- a/Cabal-tests/tests/ParserTests/regressions/elif2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/elif2.expr @@ -62,11 +62,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -133,11 +133,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -209,11 +209,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -279,11 +279,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -355,11 +355,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -412,4 +412,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr index 553b88dc595..b2ee9153325 100644 --- a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr +++ b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr @@ -54,11 +54,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -120,4 +120,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation.expr b/Cabal-tests/tests/ParserTests/regressions/indentation.expr index f36a8997717..451c2095290 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation.expr @@ -63,11 +63,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -121,4 +121,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr index 11afbcfd5d3..dc752d3adb0 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr @@ -56,11 +56,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -114,4 +114,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr index 964bad3f924..87336f54222 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr @@ -58,11 +58,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -116,4 +116,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr index 996fa26eece..ba0d82a1ec5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr @@ -57,11 +57,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -143,11 +143,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -231,11 +231,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -286,4 +286,5 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr index c3e08359046..8e58a5e40fe 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr @@ -51,11 +51,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -181,4 +181,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr index 001d3c86515..d944b6020c2 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr @@ -51,11 +51,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -149,11 +149,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -219,11 +219,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -302,11 +302,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -382,4 +382,5 @@ GenericPackageDescription { "sublib")]))], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr index ca99e3d554f..5749f6b53ca 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr @@ -51,11 +51,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -149,11 +149,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -219,11 +219,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -312,11 +312,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -392,4 +392,5 @@ GenericPackageDescription { "sublib")]))], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr index b2f47a1a938..b9cce7f5dac 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr @@ -51,11 +51,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -149,11 +149,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -206,4 +206,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr index ce7c453e697..dc662dcb6b4 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr @@ -51,11 +51,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -125,4 +125,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr index b6dc81fee1b..f4277963bdf 100644 --- a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr +++ b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr @@ -93,11 +93,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -194,11 +194,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -361,11 +361,11 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [4, 2, 1]))], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -477,4 +477,5 @@ GenericPackageDescription { (mkVersion [0, 10])) mainLibSet], condTreeComponents = []}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr index 3a1d7d5f075..6b5cc34c836 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr @@ -61,11 +61,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -167,4 +167,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr index 230ebf53136..cb87026befb 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr @@ -54,11 +54,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -160,4 +160,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr index b331abffcca..d5ad800e7f6 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr @@ -144,11 +144,11 @@ GenericPackageDescription { (mkVersion [0]))], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -250,11 +250,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -337,11 +337,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -424,11 +424,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [ @@ -499,11 +499,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -569,11 +569,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -637,11 +637,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -707,11 +707,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -766,4 +766,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr index 9f6a16ada6e..5d8360f7a0b 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr @@ -149,11 +149,11 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0]))], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -255,11 +255,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -342,11 +342,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -429,11 +429,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [ @@ -501,11 +501,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -571,11 +571,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -639,11 +639,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -709,11 +709,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -768,4 +768,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr index 0a137660468..f27e11ee6d9 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr @@ -55,11 +55,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -162,4 +162,5 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr index db28c928ddb..df6264144f3 100644 --- a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr +++ b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr @@ -63,11 +63,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -159,4 +159,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr index d2f1efdd913..1d694553cc0 100644 --- a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr @@ -54,11 +54,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -135,11 +135,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -200,4 +200,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr index 838f87733eb..38d257b86e9 100644 --- a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr +++ b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr @@ -54,11 +54,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -120,4 +120,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr index ccfe4421c7b..52232668957 100644 --- a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr +++ b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr @@ -69,11 +69,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -140,11 +140,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -198,4 +198,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/shake.expr b/Cabal-tests/tests/ParserTests/regressions/shake.expr index 5be08b04064..2711787a719 100644 --- a/Cabal-tests/tests/ParserTests/regressions/shake.expr +++ b/Cabal-tests/tests/ParserTests/regressions/shake.expr @@ -189,11 +189,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -480,11 +480,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = ["-DPORTABLE"], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -550,11 +550,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -627,11 +627,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -697,11 +697,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -778,11 +778,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -857,11 +857,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1183,11 +1183,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1253,11 +1253,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = ["-DPORTABLE"], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1320,11 +1320,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1394,11 +1394,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1461,11 +1461,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1539,11 +1539,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1617,11 +1617,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1992,11 +1992,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2064,11 +2064,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2136,11 +2136,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = ["-DPORTABLE"], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2207,11 +2207,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2285,11 +2285,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2356,11 +2356,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2438,11 +2438,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2501,4 +2501,5 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}, condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr index 88500d2d365..735c5142bf0 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr @@ -52,11 +52,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -110,4 +110,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr index 9cd00ea1103..9e66a2553fc 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr @@ -56,11 +56,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -114,4 +114,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr index e8b2eca8989..057c88025eb 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr @@ -56,11 +56,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -114,4 +114,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr index 2db686aa40f..9c61f0a940b 100644 --- a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr +++ b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr @@ -81,11 +81,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -254,11 +254,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -435,11 +435,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -544,11 +544,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -599,4 +599,5 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr index c086ae618aa..a2738e2e433 100644 --- a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr +++ b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr @@ -78,11 +78,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -264,4 +264,5 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} diff --git a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr index e4e6a457a3d..d928d51ae60 100644 --- a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr +++ b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr @@ -72,11 +72,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -161,11 +161,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -243,4 +243,5 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} From edd270c3882c683ec2491c9ec5142e16a1796cb7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 3 Oct 2025 16:06:53 +0800 Subject: [PATCH 12/83] test: accept new golden expressions --- .../tests/ParserTests/regressions/common.expr | 11 ++++++++--- .../tests/ParserTests/regressions/common3.expr | 11 ++++++++--- .../tests/ParserTests/regressions/mixin-2.expr | 15 +++++++++++++-- .../tests/ParserTests/regressions/mixin-3.expr | 15 +++++++++++++-- 4 files changed, 42 insertions(+), 10 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/regressions/common.expr b/Cabal-tests/tests/ParserTests/regressions/common.expr index e8c766460f2..2d0d28e3b75 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common.expr @@ -67,11 +67,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -147,11 +147,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -209,4 +209,9 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList + [ + _×_ + (Position 7 1) + "-- note: empty field"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/common3.expr b/Cabal-tests/tests/ParserTests/regressions/common3.expr index be783c4cab6..57042cfdd1f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common3.expr @@ -67,11 +67,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -147,11 +147,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -233,4 +233,9 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList + [ + _×_ + (Position 7 1) + "-- note: empty field"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr index 6c2239df825..0bbdc6c4593 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr @@ -55,11 +55,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -162,4 +162,15 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList + [ + _×_ + (Position 5 1) + "-- mixin field:", + _×_ + (Position 6 1) + "-- in 2.2 we got leading/trailing commas", + _×_ + (Position 7 1) + "-- in 3.0 we got lax space parsing"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr index a4a94aac32c..b1537200ba2 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr @@ -55,11 +55,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -145,4 +145,15 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList + [ + _×_ + (Position 5 1) + "-- mixin field:", + _×_ + (Position 6 1) + "-- in 2.2 we got leading/trailing commas", + _×_ + (Position 7 1) + "-- in 3.0 we got lax space parsing"]} From 53703c027071c8a2e8688a14bc5f6b3b9adb7105 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 7 Oct 2025 11:16:23 +0800 Subject: [PATCH 13/83] test: rename comment test group --- Cabal-tests/tests/ParserTests.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index b24508f127b..7643ba4bead 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -104,10 +104,10 @@ warningTest wt fp = testCase (show wt) $ do -- Verify that comments are parsed correctly commentTests :: TestTree -commentTests = testGroup "warnings triggered" - [ commentTest "nosections-before" mempty - , commentTest "nosections-after" mempty - , commentTest "nosections-mixed" mempty +commentTests = testGroup "comments" + [ commentTest "nosections-before.cabal" mempty + , commentTest "nosections-after.cabal" mempty + , commentTest "nosections-mixed.cabal" mempty ] commentTest :: FilePath -> ExactComments Position -> TestTree From 2ef72c5f5ca105e12e83b1bfb11853a26ba865cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 8 Oct 2025 12:29:56 +0800 Subject: [PATCH 14/83] debug: trace tokens --- .../src/Distribution/Fields/Parser.hs | 21 ++++++++++++------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 78ff4fcf38e..c5d2cf954d0 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -73,10 +73,11 @@ mkLexState' st = type Parser a = ParsecT LexState' () Identity a instance Stream LexState' Identity LToken where + -- DEBUG(leana8959): remove tracing uncons (LexState' _ (tok, st')) = case tok of - L _ EOF -> return Nothing - _ -> return $ Just (tok, st') + L _ EOF -> return $ trace "[x] Got token EOF" Nothing + _ -> return (trace ("[x] Got token tok " ++ show tok) $ Just (tok, st')) -- | Get lexer warnings accumulated so far getLexerWarnings :: Parser [LexWarning] @@ -236,11 +237,13 @@ cabalStyleFile = do return es commentsAround :: (a -> [Field Position]) -> Parser a -> Parser [Field Position] -commentsAround f p = do - pre <- many tokComment - res <- p - post <- many tokComment - pure $ pre <> f res <> post +commentsAround f p = + -- DEBUG(leana8959): + fmap (\x -> trace ("[y]" <> show x) x) $ + mconcat + [ try (many tokComment <> fmap f p) + , many tokComment + ] -- Elements that live at the top level or inside a section, i.e. fields -- and sections content @@ -390,7 +393,9 @@ readFields' s = do parse parser "the input" lexSt where parser = do - fields <- cabalStyleFile + fields <- + fmap (\x -> trace ("[readFields']" <> show x) x) + cabalStyleFile ws <- getLexerWarnings -- lexer accumulates warnings in reverse (consing them to the list) pure (fields, reverse ws ++ checkIndentation fields []) From e5d0e91b50d7c20e34283e4362bbefa77661cd06 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 8 Oct 2025 17:58:02 +0800 Subject: [PATCH 15/83] fix: split comments recursively --- Cabal-syntax/src/Distribution/FieldGrammar.hs | 21 ++++++++++++------- .../Distribution/PackageDescription/Parsec.hs | 17 +++++++++++++-- 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index 690226fe049..8341aeb0432 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -26,6 +26,7 @@ module Distribution.FieldGrammar , Section (..) , Fields , partitionFields + , splitComments , takeFields , runFieldParser , runFieldParser' @@ -103,17 +104,21 @@ partitionFields = finalize . foldl' f (PS mempty mempty mempty) -- | Take all fields from the front. -- Returns a tuple containing the comments, nameless fields, and sections -takeFields :: Ord ann => [Field ann] -> (Map ann ByteString, (Fields ann, [Field ann])) -takeFields = - Bi.bimap Map.fromList (finalize . spanMaybe match) - . splitComments +takeFields :: Ord ann => [Field ann] -> (Fields ann, [Field ann]) +takeFields = finalize . spanMaybe match where finalize (fs, rest) = (Map.fromListWith (flip (++)) fs, rest) match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs]) match _ = Nothing - splitComments = partitionEithers . map f - where - f (Comment cmt ann) = Left (ann, cmt) - f field = Right field +splitComments :: Ord ann => [Field ann] -> (Map.Map ann ByteString, [Field ann]) +splitComments = finalize . foldl' (flip go) (mempty, []) + where + finalize = Bi.second reverse + + go (Comment cmt ann) = Bi.first $ Map.insert ann cmt + go (Section name args fs) = + let (cs', fs') = splitComments fs + in Bi.bimap ( cs' <> ) ( Section name args fs' : ) + go field = Bi.second (field :) diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index f3cb96cf1f1..f7cabe4ed1c 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} -- | -- Module : Distribution.PackageDescription.Parsec @@ -157,8 +158,20 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do parseWarnings (toPWarnings lexWarnings) for_ utf8WarnPos $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos - let (syntax, fs') = sectionizeFields fs - let (comments, (fields, sectionFields)) = takeFields fs' + + -- DEBUG(leana8959): + + let (comments, fs') = + (\(u, v) -> trace ( + "[pGPD'/fs]" <> show fs <> "\n" + <> "[pGPD'/comments]" <> show u <> "\n" <> "[pGPD'/fs'']" <> show v + ) (u, v)) + $ splitComments fs + + let (syntax, fs'') = sectionizeFields fs' + let (fields, sectionFields) = + (\(u, v) -> trace ("[pGPD'/fields]" <> show u <> "\n" <> "[pGPD'/sectionFields]" <> show v) (u, v)) + $ takeFields fs'' -- cabal-version specVer <- case scannedVer of From a4455b3ab4c76218e65a84ceb874295eda62ef59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 8 Oct 2025 18:13:26 +0800 Subject: [PATCH 16/83] fix: consume comments after colon in FieldLayoutOrBraces --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index c5d2cf954d0..65a9246dd51 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -252,7 +252,7 @@ commentsAround f p = elements :: IndentLevel -> Parser [Field Position] elements ilevel = do -- TODO: check if syntaxically any element can be surrounded by cabal - groups <- many (commentsAround (\f -> [f]) $ element ilevel) + groups <- many (commentsAround id $ element ilevel) pure $ mconcat groups -- An individual element, ie a field or a section. These can either use @@ -261,7 +261,7 @@ elements ilevel = do -- -- element ::= '\\n' name elementInLayoutContext -- | name elementInNonLayoutContext -element :: IndentLevel -> Parser (Field Position) +element :: IndentLevel -> Parser [Field Position] element ilevel = ( do ilevel' <- indentOfAtLeast ilevel @@ -270,7 +270,7 @@ element ilevel = ) <|> ( do name <- fieldSecName - elementInNonLayoutContext name + (\f -> [f]) <$> elementInNonLayoutContext name ) -- An element (field or section) that is valid in a layout context. @@ -279,13 +279,13 @@ element ilevel = -- -- elementInLayoutContext ::= ':' fieldLayoutOrBraces -- | arg* sectionLayoutOrBraces -elementInLayoutContext :: IndentLevel -> Name Position -> Parser (Field Position) +elementInLayoutContext :: IndentLevel -> Name Position -> Parser [Field Position] elementInLayoutContext ilevel name = - (do colon; fieldLayoutOrBraces ilevel name) + (do colon; commentsAround (\f -> [f]) (fieldLayoutOrBraces ilevel name)) <|> ( do args <- many sectionArg elems <- sectionLayoutOrBraces ilevel - return (Section name args elems) + return [Section name args elems] ) -- An element (field or section) that is valid in a non-layout context. From 3bf77b23bb7331fa6924f8d7ccdcbee5eb86161a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 8 Oct 2025 18:15:18 +0800 Subject: [PATCH 17/83] debug: remove tracing --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 5 ++--- .../src/Distribution/PackageDescription/Parsec.hs | 14 ++------------ 2 files changed, 4 insertions(+), 15 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 65a9246dd51..d766b419a57 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -73,11 +73,10 @@ mkLexState' st = type Parser a = ParsecT LexState' () Identity a instance Stream LexState' Identity LToken where - -- DEBUG(leana8959): remove tracing uncons (LexState' _ (tok, st')) = case tok of - L _ EOF -> return $ trace "[x] Got token EOF" Nothing - _ -> return (trace ("[x] Got token tok " ++ show tok) $ Just (tok, st')) + L _ EOF -> return Nothing + _ -> return $ Just (tok, st') -- | Get lexer warnings accumulated so far getLexerWarnings :: Parser [LexWarning] diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index f7cabe4ed1c..99b1c0b33af 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -159,19 +159,9 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do for_ utf8WarnPos $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos - -- DEBUG(leana8959): - - let (comments, fs') = - (\(u, v) -> trace ( - "[pGPD'/fs]" <> show fs <> "\n" - <> "[pGPD'/comments]" <> show u <> "\n" <> "[pGPD'/fs'']" <> show v - ) (u, v)) - $ splitComments fs - + let (comments, fs') = splitComments fs let (syntax, fs'') = sectionizeFields fs' - let (fields, sectionFields) = - (\(u, v) -> trace ("[pGPD'/fields]" <> show u <> "\n" <> "[pGPD'/sectionFields]" <> show v) (u, v)) - $ takeFields fs'' + let (fields, sectionFields) = takeFields fs'' -- cabal-version specVer <- case scannedVer of From 29bf6afda2b10b3d6736aaad0236ac711aabbe83 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 8 Oct 2025 18:19:34 +0800 Subject: [PATCH 18/83] test: update expected --- .../ParserTests/regressions/Octree-0.5.expr | 6 +++- .../ParserTests/regressions/big-version.expr | 9 ++++-- .../regressions/common-conditional.expr | 7 ++++- .../ParserTests/regressions/common2.expr | 10 ++++++- .../ParserTests/regressions/common3.expr | 5 +++- .../ParserTests/regressions/encoding-0.8.expr | 18 ++++++++++-- .../ParserTests/regressions/issue-5055.expr | 9 +++++- .../ParserTests/regressions/issue-6083-a.expr | 6 +++- .../ParserTests/regressions/issue-6083-b.expr | 6 +++- .../ParserTests/regressions/issue-6083-c.expr | 6 +++- .../regressions/issue-6083-pkg-pkg.expr | 6 +++- .../ParserTests/regressions/issue-774.expr | 15 ++++++++-- .../regressions/jaeger-flamegraph.expr | 6 +++- .../regressions/leading-comma-2.expr | 6 +++- .../tests/ParserTests/regressions/libpq1.expr | 28 ++++++++++++++++++- .../tests/ParserTests/regressions/libpq2.expr | 28 ++++++++++++++++++- .../tests/ParserTests/regressions/shake.expr | 15 +++++++++- 17 files changed, 166 insertions(+), 20 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr index 2145b4817c0..d0d83ef636d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr +++ b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr @@ -402,4 +402,8 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 40 1) + " -- We have a symlink: README.lhs -> README.md"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/big-version.expr b/Cabal-tests/tests/ParserTests/regressions/big-version.expr index 4d3659e4592..13a4ed20b8e 100644 --- a/Cabal-tests/tests/ParserTests/regressions/big-version.expr +++ b/Cabal-tests/tests/ParserTests/regressions/big-version.expr @@ -53,11 +53,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -111,4 +111,9 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList + [ + _×_ + (Position 3 1) + "-- 9 digits"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr index 6574797f6ed..eb1beac92c5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr @@ -714,4 +714,9 @@ GenericPackageDescription { condBranchIfFalse = Nothing}]}, condBranchIfFalse = Nothing}]}], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = + Map.fromList + [ + _×_ + (Position 37 1) + " -- buildable fields verify that we don't have duplicate field warnings"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/common2.expr b/Cabal-tests/tests/ParserTests/regressions/common2.expr index a44fe3289b4..619105e1778 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common2.expr @@ -751,4 +751,12 @@ GenericPackageDescription { condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = + Map.fromList + [ + _×_ + (Position 31 1) + "-- .expr should show libVisible: False", + _×_ + (Position 44 1) + " -- buildable fields verify that we don't have duplicate field warnings"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/common3.expr b/Cabal-tests/tests/ParserTests/regressions/common3.expr index 57042cfdd1f..5d7b52aabc7 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common3.expr @@ -238,4 +238,7 @@ GenericPackageDescription { [ _×_ (Position 7 1) - "-- note: empty field"]} + "-- note: empty field", + _×_ + (Position 23 1) + " -- not first: will be omitted and generate warning"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr index 02c4a4222c7..96b0566376e 100644 --- a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr +++ b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr @@ -67,11 +67,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -145,4 +145,18 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList + [ + _×_ + (Position 5 1) + "-- double-dash files", + _×_ + (Position 7 1) + " -- this is comment", + _×_ + (Position 17 1) + " -- version range round trip is better", + _×_ + (Position 23 1) + " -- options with spaces"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr index ba0d82a1ec5..bc77dbc2767 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr @@ -287,4 +287,11 @@ GenericPackageDescription { condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 16 1) + " -- TODO: fix so `type` can be on the top level", + _×_ + (Position 25 1) + " -- type: exitcode-stdio-1.0"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr index d944b6020c2..ba8980ea840 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr @@ -383,4 +383,8 @@ GenericPackageDescription { condTreeComponents = []}], condTestSuites = [], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 7 1) + " -- This should be parsed as the main lib"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr index 5749f6b53ca..87747149e4a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr @@ -393,4 +393,8 @@ GenericPackageDescription { condTreeComponents = []}], condTestSuites = [], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 7 1) + " -- This should be parsed as the main lib"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr index b9cce7f5dac..90fd4acb275 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr @@ -207,4 +207,8 @@ GenericPackageDescription { condExecutables = [], condTestSuites = [], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 7 1) + " -- This should be parsed as the main lib"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr index dc662dcb6b4..1d2235dd53a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr @@ -126,4 +126,8 @@ GenericPackageDescription { condExecutables = [], condTestSuites = [], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 7 1) + " -- This should be parsed as the main lib"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr index 4aeb65cb960..18257cbc664 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr @@ -61,11 +61,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -123,4 +123,15 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList + [ + _×_ + (Position 12 1) + "-- we test that check warns about this", + _×_ + (Position 19 1) + " -- Test for round-trip of ghc-options here too", + _×_ + (Position 20 1) + " -- See https://github.com/haskell/cabal/issues/2661"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr index f4277963bdf..28f4e2c285f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr +++ b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr @@ -478,4 +478,8 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 32 1) + "-- https://www.haskell.org/cabal/users-guide/cabal-projectindex.html"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr index 6b5cc34c836..38db86582b9 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr @@ -168,4 +168,8 @@ GenericPackageDescription { condExecutables = [], condTestSuites = [], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 10 1) + " -- empty field on purpose"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr index d5ad800e7f6..89f1a0a8114 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr @@ -767,4 +767,30 @@ GenericPackageDescription { condExecutables = [], condTestSuites = [], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = + Map.fromList + [ + _×_ + (Position 42 1) + "-- If true, use pkg-config, otherwise use the pg_config based build", + _×_ + (Position 43 1) + "-- configuration", + _×_ + (Position 69 1) + " -- Due to https://sourceware.org/bugzilla/show_bug.cgi?id=22948,", + _×_ + (Position 70 1) + " -- if we specify pq instead of libpq, then ld might link against", + _×_ + (Position 71 1) + " -- libpq.dll directly, which can lead to segfaults. As a temporary hack,", + _×_ + (Position 72 1) + " -- we force ld to link against the libpq.lib import library directly", + _×_ + (Position 73 1) + " -- by specifying libpq here.", + _×_ + (Position 80 1) + " -- Other-modules:"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr index 5d8360f7a0b..bfce7bbf678 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr @@ -769,4 +769,30 @@ GenericPackageDescription { condExecutables = [], condTestSuites = [], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = + Map.fromList + [ + _×_ + (Position 42 1) + "-- If true, use pkg-config, otherwise use the pg_config based build", + _×_ + (Position 43 1) + "-- configuration", + _×_ + (Position 69 1) + " -- Due to https://sourceware.org/bugzilla/show_bug.cgi?id=22948,", + _×_ + (Position 70 1) + " -- if we specify pq instead of libpq, then ld might link against", + _×_ + (Position 71 1) + " -- libpq.dll directly, which can lead to segfaults. As a temporary hack,", + _×_ + (Position 72 1) + " -- we force ld to link against the libpq.lib import library directly", + _×_ + (Position 73 1) + " -- by specifying libpq here.", + _×_ + (Position 80 1) + " -- Other-modules:"]} diff --git a/Cabal-tests/tests/ParserTests/regressions/shake.expr b/Cabal-tests/tests/ParserTests/regressions/shake.expr index 2711787a719..17cb4e52735 100644 --- a/Cabal-tests/tests/ParserTests/regressions/shake.expr +++ b/Cabal-tests/tests/ParserTests/regressions/shake.expr @@ -2502,4 +2502,17 @@ GenericPackageDescription { condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 83 1) + " -- dot directory on own row", + _×_ + (Position 176 1) + " -- GHC bug 7646 means -threaded causes errors", + _×_ + (Position 274 1) + " -- space leak introduced by -O1 in 7.4, see #445", + _×_ + (Position 277 1) + " -- GHC bug 7646 (fixed in 7.8) means -threaded causes errors"]} From 0a887c57add54b4fd31d55f5557d69753943ad2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 8 Oct 2025 18:40:29 +0800 Subject: [PATCH 19/83] test: improve comment tests --- Cabal-tests/tests/ParserTests.hs | 37 +++++++++++-------- .../comments/layout-many-sections.cabal | 31 ++++++++++++++++ .../comments/layout-many-sections.expr | 17 +++++++++ .../comments/layout-nosections-after.cabal | 8 ++++ .../comments/layout-nosections-after.expr | 5 +++ .../comments/layout-nosections-before.cabal | 8 ++++ .../comments/layout-nosections-before.expr | 5 +++ .../comments/layout-nosections-mixed.cabal | 12 ++++++ .../comments/layout-nosections-mixed.expr | 14 +++++++ .../comments/nosections-after.cabal | 4 -- .../comments/nosections-before.cabal | 4 -- .../comments/nosections-mixed.cabal | 11 ------ 12 files changed, 122 insertions(+), 34 deletions(-) create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-many-sections.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-nosections-after.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-nosections-after.expr create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-nosections-before.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-nosections-before.expr create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-nosections-mixed.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-nosections-mixed.expr delete mode 100644 Cabal-tests/tests/ParserTests/comments/nosections-after.cabal delete mode 100644 Cabal-tests/tests/ParserTests/comments/nosections-before.cabal delete mode 100644 Cabal-tests/tests/ParserTests/comments/nosections-mixed.cabal diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 7643ba4bead..7516c16d683 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -10,13 +10,11 @@ import Test.Tasty import Test.Tasty.Golden.Advanced (goldenTest) import Test.Tasty.HUnit -import Control.Monad (unless, void, when) +import Control.Monad (unless, void) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) import Data.Maybe (isNothing) import Distribution.Fields (pwarning) import Distribution.PackageDescription (GenericPackageDescription(exactComments)) -import Distribution.Types.GenericPackageDescription(ExactComments) -import Distribution.Parsec.Position (Position) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.Parsec (PWarnType (..), PWarning (..), showPErrorWithSource, showPWarningWithSource) @@ -102,25 +100,34 @@ warningTest wt fp = testCase (show wt) $ do -- comment ------------------------------------------------------------------------------- + +#ifdef MIN_VERSION_tree_diff -- Verify that comments are parsed correctly commentTests :: TestTree commentTests = testGroup "comments" - [ commentTest "nosections-before.cabal" mempty - , commentTest "nosections-after.cabal" mempty - , commentTest "nosections-mixed.cabal" mempty + [ commentTest "layout-nosections-before.cabal" + , commentTest "layout-nosections-after.cabal" + , commentTest "layout-nosections-mixed.cabal" + , commentTest "layout-many-sections.cabal" ] -commentTest :: FilePath -> ExactComments Position -> TestTree -commentTest fp expected = testCase fp $ do - contents <- BS.readFile $ "tests" "ParserTests" "comments" fp +commentTest :: FilePath -> TestTree +commentTest fp = ediffGolden goldenTest "comment expr" exprFile $ do + contents <- BS.readFile input + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents + let (warns, x) = runParseResult res - let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents - let (warns, x) = runParseResult res + unless (null warns) (fail $ show warns) - when (not $ null warns) (assertFailure $ "got warning: " ++ show warns) - case x of - Right output -> assertEqual "exact comments" (exactComments output) expected - Left _ -> assertFailure "parser failed." + case x of + Right output -> pure $ toExpr (exactComments output) + Left (v, errs) -> + fail $ + unlines $ ("VERSION: " ++ show v) : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) + where + input = "tests" "ParserTests" "comments" fp + exprFile = replaceExtension input "expr" +#endif ------------------------------------------------------------------------------- -- Errors diff --git a/Cabal-tests/tests/ParserTests/comments/layout-many-sections.cabal b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.cabal new file mode 100644 index 00000000000..1c25236714a --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.cabal @@ -0,0 +1,31 @@ +cabal-version: 2.2 +name: common +version: 0 + -- comment 1 +synopsis: Common-stanza demo demo +build-type: Simple + +source-repository head + Type: git + -- comment 2 + Location: https://github.com/hvr/-.git + +common windows + if os(windows) + build-depends: Win32 + +common deps + build-depends: + base >=4.10 && <4.11, + containers + +library + import: deps + + -- comment 3 + default-language: Haskell2010 + exposed-modules: ElseIf +-- comment 4 + + build-depends: -- comment 5 + ghc-prim diff --git a/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr new file mode 100644 index 00000000000..ed943971ae5 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr @@ -0,0 +1,17 @@ +Map.fromList + [ + _×_ + (Position 4 1) + " -- comment 1", + _×_ + (Position 10 1) + " -- comment 2", + _×_ + (Position 25 1) + " -- comment 3", + _×_ + (Position 28 1) + "-- comment 4", + _×_ + (Position 30 18) + "-- still a comment"] diff --git a/Cabal-tests/tests/ParserTests/comments/layout-nosections-after.cabal b/Cabal-tests/tests/ParserTests/comments/layout-nosections-after.cabal new file mode 100644 index 00000000000..a60e3734a22 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-nosections-after.cabal @@ -0,0 +1,8 @@ +name: comment-after-nameless-field +version: 1 +cabal-version: >= 1.8 +-- comment after + +library + build-depends: + base >= 4 diff --git a/Cabal-tests/tests/ParserTests/comments/layout-nosections-after.expr b/Cabal-tests/tests/ParserTests/comments/layout-nosections-after.expr new file mode 100644 index 00000000000..e758db9d2ea --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-nosections-after.expr @@ -0,0 +1,5 @@ +Map.fromList + [ + _×_ + (Position 4 1) + "-- comment after"] diff --git a/Cabal-tests/tests/ParserTests/comments/layout-nosections-before.cabal b/Cabal-tests/tests/ParserTests/comments/layout-nosections-before.cabal new file mode 100644 index 00000000000..e08cfc2fdd1 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-nosections-before.cabal @@ -0,0 +1,8 @@ +-- comment before +name: comment-before-nameless-field +version: 1 +cabal-version: >= 1.8 + +library + build-depends: + base >= 4 diff --git a/Cabal-tests/tests/ParserTests/comments/layout-nosections-before.expr b/Cabal-tests/tests/ParserTests/comments/layout-nosections-before.expr new file mode 100644 index 00000000000..b3216d5c8f8 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-nosections-before.expr @@ -0,0 +1,5 @@ +Map.fromList + [ + _×_ + (Position 1 1) + "-- comment before"] diff --git a/Cabal-tests/tests/ParserTests/comments/layout-nosections-mixed.cabal b/Cabal-tests/tests/ParserTests/comments/layout-nosections-mixed.cabal new file mode 100644 index 00000000000..b3c9f48a7ca --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-nosections-mixed.cabal @@ -0,0 +1,12 @@ +-- comment before + +name: comment-after-nameless-field + -- comment within +version: 1 + -- another comment within +cabal-version: >= 1.8 +-- comment after + +library + build-depends: + base >= 4 diff --git a/Cabal-tests/tests/ParserTests/comments/layout-nosections-mixed.expr b/Cabal-tests/tests/ParserTests/comments/layout-nosections-mixed.expr new file mode 100644 index 00000000000..01bccdeef5c --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-nosections-mixed.expr @@ -0,0 +1,14 @@ +Map.fromList + [ + _×_ + (Position 1 1) + "-- comment before", + _×_ + (Position 4 1) + " -- comment within", + _×_ + (Position 6 1) + " -- another comment within", + _×_ + (Position 8 1) + "-- comment after"] diff --git a/Cabal-tests/tests/ParserTests/comments/nosections-after.cabal b/Cabal-tests/tests/ParserTests/comments/nosections-after.cabal deleted file mode 100644 index 6a1fc5402f9..00000000000 --- a/Cabal-tests/tests/ParserTests/comments/nosections-after.cabal +++ /dev/null @@ -1,4 +0,0 @@ -name: bom -version: 1 -cabal-version: >= 1.8 --- comment after diff --git a/Cabal-tests/tests/ParserTests/comments/nosections-before.cabal b/Cabal-tests/tests/ParserTests/comments/nosections-before.cabal deleted file mode 100644 index c482b210316..00000000000 --- a/Cabal-tests/tests/ParserTests/comments/nosections-before.cabal +++ /dev/null @@ -1,4 +0,0 @@ --- comment before -name: bom -version: 1 -cabal-version: >= 1.8 diff --git a/Cabal-tests/tests/ParserTests/comments/nosections-mixed.cabal b/Cabal-tests/tests/ParserTests/comments/nosections-mixed.cabal deleted file mode 100644 index 3002fc3ceb3..00000000000 --- a/Cabal-tests/tests/ParserTests/comments/nosections-mixed.cabal +++ /dev/null @@ -1,11 +0,0 @@ - --- comment before -name: bom - --- comment within surrounded by blanks - -version: 1 - -- comment within -cabal-version: >= 1.8 - --- comment after From 3fc392cdf7cbbeb8b7238aa2122d17a1e35fffea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 10:20:38 +0800 Subject: [PATCH 20/83] test: correct comment tests --- Cabal-tests/tests/ParserTests.hs | 6 +++--- .../tests/ParserTests/comments/layout-many-sections.expr | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 7516c16d683..644ae4e2f88 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -112,9 +112,9 @@ commentTests = testGroup "comments" ] commentTest :: FilePath -> TestTree -commentTest fp = ediffGolden goldenTest "comment expr" exprFile $ do +commentTest fname = ediffGolden goldenTest fname exprFile $ do contents <- BS.readFile input - let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents + let res = withSource (PCabalFile (input, contents)) $ parseGenericPackageDescription contents let (warns, x) = runParseResult res unless (null warns) (fail $ show warns) @@ -125,7 +125,7 @@ commentTest fp = ediffGolden goldenTest "comment expr" exprFile $ do fail $ unlines $ ("VERSION: " ++ show v) : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) where - input = "tests" "ParserTests" "comments" fp + input = "tests" "ParserTests" "comments" fname exprFile = replaceExtension input "expr" #endif diff --git a/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr index ed943971ae5..0d85d780573 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr @@ -14,4 +14,4 @@ Map.fromList "-- comment 4", _×_ (Position 30 18) - "-- still a comment"] + "-- comment 5"] From 2287f93876c4745b5426ee5be17f48fbe3680ee1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 10:36:23 +0800 Subject: [PATCH 21/83] test: assert interleaving comment parsing --- Cabal-tests/tests/ParserTests.hs | 5 +++- .../layout-interleaved-in-section.cabal | 24 +++++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.cabal diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 644ae4e2f88..024ab8706c3 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -109,6 +109,7 @@ commentTests = testGroup "comments" , commentTest "layout-nosections-after.cabal" , commentTest "layout-nosections-mixed.cabal" , commentTest "layout-many-sections.cabal" + , commentTest "layout-interleaved-in-section.cabal" ] commentTest :: FilePath -> TestTree @@ -117,7 +118,9 @@ commentTest fname = ediffGolden goldenTest fname exprFile $ do let res = withSource (PCabalFile (input, contents)) $ parseGenericPackageDescription contents let (warns, x) = runParseResult res - unless (null warns) (fail $ show warns) + unless (null warns) (fail $ + unlines (map (showPWarningWithSource . fmap renderCabalFileSource) warns) + ) case x of Right output -> pure $ toExpr (exactComments output) diff --git a/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.cabal b/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.cabal new file mode 100644 index 00000000000..4feeab2659a --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.cabal @@ -0,0 +1,24 @@ +cabal-version: 2.2 +name: common +version: 0 +synopsis: Common-stanza demo +build-type: Simple + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +common deps + build-depends: + -- foo + base >=4.10 && <4.11, + -- bar + containers + -- baz + +library + import: deps + default-language: Haskell2010 + exposed-modules: ElseIf + build-depends: + ghc-prim From a61a9e8435072e0535389b24af4bee11ecf8a091 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 11:00:25 +0800 Subject: [PATCH 22/83] fix: correct interleaving comment parsing --- .../src/Distribution/Fields/Parser.hs | 39 +++++++++++++------ .../layout-interleaved-in-section.expr | 1 + 2 files changed, 28 insertions(+), 12 deletions(-) create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.expr diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index d766b419a57..23a53fa8460 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -76,6 +76,7 @@ instance Stream LexState' Identity LToken where uncons (LexState' _ (tok, st')) = case tok of L _ EOF -> return Nothing + -- L _ (TokComment {}) -> return Nothing _ -> return $ Just (tok, st') -- | Get lexer warnings accumulated so far @@ -235,14 +236,21 @@ cabalStyleFile = do eof return es +commentsAfter :: Show a => Parser a -> Parser (a, [Field Position]) +commentsAfter p = + -- DEBUG(leana8959): + fmap (\x -> trace ("[y]" <> show x) x) $ + liftA2 (,) p (many tokComment) + commentsAround :: (a -> [Field Position]) -> Parser a -> Parser [Field Position] commentsAround f p = -- DEBUG(leana8959): fmap (\x -> trace ("[y]" <> show x) x) $ - mconcat - [ try (many tokComment <> fmap f p) - , many tokComment - ] + mconcat + [ many tokComment + , fmap f p + , many tokComment + ] -- Elements that live at the top level or inside a section, i.e. fields -- and sections content @@ -280,7 +288,7 @@ element ilevel = -- | arg* sectionLayoutOrBraces elementInLayoutContext :: IndentLevel -> Name Position -> Parser [Field Position] elementInLayoutContext ilevel name = - (do colon; commentsAround (\f -> [f]) (fieldLayoutOrBraces ilevel name)) + (do colon; commentsAround id (fieldLayoutOrBraces ilevel name)) <|> ( do args <- many sectionArg elems <- sectionLayoutOrBraces ilevel @@ -309,20 +317,27 @@ elementInNonLayoutContext name = -- -- fieldLayoutOrBraces ::= '\\n'? '{' content '}' -- | line? ('\\n' line)* -fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser (Field Position) +fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser [Field Position] fieldLayoutOrBraces ilevel name = braces <|> fieldLayout where braces = do openBrace - ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent) + preCmts <- many tokComment + (ls, postCmtsGroups) <- unzip <$> inLexerMode (LexerMode in_field_braces) (many $ commentsAfter fieldContent) closeBrace - return (Field name ls) + return $ preCmts <> [Field name ls] <> mconcat postCmtsGroups fieldLayout = inLexerMode (LexerMode in_field_layout) $ do + preCmts <- many tokComment l <- optionMaybe fieldContent - ls <- many (do _ <- indentOfAtLeast ilevel; fieldContent) - return $ case l of - Nothing -> Field name ls - Just l' -> Field name (l' : ls) + (ls, postCmtsGroups) <- unzip <$> many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) + return $ + mconcat + [ preCmts + , case l of + Nothing -> [Field name ls] + Just l' -> [Field name (l' : ls)] + , mconcat postCmtsGroups + ] -- The body of a section, using either layout style or braces style. -- diff --git a/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.expr b/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.expr new file mode 100644 index 00000000000..af4054bdf4f --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.expr @@ -0,0 +1 @@ +Map.fromList [] From d5769d97420bef7087ad87efdb5d922fc5b7b90c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 11:13:26 +0800 Subject: [PATCH 23/83] test: update expected --- .../layout-interleaved-in-section.expr | 12 +- .../ParserTests/regressions/hasktorch.expr | 137 +++++++++++++++--- 2 files changed, 129 insertions(+), 20 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.expr b/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.expr index af4054bdf4f..eabe7ac1e8b 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-interleaved-in-section.expr @@ -1 +1,11 @@ -Map.fromList [] +Map.fromList + [ + _×_ + (Position 13 1) + " -- foo", + _×_ + (Position 15 1) + " -- bar", + _×_ + (Position 17 1) + " -- baz"] diff --git a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr index 9dfa089a3d5..ef7c0b4ace2 100644 --- a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr +++ b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr @@ -268,11 +268,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -603,11 +603,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -848,11 +848,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1051,11 +1051,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1391,11 +1391,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2713,11 +2713,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2805,11 +2805,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -5034,11 +5034,11 @@ GenericPackageDescription { cppOptions = [ "-DCUDA", "-DHASKTORCH_INTERNAL_CUDA"], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -6406,11 +6406,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -6499,11 +6499,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -8169,11 +8169,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -8660,11 +8660,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9426,11 +9426,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9549,11 +9549,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9657,11 +9657,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9765,11 +9765,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9862,11 +9862,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9960,11 +9960,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -10245,4 +10245,103 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = + Map.fromList + [ + _×_ + (Position 2 1) + "-- ================================================================ --", + _×_ + (Position 3 1) + "-- ======== This cabal file has been modified from dhall ========== --", + _×_ + (Position 4 1) + "-- ======== This constitutes the 0.0.1.0 release. ========== --", + _×_ + (Position 5 1) + "-- ======== Dhall can generate this file, but will never ========== --", + _×_ + (Position 6 1) + "-- ======== be able to upload to hackage. For more, see: ========== --", + _×_ + (Position 7 1) + "-- ==== https://github.com/haskell/hackage-server/issues/795 ====== --", + _×_ + (Position 8 1) + "-- ================================================================ --", + _×_ + (Position 70 1) + " -- containers ==0.5.10 || >0.5.10,", + _×_ + (Position 71 1) + " -- deepseq ==1.3.0 || >1.3.0,", + _×_ + (Position 73 1) + " -- managed (==1.0.0 || >1.0.0) && <1.1,", + _×_ + (Position 74 1) + " -- microlens ==0.4.8 || >0.4.8,", + _×_ + (Position 75 1) + " -- numeric-limits ==0.1.0 || >0.1.0,", + _×_ + (Position 79 1) + " -- typelits-witnesses ==0.2.3 || >0.2.3,", + _×_ + (Position 84 1) + " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", + _×_ + (Position 85 1) + " -- BEGIN EDITS", + _×_ + (Position 86 1) + " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", + _×_ + (Position 148 1) + " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", + _×_ + (Position 149 1) + " -- END EDITS", + _×_ + (Position 150 1) + " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", + _×_ + (Position 203 1) + " -- containers ==0.5.10 || >0.5.10,", + _×_ + (Position 204 1) + " -- deepseq ==1.3.0 || >1.3.0,", + _×_ + (Position 208 1) + " -- managed (==1.0.0 || >1.0.0) && <1.1,", + _×_ + (Position 209 1) + " -- microlens ==0.4.8 || >0.4.8,", + _×_ + (Position 210 1) + " -- numeric-limits ==0.1.0 || >0.1.0,", + _×_ + (Position 214 1) + " -- typelits-witnesses ==0.2.3 || >0.2.3,", + _×_ + (Position 282 1) + " -- containers ==0.5.10 || >0.5.10,", + _×_ + (Position 283 1) + " -- deepseq ==1.3.0 || >1.3.0,", + _×_ + (Position 287 1) + " -- managed (==1.0.0 || >1.0.0) && <1.1,", + _×_ + (Position 288 1) + " -- microlens ==0.4.8 || >0.4.8,", + _×_ + (Position 289 1) + " -- numeric-limits ==0.1.0 || >0.1.0,", + _×_ + (Position 293 1) + " -- typelits-witnesses ==0.2.3 || >0.2.3,", + _×_ + (Position 551 1) + " -- text ==1.2.2 || >1.2.2,"]} From bc9bd4034b9969ef80483fd67b8f7c38678ed54e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 11:18:11 +0800 Subject: [PATCH 24/83] debug: remove tracing --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 23a53fa8460..9f5f3e793d7 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -238,14 +238,10 @@ cabalStyleFile = do commentsAfter :: Show a => Parser a -> Parser (a, [Field Position]) commentsAfter p = - -- DEBUG(leana8959): - fmap (\x -> trace ("[y]" <> show x) x) $ liftA2 (,) p (many tokComment) commentsAround :: (a -> [Field Position]) -> Parser a -> Parser [Field Position] commentsAround f p = - -- DEBUG(leana8959): - fmap (\x -> trace ("[y]" <> show x) x) $ mconcat [ many tokComment , fmap f p @@ -407,9 +403,7 @@ readFields' s = do parse parser "the input" lexSt where parser = do - fields <- - fmap (\x -> trace ("[readFields']" <> show x) x) - cabalStyleFile + fields <- cabalStyleFile ws <- getLexerWarnings -- lexer accumulates warnings in reverse (consing them to the list) pure (fields, reverse ws ++ checkIndentation fields []) From 8ad684efb6e9dd6949e98ac5c4f15a9fdd2f8f2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 16:31:59 +0800 Subject: [PATCH 25/83] test: assert parsing of fieldline flag --- Cabal-tests/tests/ParserTests.hs | 1 + .../comments/layout-fieldline-is-flag.cabal | 13 + .../comments/layout-fieldline-is-flag.expr | 1 + Cabal/Cabal.cabal | 762 +++++++++--------- 4 files changed, 378 insertions(+), 399 deletions(-) create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.expr diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 024ab8706c3..d3d4dea8032 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -110,6 +110,7 @@ commentTests = testGroup "comments" , commentTest "layout-nosections-mixed.cabal" , commentTest "layout-many-sections.cabal" , commentTest "layout-interleaved-in-section.cabal" + , commentTest "layout-fieldline-is-flag.cabal" ] commentTest :: FilePath -> TestTree diff --git a/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.cabal b/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.cabal new file mode 100644 index 00000000000..adaebc31379 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.cabal @@ -0,0 +1,13 @@ +cabal-version: 2.2 +name: common +version: 0 +synopsis: Common-stanza demo +build-type: Simple + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + x-doctest-options: --preserve-it + -- The previous thing shouldn't be parsed as a comment because it's a flag + -- This however, is a comment + ghc-options: -Wall -threaded diff --git a/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.expr b/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.expr new file mode 100644 index 00000000000..af4054bdf4f --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.expr @@ -0,0 +1 @@ +Map.fromList [] diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 97e8c0d2811..3300d883ffb 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -1,419 +1,383 @@ -cabal-version: 3.6 -name: Cabal -version: 3.17.0.0 -copyright: 2003-2025, Cabal Development Team (see AUTHORS file) -license: BSD-3-Clause -license-file: LICENSE -author: Cabal Development Team -maintainer: cabal-devel@haskell.org -homepage: http://www.haskell.org/cabal/ -bug-reports: https://github.com/haskell/cabal/issues -synopsis: A framework for packaging Haskell software +cabal-version: 3.6 +name: Cabal +version: 3.17.0.0 +license: BSD-3-Clause +license-file: LICENSE +copyright: 2003-2025, Cabal Development Team (see AUTHORS file) +maintainer: cabal-devel@haskell.org +author: Cabal Development Team +homepage: http://www.haskell.org/cabal/ +bug-reports: https://github.com/haskell/cabal/issues +synopsis: A framework for packaging Haskell software description: - The Haskell Common Architecture for Building Applications and - Libraries: a framework defining a common interface for authors to more - easily build their Haskell applications in a portable way. - . - The Haskell Cabal is part of a larger infrastructure for distributing, - organizing, and cataloging Haskell libraries and tools. -category: Distribution -build-type: Simple --- If we use a new Cabal feature, this needs to be changed to Custom so --- we can bootstrap. + The Haskell Common Architecture for Building Applications and + Libraries: a framework defining a common interface for authors to more + easily build their Haskell applications in a portable way. + . + The Haskell Cabal is part of a larger infrastructure for distributing, + organizing, and cataloging Haskell libraries and tools. +category: Distribution +build-type: Simple extra-doc-files: - README.md ChangeLog.md + README.md + ChangeLog.md source-repository head - type: git - location: https://github.com/haskell/cabal/ - subdir: Cabal + type: git + location: https://github.com/haskell/cabal/ + subdir: Cabal flag git-rev - description: include Git revision hash in version - default: False - manual: True + description: include Git revision hash in version + default: False + manual: True library - default-language: Haskell2010 - hs-source-dirs: src + exposed-modules: + Distribution.Backpack.Configure + Distribution.Backpack.ComponentsGraph + Distribution.Backpack.ConfiguredComponent + Distribution.Backpack.DescribeUnitId + Distribution.Backpack.FullUnitId + Distribution.Backpack.LinkedComponent + Distribution.Backpack.ModSubst + Distribution.Backpack.ModuleShape + Distribution.Backpack.PreModuleShape + Distribution.Utils.IOData + Distribution.Utils.LogProgress + Distribution.Utils.MapAccum + Distribution.Compat.CreatePipe + Distribution.Compat.Directory + Distribution.Compat.Environment + Distribution.Compat.FilePath + Distribution.Compat.Internal.TempFile + Distribution.Compat.ResponseFile + Distribution.Compat.Prelude.Internal + Distribution.Compat.Process + Distribution.Compat.Stack + Distribution.Compat.Time + Distribution.Make + Distribution.PackageDescription.Check + Distribution.ReadE + Distribution.Simple + Distribution.Simple.Bench + Distribution.Simple.Build + Distribution.Simple.Build.Inputs + Distribution.Simple.Build.Macros + Distribution.Simple.Build.PackageInfoModule + Distribution.Simple.Build.PathsModule + Distribution.Simple.BuildPaths + Distribution.Simple.BuildTarget + Distribution.Simple.BuildToolDepends + Distribution.Simple.BuildWay + Distribution.Simple.CCompiler + Distribution.Simple.Command + Distribution.Simple.Compiler + Distribution.Simple.Configure + Distribution.Simple.Errors + Distribution.Simple.FileMonitor.Types + Distribution.Simple.Flag + Distribution.Simple.GHC + Distribution.Simple.GHCJS + Distribution.Simple.Haddock + Distribution.Simple.Glob + Distribution.Simple.Glob.Internal + Distribution.Simple.Hpc + Distribution.Simple.Install + Distribution.Simple.InstallDirs + Distribution.Simple.InstallDirs.Internal + Distribution.Simple.LocalBuildInfo + Distribution.Simple.PackageDescription + Distribution.Simple.PackageIndex + Distribution.Simple.PreProcess + Distribution.Simple.PreProcess.Types + Distribution.Simple.PreProcess.Unlit + Distribution.Simple.Program + Distribution.Simple.Program.Ar + Distribution.Simple.Program.Builtin + Distribution.Simple.Program.Db + Distribution.Simple.Program.Find + Distribution.Simple.Program.GHC + Distribution.Simple.Program.HcPkg + Distribution.Simple.Program.Hpc + Distribution.Simple.Program.Internal + Distribution.Simple.Program.Ld + Distribution.Simple.Program.ResponseFile + Distribution.Simple.Program.Run + Distribution.Simple.Program.Script + Distribution.Simple.Program.Strip + Distribution.Simple.Program.Types + Distribution.Simple.Register + Distribution.Simple.Setup + Distribution.Simple.ShowBuildInfo + Distribution.Simple.SrcDist + Distribution.Simple.Test + Distribution.Simple.Test.ExeV10 + Distribution.Simple.Test.LibV09 + Distribution.Simple.Test.Log + Distribution.Simple.UHC + Distribution.Simple.UserHooks + Distribution.Simple.SetupHooks.Errors + Distribution.Simple.SetupHooks.Internal + Distribution.Simple.SetupHooks.Rule + Distribution.Simple.Utils + Distribution.TestSuite + Distribution.Types.AnnotatedId + Distribution.Types.ComponentInclude + Distribution.Types.DumpBuildInfo + Distribution.Types.PackageName.Magic + Distribution.Types.ComponentLocalBuildInfo + Distribution.Types.LocalBuildConfig + Distribution.Types.LocalBuildInfo + Distribution.Types.TargetInfo + Distribution.Types.GivenComponent + Distribution.Types.ParStrat + Distribution.Utils.Json + Distribution.Utils.NubList + Distribution.Utils.Progress + Distribution.Verbosity + Distribution.Verbosity.Internal - build-depends: - , Cabal-syntax ^>= 3.17 - , array >= 0.4.0.1 && < 0.6 - , base >= 4.13 && < 5 - , bytestring >= 0.10.0.0 && < 0.13 - , containers >= 0.5.0.0 && < 0.9 - , deepseq >= 1.3.0.1 && < 1.7 - , directory >= 1.2 && < 1.4 - , filepath >= 1.3.0.1 && < 1.6 - , pretty >= 1.1.1 && < 1.2 - , process >= 1.2.1.0 && < 1.7 - , time >= 1.4.0.1 && < 1.16 + reexported-modules: + Distribution.Backpack, + Distribution.CabalSpecVersion, + Distribution.Compat.Binary, + Distribution.Compat.CharParsing, + Distribution.Compat.DList, + Distribution.Compat.Exception, + Distribution.Compat.Graph, + Distribution.Compat.Lens, + Distribution.Compat.MonadFail, + Distribution.Compat.Newtype, + Distribution.Compat.NonEmptySet, + Distribution.Compat.Parsing, + Distribution.Compat.Prelude, + Distribution.Compat.Semigroup, + Distribution.Compiler, + Distribution.FieldGrammar, + Distribution.FieldGrammar.Class, + Distribution.FieldGrammar.FieldDescrs, + Distribution.FieldGrammar.Newtypes, + Distribution.FieldGrammar.Parsec, + Distribution.FieldGrammar.Pretty, + Distribution.Fields, + Distribution.Fields.ConfVar, + Distribution.Fields.Field, + Distribution.Fields.Lexer, + Distribution.Fields.LexerMonad, + Distribution.Fields.ParseResult, + Distribution.Fields.Parser, + Distribution.Fields.Pretty, + Distribution.InstalledPackageInfo, + Distribution.License, + Distribution.ModuleName, + Distribution.Package, + Distribution.PackageDescription, + Distribution.PackageDescription.Configuration, + Distribution.PackageDescription.FieldGrammar, + Distribution.PackageDescription.Parsec, + Distribution.PackageDescription.PrettyPrint, + Distribution.PackageDescription.Quirks, + Distribution.PackageDescription.Utils, + Distribution.Parsec, + Distribution.Parsec.Error, + Distribution.Parsec.FieldLineStream, + Distribution.Parsec.Position, + Distribution.Parsec.Warning, + Distribution.Pretty, + Distribution.SPDX, + Distribution.SPDX.License, + Distribution.SPDX.LicenseExceptionId, + Distribution.SPDX.LicenseExpression, + Distribution.SPDX.LicenseId, + Distribution.SPDX.LicenseListVersion, + Distribution.SPDX.LicenseReference, + Distribution.System, + Distribution.Text, + Distribution.Types.AbiDependency, + Distribution.Types.AbiHash, + Distribution.Types.Benchmark, + Distribution.Types.Benchmark.Lens, + Distribution.Types.BenchmarkInterface, + Distribution.Types.BenchmarkType, + Distribution.Types.BuildInfo, + Distribution.Types.BuildInfo.Lens, + Distribution.Types.BuildType, + Distribution.Types.Component, + Distribution.Types.ComponentId, + Distribution.Types.ComponentName, + Distribution.Types.ComponentRequestedSpec, + Distribution.Types.CondTree, + Distribution.Types.Condition, + Distribution.Types.ConfVar, + Distribution.Types.Dependency, + Distribution.Types.DependencyMap, + Distribution.Types.DependencySatisfaction, + Distribution.Types.ExeDependency, + Distribution.Types.Executable, + Distribution.Types.Executable.Lens, + Distribution.Types.ExecutableScope, + Distribution.Types.ExposedModule, + Distribution.Types.Flag, + Distribution.Types.ForeignLib, + Distribution.Types.ForeignLib.Lens, + Distribution.Types.ForeignLibOption, + Distribution.Types.ForeignLibType, + Distribution.Types.GenericPackageDescription, + Distribution.Types.GenericPackageDescription.Lens, + Distribution.Types.HookedBuildInfo, + Distribution.Types.IncludeRenaming, + Distribution.Types.InstalledPackageInfo, + Distribution.Types.InstalledPackageInfo.Lens, + Distribution.Types.InstalledPackageInfo.FieldGrammar, + Distribution.Types.LegacyExeDependency, + Distribution.Types.Lens, + Distribution.Types.Library, + Distribution.Types.Library.Lens, + Distribution.Types.LibraryName, + Distribution.Types.LibraryVisibility, + Distribution.Types.MissingDependency, + Distribution.Types.MissingDependencyReason, + Distribution.Types.Mixin, + Distribution.Types.Module, + Distribution.Types.ModuleReexport, + Distribution.Types.ModuleRenaming, + Distribution.Types.MungedPackageId, + Distribution.Types.MungedPackageName, + Distribution.Types.PackageDescription, + Distribution.Types.PackageDescription.Lens, + Distribution.Types.PackageId, + Distribution.Types.PackageId.Lens, + Distribution.Types.PackageName, + Distribution.Types.PackageVersionConstraint, + Distribution.Types.PkgconfigDependency, + Distribution.Types.PkgconfigName, + Distribution.Types.PkgconfigVersion, + Distribution.Types.PkgconfigVersionRange, + Distribution.Types.SetupBuildInfo, + Distribution.Types.SetupBuildInfo.Lens, + Distribution.Types.SourceRepo, + Distribution.Types.SourceRepo.Lens, + Distribution.Types.TestSuite, + Distribution.Types.TestSuite.Lens, + Distribution.Types.TestSuiteInterface, + Distribution.Types.TestType, + Distribution.Types.UnitId, + Distribution.Types.UnqualComponentName, + Distribution.Types.Version, + Distribution.Types.VersionInterval, + Distribution.Types.VersionInterval.Legacy, + Distribution.Types.VersionRange, + Distribution.Types.VersionRange.Internal, + Distribution.Utils.Base62, + Distribution.Utils.Generic, + Distribution.Utils.MD5, + Distribution.Utils.Path, + Distribution.Utils.ShortText, + Distribution.Utils.String, + Distribution.Utils.Structured, + Distribution.Version, + Language.Haskell.Extension - if os(windows) - build-depends: - , Win32 >= 2.3.0.0 && < 2.15 - else - build-depends: - , unix >= 2.8.6.0 && < 2.9 - - if flag(git-rev) - build-depends: - , githash ^>= 0.1.7.0 - cpp-options: -DGIT_REV - - ghc-options: - -Wall - -fno-ignore-asserts - -Wtabs - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wno-unticked-promoted-constructors + hs-source-dirs: src + other-modules: + Distribution.Backpack.PreExistingComponent + Distribution.Backpack.ReadyComponent + Distribution.Backpack.MixLink + Distribution.Backpack.ModuleScope + Distribution.Backpack.UnifyM + Distribution.Backpack.Id + Distribution.Utils.UnionFind + Distribution.Compat.Async + Distribution.Compat.CopyFile + Distribution.Compat.GetShortPathName + Distribution.Compat.SnocList + Distribution.GetOpt + Distribution.Lex + Distribution.PackageDescription.Check.Common + Distribution.PackageDescription.Check.Conditional + Distribution.PackageDescription.Check.Monad + Distribution.PackageDescription.Check.Paths + Distribution.PackageDescription.Check.Target + Distribution.PackageDescription.Check.Warning + Distribution.Simple.Build.Macros.Z + Distribution.Simple.Build.PackageInfoModule.Z + Distribution.Simple.Build.PathsModule.Z + Distribution.Simple.GHC.Build + Distribution.Simple.GHC.Build.ExtraSources + Distribution.Simple.GHC.Build.Link + Distribution.Simple.GHC.Build.Modules + Distribution.Simple.GHC.Build.Utils + Distribution.Simple.GHC.EnvironmentParser + Distribution.Simple.GHC.Internal + Distribution.Simple.GHC.ImplInfo + Distribution.Simple.ConfigureScript + Distribution.Simple.Setup.Benchmark + Distribution.Simple.Setup.Build + Distribution.Simple.Setup.Clean + Distribution.Simple.Setup.Common + Distribution.Simple.Setup.Config + Distribution.Simple.Setup.Copy + Distribution.Simple.Setup.Global + Distribution.Simple.Setup.Haddock + Distribution.Simple.Setup.Hscolour + Distribution.Simple.Setup.Install + Distribution.Simple.Setup.Register + Distribution.Simple.Setup.Repl + Distribution.Simple.Setup.SDist + Distribution.Simple.Setup.Test + Distribution.ZinzaPrelude + Paths_Cabal - if impl(ghc >= 8.0) - ghc-options: -Wcompat -Wnoncanonical-monad-instances + autogen-modules: Paths_Cabal + default-language: Haskell2010 + other-extensions: + BangPatterns CPP DefaultSignatures DeriveDataTypeable + DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable + ExistentialQuantification FlexibleContexts FlexibleInstances + GeneralizedNewtypeDeriving ImplicitParams KindSignatures LambdaCase + NondecreasingIndentation OverloadedStrings PatternSynonyms + RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving + Trustworthy TypeFamilies TypeOperators TypeSynonymInstances + UndecidableInstances - if impl(ghc >= 8.0) && impl(ghc < 8.8) - ghc-options: -Wnoncanonical-monadfail-instances + ghc-options: + -Wall -fno-ignore-asserts -Wtabs -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wno-unticked-promoted-constructors - if impl(ghc >= 9.14) - ghc-options: -Wno-pattern-namespace-specifier -Wno-incomplete-record-selectors + build-depends: + Cabal-syntax ^>=3.17, + array >=0.4.0.1 && <0.6, + base >=4.13 && <5, + bytestring >=0.10.0.0 && <0.13, + containers >=0.5.0.0 && <0.9, + deepseq >=1.3.0.1 && <1.7, + directory >=1.2 && <1.4, + filepath >=1.3.0.1 && <1.6, + pretty >=1.1.1 && <1.2, + process >=1.2.1.0 && <1.7, + time >=1.4.0.1 && <1.16, + transformers >=0.3 && <0.4 || >=0.4.1.0 && <0.7, + mtl >=2.1 && <2.4, + parsec >=3.1.13.0 && <3.2 - exposed-modules: - Distribution.Backpack.Configure - Distribution.Backpack.ComponentsGraph - Distribution.Backpack.ConfiguredComponent - Distribution.Backpack.DescribeUnitId - Distribution.Backpack.FullUnitId - Distribution.Backpack.LinkedComponent - Distribution.Backpack.ModSubst - Distribution.Backpack.ModuleShape - Distribution.Backpack.PreModuleShape - Distribution.Utils.IOData - Distribution.Utils.LogProgress - Distribution.Utils.MapAccum - Distribution.Compat.CreatePipe - Distribution.Compat.Directory - Distribution.Compat.Environment - Distribution.Compat.FilePath - Distribution.Compat.Internal.TempFile - Distribution.Compat.ResponseFile - Distribution.Compat.Prelude.Internal - Distribution.Compat.Process - Distribution.Compat.Stack - Distribution.Compat.Time - Distribution.Make - Distribution.PackageDescription.Check - Distribution.ReadE - Distribution.Simple - Distribution.Simple.Bench - Distribution.Simple.Build - Distribution.Simple.Build.Inputs - Distribution.Simple.Build.Macros - Distribution.Simple.Build.PackageInfoModule - Distribution.Simple.Build.PathsModule - Distribution.Simple.BuildPaths - Distribution.Simple.BuildTarget - Distribution.Simple.BuildToolDepends - Distribution.Simple.BuildWay - Distribution.Simple.CCompiler - Distribution.Simple.Command - Distribution.Simple.Compiler - Distribution.Simple.Configure - Distribution.Simple.Errors - Distribution.Simple.FileMonitor.Types - Distribution.Simple.Flag - Distribution.Simple.GHC - Distribution.Simple.GHCJS - Distribution.Simple.Haddock - Distribution.Simple.Glob - Distribution.Simple.Glob.Internal - Distribution.Simple.Hpc - Distribution.Simple.Install - Distribution.Simple.InstallDirs - Distribution.Simple.InstallDirs.Internal - Distribution.Simple.LocalBuildInfo - Distribution.Simple.PackageDescription - Distribution.Simple.PackageIndex - Distribution.Simple.PreProcess - Distribution.Simple.PreProcess.Types - Distribution.Simple.PreProcess.Unlit - Distribution.Simple.Program - Distribution.Simple.Program.Ar - Distribution.Simple.Program.Builtin - Distribution.Simple.Program.Db - Distribution.Simple.Program.Find - Distribution.Simple.Program.GHC - Distribution.Simple.Program.HcPkg - Distribution.Simple.Program.Hpc - Distribution.Simple.Program.Internal - Distribution.Simple.Program.Ld - Distribution.Simple.Program.ResponseFile - Distribution.Simple.Program.Run - Distribution.Simple.Program.Script - Distribution.Simple.Program.Strip - Distribution.Simple.Program.Types - Distribution.Simple.Register - Distribution.Simple.Setup - Distribution.Simple.ShowBuildInfo - Distribution.Simple.SrcDist - Distribution.Simple.Test - Distribution.Simple.Test.ExeV10 - Distribution.Simple.Test.LibV09 - Distribution.Simple.Test.Log - Distribution.Simple.UHC - Distribution.Simple.UserHooks - Distribution.Simple.SetupHooks.Errors - Distribution.Simple.SetupHooks.Internal - Distribution.Simple.SetupHooks.Rule - Distribution.Simple.Utils - Distribution.TestSuite - Distribution.Types.AnnotatedId - Distribution.Types.ComponentInclude - Distribution.Types.DumpBuildInfo - Distribution.Types.PackageName.Magic - Distribution.Types.ComponentLocalBuildInfo - Distribution.Types.LocalBuildConfig - Distribution.Types.LocalBuildInfo - Distribution.Types.TargetInfo - Distribution.Types.GivenComponent - Distribution.Types.ParStrat - Distribution.Utils.Json - Distribution.Utils.NubList - Distribution.Utils.Progress - Distribution.Verbosity - Distribution.Verbosity.Internal + if os(windows) + build-depends: Win32 >=2.3.0.0 && <2.15 - -- We reexport all of Cabal-syntax to aid in compatibility for downstream - -- users. In the future we may opt to deprecate some or all of these exports. - -- See haskell/Cabal#7974. - reexported-modules: - Distribution.Backpack, - Distribution.CabalSpecVersion, - Distribution.Compat.Binary, - Distribution.Compat.CharParsing, - Distribution.Compat.DList, - Distribution.Compat.Exception, - Distribution.Compat.Graph, - Distribution.Compat.Lens, - Distribution.Compat.MonadFail, - Distribution.Compat.Newtype, - Distribution.Compat.NonEmptySet, - Distribution.Compat.Parsing, - Distribution.Compat.Prelude, - Distribution.Compat.Semigroup, - Distribution.Compiler, - Distribution.FieldGrammar, - Distribution.FieldGrammar.Class, - Distribution.FieldGrammar.FieldDescrs, - Distribution.FieldGrammar.Newtypes, - Distribution.FieldGrammar.Parsec, - Distribution.FieldGrammar.Pretty, - Distribution.Fields, - Distribution.Fields.ConfVar, - Distribution.Fields.Field, - Distribution.Fields.Lexer, - Distribution.Fields.LexerMonad, - Distribution.Fields.ParseResult, - Distribution.Fields.Parser, - Distribution.Fields.Pretty, - Distribution.InstalledPackageInfo, - Distribution.License, - Distribution.ModuleName, - Distribution.Package, - Distribution.PackageDescription, - Distribution.PackageDescription.Configuration, - Distribution.PackageDescription.FieldGrammar, - Distribution.PackageDescription.Parsec, - Distribution.PackageDescription.PrettyPrint, - Distribution.PackageDescription.Quirks, - Distribution.PackageDescription.Utils, - Distribution.Parsec, - Distribution.Parsec.Error, - Distribution.Parsec.FieldLineStream, - Distribution.Parsec.Position, - Distribution.Parsec.Warning, - Distribution.Pretty, - Distribution.SPDX, - Distribution.SPDX.License, - Distribution.SPDX.LicenseExceptionId, - Distribution.SPDX.LicenseExpression, - Distribution.SPDX.LicenseId, - Distribution.SPDX.LicenseListVersion, - Distribution.SPDX.LicenseReference, - Distribution.System, - Distribution.Text, - Distribution.Types.AbiDependency, - Distribution.Types.AbiHash, - Distribution.Types.Benchmark, - Distribution.Types.Benchmark.Lens, - Distribution.Types.BenchmarkInterface, - Distribution.Types.BenchmarkType, - Distribution.Types.BuildInfo, - Distribution.Types.BuildInfo.Lens, - Distribution.Types.BuildType, - Distribution.Types.Component, - Distribution.Types.ComponentId, - Distribution.Types.ComponentName, - Distribution.Types.ComponentRequestedSpec, - Distribution.Types.CondTree, - Distribution.Types.Condition, - Distribution.Types.ConfVar, - Distribution.Types.Dependency, - Distribution.Types.DependencyMap, - Distribution.Types.DependencySatisfaction, - Distribution.Types.ExeDependency, - Distribution.Types.Executable, - Distribution.Types.Executable.Lens, - Distribution.Types.ExecutableScope, - Distribution.Types.ExposedModule, - Distribution.Types.Flag, - Distribution.Types.ForeignLib, - Distribution.Types.ForeignLib.Lens, - Distribution.Types.ForeignLibOption, - Distribution.Types.ForeignLibType, - Distribution.Types.GenericPackageDescription, - Distribution.Types.GenericPackageDescription.Lens, - Distribution.Types.HookedBuildInfo, - Distribution.Types.IncludeRenaming, - Distribution.Types.InstalledPackageInfo, - Distribution.Types.InstalledPackageInfo.Lens, - Distribution.Types.InstalledPackageInfo.FieldGrammar, - Distribution.Types.LegacyExeDependency, - Distribution.Types.Lens, - Distribution.Types.Library, - Distribution.Types.Library.Lens, - Distribution.Types.LibraryName, - Distribution.Types.LibraryVisibility, - Distribution.Types.MissingDependency, - Distribution.Types.MissingDependencyReason, - Distribution.Types.Mixin, - Distribution.Types.Module, - Distribution.Types.ModuleReexport, - Distribution.Types.ModuleRenaming, - Distribution.Types.MungedPackageId, - Distribution.Types.MungedPackageName, - Distribution.Types.PackageDescription, - Distribution.Types.PackageDescription.Lens, - Distribution.Types.PackageId, - Distribution.Types.PackageId.Lens, - Distribution.Types.PackageName, - Distribution.Types.PackageVersionConstraint, - Distribution.Types.PkgconfigDependency, - Distribution.Types.PkgconfigName, - Distribution.Types.PkgconfigVersion, - Distribution.Types.PkgconfigVersionRange, - Distribution.Types.SetupBuildInfo, - Distribution.Types.SetupBuildInfo.Lens, - Distribution.Types.SourceRepo, - Distribution.Types.SourceRepo.Lens, - Distribution.Types.TestSuite, - Distribution.Types.TestSuite.Lens, - Distribution.Types.TestSuiteInterface, - Distribution.Types.TestType, - Distribution.Types.UnitId, - Distribution.Types.UnqualComponentName, - Distribution.Types.Version, - Distribution.Types.VersionInterval, - Distribution.Types.VersionInterval.Legacy, - Distribution.Types.VersionRange, - Distribution.Types.VersionRange.Internal, - Distribution.Utils.Base62, - Distribution.Utils.Generic, - Distribution.Utils.MD5, - Distribution.Utils.Path, - Distribution.Utils.ShortText, - Distribution.Utils.String, - Distribution.Utils.Structured, - Distribution.Version, - Language.Haskell.Extension + else + build-depends: unix >=2.8.6.0 && <2.9 - -- Parsec parser-related modules - build-depends: - -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity - -- See also https://github.com/ekmett/transformers-compat/issues/35 - , transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.7) - , mtl >= 2.1 && < 2.4 - , parsec >= 3.1.13.0 && < 3.2 + if flag(git-rev) + cpp-options: -DGIT_REV + build-depends: githash ^>=0.1.7.0 - other-modules: - Distribution.Backpack.PreExistingComponent - Distribution.Backpack.ReadyComponent - Distribution.Backpack.MixLink - Distribution.Backpack.ModuleScope - Distribution.Backpack.UnifyM - Distribution.Backpack.Id - Distribution.Utils.UnionFind - Distribution.Compat.Async - Distribution.Compat.CopyFile - Distribution.Compat.GetShortPathName - Distribution.Compat.SnocList - Distribution.GetOpt - Distribution.Lex - Distribution.PackageDescription.Check.Common - Distribution.PackageDescription.Check.Conditional - Distribution.PackageDescription.Check.Monad - Distribution.PackageDescription.Check.Paths - Distribution.PackageDescription.Check.Target - Distribution.PackageDescription.Check.Warning - Distribution.Simple.Build.Macros.Z - Distribution.Simple.Build.PackageInfoModule.Z - Distribution.Simple.Build.PathsModule.Z - Distribution.Simple.GHC.Build - Distribution.Simple.GHC.Build.ExtraSources - Distribution.Simple.GHC.Build.Link - Distribution.Simple.GHC.Build.Modules - Distribution.Simple.GHC.Build.Utils - Distribution.Simple.GHC.EnvironmentParser - Distribution.Simple.GHC.Internal - Distribution.Simple.GHC.ImplInfo - Distribution.Simple.ConfigureScript - Distribution.Simple.Setup.Benchmark - Distribution.Simple.Setup.Build - Distribution.Simple.Setup.Clean - Distribution.Simple.Setup.Common - Distribution.Simple.Setup.Config - Distribution.Simple.Setup.Copy - Distribution.Simple.Setup.Global - Distribution.Simple.Setup.Haddock - Distribution.Simple.Setup.Hscolour - Distribution.Simple.Setup.Install - Distribution.Simple.Setup.Register - Distribution.Simple.Setup.Repl - Distribution.Simple.Setup.SDist - Distribution.Simple.Setup.Test - Distribution.ZinzaPrelude - Paths_Cabal + if impl(ghc >=8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances - autogen-modules: - Paths_Cabal + if (impl(ghc >=8.0) && impl(ghc <8.8)) + ghc-options: -Wnoncanonical-monadfail-instances - other-extensions: - BangPatterns - CPP - DefaultSignatures - DeriveDataTypeable - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveTraversable - ExistentialQuantification - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving - ImplicitParams - KindSignatures - LambdaCase - NondecreasingIndentation - OverloadedStrings - PatternSynonyms - RankNTypes - RecordWildCards - ScopedTypeVariables - StandaloneDeriving - Trustworthy - TypeFamilies - TypeOperators - TypeSynonymInstances - UndecidableInstances + if impl(ghc >=9.14) + ghc-options: + -Wno-pattern-namespace-specifier -Wno-incomplete-record-selectors From f1abd475ba5e50138bc8191cd19cf2cebbe43b78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 16:50:26 +0800 Subject: [PATCH 26/83] test: update expected --- .../ParserTests/regressions/generics-sop.expr | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr index a7cdf1a4300..6e4ab92f3ea 100644 --- a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr +++ b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr @@ -163,11 +163,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -334,11 +334,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -421,11 +421,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -526,11 +526,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -599,11 +599,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -673,11 +673,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -771,11 +771,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -852,4 +852,5 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = []} + condBenchmarks = [], + exactComments = Map.fromList []} From 70177ee9abfadf4bdf16bf23091befb360d98952 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 17:31:04 +0800 Subject: [PATCH 27/83] fix: correct parsing fieldLine starting with -- as comment --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 9f5f3e793d7..9b9e6b3646d 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -284,7 +284,7 @@ element ilevel = -- | arg* sectionLayoutOrBraces elementInLayoutContext :: IndentLevel -> Name Position -> Parser [Field Position] elementInLayoutContext ilevel name = - (do colon; commentsAround id (fieldLayoutOrBraces ilevel name)) + (do colon; fieldLayoutOrBraces ilevel name) <|> ( do args <- many sectionArg elems <- sectionLayoutOrBraces ilevel From dc92b2433fcf29301a0ae5f9be75092c856e05ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 17:31:29 +0800 Subject: [PATCH 28/83] test: update expected --- .../ParserTests/comments/layout-fieldline-is-flag.expr | 9 ++++++++- .../tests/ParserTests/regressions/generics-sop.expr | 6 +++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.expr b/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.expr index af4054bdf4f..22fa101117f 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-fieldline-is-flag.expr @@ -1 +1,8 @@ -Map.fromList [] +Map.fromList + [ + _×_ + (Position 11 1) + " -- The previous thing shouldn't be parsed as a comment because it's a flag", + _×_ + (Position 12 1) + " -- This however, is a comment"] diff --git a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr index 6e4ab92f3ea..d3077802425 100644 --- a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr +++ b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr @@ -853,4 +853,8 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condBenchmarks = [], - exactComments = Map.fromList []} + exactComments = Map.fromList + [ + _×_ + (Position 58 1) + " -- exposed via Generics.SOP:"]} From 9091f3be80a82580c633e3d517161a1ec07e7431 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 17:35:49 +0800 Subject: [PATCH 29/83] test: remove test case that doesn't pass on upstream --- .../tests/ParserTests/comments/layout-many-sections.cabal | 2 +- .../tests/ParserTests/comments/layout-many-sections.expr | 5 +---- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/comments/layout-many-sections.cabal b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.cabal index 1c25236714a..4c67a264192 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-many-sections.cabal +++ b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.cabal @@ -27,5 +27,5 @@ library exposed-modules: ElseIf -- comment 4 - build-depends: -- comment 5 + build-depends: ghc-prim diff --git a/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr index 0d85d780573..766117a5762 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-many-sections.expr @@ -11,7 +11,4 @@ Map.fromList " -- comment 3", _×_ (Position 28 1) - "-- comment 4", - _×_ - (Position 30 18) - "-- comment 5"] + "-- comment 4"] From c42a3ba52bdeda0aced8549ed9477b221348695c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Thu, 9 Oct 2025 18:02:16 +0800 Subject: [PATCH 30/83] minor fixes --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 2 +- Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 9b9e6b3646d..2ff409049bf 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -428,7 +428,7 @@ checkIndentation' :: Position -> [Field Position] -> [LexWarning] -> [LexWarning checkIndentation' _ [] = id checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation' (nameAnn name) fs' checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation' _ (Comment {} : fs') = id +checkIndentation' _ (Comment {} : _fs') = id -- | Check that positions' columns are the same. checkIndentation'' :: Position -> Position -> [LexWarning] -> [LexWarning] diff --git a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs index 15c2c15fe09..4017920cbee 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs @@ -237,6 +237,7 @@ pdToGpd pd = , condExecutables = mkCondTree' exeName <$> executables pd , condTestSuites = mkCondTree' testName <$> testSuites pd , condBenchmarks = mkCondTree' benchmarkName <$> benchmarks pd + , exactComments = mempty -- We preserve the behaviour of "drop all comments" for now } where -- We set CondTree's [Dependency] to an empty list, as it From 834d03b51e809f674ea8940732d95d4d9538538a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 08:50:45 +0800 Subject: [PATCH 31/83] test: ignore comment in test comparison --- Cabal-tests/tests/ParserTests.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index d3d4dea8032..44b16dc484a 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -292,7 +292,8 @@ formatRoundTripTest fp = testCase "roundtrip" $ do -- previously we mangled licenses a bit let y' = y {- FOURMOLU_DISABLE -} - unless (x == y') $ + -- we disable comparison on exactComments for now because we can't print it yet + unless (x { exactComments = mempty } == y') $ #ifdef MIN_VERSION_tree_diff assertFailure $ unlines [ "re-parsed doesn't match" From 13bc3a8113ea6dca40b2973d14f0d2088c5dcf63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 11:02:34 +0800 Subject: [PATCH 32/83] docs: improve comments on the grammar --- .../src/Distribution/Fields/Parser.hs | 52 +++++++++++-------- 1 file changed, 29 insertions(+), 23 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 2ff409049bf..8da75f6a2ab 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -171,6 +171,8 @@ indentOfAtLeast (IndentLevel i) = try $ do newtype LexerMode = LexerMode Int +-- | This would change the state of the lexer and make interpretations of tokens different! +-- Certain lexer states are unreachable without it. inLexerMode :: LexerMode -> Parser p -> Parser p inLexerMode (LexerMode mode) p = do setLexerMode mode; x <- p; setLexerMode in_section; return x @@ -178,39 +180,43 @@ inLexerMode (LexerMode mode) p = ----------------------- -- Cabal file grammar -- +-- The non-terminals of the following grammar (symbols starting in uppercase) +-- have their corresponding parser of the same name, starting with lowercase +-- letter. -- $grammar -- -- @ --- CabalStyleFile ::= SecElems +-- CabalStyleFile ::= Elements -- --- SecElems ::= SecElem* '\\n'? --- SecElem ::= '\\n' SecElemLayout | SecElemBraces --- SecElemLayout ::= FieldLayout | FieldBraces | SectionLayout | SectionBraces --- SecElemBraces ::= FieldInline | FieldBraces | SectionBraces --- FieldLayout ::= name ':' line? ('\\n' line)* --- FieldBraces ::= name ':' '\\n'? '{' content '}' --- FieldInline ::= name ':' content --- SectionLayout ::= name arg* SecElems --- SectionBraces ::= name arg* '\\n'? '{' SecElems '}' +-- Elements ::= Elements* '\\n'? +-- Element ::= '\\n' ElementInLayoutContext +-- | ElementInNonLayoutContext +-- ElementInLayoutContext ::= FieldLayout | FieldBraces | SectionLayout | SectionBraces +-- ElementInNonLayoutContext ::= FieldInline | FieldBraces | SectionBraces +-- FieldLayout ::= name ':' line? ('\\n' line)* +-- FieldBraces ::= name ':' '\\n'? '{' content '}' +-- FieldInline ::= name ':' content +-- SectionLayout ::= name arg* Elements +-- SectionBraces ::= name arg* '\\n'? '{' Elements '}' -- @ -- -- and the same thing but left factored... -- -- @ --- SecElems ::= SecElem* --- SecElem ::= '\\n' name SecElemLayout --- | name SecElemBraces --- SecElemLayout ::= ':' FieldLayoutOrBraces --- | arg* SectionLayoutOrBraces --- FieldLayoutOrBraces ::= '\\n'? '{' content '}' --- | line? ('\\n' line)* --- SectionLayoutOrBraces ::= '\\n'? '{' SecElems '\\n'? '}' --- | SecElems --- SecElemBraces ::= ':' FieldInlineOrBraces --- | arg* '\\n'? '{' SecElems '\\n'? '}' --- FieldInlineOrBraces ::= '\\n'? '{' content '}' --- | content +-- Elements ::= Element* +-- Element ::= '\\n' name ElementInLayoutContext +-- | name ElementInNonLayoutContext +-- ElementInLayoutContext ::= ':' FieldLayoutOrBraces +-- | arg* SectionLayoutOrBraces +-- FieldLayoutOrBraces ::= '\\n'? '{' content '}' +-- | line? ('\\n' line)* +-- SectionLayoutOrBraces ::= '\\n'? '{' Elements '\\n'? '}' +-- | Elements +-- ElementInNonLayoutContext ::= ':' FieldInlineOrBraces +-- | arg* '\\n'? '{' Elements '\\n'? '}' +-- FieldInlineOrBraces ::= '\\n'? '{' content '}' +-- | content -- @ -- -- Note how we have several productions with the sequence: From b4546bf0bc2882464ae8b73c9617bfa4bc85c626 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 11:07:38 +0800 Subject: [PATCH 33/83] style: whitespace --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 8da75f6a2ab..46d4c5d3519 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -372,7 +372,7 @@ fieldInlineOrBraces name = ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent)) return (Field name ls) ) - + -- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST. -- From c965a0642eac7d568ac252645dcf02e3bfb32b73 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 11:09:28 +0800 Subject: [PATCH 34/83] style: fourmolu --- Cabal-syntax/src/Distribution/FieldGrammar.hs | 6 +++--- Cabal-syntax/src/Distribution/Fields/Parser.hs | 17 ++++++++--------- .../Distribution/PackageDescription/Parsec.hs | 5 +++-- .../src/Distribution/Parsec/Position.hs | 4 ++-- .../Types/GenericPackageDescription.hs | 2 +- 5 files changed, 17 insertions(+), 17 deletions(-) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index 8341aeb0432..bab8ac3f867 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -39,8 +39,8 @@ module Distribution.FieldGrammar import Distribution.Compat.Prelude import Prelude () -import Data.ByteString (ByteString) import qualified Data.Bifunctor as Bi +import Data.ByteString (ByteString) import qualified Data.Map.Strict as Map import Distribution.FieldGrammar.Class @@ -100,7 +100,7 @@ partitionFields = finalize . foldl' f (PS mempty mempty mempty) | otherwise = reverse s : ss f (PS fs s ss) (Section name sargs sfields) = PS fs (MkSection name sargs sfields : s) ss - f ps (Comment {}) = ps + f ps (Comment{}) = ps -- | Take all fields from the front. -- Returns a tuple containing the comments, nameless fields, and sections @@ -120,5 +120,5 @@ splitComments = finalize . foldl' (flip go) (mempty, []) go (Comment cmt ann) = Bi.first $ Map.insert ann cmt go (Section name args fs) = let (cs', fs') = splitComments fs - in Bi.bimap ( cs' <> ) ( Section name args fs' : ) + in Bi.bimap (cs' <>) (Section name args fs' :) go field = Bi.second (field :) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 46d4c5d3519..224b8afaf28 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -244,15 +244,15 @@ cabalStyleFile = do commentsAfter :: Show a => Parser a -> Parser (a, [Field Position]) commentsAfter p = - liftA2 (,) p (many tokComment) + liftA2 (,) p (many tokComment) commentsAround :: (a -> [Field Position]) -> Parser a -> Parser [Field Position] commentsAround f p = - mconcat - [ many tokComment - , fmap f p - , many tokComment - ] + mconcat + [ many tokComment + , fmap f p + , many tokComment + ] -- Elements that live at the top level or inside a section, i.e. fields -- and sections content @@ -373,7 +373,6 @@ fieldInlineOrBraces name = return (Field name ls) ) - -- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST. -- -- 'readFields' assumes that input 'B8.ByteString' is valid UTF8, specifically it doesn't validate that file is valid UTF8. @@ -427,14 +426,14 @@ checkIndentation :: [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation [] = id checkIndentation (Field name _ : fs') = checkIndentation' (nameAnn name) fs' checkIndentation (Section name _ fs : fs') = checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation (Comment {} : fs') = checkIndentation fs' +checkIndentation (Comment{} : fs') = checkIndentation fs' -- | We compare adjacent fields to reduce the amount of reported indentation warnings. checkIndentation' :: Position -> [Field Position] -> [LexWarning] -> [LexWarning] checkIndentation' _ [] = id checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation' (nameAnn name) fs' checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation' _ (Comment {} : _fs') = id +checkIndentation' _ (Comment{} : _fs') = id -- | Check that positions' columns are the same. checkIndentation'' :: Position -> Position -> [LexWarning] -> [LexWarning] diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 99b1c0b33af..4409f39024b 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -1,8 +1,8 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE BangPatterns #-} -- | -- Module : Distribution.PackageDescription.Parsec @@ -205,7 +205,8 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do -- Sections let gpd = emptyGenericPackageDescription - { exactComments = comments } + { exactComments = comments + } & L.packageDescription .~ pd gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty) diff --git a/Cabal-syntax/src/Distribution/Parsec/Position.hs b/Cabal-syntax/src/Distribution/Parsec/Position.hs index 76ba444ab84..3a80b1d87cc 100644 --- a/Cabal-syntax/src/Distribution/Parsec/Position.hs +++ b/Cabal-syntax/src/Distribution/Parsec/Position.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Distribution.Parsec.Position ( Position (..) diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index f55567b1620..2f2eac7b3a7 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -13,8 +13,8 @@ module Distribution.Types.GenericPackageDescription import Distribution.Compat.Prelude import Prelude () -import Distribution.Parsec.Position (Position) import Data.ByteString +import Distribution.Parsec.Position (Position) -- lens import Distribution.Compat.Lens as L From e39cc46fbe99bfa2605c0c5d3a77646973357070 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 11:14:12 +0800 Subject: [PATCH 35/83] ref: simplification --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 224b8afaf28..f81bec41b57 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -242,15 +242,14 @@ cabalStyleFile = do eof return es -commentsAfter :: Show a => Parser a -> Parser (a, [Field Position]) -commentsAfter p = - liftA2 (,) p (many tokComment) +commentsAfter :: Parser a -> Parser (a, [Field Position]) +commentsAfter p = liftA2 (,) p (many tokComment) -commentsAround :: (a -> [Field Position]) -> Parser a -> Parser [Field Position] -commentsAround f p = +commentsAround :: Parser [Field Position] -> Parser [Field Position] +commentsAround p = mconcat [ many tokComment - , fmap f p + , p , many tokComment ] @@ -261,7 +260,7 @@ commentsAround f p = elements :: IndentLevel -> Parser [Field Position] elements ilevel = do -- TODO: check if syntaxically any element can be surrounded by cabal - groups <- many (commentsAround id $ element ilevel) + groups <- many (commentsAround $ element ilevel) pure $ mconcat groups -- An individual element, ie a field or a section. These can either use @@ -433,7 +432,7 @@ checkIndentation' :: Position -> [Field Position] -> [LexWarning] -> [LexWarning checkIndentation' _ [] = id checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation' (nameAnn name) fs' checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation' _ (Comment{} : _fs') = id +checkIndentation' _ (Comment{} : _) = id -- | Check that positions' columns are the same. checkIndentation'' :: Position -> Position -> [LexWarning] -> [LexWarning] From d3a5620e0f4955048864d9adc0cff8be0d159620 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 11:25:19 +0800 Subject: [PATCH 36/83] docs: update grammar specification for comments --- .../src/Distribution/Fields/Parser.hs | 24 ++++++++----------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index f81bec41b57..b5af3b3469a 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -195,7 +195,7 @@ inLexerMode (LexerMode mode) p = -- ElementInLayoutContext ::= FieldLayout | FieldBraces | SectionLayout | SectionBraces -- ElementInNonLayoutContext ::= FieldInline | FieldBraces | SectionBraces -- FieldLayout ::= name ':' line? ('\\n' line)* --- FieldBraces ::= name ':' '\\n'? '{' content '}' +-- FieldBraces ::= name ':' '\\n'? '{' content* '}' -- FieldInline ::= name ':' content -- SectionLayout ::= name arg* Elements -- SectionBraces ::= name arg* '\\n'? '{' Elements '}' @@ -204,13 +204,13 @@ inLexerMode (LexerMode mode) p = -- and the same thing but left factored... -- -- @ --- Elements ::= Element* +-- Elements ::= (Comments* Element Comment*)* -- Element ::= '\\n' name ElementInLayoutContext -- | name ElementInNonLayoutContext -- ElementInLayoutContext ::= ':' FieldLayoutOrBraces -- | arg* SectionLayoutOrBraces --- FieldLayoutOrBraces ::= '\\n'? '{' content '}' --- | line? ('\\n' line)* +-- FieldLayoutOrBraces ::= '\\n'? '{' comment* (content comment*)* '}' +-- | comment* line? ('\\n' line comment*)* -- SectionLayoutOrBraces ::= '\\n'? '{' Elements '\\n'? '}' -- | Elements -- ElementInNonLayoutContext ::= ':' FieldInlineOrBraces @@ -242,24 +242,20 @@ cabalStyleFile = do eof return es +-- | Collect the comments after a parser succeeds commentsAfter :: Parser a -> Parser (a, [Field Position]) commentsAfter p = liftA2 (,) p (many tokComment) +-- | Collect the comments before and after a parser commentsAround :: Parser [Field Position] -> Parser [Field Position] -commentsAround p = - mconcat - [ many tokComment - , p - , many tokComment - ] +commentsAround p = mconcat [many tokComment, p, many tokComment] -- Elements that live at the top level or inside a section, i.e. fields -- and sections content -- --- elements ::= element* +-- elements ::= (comment* element comment*)* elements :: IndentLevel -> Parser [Field Position] elements ilevel = do - -- TODO: check if syntaxically any element can be surrounded by cabal groups <- many (commentsAround $ element ilevel) pure $ mconcat groups @@ -316,8 +312,8 @@ elementInNonLayoutContext name = -- The body of a field, using either layout style or braces style. -- --- fieldLayoutOrBraces ::= '\\n'? '{' content '}' --- | line? ('\\n' line)* +-- fieldLayoutOrBraces ::= '\\n'? '{' comment* (content comment*)* '}' +-- | comment* line? ('\\n' line comment*)* fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser [Field Position] fieldLayoutOrBraces ilevel name = braces <|> fieldLayout where From d03d90d58c875e775e9d864a04648c9f8dbdee64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 11:30:36 +0800 Subject: [PATCH 37/83] ref: run hlint --- Cabal-syntax/src/Distribution/FieldGrammar.hs | 2 +- Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs | 1 - Cabal-syntax/src/Distribution/Parsec/Position.hs | 1 - .../src/Distribution/Types/GenericPackageDescription.hs | 1 - 4 files changed, 1 insertion(+), 4 deletions(-) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index bab8ac3f867..d831ccf25d5 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -104,7 +104,7 @@ partitionFields = finalize . foldl' f (PS mempty mempty mempty) -- | Take all fields from the front. -- Returns a tuple containing the comments, nameless fields, and sections -takeFields :: Ord ann => [Field ann] -> (Fields ann, [Field ann]) +takeFields :: [Field ann] -> (Fields ann, [Field ann]) takeFields = finalize . spanMaybe match where finalize (fs, rest) = (Map.fromListWith (flip (++)) fs, rest) diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 4409f39024b..e00974861c3 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} diff --git a/Cabal-syntax/src/Distribution/Parsec/Position.hs b/Cabal-syntax/src/Distribution/Parsec/Position.hs index 3a80b1d87cc..e5f98abdc60 100644 --- a/Cabal-syntax/src/Distribution/Parsec/Position.hs +++ b/Cabal-syntax/src/Distribution/Parsec/Position.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index 2f2eac7b3a7..6f4be028ebe 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} module Distribution.Types.GenericPackageDescription ( GenericPackageDescription (..) From b0e8d87c5fe7d643cdbed311b42542d7ef913ab7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 11:43:50 +0800 Subject: [PATCH 38/83] improve describeToken on comments --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index b5af3b3469a..0ca07250cef 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -115,7 +115,7 @@ describeToken t = case t of Colon -> "\":\"" OpenBrace -> "\"{\"" CloseBrace -> "\"}\"" - TokComment c -> B8.unpack c + TokComment c -> "comment \"" ++ B8.unpack c ++ "\"" -- SemiColon -> "\";\"" EOF -> "end of file" LexicalError is -> "character in input " ++ show (B8.head is) From 882845455f7a71995cd95a133e025b5ad5e1aacc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 11:48:56 +0800 Subject: [PATCH 39/83] ref: make diff smaller --- Cabal-syntax/src/Distribution/FieldGrammar.hs | 9 +++++---- Cabal-syntax/src/Distribution/Fields/Lexer.x | 4 ---- Cabal-syntax/src/Distribution/Fields/Parser.hs | 3 +-- .../src/Distribution/PackageDescription/Parsec.hs | 2 +- .../src/Distribution/Types/GenericPackageDescription.hs | 4 ++-- .../Distribution/Types/GenericPackageDescription/Lens.hs | 4 ++-- 6 files changed, 11 insertions(+), 15 deletions(-) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index d831ccf25d5..286fc7bc274 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -26,7 +26,7 @@ module Distribution.FieldGrammar , Section (..) , Fields , partitionFields - , splitComments + , extractComments , takeFields , runFieldParser , runFieldParser' @@ -112,13 +112,14 @@ takeFields = finalize . spanMaybe match match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs]) match _ = Nothing -splitComments :: Ord ann => [Field ann] -> (Map.Map ann ByteString, [Field ann]) -splitComments = finalize . foldl' (flip go) (mempty, []) +-- | Collect comments into a map. The second field of the output will have no comment +extractComments :: Ord ann => [Field ann] -> (Map.Map ann ByteString, [Field ann]) +extractComments = finalize . foldl' (flip go) (mempty, []) where finalize = Bi.second reverse go (Comment cmt ann) = Bi.first $ Map.insert ann cmt go (Section name args fs) = - let (cs', fs') = splitComments fs + let (cs', fs') = extractComments fs in Bi.bimap (cs' <>) (Section name args fs' :) go field = Bi.second (field :) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index 770155b6dac..89b7b65cba7 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -101,8 +101,6 @@ tokens :- when (len' /= len) $ adjustPos (incPos (len' - len)) setStartCode in_section return (L pos (Indent len')) } - - -- TODO: maybe preserve the space here? $spacetab* \{ { tok OpenBrace } $spacetab* \} { tok CloseBrace } } @@ -136,7 +134,6 @@ tokens :- { $spacetab+; - $field_layout' $field_layout* { toki TokFieldLine } @nl { \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken } } @@ -147,7 +144,6 @@ tokens :- { $spacetab+; - $field_braces' $field_braces* { toki TokFieldLine } \{ { tok OpenBrace } \} { tok CloseBrace } diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 0ca07250cef..348f48eb8b1 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -76,8 +76,7 @@ instance Stream LexState' Identity LToken where uncons (LexState' _ (tok, st')) = case tok of L _ EOF -> return Nothing - -- L _ (TokComment {}) -> return Nothing - _ -> return $ Just (tok, st') + _ -> return (Just (tok, st')) -- | Get lexer warnings accumulated so far getLexerWarnings :: Parser [LexWarning] diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index e00974861c3..0c822799a3c 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -158,7 +158,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do for_ utf8WarnPos $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos - let (comments, fs') = splitComments fs + let (comments, fs') = extractComments fs let (syntax, fs'') = sectionizeFields fs' let (fields, sectionFields) = takeFields fs'' diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index 6f4be028ebe..d05264e364c 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -94,7 +94,7 @@ emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescripti -- Traversal Instances instance L.HasBuildInfos GenericPackageDescription where - traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 mFields) = + traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 comments) = GenericPackageDescription <$> L.traverseBuildInfos f p <*> pure v @@ -105,7 +105,7 @@ instance L.HasBuildInfos GenericPackageDescription where <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x4 <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x5 <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x6 - <*> pure mFields + <*> pure comments -- We use this traversal to keep [Dependency] field in CondTree up to date. traverseCondTreeBuildInfo diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs index 10a32feda68..461252f3006 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs @@ -81,7 +81,7 @@ allCondTrees ) -> GenericPackageDescription -> f GenericPackageDescription -allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 exactComments) = +allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 comments) = GenericPackageDescription <$> pure p <*> pure v @@ -92,7 +92,7 @@ allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 exactComments <*> (traverse . _2) f x4 <*> (traverse . _2) f x5 <*> (traverse . _2) f x6 - <*> pure exactComments + <*> pure comments ------------------------------------------------------------------------------- -- Flag From 2ebec823f82a1163eed9302c349d499fd6afacaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 12:14:28 +0800 Subject: [PATCH 40/83] test: fix no-thunks test --- Cabal-syntax/Cabal-syntax.cabal | 4 +++- Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs | 3 ++- Cabal-syntax/src/Distribution/Parsec/Position.hs | 5 ++++- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal index 9d0bdfbf27d..a19c547f412 100644 --- a/Cabal-syntax/Cabal-syntax.cabal +++ b/Cabal-syntax/Cabal-syntax.cabal @@ -44,7 +44,9 @@ library -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity -- See also https://github.com/ekmett/transformers-compat/issues/35 , transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.7) - , tree-diff + -- for tests + , tree-diff >=0.1 && <0.4 + , nothunks >=0.1.1.0 && <0.3 ghc-options: -Wall diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 0c822799a3c..09f61bf7e09 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} @@ -158,7 +159,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do for_ utf8WarnPos $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos - let (comments, fs') = extractComments fs + let (!comments, fs') = extractComments fs let (syntax, fs'') = sectionizeFields fs' let (fields, sectionFields) = takeFields fs'' diff --git a/Cabal-syntax/src/Distribution/Parsec/Position.hs b/Cabal-syntax/src/Distribution/Parsec/Position.hs index e5f98abdc60..a22b2c013e1 100644 --- a/Cabal-syntax/src/Distribution/Parsec/Position.hs +++ b/Cabal-syntax/src/Distribution/Parsec/Position.hs @@ -11,7 +11,9 @@ module Distribution.Parsec.Position , positionRow ) where -import Data.TreeDiff.Class +import Data.TreeDiff.Class (ToExpr) +import NoThunks.Class (NoThunks) + import Distribution.Compat.Prelude import Prelude () @@ -25,6 +27,7 @@ data Position instance Binary Position instance Structured Position instance ToExpr Position +instance NoThunks Position instance NFData Position where rnf = genericRnf -- | Shift position by n columns to the right. From 4e0876f2760a32a4b422c3ba0eefe5dc498fdb5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 12:17:08 +0800 Subject: [PATCH 41/83] test: fix md5Check test --- Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 129f8d0d85c..bfcb706ac63 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -29,7 +29,7 @@ md5Check proxy md5Int = structureHash proxy @?= md5FromInteger md5Int md5CheckGenericPackageDescription :: Proxy GenericPackageDescription -> Assertion md5CheckGenericPackageDescription proxy = md5Check proxy - 0xc039c6741dead5203ad2b33bd3bf4dc8 + 0x72eddc4ff39a369afefa1347aae6184e md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion md5CheckLocalBuildInfo proxy = md5Check proxy From 51fd822e96857c3d61a726655b832249f8e27b99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Fri, 10 Oct 2025 21:55:59 +0800 Subject: [PATCH 42/83] fix compiler errors and warnings --- Cabal-syntax/src/Distribution/Fields/Field.hs | 3 +++ Cabal-syntax/src/Distribution/Fields/Pretty.hs | 7 ++++++- .../src/Distribution/Solver/Modular/IndexConversion.hs | 2 +- cabal-install/src/Distribution/Client/IndexUtils.hs | 3 ++- cabal-install/src/Distribution/Deprecated/ParseUtils.hs | 7 ++++++- cabal-install/tests/IntegrationTests2.hs | 2 +- .../tests/UnitTests/Distribution/Solver/Modular/DSL.hs | 2 +- 7 files changed, 20 insertions(+), 6 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index fc0045ec586..d9357fdc26e 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -58,6 +58,7 @@ deriving instance Ord ann => Ord (Field ann) fieldName :: Field ann -> Name ann fieldName (Field n _) = n fieldName (Section n _ _) = n +fieldName (Comment{}) = error "comment doesn't have a name" fieldAnn :: Field ann -> ann fieldAnn = nameAnn . fieldName @@ -68,6 +69,7 @@ fieldAnn = nameAnn . fieldName fieldUniverse :: Field ann -> [Field ann] fieldUniverse f@(Section _ _ fs) = f : concatMap fieldUniverse fs fieldUniverse f@(Field _ _) = [f] +fieldUniverse f@(Comment{}) = [f] -- | A line of text representing the value of a field from a Cabal file. -- A field may contain multiple lines. @@ -170,6 +172,7 @@ instance F1.Foldable1 Field where F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys) foldMap1 f (Section x ys zs) = F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys ++ map (F1.foldMap1 f) zs) + foldMap1 f (Comment _ ann) = f ann -- | @since 3.12.0.0 instance F1.Foldable1 FieldLine where diff --git a/Cabal-syntax/src/Distribution/Fields/Pretty.hs b/Cabal-syntax/src/Distribution/Fields/Pretty.hs index d458ca41e80..ef93d933e99 100644 --- a/Cabal-syntax/src/Distribution/Fields/Pretty.hs +++ b/Cabal-syntax/src/Distribution/Fields/Pretty.hs @@ -181,10 +181,15 @@ genericFromParsecFields -> f [PrettyField ann] genericFromParsecFields f g = goMany where - goMany = traverse go + goMany = traverse go . filter notComment go (P.Field (P.Name ann name) fls) = PrettyField ann name <$> f name fls go (P.Section (P.Name ann name) secargs fs) = PrettySection ann name <$> g name secargs <*> goMany fs + go (P.Comment{}) = error "comment is filtered out" + + -- TODO(leana8959): outside of the scope of the comment parsing PR + notComment (P.Comment{}) = False + notComment _ = True -- | Used in 'fromParsecFields'. prettyFieldLines :: FieldName -> [P.FieldLine ann] -> PP.Doc diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs index 72d0b8193e3..4dab32883e2 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs @@ -176,7 +176,7 @@ convGPD :: OS -> Arch -> CompilerInfo -> [LabeledPackageConstraint] -> StrongFlags -> SolveExecutables -> PN -> GenericPackageDescription -> PInfo convGPD os arch cinfo constraints strfl solveExes pn - (GenericPackageDescription pkg scannedVersion flags mlib sub_libs flibs exes tests benchs) = + (GenericPackageDescription pkg scannedVersion flags mlib sub_libs flibs exes tests benchs _comments) = let fds = flagInfo strfl flags diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index f85db2b74c1..28f07a0b646 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -80,6 +80,7 @@ import Distribution.Package import Distribution.PackageDescription ( GenericPackageDescription (..) , PackageDescription (..) + , emptyGenericPackageDescription , emptyPackageDescription ) import Distribution.Simple.Compiler @@ -1113,7 +1114,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach where dummyPackageDescription :: Version -> GenericPackageDescription dummyPackageDescription specVer = - GenericPackageDescription + emptyGenericPackageDescription { packageDescription = emptyPackageDescription { package = pkgid diff --git a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs index 3ebfcd7668a..86ba6676009 100644 --- a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs +++ b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs @@ -441,13 +441,18 @@ readFields input = case Fields.readFields' input of pos = PE.errorPos perr legacyFields :: [Fields.Field Parsec.Position] -> [Field] -legacyFields = map legacyField +legacyFields = map legacyField . filter notComment + where + -- TODO(leana8959): outside of the scope of the comment parsing PR + notComment (Fields.Comment{}) = False + notComment _ = True legacyField :: Fields.Field Parsec.Position -> Field legacyField (Fields.Field (Fields.Name pos name) fls) = F (posToLineNo pos) (fromUTF8BS name) (Fields.fieldLinesToString fls) legacyField (Fields.Section (Fields.Name pos name) args fs) = Section (posToLineNo pos) (fromUTF8BS name) (Fields.sectionArgsToString args) (legacyFields fs) +legacyField (Fields.Comment{}) = error "there's no legacy comment field" posToLineNo :: Parsec.Position -> LineNo posToLineNo (Parsec.Position row _) = row diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 6a5bdba1aba..c70d1ba7151 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -651,7 +651,7 @@ testTargetSelectorAmbiguous reportSubCase = do , srcpkgSource = LocalUnpackedPackage loc , srcpkgDescrOverride = Nothing , srcpkgDescription = - GenericPackageDescription + emptyGenericPackageDescription { packageDescription = emptyPackageDescription{package = pkgid} , gpdScannedVersion = Nothing , genPackageFlags = [] diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 0d17ddc32b7..38e4861b01b 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -437,7 +437,7 @@ exAvSrcPkg ex = , srcpkgSource = LocalTarballPackage "<>" , srcpkgDescrOverride = Nothing , srcpkgDescription = - C.GenericPackageDescription + C.emptyGenericPackageDescription { C.packageDescription = C.emptyPackageDescription { C.package = pkgId From 4cee6fd3352bb4f5f31087f743ce18f6665e0ba8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 13 Oct 2025 11:58:52 +0800 Subject: [PATCH 43/83] test: add expectation for failing hackage test We also reintroduced the flag "CABAL_PARSEC_DEBUG" to debug the lexer/parser. --- Cabal-syntax/Cabal-syntax.cabal | 11 + Cabal-syntax/src/Distribution/Fields/Field.hs | 18 +- Cabal-syntax/src/Distribution/Fields/Lexer.x | 15 +- .../src/Distribution/Fields/Parser.hs | 6 +- Cabal-tests/tests/ParserTests.hs | 17 ++ .../ParserTests/comments/hackage-001.cabal | 253 ++++++++++++++++++ .../ParserTests/comments/hackage-001.expr | 94 +++++++ 7 files changed, 401 insertions(+), 13 deletions(-) create mode 100644 Cabal-tests/tests/ParserTests/comments/hackage-001.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/hackage-001.expr diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal index a19c547f412..cd67841f0c5 100644 --- a/Cabal-syntax/Cabal-syntax.cabal +++ b/Cabal-syntax/Cabal-syntax.cabal @@ -18,6 +18,11 @@ build-type: Simple extra-doc-files: README.md ChangeLog.md +flag CABAL_PARSEC_DEBUG + description: Enable debug build for the cabal field lexer/parser. + default: False + manual: True + source-repository head type: git location: https://github.com/haskell/cabal/ @@ -62,6 +67,12 @@ library if impl(ghc >= 8.0) && impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances + if flag(CABAL_PARSEC_DEBUG) + CPP-Options: -DCABAL_PARSEC_DEBUG + build-depends: + -- TODO(leana8959): set bounds + vector + build-tool-depends: alex:alex exposed-modules: diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index d9357fdc26e..bd15c31990d 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} -- | Cabal-like file AST types: 'Field', 'Section' etc -- @@ -32,6 +33,7 @@ module Distribution.Fields.Field import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.Char as Char +import Data.TreeDiff.Class (ToExpr) import Distribution.Compat.Prelude import Distribution.Pretty (showTokenStr) import Distribution.Utils.Generic (fromUTF8BS) @@ -49,7 +51,9 @@ data Field ann = Field !(Name ann) [FieldLine ann] | Section !(Name ann) [SectionArg ann] [Field ann] | Comment !ByteString ann - deriving (Eq, Show, Functor, Foldable, Traversable) + deriving (Eq, Show, Functor, Foldable, Traversable, Generic) + +instance ToExpr ann => ToExpr (Field ann) -- | @since 3.12.0.0 deriving instance Ord ann => Ord (Field ann) @@ -76,7 +80,9 @@ fieldUniverse f@(Comment{}) = [f] -- -- /Invariant:/ 'ByteString' has no newlines. data FieldLine ann = FieldLine !ann !ByteString - deriving (Eq, Show, Functor, Foldable, Traversable) + deriving (Eq, Show, Functor, Foldable, Traversable, Generic) + +instance (ToExpr ann) => ToExpr (FieldLine ann) -- | @since 3.12.0.0 deriving instance Ord ann => Ord (FieldLine ann) @@ -97,7 +103,9 @@ data SectionArg ann SecArgStr !ann !ByteString | -- | everything else, mm. operators (e.g. in if-section conditionals) SecArgOther !ann !ByteString - deriving (Eq, Show, Functor, Foldable, Traversable) + deriving (Eq, Show, Functor, Foldable, Traversable, Generic) + +instance ToExpr ann => ToExpr (SectionArg ann) -- | @since 3.12.0.0 deriving instance Ord ann => Ord (SectionArg ann) @@ -118,7 +126,9 @@ type FieldName = ByteString -- -- /Invariant/: 'ByteString' is lower-case ASCII. data Name ann = Name !ann !FieldName - deriving (Eq, Show, Functor, Foldable, Traversable) + deriving (Eq, Show, Functor, Foldable, Traversable, Generic) + +instance ToExpr ann => ToExpr (Name ann) -- | @since 3.12.0.0 deriving instance Ord ann => Ord (Name ann) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index 89b7b65cba7..4eddb0b24dd 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -31,7 +31,6 @@ import qualified Data.ByteString.Char8 as B.Char8 import qualified Data.Word as Word #ifdef CABAL_PARSEC_DEBUG -import Debug.Trace import qualified Data.Vector as V import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -231,7 +230,9 @@ lexToken = do setInput inp' let !len_bytes = B.length inp - B.length inp' t <- action pos len_bytes inp - --traceShow t $ return tok +#ifdef CABAL_PARSEC_DEBUG + traceM (show t) +#endif return t @@ -242,10 +243,12 @@ checkPosition pos@(Position lineno colno) inp inp' len_chars = do let len_bytes = B.length inp - B.length inp' pos_txt | lineno-1 < V.length text_lines = T.take len_chars (T.drop (colno-1) (text_lines V.! (lineno-1))) | otherwise = T.empty - real_txt = B.take len_bytes inp - when (pos_txt /= T.decodeUtf8 real_txt) $ - traceShow (pos, pos_txt, T.decodeUtf8 real_txt) $ - traceShow (take 3 (V.toList text_lines)) $ return () + real_txt :: B.ByteString + real_txt = B.take len_bytes inp + when (pos_txt /= T.decodeUtf8 real_txt) $ do + traceM $ show (pos, pos_txt, T.decodeUtf8 real_txt) + traceM $ show (take 3 (V.toList text_lines)) + return () where getDbgText = Lex $ \s@LexState{ dbgText = txt } -> LexResult s txt #else diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 348f48eb8b1..e0e650f7c83 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -29,6 +29,7 @@ module Distribution.Fields.Parser , parseStr , parseBS #endif + , formatError ) where {- FOURMOLU_ENABLE -} @@ -51,11 +52,9 @@ import Text.Parsec.Pos import Text.Parsec.Prim hiding (many, (<|>)) import Prelude () -#ifdef CABAL_PARSEC_DEBUG import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T -#endif -- $setup -- >>> import Data.Either (isLeft) @@ -453,7 +452,9 @@ parseStr p = parseBS p . B8.pack parseBS :: Show a => Parser a -> B8.ByteString -> IO () parseBS p = parseTest' p "" +#endif +-- TODO(leana8959): moved out of feature flag for hackagetests formatError :: B8.ByteString -> ParseError -> String formatError input perr = unlines @@ -479,7 +480,6 @@ lines' s1 Just ('\n', s4) | c == '\r' -> l : lines' s4 _ -> l : lines' s3 | otherwise -> [l] -#endif eof :: Parser () eof = notFollowedBy anyToken "end of file" diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 44b16dc484a..cfab1ca2e4d 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -14,6 +14,7 @@ import Control.Monad (unless, void) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) import Data.Maybe (isNothing) import Distribution.Fields (pwarning) +import Distribution.Fields.Parser (readFields', formatError) import Distribution.PackageDescription (GenericPackageDescription(exactComments)) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) @@ -111,8 +112,24 @@ commentTests = testGroup "comments" , commentTest "layout-many-sections.cabal" , commentTest "layout-interleaved-in-section.cabal" , commentTest "layout-fieldline-is-flag.cabal" + , readFieldTest "hackage-001.cabal" ] +readFieldTest :: FilePath -> TestTree +readFieldTest fname = ediffGolden goldenTest fname exprFile $ do + contents <- BS.readFile input + let res = readFields' contents + + case res of + Left perr -> fail $ formatError contents perr + Right (fs, warns) -> do + unless (null warns) (fail $ unlines (map show warns)) + pure fs + + where + input = "tests" "ParserTests" "comments" fname + exprFile = replaceExtension input "expr" + commentTest :: FilePath -> TestTree commentTest fname = ediffGolden goldenTest fname exprFile $ do contents <- BS.readFile input diff --git a/Cabal-tests/tests/ParserTests/comments/hackage-001.cabal b/Cabal-tests/tests/ParserTests/comments/hackage-001.cabal new file mode 100644 index 00000000000..57ba1a7cec4 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/hackage-001.cabal @@ -0,0 +1,253 @@ +-- Taken from integration test, "readField" + +-- This is the configuration file for the 'cabal' command line tool. +-- +-- The available configuration options are listed below. +-- Some of them have default values listed. +-- +-- Lines (like this one) beginning with '--' are comments. +-- Be careful with spaces and indentation because they are +-- used to indicate layout for nested sections. +-- +-- This config file was generated using the following versions +-- of Cabal and cabal-install: +-- Cabal library version: 3.12.1.0 +-- cabal-install version: 3.12.1.0 + + +repository hackage.haskell.org + url: http://hackage.haskell.org/ + -- secure: True + -- root-keys: + -- key-threshold: 3 + +-- ignore-expiry: False +-- http-transport: +-- nix: +-- store-dir: +-- active-repositories: +-- local-no-index-repo: +remote-repo-cache: /home/foo/.cache/cabal/packages +-- logs-dir: /home/foo/.cache/cabal/logs +-- default-user-config: +-- verbose: 1 +-- compiler: ghc +-- cabal-file: +-- with-compiler: +-- with-hc-pkg: +-- program-prefix: +-- program-suffix: +-- library-vanilla: True +-- library-profiling: +-- shared: +-- static: +-- executable-dynamic: False +-- executable-static: False +-- profiling: +-- executable-profiling: +-- profiling-detail: +-- library-profiling-detail: +-- optimization: True +-- debug-info: False +-- build-info: +-- library-for-ghci: +-- split-sections: False +-- split-objs: False +-- executable-stripping: +-- library-stripping: +-- configure-option: +-- user-install: True +-- package-db: +-- flags: +-- extra-include-dirs: +-- deterministic: +-- cid: +-- extra-lib-dirs: +-- extra-lib-dirs-static: +-- extra-framework-dirs: +-- extra-prog-path: +-- instantiate-with: +-- tests: False +-- coverage: False +-- library-coverage: +-- exact-configuration: False +-- benchmarks: False +-- relocatable: False +-- response-files: +-- allow-depending-on-private-libs: +-- coverage-for: +-- cabal-lib-version: +-- append: +-- backup: +-- constraint: +-- preference: +-- solver: modular +-- allow-older: False +-- allow-newer: False +-- write-ghc-environment-files: +-- documentation: False +-- doc-index-file: $datadir/doc/$arch-$os-$compiler/index.html +-- only-download: False +-- target-package-db: +-- max-backjumps: 4000 +-- reorder-goals: False +-- count-conflicts: True +-- fine-grained-conflicts: True +-- minimize-conflict-set: False +-- independent-goals: False +-- prefer-oldest: False +-- shadow-installed-packages: False +-- strong-flags: False +-- allow-boot-library-installs: False +-- reject-unconstrained-dependencies: none +-- reinstall: False +-- avoid-reinstalls: False +-- force-reinstalls: False +-- upgrade-dependencies: False +-- index-state: +-- root-cmd: +-- symlink-bindir: +build-summary: /home/foo/.cache/cabal/logs/build.log +-- build-log: +remote-build-reporting: none +-- report-planning-failure: False +-- per-component: True +-- run-tests: +-- semaphore: False +jobs: $ncpus +-- keep-going: False +-- offline: False +-- lib: False +-- package-env: +-- overwrite-policy: +-- install-method: +installdir: /home/foo/.local/bin +-- token: +-- username: +-- password: +-- password-command: +-- multi-repl: +-- builddir: + +haddock + -- keep-temp-files: False + -- hoogle: False + -- html: False + -- html-location: + -- executables: False + -- tests: False + -- benchmarks: False + -- foreign-libraries: False + -- all: + -- internal: False + -- css: + -- hyperlink-source: False + -- quickjump: False + -- hscolour-css: + -- contents-location: + -- index-location: + -- base-url: + -- lib: + -- output-dir: + +init + -- interactive: False + -- quiet: False + -- no-comments: False + -- minimal: False + -- cabal-version: 3.0 + -- license: + -- extra-doc-file: + -- tests: + -- test-dir: + -- simple: False + -- language: Haskell2010 + -- application-dir: app + -- source-dir: src + +install-dirs user + -- prefix: /home/foo/.cabal + -- bindir: $prefix/bin + -- libdir: $prefix/lib + -- libsubdir: $abi/$libname + -- dynlibdir: $libdir/$abi + -- libexecdir: $prefix/libexec + -- libexecsubdir: $abi/$pkgid + -- datadir: $prefix/share + -- datasubdir: $abi/$pkgid + -- docdir: $datadir/doc/$abi/$pkgid + -- htmldir: $docdir/html + -- haddockdir: $htmldir + -- sysconfdir: $prefix/etc + +install-dirs global + -- prefix: /usr/local + -- bindir: $prefix/bin + -- libdir: $prefix/lib + -- libsubdir: $abi/$libname + -- dynlibdir: $libdir/$abi + -- libexecdir: $prefix/libexec + -- libexecsubdir: $abi/$pkgid + -- datadir: $prefix/share + -- datasubdir: $abi/$pkgid + -- docdir: $datadir/doc/$abi/$pkgid + -- htmldir: $docdir/html + -- haddockdir: $htmldir + -- sysconfdir: $prefix/etc + +program-locations + -- alex-location: + -- ar-location: + -- c2hs-location: + -- cpphs-location: + -- doctest-location: + -- gcc-location: + -- ghc-location: + -- ghc-pkg-location: + -- ghcjs-location: + -- ghcjs-pkg-location: + -- greencard-location: + -- haddock-location: + -- happy-location: + -- haskell-suite-location: + -- haskell-suite-pkg-location: + -- hmake-location: + -- hpc-location: + -- hsc2hs-location: + -- hscolour-location: + -- jhc-location: + -- ld-location: + -- pkg-config-location: + -- runghc-location: + -- strip-location: + -- tar-location: + -- uhc-location: + +program-default-options + -- alex-options: + -- ar-options: + -- c2hs-options: + -- cpphs-options: + -- doctest-options: + -- gcc-options: + -- ghc-options: + -- ghc-pkg-options: + -- ghcjs-options: + -- ghcjs-pkg-options: + -- greencard-options: + -- haddock-options: + -- happy-options: + -- haskell-suite-options: + -- haskell-suite-pkg-options: + -- hmake-options: + -- hpc-options: + -- hsc2hs-options: + -- hscolour-options: + -- jhc-options: + -- ld-options: + -- pkg-config-options: + -- runghc-options: + -- strip-options: + -- tar-options: + -- uhc-options: + diff --git a/Cabal-tests/tests/ParserTests/comments/hackage-001.expr b/Cabal-tests/tests/ParserTests/comments/hackage-001.expr new file mode 100644 index 00000000000..938e06b11e3 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/hackage-001.expr @@ -0,0 +1,94 @@ +[ + Section + (Name + (Position 18 1) + "repository") + [ + SecArgName + (Position 18 12) + "hackage.haskell.org"] + [ + Field + (Name (Position 19 3) "url") + [ + FieldLine + (Position 19 8) + "http://hackage.haskell.org/"]], + Field + (Name + (Position 30 1) + "remote-repo-cache") + [ + FieldLine + (Position 30 20) + "/home/leana/.cache/cabal/packages"], + Field + (Name + (Position 110 1) + "build-summary") + [ + FieldLine + (Position 110 16) + "/home/leana/.cache/cabal/logs/build.log"], + Field + (Name + (Position 112 1) + "remote-build-reporting") + [ + FieldLine + (Position 112 25) + "none"], + Field + (Name (Position 117 1) "jobs") + [ + FieldLine + (Position 117 7) + "$ncpus"], + Field + (Name + (Position 124 1) + "installdir") + [ + FieldLine + (Position 124 13) + "/home/leana/.local/bin"], + Section + (Name + (Position 132 1) + "haddock") + [] + [], + Section + (Name (Position 153 1) "init") + [] + [], + Section + (Name + (Position 168 1) + "install-dirs") + [ + SecArgName + (Position 168 14) + "user"] + [], + Section + (Name + (Position 183 1) + "install-dirs") + [ + SecArgName + (Position 183 14) + "global"] + [], + Section + (Name + (Position 198 1) + "program-locations") + [] + [], + Section + (Name + (Position 226 1) + "program-default-options") + [] + []] From b948bc4f9a8aa8213c73824e761e595083abd604 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 13 Oct 2025 21:24:31 +0800 Subject: [PATCH 44/83] fix hackage test 001 --- Cabal-syntax/src/Distribution/Fields/Lexer.x | 9 +- .../src/Distribution/Fields/Parser.hs | 16 +- .../ParserTests/comments/hackage-001.expr | 959 +++++++++++++++++- 3 files changed, 961 insertions(+), 23 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index 4eddb0b24dd..85730608f8a 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -230,9 +230,6 @@ lexToken = do setInput inp' let !len_bytes = B.length inp - B.length inp' t <- action pos len_bytes inp -#ifdef CABAL_PARSEC_DEBUG - traceM (show t) -#endif return t @@ -245,9 +242,9 @@ checkPosition pos@(Position lineno colno) inp inp' len_chars = do | otherwise = T.empty real_txt :: B.ByteString real_txt = B.take len_bytes inp - when (pos_txt /= T.decodeUtf8 real_txt) $ do - traceM $ show (pos, pos_txt, T.decodeUtf8 real_txt) - traceM $ show (take 3 (V.toList text_lines)) + when (pos_txt /= T.decodeUtf8 real_txt) $ + traceShow (pos, pos_txt, T.decodeUtf8 real_txt) $ + traceShow (take 3 (V.toList text_lines)) $ return () where getDbgText = Lex $ \s@LexState{ dbgText = txt } -> LexResult s txt diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index e0e650f7c83..b4e270d954c 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -244,18 +244,20 @@ cabalStyleFile = do commentsAfter :: Parser a -> Parser (a, [Field Position]) commentsAfter p = liftA2 (,) p (many tokComment) --- | Collect the comments before and after a parser -commentsAround :: Parser [Field Position] -> Parser [Field Position] -commentsAround p = mconcat [many tokComment, p, many tokComment] - -- Elements that live at the top level or inside a section, i.e. fields -- and sections content -- --- elements ::= (comment* element comment*)* +-- elements ::= comment* (element comment)* +-- TODO(leana8959): the order is messed up, is it worth it to make it normal elements :: IndentLevel -> Parser [Field Position] elements ilevel = do - groups <- many (commentsAround $ element ilevel) - pure $ mconcat groups + preCmts <- many tokComment + (fs, postCmtsGroups) <- unzip <$> many (commentsAfter $ element ilevel) + pure $ mconcat + [ preCmts + , mconcat fs + , mconcat postCmtsGroups + ] -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on diff --git a/Cabal-tests/tests/ParserTests/comments/hackage-001.expr b/Cabal-tests/tests/ParserTests/comments/hackage-001.expr index 938e06b11e3..58a2943e6aa 100644 --- a/Cabal-tests/tests/ParserTests/comments/hackage-001.expr +++ b/Cabal-tests/tests/ParserTests/comments/hackage-001.expr @@ -1,4 +1,40 @@ [ + Comment + "-- Taken from integration test, \"readField\"" + (Position 1 1), + Comment + "-- This is the configuration file for the 'cabal' command line tool." + (Position 3 1), + Comment "--" (Position 4 1), + Comment + "-- The available configuration options are listed below." + (Position 5 1), + Comment + "-- Some of them have default values listed." + (Position 6 1), + Comment "--" (Position 7 1), + Comment + "-- Lines (like this one) beginning with '--' are comments." + (Position 8 1), + Comment + "-- Be careful with spaces and indentation because they are" + (Position 9 1), + Comment + "-- used to indicate layout for nested sections." + (Position 10 1), + Comment "--" (Position 11 1), + Comment + "-- This config file was generated using the following versions" + (Position 12 1), + Comment + "-- of Cabal and cabal-install:" + (Position 13 1), + Comment + "-- Cabal library version: 3.12.1.0" + (Position 14 1), + Comment + "-- cabal-install version: 3.12.1.0" + (Position 15 1), Section (Name (Position 18 1) @@ -13,7 +49,34 @@ [ FieldLine (Position 19 8) - "http://hackage.haskell.org/"]], + "http://hackage.haskell.org/"], + Comment + " -- secure: True" + (Position 20 1), + Comment + " -- root-keys:" + (Position 21 1), + Comment + " -- key-threshold: 3" + (Position 22 1), + Comment + "-- ignore-expiry: False" + (Position 24 1), + Comment + "-- http-transport:" + (Position 25 1), + Comment + "-- nix:" + (Position 26 1), + Comment + "-- store-dir:" + (Position 27 1), + Comment + "-- active-repositories:" + (Position 28 1), + Comment + "-- local-no-index-repo:" + (Position 29 1)], Field (Name (Position 30 1) @@ -21,7 +84,244 @@ [ FieldLine (Position 30 20) - "/home/leana/.cache/cabal/packages"], + "/home/foo/.cache/cabal/packages"], + Comment + "-- logs-dir: /home/foo/.cache/cabal/logs" + (Position 31 1), + Comment + "-- default-user-config:" + (Position 32 1), + Comment + "-- verbose: 1" + (Position 33 1), + Comment + "-- compiler: ghc" + (Position 34 1), + Comment + "-- cabal-file:" + (Position 35 1), + Comment + "-- with-compiler:" + (Position 36 1), + Comment + "-- with-hc-pkg:" + (Position 37 1), + Comment + "-- program-prefix:" + (Position 38 1), + Comment + "-- program-suffix:" + (Position 39 1), + Comment + "-- library-vanilla: True" + (Position 40 1), + Comment + "-- library-profiling:" + (Position 41 1), + Comment + "-- shared:" + (Position 42 1), + Comment + "-- static:" + (Position 43 1), + Comment + "-- executable-dynamic: False" + (Position 44 1), + Comment + "-- executable-static: False" + (Position 45 1), + Comment + "-- profiling:" + (Position 46 1), + Comment + "-- executable-profiling:" + (Position 47 1), + Comment + "-- profiling-detail:" + (Position 48 1), + Comment + "-- library-profiling-detail:" + (Position 49 1), + Comment + "-- optimization: True" + (Position 50 1), + Comment + "-- debug-info: False" + (Position 51 1), + Comment + "-- build-info:" + (Position 52 1), + Comment + "-- library-for-ghci:" + (Position 53 1), + Comment + "-- split-sections: False" + (Position 54 1), + Comment + "-- split-objs: False" + (Position 55 1), + Comment + "-- executable-stripping:" + (Position 56 1), + Comment + "-- library-stripping:" + (Position 57 1), + Comment + "-- configure-option:" + (Position 58 1), + Comment + "-- user-install: True" + (Position 59 1), + Comment + "-- package-db:" + (Position 60 1), + Comment + "-- flags:" + (Position 61 1), + Comment + "-- extra-include-dirs:" + (Position 62 1), + Comment + "-- deterministic:" + (Position 63 1), + Comment + "-- cid:" + (Position 64 1), + Comment + "-- extra-lib-dirs:" + (Position 65 1), + Comment + "-- extra-lib-dirs-static:" + (Position 66 1), + Comment + "-- extra-framework-dirs:" + (Position 67 1), + Comment + "-- extra-prog-path:" + (Position 68 1), + Comment + "-- instantiate-with:" + (Position 69 1), + Comment + "-- tests: False" + (Position 70 1), + Comment + "-- coverage: False" + (Position 71 1), + Comment + "-- library-coverage:" + (Position 72 1), + Comment + "-- exact-configuration: False" + (Position 73 1), + Comment + "-- benchmarks: False" + (Position 74 1), + Comment + "-- relocatable: False" + (Position 75 1), + Comment + "-- response-files:" + (Position 76 1), + Comment + "-- allow-depending-on-private-libs:" + (Position 77 1), + Comment + "-- coverage-for:" + (Position 78 1), + Comment + "-- cabal-lib-version:" + (Position 79 1), + Comment + "-- append:" + (Position 80 1), + Comment + "-- backup:" + (Position 81 1), + Comment + "-- constraint:" + (Position 82 1), + Comment + "-- preference:" + (Position 83 1), + Comment + "-- solver: modular" + (Position 84 1), + Comment + "-- allow-older: False" + (Position 85 1), + Comment + "-- allow-newer: False" + (Position 86 1), + Comment + "-- write-ghc-environment-files:" + (Position 87 1), + Comment + "-- documentation: False" + (Position 88 1), + Comment + "-- doc-index-file: $datadir/doc/$arch-$os-$compiler/index.html" + (Position 89 1), + Comment + "-- only-download: False" + (Position 90 1), + Comment + "-- target-package-db:" + (Position 91 1), + Comment + "-- max-backjumps: 4000" + (Position 92 1), + Comment + "-- reorder-goals: False" + (Position 93 1), + Comment + "-- count-conflicts: True" + (Position 94 1), + Comment + "-- fine-grained-conflicts: True" + (Position 95 1), + Comment + "-- minimize-conflict-set: False" + (Position 96 1), + Comment + "-- independent-goals: False" + (Position 97 1), + Comment + "-- prefer-oldest: False" + (Position 98 1), + Comment + "-- shadow-installed-packages: False" + (Position 99 1), + Comment + "-- strong-flags: False" + (Position 100 1), + Comment + "-- allow-boot-library-installs: False" + (Position 101 1), + Comment + "-- reject-unconstrained-dependencies: none" + (Position 102 1), + Comment + "-- reinstall: False" + (Position 103 1), + Comment + "-- avoid-reinstalls: False" + (Position 104 1), + Comment + "-- force-reinstalls: False" + (Position 105 1), + Comment + "-- upgrade-dependencies: False" + (Position 106 1), + Comment + "-- index-state:" + (Position 107 1), + Comment + "-- root-cmd:" + (Position 108 1), + Comment + "-- symlink-bindir:" + (Position 109 1), Field (Name (Position 110 1) @@ -29,7 +329,10 @@ [ FieldLine (Position 110 16) - "/home/leana/.cache/cabal/logs/build.log"], + "/home/foo/.cache/cabal/logs/build.log"], + Comment + "-- build-log:" + (Position 111 1), Field (Name (Position 112 1) @@ -51,17 +354,131 @@ [ FieldLine (Position 124 13) - "/home/leana/.local/bin"], + "/home/foo/.local/bin"], + Comment + "-- token:" + (Position 125 1), + Comment + "-- username:" + (Position 126 1), + Comment + "-- password:" + (Position 127 1), + Comment + "-- password-command:" + (Position 128 1), + Comment + "-- multi-repl:" + (Position 129 1), + Comment + "-- builddir:" + (Position 130 1), Section (Name (Position 132 1) "haddock") [] - [], + [ + Comment + " -- keep-temp-files: False" + (Position 133 1), + Comment + " -- hoogle: False" + (Position 134 1), + Comment + " -- html: False" + (Position 135 1), + Comment + " -- html-location:" + (Position 136 1), + Comment + " -- executables: False" + (Position 137 1), + Comment + " -- tests: False" + (Position 138 1), + Comment + " -- benchmarks: False" + (Position 139 1), + Comment + " -- foreign-libraries: False" + (Position 140 1), + Comment + " -- all:" + (Position 141 1), + Comment + " -- internal: False" + (Position 142 1), + Comment + " -- css:" + (Position 143 1), + Comment + " -- hyperlink-source: False" + (Position 144 1), + Comment + " -- quickjump: False" + (Position 145 1), + Comment + " -- hscolour-css:" + (Position 146 1), + Comment + " -- contents-location:" + (Position 147 1), + Comment + " -- index-location:" + (Position 148 1), + Comment + " -- base-url:" + (Position 149 1), + Comment + " -- lib:" + (Position 150 1), + Comment + " -- output-dir:" + (Position 151 1)], Section (Name (Position 153 1) "init") [] - [], + [ + Comment + " -- interactive: False" + (Position 154 1), + Comment + " -- quiet: False" + (Position 155 1), + Comment + " -- no-comments: False" + (Position 156 1), + Comment + " -- minimal: False" + (Position 157 1), + Comment + " -- cabal-version: 3.0" + (Position 158 1), + Comment + " -- license:" + (Position 159 1), + Comment + " -- extra-doc-file:" + (Position 160 1), + Comment + " -- tests:" + (Position 161 1), + Comment + " -- test-dir:" + (Position 162 1), + Comment + " -- simple: False" + (Position 163 1), + Comment + " -- language: Haskell2010" + (Position 164 1), + Comment + " -- application-dir: app" + (Position 165 1), + Comment + " -- source-dir: src" + (Position 166 1)], Section (Name (Position 168 1) @@ -70,7 +487,46 @@ SecArgName (Position 168 14) "user"] - [], + [ + Comment + " -- prefix: /home/foo/.cabal" + (Position 169 1), + Comment + " -- bindir: $prefix/bin" + (Position 170 1), + Comment + " -- libdir: $prefix/lib" + (Position 171 1), + Comment + " -- libsubdir: $abi/$libname" + (Position 172 1), + Comment + " -- dynlibdir: $libdir/$abi" + (Position 173 1), + Comment + " -- libexecdir: $prefix/libexec" + (Position 174 1), + Comment + " -- libexecsubdir: $abi/$pkgid" + (Position 175 1), + Comment + " -- datadir: $prefix/share" + (Position 176 1), + Comment + " -- datasubdir: $abi/$pkgid" + (Position 177 1), + Comment + " -- docdir: $datadir/doc/$abi/$pkgid" + (Position 178 1), + Comment + " -- htmldir: $docdir/html" + (Position 179 1), + Comment + " -- haddockdir: $htmldir" + (Position 180 1), + Comment + " -- sysconfdir: $prefix/etc" + (Position 181 1)], Section (Name (Position 183 1) @@ -79,16 +535,499 @@ SecArgName (Position 183 14) "global"] - [], + [ + Comment + " -- prefix: /usr/local" + (Position 184 1), + Comment + " -- bindir: $prefix/bin" + (Position 185 1), + Comment + " -- libdir: $prefix/lib" + (Position 186 1), + Comment + " -- libsubdir: $abi/$libname" + (Position 187 1), + Comment + " -- dynlibdir: $libdir/$abi" + (Position 188 1), + Comment + " -- libexecdir: $prefix/libexec" + (Position 189 1), + Comment + " -- libexecsubdir: $abi/$pkgid" + (Position 190 1), + Comment + " -- datadir: $prefix/share" + (Position 191 1), + Comment + " -- datasubdir: $abi/$pkgid" + (Position 192 1), + Comment + " -- docdir: $datadir/doc/$abi/$pkgid" + (Position 193 1), + Comment + " -- htmldir: $docdir/html" + (Position 194 1), + Comment + " -- haddockdir: $htmldir" + (Position 195 1), + Comment + " -- sysconfdir: $prefix/etc" + (Position 196 1)], Section (Name (Position 198 1) "program-locations") [] - [], + [ + Comment + " -- alex-location:" + (Position 199 1), + Comment + " -- ar-location:" + (Position 200 1), + Comment + " -- c2hs-location:" + (Position 201 1), + Comment + " -- cpphs-location:" + (Position 202 1), + Comment + " -- doctest-location:" + (Position 203 1), + Comment + " -- gcc-location:" + (Position 204 1), + Comment + " -- ghc-location:" + (Position 205 1), + Comment + " -- ghc-pkg-location:" + (Position 206 1), + Comment + " -- ghcjs-location:" + (Position 207 1), + Comment + " -- ghcjs-pkg-location:" + (Position 208 1), + Comment + " -- greencard-location:" + (Position 209 1), + Comment + " -- haddock-location:" + (Position 210 1), + Comment + " -- happy-location:" + (Position 211 1), + Comment + " -- haskell-suite-location:" + (Position 212 1), + Comment + " -- haskell-suite-pkg-location:" + (Position 213 1), + Comment + " -- hmake-location:" + (Position 214 1), + Comment + " -- hpc-location:" + (Position 215 1), + Comment + " -- hsc2hs-location:" + (Position 216 1), + Comment + " -- hscolour-location:" + (Position 217 1), + Comment + " -- jhc-location:" + (Position 218 1), + Comment + " -- ld-location:" + (Position 219 1), + Comment + " -- pkg-config-location:" + (Position 220 1), + Comment + " -- runghc-location:" + (Position 221 1), + Comment + " -- strip-location:" + (Position 222 1), + Comment + " -- tar-location:" + (Position 223 1), + Comment + " -- uhc-location:" + (Position 224 1)], Section (Name (Position 226 1) "program-default-options") [] - []] + [ + Comment + " -- alex-options:" + (Position 227 1), + Comment + " -- ar-options:" + (Position 228 1), + Comment + " -- c2hs-options:" + (Position 229 1), + Comment + " -- cpphs-options:" + (Position 230 1), + Comment + " -- doctest-options:" + (Position 231 1), + Comment + " -- gcc-options:" + (Position 232 1), + Comment + " -- ghc-options:" + (Position 233 1), + Comment + " -- ghc-pkg-options:" + (Position 234 1), + Comment + " -- ghcjs-options:" + (Position 235 1), + Comment + " -- ghcjs-pkg-options:" + (Position 236 1), + Comment + " -- greencard-options:" + (Position 237 1), + Comment + " -- haddock-options:" + (Position 238 1), + Comment + " -- happy-options:" + (Position 239 1), + Comment + " -- haskell-suite-options:" + (Position 240 1), + Comment + " -- haskell-suite-pkg-options:" + (Position 241 1), + Comment + " -- hmake-options:" + (Position 242 1), + Comment + " -- hpc-options:" + (Position 243 1), + Comment + " -- hsc2hs-options:" + (Position 244 1), + Comment + " -- hscolour-options:" + (Position 245 1), + Comment + " -- jhc-options:" + (Position 246 1), + Comment + " -- ld-options:" + (Position 247 1), + Comment + " -- pkg-config-options:" + (Position 248 1), + Comment + " -- runghc-options:" + (Position 249 1), + Comment + " -- strip-options:" + (Position 250 1), + Comment + " -- tar-options:" + (Position 251 1), + Comment + " -- uhc-options:" + (Position 252 1)], + Comment + "-- logs-dir: /home/leana/.cache/cabal/logs" + (Position 31 1), + Comment + "-- default-user-config:" + (Position 32 1), + Comment + "-- verbose: 1" + (Position 33 1), + Comment + "-- compiler: ghc" + (Position 34 1), + Comment + "-- cabal-file:" + (Position 35 1), + Comment + "-- with-compiler:" + (Position 36 1), + Comment + "-- with-hc-pkg:" + (Position 37 1), + Comment + "-- program-prefix:" + (Position 38 1), + Comment + "-- program-suffix:" + (Position 39 1), + Comment + "-- library-vanilla: True" + (Position 40 1), + Comment + "-- library-profiling:" + (Position 41 1), + Comment + "-- shared:" + (Position 42 1), + Comment + "-- static:" + (Position 43 1), + Comment + "-- executable-dynamic: False" + (Position 44 1), + Comment + "-- executable-static: False" + (Position 45 1), + Comment + "-- profiling:" + (Position 46 1), + Comment + "-- executable-profiling:" + (Position 47 1), + Comment + "-- profiling-detail:" + (Position 48 1), + Comment + "-- library-profiling-detail:" + (Position 49 1), + Comment + "-- optimization: True" + (Position 50 1), + Comment + "-- debug-info: False" + (Position 51 1), + Comment + "-- build-info:" + (Position 52 1), + Comment + "-- library-for-ghci:" + (Position 53 1), + Comment + "-- split-sections: False" + (Position 54 1), + Comment + "-- split-objs: False" + (Position 55 1), + Comment + "-- executable-stripping:" + (Position 56 1), + Comment + "-- library-stripping:" + (Position 57 1), + Comment + "-- configure-option:" + (Position 58 1), + Comment + "-- user-install: True" + (Position 59 1), + Comment + "-- package-db:" + (Position 60 1), + Comment + "-- flags:" + (Position 61 1), + Comment + "-- extra-include-dirs:" + (Position 62 1), + Comment + "-- deterministic:" + (Position 63 1), + Comment + "-- cid:" + (Position 64 1), + Comment + "-- extra-lib-dirs:" + (Position 65 1), + Comment + "-- extra-lib-dirs-static:" + (Position 66 1), + Comment + "-- extra-framework-dirs:" + (Position 67 1), + Comment + "-- extra-prog-path:" + (Position 68 1), + Comment + "-- instantiate-with:" + (Position 69 1), + Comment + "-- tests: False" + (Position 70 1), + Comment + "-- coverage: False" + (Position 71 1), + Comment + "-- library-coverage:" + (Position 72 1), + Comment + "-- exact-configuration: False" + (Position 73 1), + Comment + "-- benchmarks: False" + (Position 74 1), + Comment + "-- relocatable: False" + (Position 75 1), + Comment + "-- response-files:" + (Position 76 1), + Comment + "-- allow-depending-on-private-libs:" + (Position 77 1), + Comment + "-- coverage-for:" + (Position 78 1), + Comment + "-- cabal-lib-version:" + (Position 79 1), + Comment + "-- append:" + (Position 80 1), + Comment + "-- backup:" + (Position 81 1), + Comment + "-- constraint:" + (Position 82 1), + Comment + "-- preference:" + (Position 83 1), + Comment + "-- solver: modular" + (Position 84 1), + Comment + "-- allow-older: False" + (Position 85 1), + Comment + "-- allow-newer: False" + (Position 86 1), + Comment + "-- write-ghc-environment-files:" + (Position 87 1), + Comment + "-- documentation: False" + (Position 88 1), + Comment + "-- doc-index-file: $datadir/doc/$arch-$os-$compiler/index.html" + (Position 89 1), + Comment + "-- only-download: False" + (Position 90 1), + Comment + "-- target-package-db:" + (Position 91 1), + Comment + "-- max-backjumps: 4000" + (Position 92 1), + Comment + "-- reorder-goals: False" + (Position 93 1), + Comment + "-- count-conflicts: True" + (Position 94 1), + Comment + "-- fine-grained-conflicts: True" + (Position 95 1), + Comment + "-- minimize-conflict-set: False" + (Position 96 1), + Comment + "-- independent-goals: False" + (Position 97 1), + Comment + "-- prefer-oldest: False" + (Position 98 1), + Comment + "-- shadow-installed-packages: False" + (Position 99 1), + Comment + "-- strong-flags: False" + (Position 100 1), + Comment + "-- allow-boot-library-installs: False" + (Position 101 1), + Comment + "-- reject-unconstrained-dependencies: none" + (Position 102 1), + Comment + "-- reinstall: False" + (Position 103 1), + Comment + "-- avoid-reinstalls: False" + (Position 104 1), + Comment + "-- force-reinstalls: False" + (Position 105 1), + Comment + "-- upgrade-dependencies: False" + (Position 106 1), + Comment + "-- index-state:" + (Position 107 1), + Comment + "-- root-cmd:" + (Position 108 1), + Comment + "-- symlink-bindir:" + (Position 109 1), + Comment + "-- build-log:" + (Position 111 1), + Comment + "-- report-planning-failure: False" + (Position 113 1), + Comment + "-- per-component: True" + (Position 114 1), + Comment + "-- run-tests:" + (Position 115 1), + Comment + "-- semaphore: False" + (Position 116 1), + Comment + "-- keep-going: False" + (Position 118 1), + Comment + "-- offline: False" + (Position 119 1), + Comment + "-- lib: False" + (Position 120 1), + Comment + "-- package-env:" + (Position 121 1), + Comment + "-- overwrite-policy:" + (Position 122 1), + Comment + "-- install-method:" + (Position 123 1), + Comment + "-- token:" + (Position 125 1), + Comment + "-- username:" + (Position 126 1), + Comment + "-- password:" + (Position 127 1), + Comment + "-- password-command:" + (Position 128 1), + Comment + "-- multi-repl:" + (Position 129 1), + Comment + "-- builddir:" + (Position 130 1)] From e317efb3906c189d20b33e8e24f0e6e9c17a20cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 14 Oct 2025 11:28:02 +0800 Subject: [PATCH 45/83] fix hackage test --- .../src/Distribution/Fields/Parser.hs | 6 +- Cabal-tests/tests/ParserTests.hs | 2 + .../ParserTests/comments/hackage-001.expr | 320 ++---------------- .../ParserTests/comments/happs.094.cabal | 75 ++++ .../tests/ParserTests/comments/happs.094.expr | 8 + 5 files changed, 120 insertions(+), 291 deletions(-) create mode 100644 Cabal-tests/tests/ParserTests/comments/happs.094.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/happs.094.expr diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index b4e270d954c..7133bbb1862 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -324,15 +324,17 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout closeBrace return $ preCmts <> [Field name ls] <> mconcat postCmtsGroups fieldLayout = inLexerMode (LexerMode in_field_layout) $ do - preCmts <- many tokComment + firstPreCmts <- many tokComment l <- optionMaybe fieldContent + firstPostCmts <- many tokComment (ls, postCmtsGroups) <- unzip <$> many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) return $ mconcat - [ preCmts + [ firstPreCmts , case l of Nothing -> [Field name ls] Just l' -> [Field name (l' : ls)] + , firstPostCmts , mconcat postCmtsGroups ] diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index cfab1ca2e4d..8cf8aab29e5 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -112,7 +112,9 @@ commentTests = testGroup "comments" , commentTest "layout-many-sections.cabal" , commentTest "layout-interleaved-in-section.cabal" , commentTest "layout-fieldline-is-flag.cabal" + , readFieldTest "hackage-001.cabal" + , commentTest "happs.094.cabal" -- aligned leading comma after comment ] readFieldTest :: FilePath -> TestTree diff --git a/Cabal-tests/tests/ParserTests/comments/hackage-001.expr b/Cabal-tests/tests/ParserTests/comments/hackage-001.expr index 58a2943e6aa..e2fe8cdc83c 100644 --- a/Cabal-tests/tests/ParserTests/comments/hackage-001.expr +++ b/Cabal-tests/tests/ParserTests/comments/hackage-001.expr @@ -341,12 +341,42 @@ FieldLine (Position 112 25) "none"], + Comment + "-- report-planning-failure: False" + (Position 113 1), + Comment + "-- per-component: True" + (Position 114 1), + Comment + "-- run-tests:" + (Position 115 1), + Comment + "-- semaphore: False" + (Position 116 1), Field (Name (Position 117 1) "jobs") [ FieldLine (Position 117 7) "$ncpus"], + Comment + "-- keep-going: False" + (Position 118 1), + Comment + "-- offline: False" + (Position 119 1), + Comment + "-- lib: False" + (Position 120 1), + Comment + "-- package-env:" + (Position 121 1), + Comment + "-- overwrite-policy:" + (Position 122 1), + Comment + "-- install-method:" + (Position 123 1), Field (Name (Position 124 1) @@ -742,292 +772,4 @@ (Position 251 1), Comment " -- uhc-options:" - (Position 252 1)], - Comment - "-- logs-dir: /home/leana/.cache/cabal/logs" - (Position 31 1), - Comment - "-- default-user-config:" - (Position 32 1), - Comment - "-- verbose: 1" - (Position 33 1), - Comment - "-- compiler: ghc" - (Position 34 1), - Comment - "-- cabal-file:" - (Position 35 1), - Comment - "-- with-compiler:" - (Position 36 1), - Comment - "-- with-hc-pkg:" - (Position 37 1), - Comment - "-- program-prefix:" - (Position 38 1), - Comment - "-- program-suffix:" - (Position 39 1), - Comment - "-- library-vanilla: True" - (Position 40 1), - Comment - "-- library-profiling:" - (Position 41 1), - Comment - "-- shared:" - (Position 42 1), - Comment - "-- static:" - (Position 43 1), - Comment - "-- executable-dynamic: False" - (Position 44 1), - Comment - "-- executable-static: False" - (Position 45 1), - Comment - "-- profiling:" - (Position 46 1), - Comment - "-- executable-profiling:" - (Position 47 1), - Comment - "-- profiling-detail:" - (Position 48 1), - Comment - "-- library-profiling-detail:" - (Position 49 1), - Comment - "-- optimization: True" - (Position 50 1), - Comment - "-- debug-info: False" - (Position 51 1), - Comment - "-- build-info:" - (Position 52 1), - Comment - "-- library-for-ghci:" - (Position 53 1), - Comment - "-- split-sections: False" - (Position 54 1), - Comment - "-- split-objs: False" - (Position 55 1), - Comment - "-- executable-stripping:" - (Position 56 1), - Comment - "-- library-stripping:" - (Position 57 1), - Comment - "-- configure-option:" - (Position 58 1), - Comment - "-- user-install: True" - (Position 59 1), - Comment - "-- package-db:" - (Position 60 1), - Comment - "-- flags:" - (Position 61 1), - Comment - "-- extra-include-dirs:" - (Position 62 1), - Comment - "-- deterministic:" - (Position 63 1), - Comment - "-- cid:" - (Position 64 1), - Comment - "-- extra-lib-dirs:" - (Position 65 1), - Comment - "-- extra-lib-dirs-static:" - (Position 66 1), - Comment - "-- extra-framework-dirs:" - (Position 67 1), - Comment - "-- extra-prog-path:" - (Position 68 1), - Comment - "-- instantiate-with:" - (Position 69 1), - Comment - "-- tests: False" - (Position 70 1), - Comment - "-- coverage: False" - (Position 71 1), - Comment - "-- library-coverage:" - (Position 72 1), - Comment - "-- exact-configuration: False" - (Position 73 1), - Comment - "-- benchmarks: False" - (Position 74 1), - Comment - "-- relocatable: False" - (Position 75 1), - Comment - "-- response-files:" - (Position 76 1), - Comment - "-- allow-depending-on-private-libs:" - (Position 77 1), - Comment - "-- coverage-for:" - (Position 78 1), - Comment - "-- cabal-lib-version:" - (Position 79 1), - Comment - "-- append:" - (Position 80 1), - Comment - "-- backup:" - (Position 81 1), - Comment - "-- constraint:" - (Position 82 1), - Comment - "-- preference:" - (Position 83 1), - Comment - "-- solver: modular" - (Position 84 1), - Comment - "-- allow-older: False" - (Position 85 1), - Comment - "-- allow-newer: False" - (Position 86 1), - Comment - "-- write-ghc-environment-files:" - (Position 87 1), - Comment - "-- documentation: False" - (Position 88 1), - Comment - "-- doc-index-file: $datadir/doc/$arch-$os-$compiler/index.html" - (Position 89 1), - Comment - "-- only-download: False" - (Position 90 1), - Comment - "-- target-package-db:" - (Position 91 1), - Comment - "-- max-backjumps: 4000" - (Position 92 1), - Comment - "-- reorder-goals: False" - (Position 93 1), - Comment - "-- count-conflicts: True" - (Position 94 1), - Comment - "-- fine-grained-conflicts: True" - (Position 95 1), - Comment - "-- minimize-conflict-set: False" - (Position 96 1), - Comment - "-- independent-goals: False" - (Position 97 1), - Comment - "-- prefer-oldest: False" - (Position 98 1), - Comment - "-- shadow-installed-packages: False" - (Position 99 1), - Comment - "-- strong-flags: False" - (Position 100 1), - Comment - "-- allow-boot-library-installs: False" - (Position 101 1), - Comment - "-- reject-unconstrained-dependencies: none" - (Position 102 1), - Comment - "-- reinstall: False" - (Position 103 1), - Comment - "-- avoid-reinstalls: False" - (Position 104 1), - Comment - "-- force-reinstalls: False" - (Position 105 1), - Comment - "-- upgrade-dependencies: False" - (Position 106 1), - Comment - "-- index-state:" - (Position 107 1), - Comment - "-- root-cmd:" - (Position 108 1), - Comment - "-- symlink-bindir:" - (Position 109 1), - Comment - "-- build-log:" - (Position 111 1), - Comment - "-- report-planning-failure: False" - (Position 113 1), - Comment - "-- per-component: True" - (Position 114 1), - Comment - "-- run-tests:" - (Position 115 1), - Comment - "-- semaphore: False" - (Position 116 1), - Comment - "-- keep-going: False" - (Position 118 1), - Comment - "-- offline: False" - (Position 119 1), - Comment - "-- lib: False" - (Position 120 1), - Comment - "-- package-env:" - (Position 121 1), - Comment - "-- overwrite-policy:" - (Position 122 1), - Comment - "-- install-method:" - (Position 123 1), - Comment - "-- token:" - (Position 125 1), - Comment - "-- username:" - (Position 126 1), - Comment - "-- password:" - (Position 127 1), - Comment - "-- password-command:" - (Position 128 1), - Comment - "-- multi-repl:" - (Position 129 1), - Comment - "-- builddir:" - (Position 130 1)] + (Position 252 1)]] diff --git a/Cabal-tests/tests/ParserTests/comments/happs.094.cabal b/Cabal-tests/tests/ParserTests/comments/happs.094.cabal new file mode 100644 index 00000000000..f502eeb1109 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/happs.094.cabal @@ -0,0 +1,75 @@ +Name: happs-tutorial +Version: 0.9.4 +Synopsis: A Happstack Tutorial that is its own web 2.0-type demo. +Description: A nice way to learn how to build web sites with Happstack + +License: BSD3 +License-file: LICENSE +Author: Thomas Hartman, Eelco Lempsink, Creighton Hogg + +Maintainer: Thomas Hartman +Copyright: 2008 Thomas Hartman, 2009 Thomas Hartman & Creighton Hogg + +Stability: Experimental +Category: Web +Build-type: Simple + +Extra-Source-Files: + recompile-and-kill-head.sh + hackInGhci.sh + static/*.png + static/*.css + templates/*.st + src/*.hs + src/migrationexample/*.hs + src/migrationexample/*.lhs + src/migrationexample/StateVersions/*.hs + +Cabal-Version: >= 1.8 + +Flag base4 + Description: Choose the even newer, even smaller, split-up base package. + +Executable happs-tutorial + Main-is: Main.hs + hs-source-dirs: + src + Other-Modules: + StateVersions.AppState1 + ControllerBasic + ControllerGetActions + Controller + ControllerMisc + ControllerPostActions + FromDataInstances + Misc + MiscMap + ControllerStressTests + View + ghc-options: -Wall + Build-Depends: base + -- , HStringTemplate >= 0.4.0 && < 0.5.0 + -- This should be consumed by post fieldContent + , HStringTemplate >= 0.6 + , HStringTemplateHelpers >= 0.0.14 && < 1.0.0 + , mtl >= 1.1.0.0 && < 2.0.0.0 + , bytestring + , happstack >= 0.5 + , containers >= 0.2.0.0 && < 0.3.0.0 + , pretty >= 1.0.1.0 && < 2 + , pureMD5 >= 1.0.0.0 && < 1.1.0.0 + , directory >= 1.0.0.0 && < 1.1.0.0 + , filepath >= 1.1.0.0 && < 1.2.0.0 + , hscolour == 1.13 + , HTTP >= 4000 + , safe >= 0.2 && < 0.3 + , old-time >= 1.0.0.0 && < 1.1.0.0 + , parsec >= 2.1.0.0 && < 2.2.0.0 + , happstack-helpers >= 0.50 + , DebugTraceHelpers >= 0.12 && < 0.20 + , happstack-server >= 0.5 + , happstack-data >= 0.5 + , happstack-ixset >= 0.5 + , happstack-state >= 0.5 + if flag(base4) + Build-Depends: base >=4 && <5, syb diff --git a/Cabal-tests/tests/ParserTests/comments/happs.094.expr b/Cabal-tests/tests/ParserTests/comments/happs.094.expr new file mode 100644 index 00000000000..5eacd787752 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/happs.094.expr @@ -0,0 +1,8 @@ +Map.fromList + [ + _×_ + (Position 51 1) + " -- , HStringTemplate >= 0.4.0 && < 0.5.0 ", + _×_ + (Position 52 1) + " -- This should be consumed by post fieldContent"] From 2f68c5079e063710f85edf4074479a631771c0c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 14 Oct 2025 11:59:17 +0800 Subject: [PATCH 46/83] test: disable comments in comparison in roundtrip hackage test --- Cabal-tests/tests/HackageTests.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Cabal-tests/tests/HackageTests.hs b/Cabal-tests/tests/HackageTests.hs index 1265c6cb13e..97f4160d0a9 100644 --- a/Cabal-tests/tests/HackageTests.hs +++ b/Cabal-tests/tests/HackageTests.hs @@ -20,6 +20,7 @@ import Data.Foldable (traverse_) import Data.List (isPrefixOf, isSuffixOf) import Data.Maybe (mapMaybe) import Data.Monoid (Sum (..)) +import Distribution.PackageDescription (GenericPackageDescription(exactComments)) import Distribution.PackageDescription.Check (PackageCheck (..), checkPackage) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.PackageDescription.Quirks (patchQuirks) @@ -287,7 +288,8 @@ roundtripTest testFieldsTransform fpath bs = do print err exitFailure - assertEqual' bs' x y = unless (x == y || fpath == "ixset/1.0.4/ixset.cabal") $ do + -- we disable comparison on exactComments for now because we can't print it yet + assertEqual' bs' x y = unless (x { exactComments = mempty } == y || fpath == "ixset/1.0.4/ixset.cabal") $ do putStrLn fpath #ifdef MIN_VERSION_tree_diff putStrLn "====== tree-diff:" From 85d3016c937df0b60563465a8f686357ee6f501d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 14 Oct 2025 12:11:29 +0800 Subject: [PATCH 47/83] refactor parser --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 7133bbb1862..0c7241b55ce 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -33,6 +33,7 @@ module Distribution.Fields.Parser ) where {- FOURMOLU_ENABLE -} +import Control.Applicative (liftA3) import qualified Data.ByteString.Char8 as B8 import Data.Functor.Identity import Distribution.Compat.Prelude @@ -202,13 +203,13 @@ inLexerMode (LexerMode mode) p = -- and the same thing but left factored... -- -- @ --- Elements ::= (Comments* Element Comment*)* +-- Elements ::= Comments* (Element Comment*)* -- Element ::= '\\n' name ElementInLayoutContext -- | name ElementInNonLayoutContext -- ElementInLayoutContext ::= ':' FieldLayoutOrBraces -- | arg* SectionLayoutOrBraces -- FieldLayoutOrBraces ::= '\\n'? '{' comment* (content comment*)* '}' --- | comment* line? ('\\n' line comment*)* +-- | comment* line? comment* ('\\n' line comment*)* -- SectionLayoutOrBraces ::= '\\n'? '{' Elements '\\n'? '}' -- | Elements -- ElementInNonLayoutContext ::= ':' FieldInlineOrBraces @@ -240,15 +241,14 @@ cabalStyleFile = do eof return es --- | Collect the comments after a parser succeeds +-- | Collect one or more comments after a parser succeeds commentsAfter :: Parser a -> Parser (a, [Field Position]) commentsAfter p = liftA2 (,) p (many tokComment) -- Elements that live at the top level or inside a section, i.e. fields -- and sections content -- --- elements ::= comment* (element comment)* --- TODO(leana8959): the order is messed up, is it worth it to make it normal +-- elements ::= comment* (element comment*)* elements :: IndentLevel -> Parser [Field Position] elements ilevel = do preCmts <- many tokComment @@ -313,7 +313,7 @@ elementInNonLayoutContext name = -- The body of a field, using either layout style or braces style. -- -- fieldLayoutOrBraces ::= '\\n'? '{' comment* (content comment*)* '}' --- | comment* line? ('\\n' line comment*)* +-- | comment* line? comment* ('\\n' line comment*)* fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser [Field Position] fieldLayoutOrBraces ilevel name = braces <|> fieldLayout where @@ -324,9 +324,8 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout closeBrace return $ preCmts <> [Field name ls] <> mconcat postCmtsGroups fieldLayout = inLexerMode (LexerMode in_field_layout) $ do - firstPreCmts <- many tokComment - l <- optionMaybe fieldContent - firstPostCmts <- many tokComment + (firstPreCmts, l, firstPostCmts) <- + liftA3 (,,) (many tokComment) (optionMaybe fieldContent) (many tokComment) (ls, postCmtsGroups) <- unzip <$> many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) return $ mconcat From b3a1db3d1a2802c66a1bd49897bde31ec33bca21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 14 Oct 2025 12:15:49 +0800 Subject: [PATCH 48/83] refactor test --- .../src/Distribution/Fields/Parser.hs | 1 - Cabal-tests/tests/ParserTests.hs | 11 +- .../tests/ParserTests/comments/happs.094.expr | 320 +++++++++++++++++- 3 files changed, 319 insertions(+), 13 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 0c7241b55ce..55bc0ce992e 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -457,7 +457,6 @@ parseBS :: Show a => Parser a -> B8.ByteString -> IO () parseBS p = parseTest' p "" #endif --- TODO(leana8959): moved out of feature flag for hackagetests formatError :: B8.ByteString -> ParseError -> String formatError input perr = unlines diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 8cf8aab29e5..790e966dded 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -106,17 +106,20 @@ warningTest wt fp = testCase (show wt) $ do -- Verify that comments are parsed correctly commentTests :: TestTree commentTests = testGroup "comments" - [ commentTest "layout-nosections-before.cabal" + [ + -- Imported from hackage integration test + readFieldTest "hackage-001.cabal" + , readFieldTest "happs.094.cabal" -- aligned leading comma after comment + + , commentTest "layout-nosections-before.cabal" , commentTest "layout-nosections-after.cabal" , commentTest "layout-nosections-mixed.cabal" , commentTest "layout-many-sections.cabal" , commentTest "layout-interleaved-in-section.cabal" , commentTest "layout-fieldline-is-flag.cabal" - - , readFieldTest "hackage-001.cabal" - , commentTest "happs.094.cabal" -- aligned leading comma after comment ] +-- Use this test to bypass the more sophisticated checks of whether a cabal file is valid readFieldTest :: FilePath -> TestTree readFieldTest fname = ediffGolden goldenTest fname exprFile $ do contents <- BS.readFile input diff --git a/Cabal-tests/tests/ParserTests/comments/happs.094.expr b/Cabal-tests/tests/ParserTests/comments/happs.094.expr index 5eacd787752..0a290f8784d 100644 --- a/Cabal-tests/tests/ParserTests/comments/happs.094.expr +++ b/Cabal-tests/tests/ParserTests/comments/happs.094.expr @@ -1,8 +1,312 @@ -Map.fromList - [ - _×_ - (Position 51 1) - " -- , HStringTemplate >= 0.4.0 && < 0.5.0 ", - _×_ - (Position 52 1) - " -- This should be consumed by post fieldContent"] +[ + Field + (Name (Position 1 1) "name") + [ + FieldLine + (Position 1 22) + "happs-tutorial"], + Field + (Name (Position 2 1) "version") + [ + FieldLine + (Position 2 22) + "0.9.4"], + Field + (Name (Position 3 1) "synopsis") + [ + FieldLine + (Position 3 22) + "A Happstack Tutorial that is its own web 2.0-type demo. "], + Field + (Name + (Position 4 1) + "description") + [ + FieldLine + (Position 4 22) + "A nice way to learn how to build web sites with Happstack"], + Field + (Name (Position 6 1) "license") + [ + FieldLine + (Position 6 22) + "BSD3"], + Field + (Name + (Position 7 1) + "license-file") + [ + FieldLine + (Position 7 22) + "LICENSE"], + Field + (Name (Position 8 1) "author") + [ + FieldLine + (Position 8 22) + "Thomas Hartman, Eelco Lempsink, Creighton Hogg"], + Field + (Name + (Position 10 1) + "maintainer") + [ + FieldLine + (Position 10 22) + "Thomas Hartman "], + Field + (Name + (Position 11 1) + "copyright") + [ + FieldLine + (Position 11 22) + "2008 Thomas Hartman, 2009 Thomas Hartman & Creighton Hogg"], + Field + (Name + (Position 13 1) + "stability") + [ + FieldLine + (Position 13 22) + "Experimental"], + Field + (Name + (Position 14 1) + "category") + [ + FieldLine + (Position 14 22) + "Web"], + Field + (Name + (Position 15 1) + "build-type") + [ + FieldLine + (Position 15 22) + "Simple"], + Field + (Name + (Position 17 1) + "extra-source-files") + [ + FieldLine + (Position 18 5) + "recompile-and-kill-head.sh", + FieldLine + (Position 19 5) + "hackInGhci.sh", + FieldLine + (Position 20 5) + "static/*.png", + FieldLine + (Position 21 5) + "static/*.css", + FieldLine + (Position 22 5) + "templates/*.st", + FieldLine + (Position 23 5) + "src/*.hs", + FieldLine + (Position 24 5) + "src/migrationexample/*.hs", + FieldLine + (Position 25 5) + "src/migrationexample/*.lhs", + FieldLine + (Position 26 5) + "src/migrationexample/StateVersions/*.hs"], + Field + (Name + (Position 28 1) + "cabal-version") + [ + FieldLine + (Position 28 22) + ">= 1.8"], + Section + (Name (Position 30 1) "flag") + [ + SecArgName + (Position 30 6) + "base4"] + [ + Field + (Name + (Position 31 5) + "description") + [ + FieldLine + (Position 31 18) + "Choose the even newer, even smaller, split-up base package."]], + Section + (Name + (Position 33 1) + "executable") + [ + SecArgName + (Position 33 12) + "happs-tutorial"] + [ + Field + (Name (Position 34 5) "main-is") + [ + FieldLine + (Position 34 26) + "Main.hs"], + Field + (Name + (Position 35 5) + "hs-source-dirs") + [ + FieldLine + (Position 36 9) + "src"], + Field + (Name + (Position 37 5) + "other-modules") + [ + FieldLine + (Position 38 9) + "StateVersions.AppState1", + FieldLine + (Position 39 9) + "ControllerBasic", + FieldLine + (Position 40 9) + "ControllerGetActions", + FieldLine + (Position 41 9) + "Controller", + FieldLine + (Position 42 9) + "ControllerMisc", + FieldLine + (Position 43 9) + "ControllerPostActions", + FieldLine + (Position 44 9) + "FromDataInstances", + FieldLine + (Position 45 9) + "Misc", + FieldLine + (Position 46 9) + "MiscMap", + FieldLine + (Position 47 9) + "ControllerStressTests", + FieldLine + (Position 48 9) + "View"], + Field + (Name + (Position 49 5) + "ghc-options") + [ + FieldLine + (Position 49 18) + "-Wall"], + Field + (Name + (Position 50 5) + "build-depends") + [ + FieldLine + (Position 50 22) + "base", + FieldLine + (Position 53 22) + ", HStringTemplate >= 0.6", + FieldLine + (Position 54 22) + ", HStringTemplateHelpers >= 0.0.14 && < 1.0.0", + FieldLine + (Position 55 22) + ", mtl >= 1.1.0.0 && < 2.0.0.0 ", + FieldLine + (Position 56 22) + ", bytestring ", + FieldLine + (Position 57 22) + ", happstack >= 0.5", + FieldLine + (Position 58 22) + ", containers >= 0.2.0.0 && < 0.3.0.0", + FieldLine + (Position 59 22) + ", pretty >= 1.0.1.0 && < 2 ", + FieldLine + (Position 60 22) + ", pureMD5 >= 1.0.0.0 && < 1.1.0.0", + FieldLine + (Position 61 22) + ", directory >= 1.0.0.0 && < 1.1.0.0", + FieldLine + (Position 62 22) + ", filepath >= 1.1.0.0 && < 1.2.0.0", + FieldLine + (Position 63 22) + ", hscolour == 1.13", + FieldLine + (Position 64 22) + ", HTTP >= 4000", + FieldLine + (Position 65 22) + ", safe >= 0.2 && < 0.3", + FieldLine + (Position 66 22) + ", old-time >= 1.0.0.0 && < 1.1.0.0", + FieldLine + (Position 67 22) + ", parsec >= 2.1.0.0 && < 2.2.0.0", + FieldLine + (Position 68 22) + ", happstack-helpers >= 0.50", + FieldLine + (Position 69 22) + ", DebugTraceHelpers >= 0.12 && < 0.20", + FieldLine + (Position 70 22) + ", happstack-server >= 0.5", + FieldLine + (Position 71 22) + ", happstack-data >= 0.5", + FieldLine + (Position 72 22) + ", happstack-ixset >= 0.5", + FieldLine + (Position 73 22) + ", happstack-state >= 0.5"], + Comment + " -- , HStringTemplate >= 0.4.0 && < 0.5.0 " + (Position 51 1), + Comment + " -- This should be consumed by post fieldContent" + (Position 52 1), + Section + (Name (Position 74 5) "if") + [ + SecArgName + (Position 74 8) + "flag", + SecArgOther + (Position 74 12) + "(", + SecArgName + (Position 74 13) + "base4", + SecArgOther + (Position 74 18) + ")"] + [ + Field + (Name + (Position 75 7) + "build-depends") + [ + FieldLine + (Position 75 22) + "base >=4 && <5, syb"]]]] From d2811d6d9d6bff49afd81aa5cadabd3479460309 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 14 Oct 2025 12:17:17 +0800 Subject: [PATCH 49/83] style: run fourmolu --- Cabal-syntax/src/Distribution/Fields/Field.hs | 4 +- .../src/Distribution/Fields/Parser.hs | 52 +++++++++++-------- 2 files changed, 32 insertions(+), 24 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index bd15c31990d..a337a5ede6d 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveGeneric #-} -- | Cabal-like file AST types: 'Field', 'Section' etc -- @@ -82,7 +82,7 @@ fieldUniverse f@(Comment{}) = [f] data FieldLine ann = FieldLine !ann !ByteString deriving (Eq, Show, Functor, Foldable, Traversable, Generic) -instance (ToExpr ann) => ToExpr (FieldLine ann) +instance ToExpr ann => ToExpr (FieldLine ann) -- | @since 3.12.0.0 deriving instance Ord ann => Ord (FieldLine ann) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 55bc0ce992e..d21355523d2 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -53,8 +53,8 @@ import Text.Parsec.Pos import Text.Parsec.Prim hiding (many, (<|>)) import Prelude () -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import qualified Data.Text as T +import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T -- $setup @@ -253,11 +253,12 @@ elements :: IndentLevel -> Parser [Field Position] elements ilevel = do preCmts <- many tokComment (fs, postCmtsGroups) <- unzip <$> many (commentsAfter $ element ilevel) - pure $ mconcat - [ preCmts - , mconcat fs - , mconcat postCmtsGroups - ] + pure $ + mconcat + [ preCmts + , mconcat fs + , mconcat postCmtsGroups + ] -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on @@ -459,29 +460,36 @@ parseBS p = parseTest' p "" formatError :: B8.ByteString -> ParseError -> String formatError input perr = - unlines - [ "Parse error "++ show (errorPos perr) ++ ":" - , errLine - , indicator ++ errmsg ] + unlines + [ "Parse error " ++ show (errorPos perr) ++ ":" + , errLine + , indicator ++ errmsg + ] where - pos = errorPos perr - ls = lines' (T.decodeUtf8With T.lenientDecode input) - errLine = T.unpack (ls !! (sourceLine pos - 1)) + pos = errorPos perr + ls = lines' (T.decodeUtf8With T.lenientDecode input) + errLine = T.unpack (ls !! (sourceLine pos - 1)) indicator = replicate (sourceColumn pos) ' ' ++ "^" - errmsg = showErrorMessages "or" "unknown parse error" - "expecting" "unexpected" "end of file" - (errorMessages perr) + errmsg = + showErrorMessages + "or" + "unknown parse error" + "expecting" + "unexpected" + "end of file" + (errorMessages perr) -- | Handles windows/osx/unix line breaks uniformly lines' :: T.Text -> [T.Text] lines' s1 | T.null s1 = [] | otherwise = case T.break (\c -> c == '\r' || c == '\n') s1 of - (l, s2) | Just (c,s3) <- T.uncons s2 - -> case T.uncons s3 of - Just ('\n', s4) | c == '\r' -> l : lines' s4 - _ -> l : lines' s3 - | otherwise -> [l] + (l, s2) + | Just (c, s3) <- T.uncons s2 -> + case T.uncons s3 of + Just ('\n', s4) | c == '\r' -> l : lines' s4 + _ -> l : lines' s3 + | otherwise -> [l] eof :: Parser () eof = notFollowedBy anyToken "end of file" From 0772f15d511db3193f5a078d08f6b861b7a1c537 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 14 Oct 2025 20:37:38 +0800 Subject: [PATCH 50/83] remove todos yay --- Cabal-syntax/Cabal-syntax.cabal | 1 - Cabal-syntax/src/Distribution/Fields/Pretty.hs | 1 - cabal-install/src/Distribution/Deprecated/ParseUtils.hs | 1 - 3 files changed, 3 deletions(-) diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal index cd67841f0c5..935968a7fa1 100644 --- a/Cabal-syntax/Cabal-syntax.cabal +++ b/Cabal-syntax/Cabal-syntax.cabal @@ -70,7 +70,6 @@ library if flag(CABAL_PARSEC_DEBUG) CPP-Options: -DCABAL_PARSEC_DEBUG build-depends: - -- TODO(leana8959): set bounds vector build-tool-depends: alex:alex diff --git a/Cabal-syntax/src/Distribution/Fields/Pretty.hs b/Cabal-syntax/src/Distribution/Fields/Pretty.hs index ef93d933e99..7de0cec3dbc 100644 --- a/Cabal-syntax/src/Distribution/Fields/Pretty.hs +++ b/Cabal-syntax/src/Distribution/Fields/Pretty.hs @@ -187,7 +187,6 @@ genericFromParsecFields f g = goMany go (P.Section (P.Name ann name) secargs fs) = PrettySection ann name <$> g name secargs <*> goMany fs go (P.Comment{}) = error "comment is filtered out" - -- TODO(leana8959): outside of the scope of the comment parsing PR notComment (P.Comment{}) = False notComment _ = True diff --git a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs index 86ba6676009..7260131d8b9 100644 --- a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs +++ b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs @@ -443,7 +443,6 @@ readFields input = case Fields.readFields' input of legacyFields :: [Fields.Field Parsec.Position] -> [Field] legacyFields = map legacyField . filter notComment where - -- TODO(leana8959): outside of the scope of the comment parsing PR notComment (Fields.Comment{}) = False notComment _ = True From 40f9099a4271cd8f17e0a039f1105e916e3f99dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 15 Oct 2025 11:49:56 +0800 Subject: [PATCH 51/83] test: remove test dependencies move ToExpr to orphan module --- Cabal-syntax/Cabal-syntax.cabal | 3 --- Cabal-syntax/src/Distribution/Fields/Field.hs | 9 --------- Cabal-syntax/src/Distribution/Parsec/Position.hs | 5 ----- Cabal-tests/tests/NoThunks.hs | 2 ++ Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs | 7 +++++++ 5 files changed, 9 insertions(+), 17 deletions(-) diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal index 935968a7fa1..04ccd237f64 100644 --- a/Cabal-syntax/Cabal-syntax.cabal +++ b/Cabal-syntax/Cabal-syntax.cabal @@ -49,9 +49,6 @@ library -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity -- See also https://github.com/ekmett/transformers-compat/issues/35 , transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.7) - -- for tests - , tree-diff >=0.1 && <0.4 - , nothunks >=0.1.1.0 && <0.3 ghc-options: -Wall diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index a337a5ede6d..c66599db08c 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -33,7 +33,6 @@ module Distribution.Fields.Field import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.Char as Char -import Data.TreeDiff.Class (ToExpr) import Distribution.Compat.Prelude import Distribution.Pretty (showTokenStr) import Distribution.Utils.Generic (fromUTF8BS) @@ -53,8 +52,6 @@ data Field ann | Comment !ByteString ann deriving (Eq, Show, Functor, Foldable, Traversable, Generic) -instance ToExpr ann => ToExpr (Field ann) - -- | @since 3.12.0.0 deriving instance Ord ann => Ord (Field ann) @@ -82,8 +79,6 @@ fieldUniverse f@(Comment{}) = [f] data FieldLine ann = FieldLine !ann !ByteString deriving (Eq, Show, Functor, Foldable, Traversable, Generic) -instance ToExpr ann => ToExpr (FieldLine ann) - -- | @since 3.12.0.0 deriving instance Ord ann => Ord (FieldLine ann) @@ -105,8 +100,6 @@ data SectionArg ann SecArgOther !ann !ByteString deriving (Eq, Show, Functor, Foldable, Traversable, Generic) -instance ToExpr ann => ToExpr (SectionArg ann) - -- | @since 3.12.0.0 deriving instance Ord ann => Ord (SectionArg ann) @@ -128,8 +121,6 @@ type FieldName = ByteString data Name ann = Name !ann !FieldName deriving (Eq, Show, Functor, Foldable, Traversable, Generic) -instance ToExpr ann => ToExpr (Name ann) - -- | @since 3.12.0.0 deriving instance Ord ann => Ord (Name ann) diff --git a/Cabal-syntax/src/Distribution/Parsec/Position.hs b/Cabal-syntax/src/Distribution/Parsec/Position.hs index a22b2c013e1..d56433092de 100644 --- a/Cabal-syntax/src/Distribution/Parsec/Position.hs +++ b/Cabal-syntax/src/Distribution/Parsec/Position.hs @@ -11,9 +11,6 @@ module Distribution.Parsec.Position , positionRow ) where -import Data.TreeDiff.Class (ToExpr) -import NoThunks.Class (NoThunks) - import Distribution.Compat.Prelude import Prelude () @@ -26,8 +23,6 @@ data Position instance Binary Position instance Structured Position -instance ToExpr Position -instance NoThunks Position instance NFData Position where rnf = genericRnf -- | Shift position by n columns to the right. diff --git a/Cabal-tests/tests/NoThunks.hs b/Cabal-tests/tests/NoThunks.hs index a53d404dd1e..43414f8dcb4 100644 --- a/Cabal-tests/tests/NoThunks.hs +++ b/Cabal-tests/tests/NoThunks.hs @@ -20,6 +20,7 @@ import Distribution.CabalSpecVersion (CabalSpecVersion) import Distribution.Compat.NonEmptySet (NonEmptySet) import Distribution.Compiler (CompilerFlavor, PerCompilerFlavor) import Distribution.Fields (runParseResult) +import Distribution.Parsec.Position (Position) import Distribution.ModuleName (ModuleName) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, withSource) import Distribution.Parsec.Source @@ -94,6 +95,7 @@ instance NoThunks PackageDescription instance NoThunks PackageFlag instance NoThunks PackageIdentifier instance NoThunks PackageName +instance NoThunks Position instance NoThunks LegacyExeDependency instance NoThunks ExeDependency instance NoThunks PkgconfigName diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs index f7e7ca5b7b6..79edd107d49 100644 --- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs +++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs @@ -13,9 +13,11 @@ import Data.TreeDiff.Instances.CabalVersion () import Distribution.Backpack (OpenModule, OpenUnitId) import Distribution.CabalSpecVersion (CabalSpecVersion) import Distribution.Compiler (CompilerFlavor, CompilerId, PerCompilerFlavor) +import Distribution.Fields.Field (Field, Name, FieldLine, SectionArg) import Distribution.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo) import Distribution.ModuleName (ModuleName) import Distribution.PackageDescription +import Distribution.Parsec.Position (Position) import Distribution.Simple.Compiler (DebugInfoLevel, OptimisationLevel, ProfDetailLevel) import Distribution.Simple.InstallDirs import Distribution.Simple.InstallDirs.Internal @@ -56,6 +58,10 @@ instance ToExpr (SymbolicPathX allowAbs from to) instance ToExpr a => ToExpr (InstallDirs a) +instance (ToExpr ann) => ToExpr (Field ann) +instance (ToExpr ann) => ToExpr (FieldLine ann) +instance (ToExpr ann) => ToExpr (Name ann) +instance (ToExpr ann) => ToExpr (SectionArg ann) instance ToExpr AbiDependency instance ToExpr AbiHash instance ToExpr Arch @@ -110,6 +116,7 @@ instance ToExpr PkgconfigDependency instance ToExpr PkgconfigName instance ToExpr PkgconfigVersion instance ToExpr PkgconfigVersionRange +instance ToExpr Position instance ToExpr ProfDetailLevel instance ToExpr RepoKind instance ToExpr RepoType From ac9e9bb83886c103fdd3aa3e0f53218766298a0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 15 Oct 2025 12:11:40 +0800 Subject: [PATCH 52/83] test: simplify --- Cabal-tests/tests/ParserTests.hs | 4 +- .../ParserTests/comments/hackage-001.cabal | 253 ------ .../ParserTests/comments/hackage-001.expr | 775 ------------------ .../ParserTests/comments/happs.094.cabal | 75 -- .../tests/ParserTests/comments/happs.094.expr | 312 ------- .../layout-comment-in-fieldline.cabal | 11 + .../comments/layout-comment-in-fieldline.expr | 50 ++ .../layout-complex-indented-comments.cabal | 38 + .../layout-complex-indented-comments.expr | 132 +++ 9 files changed, 233 insertions(+), 1417 deletions(-) delete mode 100644 Cabal-tests/tests/ParserTests/comments/hackage-001.cabal delete mode 100644 Cabal-tests/tests/ParserTests/comments/hackage-001.expr delete mode 100644 Cabal-tests/tests/ParserTests/comments/happs.094.cabal delete mode 100644 Cabal-tests/tests/ParserTests/comments/happs.094.expr create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 790e966dded..106797184ad 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -108,8 +108,8 @@ commentTests :: TestTree commentTests = testGroup "comments" [ -- Imported from hackage integration test - readFieldTest "hackage-001.cabal" - , readFieldTest "happs.094.cabal" -- aligned leading comma after comment + readFieldTest "layout-complex-indented-comments.cabal" + , readFieldTest "layout-comment-in-fieldline.cabal" -- aligned leading comma after comment , commentTest "layout-nosections-before.cabal" , commentTest "layout-nosections-after.cabal" diff --git a/Cabal-tests/tests/ParserTests/comments/hackage-001.cabal b/Cabal-tests/tests/ParserTests/comments/hackage-001.cabal deleted file mode 100644 index 57ba1a7cec4..00000000000 --- a/Cabal-tests/tests/ParserTests/comments/hackage-001.cabal +++ /dev/null @@ -1,253 +0,0 @@ --- Taken from integration test, "readField" - --- This is the configuration file for the 'cabal' command line tool. --- --- The available configuration options are listed below. --- Some of them have default values listed. --- --- Lines (like this one) beginning with '--' are comments. --- Be careful with spaces and indentation because they are --- used to indicate layout for nested sections. --- --- This config file was generated using the following versions --- of Cabal and cabal-install: --- Cabal library version: 3.12.1.0 --- cabal-install version: 3.12.1.0 - - -repository hackage.haskell.org - url: http://hackage.haskell.org/ - -- secure: True - -- root-keys: - -- key-threshold: 3 - --- ignore-expiry: False --- http-transport: --- nix: --- store-dir: --- active-repositories: --- local-no-index-repo: -remote-repo-cache: /home/foo/.cache/cabal/packages --- logs-dir: /home/foo/.cache/cabal/logs --- default-user-config: --- verbose: 1 --- compiler: ghc --- cabal-file: --- with-compiler: --- with-hc-pkg: --- program-prefix: --- program-suffix: --- library-vanilla: True --- library-profiling: --- shared: --- static: --- executable-dynamic: False --- executable-static: False --- profiling: --- executable-profiling: --- profiling-detail: --- library-profiling-detail: --- optimization: True --- debug-info: False --- build-info: --- library-for-ghci: --- split-sections: False --- split-objs: False --- executable-stripping: --- library-stripping: --- configure-option: --- user-install: True --- package-db: --- flags: --- extra-include-dirs: --- deterministic: --- cid: --- extra-lib-dirs: --- extra-lib-dirs-static: --- extra-framework-dirs: --- extra-prog-path: --- instantiate-with: --- tests: False --- coverage: False --- library-coverage: --- exact-configuration: False --- benchmarks: False --- relocatable: False --- response-files: --- allow-depending-on-private-libs: --- coverage-for: --- cabal-lib-version: --- append: --- backup: --- constraint: --- preference: --- solver: modular --- allow-older: False --- allow-newer: False --- write-ghc-environment-files: --- documentation: False --- doc-index-file: $datadir/doc/$arch-$os-$compiler/index.html --- only-download: False --- target-package-db: --- max-backjumps: 4000 --- reorder-goals: False --- count-conflicts: True --- fine-grained-conflicts: True --- minimize-conflict-set: False --- independent-goals: False --- prefer-oldest: False --- shadow-installed-packages: False --- strong-flags: False --- allow-boot-library-installs: False --- reject-unconstrained-dependencies: none --- reinstall: False --- avoid-reinstalls: False --- force-reinstalls: False --- upgrade-dependencies: False --- index-state: --- root-cmd: --- symlink-bindir: -build-summary: /home/foo/.cache/cabal/logs/build.log --- build-log: -remote-build-reporting: none --- report-planning-failure: False --- per-component: True --- run-tests: --- semaphore: False -jobs: $ncpus --- keep-going: False --- offline: False --- lib: False --- package-env: --- overwrite-policy: --- install-method: -installdir: /home/foo/.local/bin --- token: --- username: --- password: --- password-command: --- multi-repl: --- builddir: - -haddock - -- keep-temp-files: False - -- hoogle: False - -- html: False - -- html-location: - -- executables: False - -- tests: False - -- benchmarks: False - -- foreign-libraries: False - -- all: - -- internal: False - -- css: - -- hyperlink-source: False - -- quickjump: False - -- hscolour-css: - -- contents-location: - -- index-location: - -- base-url: - -- lib: - -- output-dir: - -init - -- interactive: False - -- quiet: False - -- no-comments: False - -- minimal: False - -- cabal-version: 3.0 - -- license: - -- extra-doc-file: - -- tests: - -- test-dir: - -- simple: False - -- language: Haskell2010 - -- application-dir: app - -- source-dir: src - -install-dirs user - -- prefix: /home/foo/.cabal - -- bindir: $prefix/bin - -- libdir: $prefix/lib - -- libsubdir: $abi/$libname - -- dynlibdir: $libdir/$abi - -- libexecdir: $prefix/libexec - -- libexecsubdir: $abi/$pkgid - -- datadir: $prefix/share - -- datasubdir: $abi/$pkgid - -- docdir: $datadir/doc/$abi/$pkgid - -- htmldir: $docdir/html - -- haddockdir: $htmldir - -- sysconfdir: $prefix/etc - -install-dirs global - -- prefix: /usr/local - -- bindir: $prefix/bin - -- libdir: $prefix/lib - -- libsubdir: $abi/$libname - -- dynlibdir: $libdir/$abi - -- libexecdir: $prefix/libexec - -- libexecsubdir: $abi/$pkgid - -- datadir: $prefix/share - -- datasubdir: $abi/$pkgid - -- docdir: $datadir/doc/$abi/$pkgid - -- htmldir: $docdir/html - -- haddockdir: $htmldir - -- sysconfdir: $prefix/etc - -program-locations - -- alex-location: - -- ar-location: - -- c2hs-location: - -- cpphs-location: - -- doctest-location: - -- gcc-location: - -- ghc-location: - -- ghc-pkg-location: - -- ghcjs-location: - -- ghcjs-pkg-location: - -- greencard-location: - -- haddock-location: - -- happy-location: - -- haskell-suite-location: - -- haskell-suite-pkg-location: - -- hmake-location: - -- hpc-location: - -- hsc2hs-location: - -- hscolour-location: - -- jhc-location: - -- ld-location: - -- pkg-config-location: - -- runghc-location: - -- strip-location: - -- tar-location: - -- uhc-location: - -program-default-options - -- alex-options: - -- ar-options: - -- c2hs-options: - -- cpphs-options: - -- doctest-options: - -- gcc-options: - -- ghc-options: - -- ghc-pkg-options: - -- ghcjs-options: - -- ghcjs-pkg-options: - -- greencard-options: - -- haddock-options: - -- happy-options: - -- haskell-suite-options: - -- haskell-suite-pkg-options: - -- hmake-options: - -- hpc-options: - -- hsc2hs-options: - -- hscolour-options: - -- jhc-options: - -- ld-options: - -- pkg-config-options: - -- runghc-options: - -- strip-options: - -- tar-options: - -- uhc-options: - diff --git a/Cabal-tests/tests/ParserTests/comments/hackage-001.expr b/Cabal-tests/tests/ParserTests/comments/hackage-001.expr deleted file mode 100644 index e2fe8cdc83c..00000000000 --- a/Cabal-tests/tests/ParserTests/comments/hackage-001.expr +++ /dev/null @@ -1,775 +0,0 @@ -[ - Comment - "-- Taken from integration test, \"readField\"" - (Position 1 1), - Comment - "-- This is the configuration file for the 'cabal' command line tool." - (Position 3 1), - Comment "--" (Position 4 1), - Comment - "-- The available configuration options are listed below." - (Position 5 1), - Comment - "-- Some of them have default values listed." - (Position 6 1), - Comment "--" (Position 7 1), - Comment - "-- Lines (like this one) beginning with '--' are comments." - (Position 8 1), - Comment - "-- Be careful with spaces and indentation because they are" - (Position 9 1), - Comment - "-- used to indicate layout for nested sections." - (Position 10 1), - Comment "--" (Position 11 1), - Comment - "-- This config file was generated using the following versions" - (Position 12 1), - Comment - "-- of Cabal and cabal-install:" - (Position 13 1), - Comment - "-- Cabal library version: 3.12.1.0" - (Position 14 1), - Comment - "-- cabal-install version: 3.12.1.0" - (Position 15 1), - Section - (Name - (Position 18 1) - "repository") - [ - SecArgName - (Position 18 12) - "hackage.haskell.org"] - [ - Field - (Name (Position 19 3) "url") - [ - FieldLine - (Position 19 8) - "http://hackage.haskell.org/"], - Comment - " -- secure: True" - (Position 20 1), - Comment - " -- root-keys:" - (Position 21 1), - Comment - " -- key-threshold: 3" - (Position 22 1), - Comment - "-- ignore-expiry: False" - (Position 24 1), - Comment - "-- http-transport:" - (Position 25 1), - Comment - "-- nix:" - (Position 26 1), - Comment - "-- store-dir:" - (Position 27 1), - Comment - "-- active-repositories:" - (Position 28 1), - Comment - "-- local-no-index-repo:" - (Position 29 1)], - Field - (Name - (Position 30 1) - "remote-repo-cache") - [ - FieldLine - (Position 30 20) - "/home/foo/.cache/cabal/packages"], - Comment - "-- logs-dir: /home/foo/.cache/cabal/logs" - (Position 31 1), - Comment - "-- default-user-config:" - (Position 32 1), - Comment - "-- verbose: 1" - (Position 33 1), - Comment - "-- compiler: ghc" - (Position 34 1), - Comment - "-- cabal-file:" - (Position 35 1), - Comment - "-- with-compiler:" - (Position 36 1), - Comment - "-- with-hc-pkg:" - (Position 37 1), - Comment - "-- program-prefix:" - (Position 38 1), - Comment - "-- program-suffix:" - (Position 39 1), - Comment - "-- library-vanilla: True" - (Position 40 1), - Comment - "-- library-profiling:" - (Position 41 1), - Comment - "-- shared:" - (Position 42 1), - Comment - "-- static:" - (Position 43 1), - Comment - "-- executable-dynamic: False" - (Position 44 1), - Comment - "-- executable-static: False" - (Position 45 1), - Comment - "-- profiling:" - (Position 46 1), - Comment - "-- executable-profiling:" - (Position 47 1), - Comment - "-- profiling-detail:" - (Position 48 1), - Comment - "-- library-profiling-detail:" - (Position 49 1), - Comment - "-- optimization: True" - (Position 50 1), - Comment - "-- debug-info: False" - (Position 51 1), - Comment - "-- build-info:" - (Position 52 1), - Comment - "-- library-for-ghci:" - (Position 53 1), - Comment - "-- split-sections: False" - (Position 54 1), - Comment - "-- split-objs: False" - (Position 55 1), - Comment - "-- executable-stripping:" - (Position 56 1), - Comment - "-- library-stripping:" - (Position 57 1), - Comment - "-- configure-option:" - (Position 58 1), - Comment - "-- user-install: True" - (Position 59 1), - Comment - "-- package-db:" - (Position 60 1), - Comment - "-- flags:" - (Position 61 1), - Comment - "-- extra-include-dirs:" - (Position 62 1), - Comment - "-- deterministic:" - (Position 63 1), - Comment - "-- cid:" - (Position 64 1), - Comment - "-- extra-lib-dirs:" - (Position 65 1), - Comment - "-- extra-lib-dirs-static:" - (Position 66 1), - Comment - "-- extra-framework-dirs:" - (Position 67 1), - Comment - "-- extra-prog-path:" - (Position 68 1), - Comment - "-- instantiate-with:" - (Position 69 1), - Comment - "-- tests: False" - (Position 70 1), - Comment - "-- coverage: False" - (Position 71 1), - Comment - "-- library-coverage:" - (Position 72 1), - Comment - "-- exact-configuration: False" - (Position 73 1), - Comment - "-- benchmarks: False" - (Position 74 1), - Comment - "-- relocatable: False" - (Position 75 1), - Comment - "-- response-files:" - (Position 76 1), - Comment - "-- allow-depending-on-private-libs:" - (Position 77 1), - Comment - "-- coverage-for:" - (Position 78 1), - Comment - "-- cabal-lib-version:" - (Position 79 1), - Comment - "-- append:" - (Position 80 1), - Comment - "-- backup:" - (Position 81 1), - Comment - "-- constraint:" - (Position 82 1), - Comment - "-- preference:" - (Position 83 1), - Comment - "-- solver: modular" - (Position 84 1), - Comment - "-- allow-older: False" - (Position 85 1), - Comment - "-- allow-newer: False" - (Position 86 1), - Comment - "-- write-ghc-environment-files:" - (Position 87 1), - Comment - "-- documentation: False" - (Position 88 1), - Comment - "-- doc-index-file: $datadir/doc/$arch-$os-$compiler/index.html" - (Position 89 1), - Comment - "-- only-download: False" - (Position 90 1), - Comment - "-- target-package-db:" - (Position 91 1), - Comment - "-- max-backjumps: 4000" - (Position 92 1), - Comment - "-- reorder-goals: False" - (Position 93 1), - Comment - "-- count-conflicts: True" - (Position 94 1), - Comment - "-- fine-grained-conflicts: True" - (Position 95 1), - Comment - "-- minimize-conflict-set: False" - (Position 96 1), - Comment - "-- independent-goals: False" - (Position 97 1), - Comment - "-- prefer-oldest: False" - (Position 98 1), - Comment - "-- shadow-installed-packages: False" - (Position 99 1), - Comment - "-- strong-flags: False" - (Position 100 1), - Comment - "-- allow-boot-library-installs: False" - (Position 101 1), - Comment - "-- reject-unconstrained-dependencies: none" - (Position 102 1), - Comment - "-- reinstall: False" - (Position 103 1), - Comment - "-- avoid-reinstalls: False" - (Position 104 1), - Comment - "-- force-reinstalls: False" - (Position 105 1), - Comment - "-- upgrade-dependencies: False" - (Position 106 1), - Comment - "-- index-state:" - (Position 107 1), - Comment - "-- root-cmd:" - (Position 108 1), - Comment - "-- symlink-bindir:" - (Position 109 1), - Field - (Name - (Position 110 1) - "build-summary") - [ - FieldLine - (Position 110 16) - "/home/foo/.cache/cabal/logs/build.log"], - Comment - "-- build-log:" - (Position 111 1), - Field - (Name - (Position 112 1) - "remote-build-reporting") - [ - FieldLine - (Position 112 25) - "none"], - Comment - "-- report-planning-failure: False" - (Position 113 1), - Comment - "-- per-component: True" - (Position 114 1), - Comment - "-- run-tests:" - (Position 115 1), - Comment - "-- semaphore: False" - (Position 116 1), - Field - (Name (Position 117 1) "jobs") - [ - FieldLine - (Position 117 7) - "$ncpus"], - Comment - "-- keep-going: False" - (Position 118 1), - Comment - "-- offline: False" - (Position 119 1), - Comment - "-- lib: False" - (Position 120 1), - Comment - "-- package-env:" - (Position 121 1), - Comment - "-- overwrite-policy:" - (Position 122 1), - Comment - "-- install-method:" - (Position 123 1), - Field - (Name - (Position 124 1) - "installdir") - [ - FieldLine - (Position 124 13) - "/home/foo/.local/bin"], - Comment - "-- token:" - (Position 125 1), - Comment - "-- username:" - (Position 126 1), - Comment - "-- password:" - (Position 127 1), - Comment - "-- password-command:" - (Position 128 1), - Comment - "-- multi-repl:" - (Position 129 1), - Comment - "-- builddir:" - (Position 130 1), - Section - (Name - (Position 132 1) - "haddock") - [] - [ - Comment - " -- keep-temp-files: False" - (Position 133 1), - Comment - " -- hoogle: False" - (Position 134 1), - Comment - " -- html: False" - (Position 135 1), - Comment - " -- html-location:" - (Position 136 1), - Comment - " -- executables: False" - (Position 137 1), - Comment - " -- tests: False" - (Position 138 1), - Comment - " -- benchmarks: False" - (Position 139 1), - Comment - " -- foreign-libraries: False" - (Position 140 1), - Comment - " -- all:" - (Position 141 1), - Comment - " -- internal: False" - (Position 142 1), - Comment - " -- css:" - (Position 143 1), - Comment - " -- hyperlink-source: False" - (Position 144 1), - Comment - " -- quickjump: False" - (Position 145 1), - Comment - " -- hscolour-css:" - (Position 146 1), - Comment - " -- contents-location:" - (Position 147 1), - Comment - " -- index-location:" - (Position 148 1), - Comment - " -- base-url:" - (Position 149 1), - Comment - " -- lib:" - (Position 150 1), - Comment - " -- output-dir:" - (Position 151 1)], - Section - (Name (Position 153 1) "init") - [] - [ - Comment - " -- interactive: False" - (Position 154 1), - Comment - " -- quiet: False" - (Position 155 1), - Comment - " -- no-comments: False" - (Position 156 1), - Comment - " -- minimal: False" - (Position 157 1), - Comment - " -- cabal-version: 3.0" - (Position 158 1), - Comment - " -- license:" - (Position 159 1), - Comment - " -- extra-doc-file:" - (Position 160 1), - Comment - " -- tests:" - (Position 161 1), - Comment - " -- test-dir:" - (Position 162 1), - Comment - " -- simple: False" - (Position 163 1), - Comment - " -- language: Haskell2010" - (Position 164 1), - Comment - " -- application-dir: app" - (Position 165 1), - Comment - " -- source-dir: src" - (Position 166 1)], - Section - (Name - (Position 168 1) - "install-dirs") - [ - SecArgName - (Position 168 14) - "user"] - [ - Comment - " -- prefix: /home/foo/.cabal" - (Position 169 1), - Comment - " -- bindir: $prefix/bin" - (Position 170 1), - Comment - " -- libdir: $prefix/lib" - (Position 171 1), - Comment - " -- libsubdir: $abi/$libname" - (Position 172 1), - Comment - " -- dynlibdir: $libdir/$abi" - (Position 173 1), - Comment - " -- libexecdir: $prefix/libexec" - (Position 174 1), - Comment - " -- libexecsubdir: $abi/$pkgid" - (Position 175 1), - Comment - " -- datadir: $prefix/share" - (Position 176 1), - Comment - " -- datasubdir: $abi/$pkgid" - (Position 177 1), - Comment - " -- docdir: $datadir/doc/$abi/$pkgid" - (Position 178 1), - Comment - " -- htmldir: $docdir/html" - (Position 179 1), - Comment - " -- haddockdir: $htmldir" - (Position 180 1), - Comment - " -- sysconfdir: $prefix/etc" - (Position 181 1)], - Section - (Name - (Position 183 1) - "install-dirs") - [ - SecArgName - (Position 183 14) - "global"] - [ - Comment - " -- prefix: /usr/local" - (Position 184 1), - Comment - " -- bindir: $prefix/bin" - (Position 185 1), - Comment - " -- libdir: $prefix/lib" - (Position 186 1), - Comment - " -- libsubdir: $abi/$libname" - (Position 187 1), - Comment - " -- dynlibdir: $libdir/$abi" - (Position 188 1), - Comment - " -- libexecdir: $prefix/libexec" - (Position 189 1), - Comment - " -- libexecsubdir: $abi/$pkgid" - (Position 190 1), - Comment - " -- datadir: $prefix/share" - (Position 191 1), - Comment - " -- datasubdir: $abi/$pkgid" - (Position 192 1), - Comment - " -- docdir: $datadir/doc/$abi/$pkgid" - (Position 193 1), - Comment - " -- htmldir: $docdir/html" - (Position 194 1), - Comment - " -- haddockdir: $htmldir" - (Position 195 1), - Comment - " -- sysconfdir: $prefix/etc" - (Position 196 1)], - Section - (Name - (Position 198 1) - "program-locations") - [] - [ - Comment - " -- alex-location:" - (Position 199 1), - Comment - " -- ar-location:" - (Position 200 1), - Comment - " -- c2hs-location:" - (Position 201 1), - Comment - " -- cpphs-location:" - (Position 202 1), - Comment - " -- doctest-location:" - (Position 203 1), - Comment - " -- gcc-location:" - (Position 204 1), - Comment - " -- ghc-location:" - (Position 205 1), - Comment - " -- ghc-pkg-location:" - (Position 206 1), - Comment - " -- ghcjs-location:" - (Position 207 1), - Comment - " -- ghcjs-pkg-location:" - (Position 208 1), - Comment - " -- greencard-location:" - (Position 209 1), - Comment - " -- haddock-location:" - (Position 210 1), - Comment - " -- happy-location:" - (Position 211 1), - Comment - " -- haskell-suite-location:" - (Position 212 1), - Comment - " -- haskell-suite-pkg-location:" - (Position 213 1), - Comment - " -- hmake-location:" - (Position 214 1), - Comment - " -- hpc-location:" - (Position 215 1), - Comment - " -- hsc2hs-location:" - (Position 216 1), - Comment - " -- hscolour-location:" - (Position 217 1), - Comment - " -- jhc-location:" - (Position 218 1), - Comment - " -- ld-location:" - (Position 219 1), - Comment - " -- pkg-config-location:" - (Position 220 1), - Comment - " -- runghc-location:" - (Position 221 1), - Comment - " -- strip-location:" - (Position 222 1), - Comment - " -- tar-location:" - (Position 223 1), - Comment - " -- uhc-location:" - (Position 224 1)], - Section - (Name - (Position 226 1) - "program-default-options") - [] - [ - Comment - " -- alex-options:" - (Position 227 1), - Comment - " -- ar-options:" - (Position 228 1), - Comment - " -- c2hs-options:" - (Position 229 1), - Comment - " -- cpphs-options:" - (Position 230 1), - Comment - " -- doctest-options:" - (Position 231 1), - Comment - " -- gcc-options:" - (Position 232 1), - Comment - " -- ghc-options:" - (Position 233 1), - Comment - " -- ghc-pkg-options:" - (Position 234 1), - Comment - " -- ghcjs-options:" - (Position 235 1), - Comment - " -- ghcjs-pkg-options:" - (Position 236 1), - Comment - " -- greencard-options:" - (Position 237 1), - Comment - " -- haddock-options:" - (Position 238 1), - Comment - " -- happy-options:" - (Position 239 1), - Comment - " -- haskell-suite-options:" - (Position 240 1), - Comment - " -- haskell-suite-pkg-options:" - (Position 241 1), - Comment - " -- hmake-options:" - (Position 242 1), - Comment - " -- hpc-options:" - (Position 243 1), - Comment - " -- hsc2hs-options:" - (Position 244 1), - Comment - " -- hscolour-options:" - (Position 245 1), - Comment - " -- jhc-options:" - (Position 246 1), - Comment - " -- ld-options:" - (Position 247 1), - Comment - " -- pkg-config-options:" - (Position 248 1), - Comment - " -- runghc-options:" - (Position 249 1), - Comment - " -- strip-options:" - (Position 250 1), - Comment - " -- tar-options:" - (Position 251 1), - Comment - " -- uhc-options:" - (Position 252 1)]] diff --git a/Cabal-tests/tests/ParserTests/comments/happs.094.cabal b/Cabal-tests/tests/ParserTests/comments/happs.094.cabal deleted file mode 100644 index f502eeb1109..00000000000 --- a/Cabal-tests/tests/ParserTests/comments/happs.094.cabal +++ /dev/null @@ -1,75 +0,0 @@ -Name: happs-tutorial -Version: 0.9.4 -Synopsis: A Happstack Tutorial that is its own web 2.0-type demo. -Description: A nice way to learn how to build web sites with Happstack - -License: BSD3 -License-file: LICENSE -Author: Thomas Hartman, Eelco Lempsink, Creighton Hogg - -Maintainer: Thomas Hartman -Copyright: 2008 Thomas Hartman, 2009 Thomas Hartman & Creighton Hogg - -Stability: Experimental -Category: Web -Build-type: Simple - -Extra-Source-Files: - recompile-and-kill-head.sh - hackInGhci.sh - static/*.png - static/*.css - templates/*.st - src/*.hs - src/migrationexample/*.hs - src/migrationexample/*.lhs - src/migrationexample/StateVersions/*.hs - -Cabal-Version: >= 1.8 - -Flag base4 - Description: Choose the even newer, even smaller, split-up base package. - -Executable happs-tutorial - Main-is: Main.hs - hs-source-dirs: - src - Other-Modules: - StateVersions.AppState1 - ControllerBasic - ControllerGetActions - Controller - ControllerMisc - ControllerPostActions - FromDataInstances - Misc - MiscMap - ControllerStressTests - View - ghc-options: -Wall - Build-Depends: base - -- , HStringTemplate >= 0.4.0 && < 0.5.0 - -- This should be consumed by post fieldContent - , HStringTemplate >= 0.6 - , HStringTemplateHelpers >= 0.0.14 && < 1.0.0 - , mtl >= 1.1.0.0 && < 2.0.0.0 - , bytestring - , happstack >= 0.5 - , containers >= 0.2.0.0 && < 0.3.0.0 - , pretty >= 1.0.1.0 && < 2 - , pureMD5 >= 1.0.0.0 && < 1.1.0.0 - , directory >= 1.0.0.0 && < 1.1.0.0 - , filepath >= 1.1.0.0 && < 1.2.0.0 - , hscolour == 1.13 - , HTTP >= 4000 - , safe >= 0.2 && < 0.3 - , old-time >= 1.0.0.0 && < 1.1.0.0 - , parsec >= 2.1.0.0 && < 2.2.0.0 - , happstack-helpers >= 0.50 - , DebugTraceHelpers >= 0.12 && < 0.20 - , happstack-server >= 0.5 - , happstack-data >= 0.5 - , happstack-ixset >= 0.5 - , happstack-state >= 0.5 - if flag(base4) - Build-Depends: base >=4 && <5, syb diff --git a/Cabal-tests/tests/ParserTests/comments/happs.094.expr b/Cabal-tests/tests/ParserTests/comments/happs.094.expr deleted file mode 100644 index 0a290f8784d..00000000000 --- a/Cabal-tests/tests/ParserTests/comments/happs.094.expr +++ /dev/null @@ -1,312 +0,0 @@ -[ - Field - (Name (Position 1 1) "name") - [ - FieldLine - (Position 1 22) - "happs-tutorial"], - Field - (Name (Position 2 1) "version") - [ - FieldLine - (Position 2 22) - "0.9.4"], - Field - (Name (Position 3 1) "synopsis") - [ - FieldLine - (Position 3 22) - "A Happstack Tutorial that is its own web 2.0-type demo. "], - Field - (Name - (Position 4 1) - "description") - [ - FieldLine - (Position 4 22) - "A nice way to learn how to build web sites with Happstack"], - Field - (Name (Position 6 1) "license") - [ - FieldLine - (Position 6 22) - "BSD3"], - Field - (Name - (Position 7 1) - "license-file") - [ - FieldLine - (Position 7 22) - "LICENSE"], - Field - (Name (Position 8 1) "author") - [ - FieldLine - (Position 8 22) - "Thomas Hartman, Eelco Lempsink, Creighton Hogg"], - Field - (Name - (Position 10 1) - "maintainer") - [ - FieldLine - (Position 10 22) - "Thomas Hartman "], - Field - (Name - (Position 11 1) - "copyright") - [ - FieldLine - (Position 11 22) - "2008 Thomas Hartman, 2009 Thomas Hartman & Creighton Hogg"], - Field - (Name - (Position 13 1) - "stability") - [ - FieldLine - (Position 13 22) - "Experimental"], - Field - (Name - (Position 14 1) - "category") - [ - FieldLine - (Position 14 22) - "Web"], - Field - (Name - (Position 15 1) - "build-type") - [ - FieldLine - (Position 15 22) - "Simple"], - Field - (Name - (Position 17 1) - "extra-source-files") - [ - FieldLine - (Position 18 5) - "recompile-and-kill-head.sh", - FieldLine - (Position 19 5) - "hackInGhci.sh", - FieldLine - (Position 20 5) - "static/*.png", - FieldLine - (Position 21 5) - "static/*.css", - FieldLine - (Position 22 5) - "templates/*.st", - FieldLine - (Position 23 5) - "src/*.hs", - FieldLine - (Position 24 5) - "src/migrationexample/*.hs", - FieldLine - (Position 25 5) - "src/migrationexample/*.lhs", - FieldLine - (Position 26 5) - "src/migrationexample/StateVersions/*.hs"], - Field - (Name - (Position 28 1) - "cabal-version") - [ - FieldLine - (Position 28 22) - ">= 1.8"], - Section - (Name (Position 30 1) "flag") - [ - SecArgName - (Position 30 6) - "base4"] - [ - Field - (Name - (Position 31 5) - "description") - [ - FieldLine - (Position 31 18) - "Choose the even newer, even smaller, split-up base package."]], - Section - (Name - (Position 33 1) - "executable") - [ - SecArgName - (Position 33 12) - "happs-tutorial"] - [ - Field - (Name (Position 34 5) "main-is") - [ - FieldLine - (Position 34 26) - "Main.hs"], - Field - (Name - (Position 35 5) - "hs-source-dirs") - [ - FieldLine - (Position 36 9) - "src"], - Field - (Name - (Position 37 5) - "other-modules") - [ - FieldLine - (Position 38 9) - "StateVersions.AppState1", - FieldLine - (Position 39 9) - "ControllerBasic", - FieldLine - (Position 40 9) - "ControllerGetActions", - FieldLine - (Position 41 9) - "Controller", - FieldLine - (Position 42 9) - "ControllerMisc", - FieldLine - (Position 43 9) - "ControllerPostActions", - FieldLine - (Position 44 9) - "FromDataInstances", - FieldLine - (Position 45 9) - "Misc", - FieldLine - (Position 46 9) - "MiscMap", - FieldLine - (Position 47 9) - "ControllerStressTests", - FieldLine - (Position 48 9) - "View"], - Field - (Name - (Position 49 5) - "ghc-options") - [ - FieldLine - (Position 49 18) - "-Wall"], - Field - (Name - (Position 50 5) - "build-depends") - [ - FieldLine - (Position 50 22) - "base", - FieldLine - (Position 53 22) - ", HStringTemplate >= 0.6", - FieldLine - (Position 54 22) - ", HStringTemplateHelpers >= 0.0.14 && < 1.0.0", - FieldLine - (Position 55 22) - ", mtl >= 1.1.0.0 && < 2.0.0.0 ", - FieldLine - (Position 56 22) - ", bytestring ", - FieldLine - (Position 57 22) - ", happstack >= 0.5", - FieldLine - (Position 58 22) - ", containers >= 0.2.0.0 && < 0.3.0.0", - FieldLine - (Position 59 22) - ", pretty >= 1.0.1.0 && < 2 ", - FieldLine - (Position 60 22) - ", pureMD5 >= 1.0.0.0 && < 1.1.0.0", - FieldLine - (Position 61 22) - ", directory >= 1.0.0.0 && < 1.1.0.0", - FieldLine - (Position 62 22) - ", filepath >= 1.1.0.0 && < 1.2.0.0", - FieldLine - (Position 63 22) - ", hscolour == 1.13", - FieldLine - (Position 64 22) - ", HTTP >= 4000", - FieldLine - (Position 65 22) - ", safe >= 0.2 && < 0.3", - FieldLine - (Position 66 22) - ", old-time >= 1.0.0.0 && < 1.1.0.0", - FieldLine - (Position 67 22) - ", parsec >= 2.1.0.0 && < 2.2.0.0", - FieldLine - (Position 68 22) - ", happstack-helpers >= 0.50", - FieldLine - (Position 69 22) - ", DebugTraceHelpers >= 0.12 && < 0.20", - FieldLine - (Position 70 22) - ", happstack-server >= 0.5", - FieldLine - (Position 71 22) - ", happstack-data >= 0.5", - FieldLine - (Position 72 22) - ", happstack-ixset >= 0.5", - FieldLine - (Position 73 22) - ", happstack-state >= 0.5"], - Comment - " -- , HStringTemplate >= 0.4.0 && < 0.5.0 " - (Position 51 1), - Comment - " -- This should be consumed by post fieldContent" - (Position 52 1), - Section - (Name (Position 74 5) "if") - [ - SecArgName - (Position 74 8) - "flag", - SecArgOther - (Position 74 12) - "(", - SecArgName - (Position 74 13) - "base4", - SecArgOther - (Position 74 18) - ")"] - [ - Field - (Name - (Position 75 7) - "build-depends") - [ - FieldLine - (Position 75 22) - "base >=4 && <5, syb"]]]] diff --git a/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.cabal b/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.cabal new file mode 100644 index 00000000000..73981b27a78 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.cabal @@ -0,0 +1,11 @@ +Executable + Main-is: Main.hs + hs-source-dirs: + src + ghc-options: -Wall + Build-Depends: base + -- , foo + -- ^ This should be consumed after fieldContent + , bar + -- , comemnt + , baz diff --git a/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr b/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr new file mode 100644 index 00000000000..e1563128d97 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr @@ -0,0 +1,50 @@ +[ + Section + (Name + (Position 1 1) + "executable") + [] + [ + Field + (Name (Position 2 5) "main-is") + [ + FieldLine + (Position 2 26) + "Main.hs"], + Field + (Name + (Position 3 5) + "hs-source-dirs") + [ + FieldLine (Position 4 9) "src"], + Field + (Name + (Position 5 5) + "ghc-options") + [ + FieldLine + (Position 5 18) + "-Wall"], + Field + (Name + (Position 6 5) + "build-depends") + [ + FieldLine + (Position 6 22) + "base", + FieldLine + (Position 9 22) + ", bar", + FieldLine + (Position 11 22) + ", baz"], + Comment + " -- , foo" + (Position 7 1), + Comment + " -- ^ This should be consumed after fieldContent" + (Position 8 1), + Comment + " -- , comemnt" + (Position 10 1)]] diff --git a/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.cabal b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.cabal new file mode 100644 index 00000000000..cbc3d4db683 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.cabal @@ -0,0 +1,38 @@ +-- This is the configuration file for the 'cabal' command line tool. +-- +-- The available configuration options are listed below. + + +repository hackage.haskell.org + url: http://hackage.haskell.org/ + -- secure: True + -- root-keys: + +-- ignore-expiry: False +-- http-transport: +remote-repo-cache: /home/foo/.cache/cabal/packages +-- logs-dir: /home/foo/.cache/cabal/logs +-- default-user-config: +build-summary: /home/foo/.cache/cabal/logs/build.log +-- build-log: +remote-build-reporting: none +-- report-planning-failure: False +-- per-component: True +jobs: $ncpus +-- keep-going: False +-- offline: False +installdir: /home/foo/.local/bin +-- token: +-- username: + +haddock + -- keep-temp-files: False + -- hoogle: False + +init + -- interactive: False + -- quiet: False + +program-locations + -- alex-location: + -- ar-location: diff --git a/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr new file mode 100644 index 00000000000..070a0582e59 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr @@ -0,0 +1,132 @@ +[ + Comment + "-- This is the configuration file for the 'cabal' command line tool." + (Position 1 1), + Comment "--" (Position 2 1), + Comment + "-- The available configuration options are listed below." + (Position 3 1), + Section + (Name + (Position 6 1) + "repository") + [ + SecArgName + (Position 6 12) + "hackage.haskell.org"] + [ + Field + (Name (Position 7 3) "url") + [ + FieldLine + (Position 7 8) + "http://hackage.haskell.org/"], + Comment + " -- secure: True" + (Position 8 1), + Comment + " -- root-keys:" + (Position 9 1), + Comment + "-- ignore-expiry: False" + (Position 11 1), + Comment + "-- http-transport:" + (Position 12 1)], + Field + (Name + (Position 13 1) + "remote-repo-cache") + [ + FieldLine + (Position 13 20) + "/home/foo/.cache/cabal/packages"], + Comment + "-- logs-dir: /home/foo/.cache/cabal/logs" + (Position 14 1), + Comment + "-- default-user-config:" + (Position 15 1), + Field + (Name + (Position 16 1) + "build-summary") + [ + FieldLine + (Position 16 16) + "/home/foo/.cache/cabal/logs/build.log"], + Comment + "-- build-log:" + (Position 17 1), + Field + (Name + (Position 18 1) + "remote-build-reporting") + [ + FieldLine + (Position 18 25) + "none"], + Comment + "-- report-planning-failure: False" + (Position 19 1), + Comment + "-- per-component: True" + (Position 20 1), + Field + (Name (Position 21 1) "jobs") + [ + FieldLine + (Position 21 7) + "$ncpus"], + Comment + "-- keep-going: False" + (Position 22 1), + Comment + "-- offline: False" + (Position 23 1), + Field + (Name + (Position 24 1) + "installdir") + [ + FieldLine + (Position 24 13) + "/home/foo/.local/bin"], + Comment + "-- token:" + (Position 25 1), + Comment + "-- username:" + (Position 26 1), + Section + (Name (Position 28 1) "haddock") + [] + [ + Comment + " -- keep-temp-files: False" + (Position 29 1), + Comment + " -- hoogle: False" + (Position 30 1)], + Section + (Name (Position 32 1) "init") + [] + [ + Comment + " -- interactive: False" + (Position 33 1), + Comment + " -- quiet: False" + (Position 34 1)], + Section + (Name + (Position 36 1) + "program-locations") + [] + [ + Comment + " -- alex-location:" + (Position 37 1), + Comment + " -- ar-location:" + (Position 38 1)]] From fa09f6d0fe511f36199d787f8719ee5474607d1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 15 Oct 2025 12:23:24 +0800 Subject: [PATCH 53/83] restore accidently formatted cabal --- Cabal/Cabal.cabal | 762 ++++++++++++++++++++++++---------------------- 1 file changed, 399 insertions(+), 363 deletions(-) diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 3300d883ffb..97e8c0d2811 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -1,383 +1,419 @@ -cabal-version: 3.6 -name: Cabal -version: 3.17.0.0 -license: BSD-3-Clause -license-file: LICENSE -copyright: 2003-2025, Cabal Development Team (see AUTHORS file) -maintainer: cabal-devel@haskell.org -author: Cabal Development Team -homepage: http://www.haskell.org/cabal/ -bug-reports: https://github.com/haskell/cabal/issues -synopsis: A framework for packaging Haskell software +cabal-version: 3.6 +name: Cabal +version: 3.17.0.0 +copyright: 2003-2025, Cabal Development Team (see AUTHORS file) +license: BSD-3-Clause +license-file: LICENSE +author: Cabal Development Team +maintainer: cabal-devel@haskell.org +homepage: http://www.haskell.org/cabal/ +bug-reports: https://github.com/haskell/cabal/issues +synopsis: A framework for packaging Haskell software description: - The Haskell Common Architecture for Building Applications and - Libraries: a framework defining a common interface for authors to more - easily build their Haskell applications in a portable way. - . - The Haskell Cabal is part of a larger infrastructure for distributing, - organizing, and cataloging Haskell libraries and tools. + The Haskell Common Architecture for Building Applications and + Libraries: a framework defining a common interface for authors to more + easily build their Haskell applications in a portable way. + . + The Haskell Cabal is part of a larger infrastructure for distributing, + organizing, and cataloging Haskell libraries and tools. +category: Distribution +build-type: Simple +-- If we use a new Cabal feature, this needs to be changed to Custom so +-- we can bootstrap. -category: Distribution -build-type: Simple extra-doc-files: - README.md - ChangeLog.md + README.md ChangeLog.md source-repository head - type: git - location: https://github.com/haskell/cabal/ - subdir: Cabal + type: git + location: https://github.com/haskell/cabal/ + subdir: Cabal flag git-rev - description: include Git revision hash in version - default: False - manual: True + description: include Git revision hash in version + default: False + manual: True library - exposed-modules: - Distribution.Backpack.Configure - Distribution.Backpack.ComponentsGraph - Distribution.Backpack.ConfiguredComponent - Distribution.Backpack.DescribeUnitId - Distribution.Backpack.FullUnitId - Distribution.Backpack.LinkedComponent - Distribution.Backpack.ModSubst - Distribution.Backpack.ModuleShape - Distribution.Backpack.PreModuleShape - Distribution.Utils.IOData - Distribution.Utils.LogProgress - Distribution.Utils.MapAccum - Distribution.Compat.CreatePipe - Distribution.Compat.Directory - Distribution.Compat.Environment - Distribution.Compat.FilePath - Distribution.Compat.Internal.TempFile - Distribution.Compat.ResponseFile - Distribution.Compat.Prelude.Internal - Distribution.Compat.Process - Distribution.Compat.Stack - Distribution.Compat.Time - Distribution.Make - Distribution.PackageDescription.Check - Distribution.ReadE - Distribution.Simple - Distribution.Simple.Bench - Distribution.Simple.Build - Distribution.Simple.Build.Inputs - Distribution.Simple.Build.Macros - Distribution.Simple.Build.PackageInfoModule - Distribution.Simple.Build.PathsModule - Distribution.Simple.BuildPaths - Distribution.Simple.BuildTarget - Distribution.Simple.BuildToolDepends - Distribution.Simple.BuildWay - Distribution.Simple.CCompiler - Distribution.Simple.Command - Distribution.Simple.Compiler - Distribution.Simple.Configure - Distribution.Simple.Errors - Distribution.Simple.FileMonitor.Types - Distribution.Simple.Flag - Distribution.Simple.GHC - Distribution.Simple.GHCJS - Distribution.Simple.Haddock - Distribution.Simple.Glob - Distribution.Simple.Glob.Internal - Distribution.Simple.Hpc - Distribution.Simple.Install - Distribution.Simple.InstallDirs - Distribution.Simple.InstallDirs.Internal - Distribution.Simple.LocalBuildInfo - Distribution.Simple.PackageDescription - Distribution.Simple.PackageIndex - Distribution.Simple.PreProcess - Distribution.Simple.PreProcess.Types - Distribution.Simple.PreProcess.Unlit - Distribution.Simple.Program - Distribution.Simple.Program.Ar - Distribution.Simple.Program.Builtin - Distribution.Simple.Program.Db - Distribution.Simple.Program.Find - Distribution.Simple.Program.GHC - Distribution.Simple.Program.HcPkg - Distribution.Simple.Program.Hpc - Distribution.Simple.Program.Internal - Distribution.Simple.Program.Ld - Distribution.Simple.Program.ResponseFile - Distribution.Simple.Program.Run - Distribution.Simple.Program.Script - Distribution.Simple.Program.Strip - Distribution.Simple.Program.Types - Distribution.Simple.Register - Distribution.Simple.Setup - Distribution.Simple.ShowBuildInfo - Distribution.Simple.SrcDist - Distribution.Simple.Test - Distribution.Simple.Test.ExeV10 - Distribution.Simple.Test.LibV09 - Distribution.Simple.Test.Log - Distribution.Simple.UHC - Distribution.Simple.UserHooks - Distribution.Simple.SetupHooks.Errors - Distribution.Simple.SetupHooks.Internal - Distribution.Simple.SetupHooks.Rule - Distribution.Simple.Utils - Distribution.TestSuite - Distribution.Types.AnnotatedId - Distribution.Types.ComponentInclude - Distribution.Types.DumpBuildInfo - Distribution.Types.PackageName.Magic - Distribution.Types.ComponentLocalBuildInfo - Distribution.Types.LocalBuildConfig - Distribution.Types.LocalBuildInfo - Distribution.Types.TargetInfo - Distribution.Types.GivenComponent - Distribution.Types.ParStrat - Distribution.Utils.Json - Distribution.Utils.NubList - Distribution.Utils.Progress - Distribution.Verbosity - Distribution.Verbosity.Internal + default-language: Haskell2010 + hs-source-dirs: src - reexported-modules: - Distribution.Backpack, - Distribution.CabalSpecVersion, - Distribution.Compat.Binary, - Distribution.Compat.CharParsing, - Distribution.Compat.DList, - Distribution.Compat.Exception, - Distribution.Compat.Graph, - Distribution.Compat.Lens, - Distribution.Compat.MonadFail, - Distribution.Compat.Newtype, - Distribution.Compat.NonEmptySet, - Distribution.Compat.Parsing, - Distribution.Compat.Prelude, - Distribution.Compat.Semigroup, - Distribution.Compiler, - Distribution.FieldGrammar, - Distribution.FieldGrammar.Class, - Distribution.FieldGrammar.FieldDescrs, - Distribution.FieldGrammar.Newtypes, - Distribution.FieldGrammar.Parsec, - Distribution.FieldGrammar.Pretty, - Distribution.Fields, - Distribution.Fields.ConfVar, - Distribution.Fields.Field, - Distribution.Fields.Lexer, - Distribution.Fields.LexerMonad, - Distribution.Fields.ParseResult, - Distribution.Fields.Parser, - Distribution.Fields.Pretty, - Distribution.InstalledPackageInfo, - Distribution.License, - Distribution.ModuleName, - Distribution.Package, - Distribution.PackageDescription, - Distribution.PackageDescription.Configuration, - Distribution.PackageDescription.FieldGrammar, - Distribution.PackageDescription.Parsec, - Distribution.PackageDescription.PrettyPrint, - Distribution.PackageDescription.Quirks, - Distribution.PackageDescription.Utils, - Distribution.Parsec, - Distribution.Parsec.Error, - Distribution.Parsec.FieldLineStream, - Distribution.Parsec.Position, - Distribution.Parsec.Warning, - Distribution.Pretty, - Distribution.SPDX, - Distribution.SPDX.License, - Distribution.SPDX.LicenseExceptionId, - Distribution.SPDX.LicenseExpression, - Distribution.SPDX.LicenseId, - Distribution.SPDX.LicenseListVersion, - Distribution.SPDX.LicenseReference, - Distribution.System, - Distribution.Text, - Distribution.Types.AbiDependency, - Distribution.Types.AbiHash, - Distribution.Types.Benchmark, - Distribution.Types.Benchmark.Lens, - Distribution.Types.BenchmarkInterface, - Distribution.Types.BenchmarkType, - Distribution.Types.BuildInfo, - Distribution.Types.BuildInfo.Lens, - Distribution.Types.BuildType, - Distribution.Types.Component, - Distribution.Types.ComponentId, - Distribution.Types.ComponentName, - Distribution.Types.ComponentRequestedSpec, - Distribution.Types.CondTree, - Distribution.Types.Condition, - Distribution.Types.ConfVar, - Distribution.Types.Dependency, - Distribution.Types.DependencyMap, - Distribution.Types.DependencySatisfaction, - Distribution.Types.ExeDependency, - Distribution.Types.Executable, - Distribution.Types.Executable.Lens, - Distribution.Types.ExecutableScope, - Distribution.Types.ExposedModule, - Distribution.Types.Flag, - Distribution.Types.ForeignLib, - Distribution.Types.ForeignLib.Lens, - Distribution.Types.ForeignLibOption, - Distribution.Types.ForeignLibType, - Distribution.Types.GenericPackageDescription, - Distribution.Types.GenericPackageDescription.Lens, - Distribution.Types.HookedBuildInfo, - Distribution.Types.IncludeRenaming, - Distribution.Types.InstalledPackageInfo, - Distribution.Types.InstalledPackageInfo.Lens, - Distribution.Types.InstalledPackageInfo.FieldGrammar, - Distribution.Types.LegacyExeDependency, - Distribution.Types.Lens, - Distribution.Types.Library, - Distribution.Types.Library.Lens, - Distribution.Types.LibraryName, - Distribution.Types.LibraryVisibility, - Distribution.Types.MissingDependency, - Distribution.Types.MissingDependencyReason, - Distribution.Types.Mixin, - Distribution.Types.Module, - Distribution.Types.ModuleReexport, - Distribution.Types.ModuleRenaming, - Distribution.Types.MungedPackageId, - Distribution.Types.MungedPackageName, - Distribution.Types.PackageDescription, - Distribution.Types.PackageDescription.Lens, - Distribution.Types.PackageId, - Distribution.Types.PackageId.Lens, - Distribution.Types.PackageName, - Distribution.Types.PackageVersionConstraint, - Distribution.Types.PkgconfigDependency, - Distribution.Types.PkgconfigName, - Distribution.Types.PkgconfigVersion, - Distribution.Types.PkgconfigVersionRange, - Distribution.Types.SetupBuildInfo, - Distribution.Types.SetupBuildInfo.Lens, - Distribution.Types.SourceRepo, - Distribution.Types.SourceRepo.Lens, - Distribution.Types.TestSuite, - Distribution.Types.TestSuite.Lens, - Distribution.Types.TestSuiteInterface, - Distribution.Types.TestType, - Distribution.Types.UnitId, - Distribution.Types.UnqualComponentName, - Distribution.Types.Version, - Distribution.Types.VersionInterval, - Distribution.Types.VersionInterval.Legacy, - Distribution.Types.VersionRange, - Distribution.Types.VersionRange.Internal, - Distribution.Utils.Base62, - Distribution.Utils.Generic, - Distribution.Utils.MD5, - Distribution.Utils.Path, - Distribution.Utils.ShortText, - Distribution.Utils.String, - Distribution.Utils.Structured, - Distribution.Version, - Language.Haskell.Extension + build-depends: + , Cabal-syntax ^>= 3.17 + , array >= 0.4.0.1 && < 0.6 + , base >= 4.13 && < 5 + , bytestring >= 0.10.0.0 && < 0.13 + , containers >= 0.5.0.0 && < 0.9 + , deepseq >= 1.3.0.1 && < 1.7 + , directory >= 1.2 && < 1.4 + , filepath >= 1.3.0.1 && < 1.6 + , pretty >= 1.1.1 && < 1.2 + , process >= 1.2.1.0 && < 1.7 + , time >= 1.4.0.1 && < 1.16 - hs-source-dirs: src - other-modules: - Distribution.Backpack.PreExistingComponent - Distribution.Backpack.ReadyComponent - Distribution.Backpack.MixLink - Distribution.Backpack.ModuleScope - Distribution.Backpack.UnifyM - Distribution.Backpack.Id - Distribution.Utils.UnionFind - Distribution.Compat.Async - Distribution.Compat.CopyFile - Distribution.Compat.GetShortPathName - Distribution.Compat.SnocList - Distribution.GetOpt - Distribution.Lex - Distribution.PackageDescription.Check.Common - Distribution.PackageDescription.Check.Conditional - Distribution.PackageDescription.Check.Monad - Distribution.PackageDescription.Check.Paths - Distribution.PackageDescription.Check.Target - Distribution.PackageDescription.Check.Warning - Distribution.Simple.Build.Macros.Z - Distribution.Simple.Build.PackageInfoModule.Z - Distribution.Simple.Build.PathsModule.Z - Distribution.Simple.GHC.Build - Distribution.Simple.GHC.Build.ExtraSources - Distribution.Simple.GHC.Build.Link - Distribution.Simple.GHC.Build.Modules - Distribution.Simple.GHC.Build.Utils - Distribution.Simple.GHC.EnvironmentParser - Distribution.Simple.GHC.Internal - Distribution.Simple.GHC.ImplInfo - Distribution.Simple.ConfigureScript - Distribution.Simple.Setup.Benchmark - Distribution.Simple.Setup.Build - Distribution.Simple.Setup.Clean - Distribution.Simple.Setup.Common - Distribution.Simple.Setup.Config - Distribution.Simple.Setup.Copy - Distribution.Simple.Setup.Global - Distribution.Simple.Setup.Haddock - Distribution.Simple.Setup.Hscolour - Distribution.Simple.Setup.Install - Distribution.Simple.Setup.Register - Distribution.Simple.Setup.Repl - Distribution.Simple.Setup.SDist - Distribution.Simple.Setup.Test - Distribution.ZinzaPrelude - Paths_Cabal + if os(windows) + build-depends: + , Win32 >= 2.3.0.0 && < 2.15 + else + build-depends: + , unix >= 2.8.6.0 && < 2.9 + + if flag(git-rev) + build-depends: + , githash ^>= 0.1.7.0 + cpp-options: -DGIT_REV - autogen-modules: Paths_Cabal - default-language: Haskell2010 - other-extensions: - BangPatterns CPP DefaultSignatures DeriveDataTypeable - DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable - ExistentialQuantification FlexibleContexts FlexibleInstances - GeneralizedNewtypeDeriving ImplicitParams KindSignatures LambdaCase - NondecreasingIndentation OverloadedStrings PatternSynonyms - RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving - Trustworthy TypeFamilies TypeOperators TypeSynonymInstances - UndecidableInstances + ghc-options: + -Wall + -fno-ignore-asserts + -Wtabs + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wno-unticked-promoted-constructors - ghc-options: - -Wall -fno-ignore-asserts -Wtabs -Wincomplete-uni-patterns - -Wincomplete-record-updates -Wno-unticked-promoted-constructors + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances - build-depends: - Cabal-syntax ^>=3.17, - array >=0.4.0.1 && <0.6, - base >=4.13 && <5, - bytestring >=0.10.0.0 && <0.13, - containers >=0.5.0.0 && <0.9, - deepseq >=1.3.0.1 && <1.7, - directory >=1.2 && <1.4, - filepath >=1.3.0.1 && <1.6, - pretty >=1.1.1 && <1.2, - process >=1.2.1.0 && <1.7, - time >=1.4.0.1 && <1.16, - transformers >=0.3 && <0.4 || >=0.4.1.0 && <0.7, - mtl >=2.1 && <2.4, - parsec >=3.1.13.0 && <3.2 + if impl(ghc >= 8.0) && impl(ghc < 8.8) + ghc-options: -Wnoncanonical-monadfail-instances + + if impl(ghc >= 9.14) + ghc-options: -Wno-pattern-namespace-specifier -Wno-incomplete-record-selectors - if os(windows) - build-depends: Win32 >=2.3.0.0 && <2.15 + exposed-modules: + Distribution.Backpack.Configure + Distribution.Backpack.ComponentsGraph + Distribution.Backpack.ConfiguredComponent + Distribution.Backpack.DescribeUnitId + Distribution.Backpack.FullUnitId + Distribution.Backpack.LinkedComponent + Distribution.Backpack.ModSubst + Distribution.Backpack.ModuleShape + Distribution.Backpack.PreModuleShape + Distribution.Utils.IOData + Distribution.Utils.LogProgress + Distribution.Utils.MapAccum + Distribution.Compat.CreatePipe + Distribution.Compat.Directory + Distribution.Compat.Environment + Distribution.Compat.FilePath + Distribution.Compat.Internal.TempFile + Distribution.Compat.ResponseFile + Distribution.Compat.Prelude.Internal + Distribution.Compat.Process + Distribution.Compat.Stack + Distribution.Compat.Time + Distribution.Make + Distribution.PackageDescription.Check + Distribution.ReadE + Distribution.Simple + Distribution.Simple.Bench + Distribution.Simple.Build + Distribution.Simple.Build.Inputs + Distribution.Simple.Build.Macros + Distribution.Simple.Build.PackageInfoModule + Distribution.Simple.Build.PathsModule + Distribution.Simple.BuildPaths + Distribution.Simple.BuildTarget + Distribution.Simple.BuildToolDepends + Distribution.Simple.BuildWay + Distribution.Simple.CCompiler + Distribution.Simple.Command + Distribution.Simple.Compiler + Distribution.Simple.Configure + Distribution.Simple.Errors + Distribution.Simple.FileMonitor.Types + Distribution.Simple.Flag + Distribution.Simple.GHC + Distribution.Simple.GHCJS + Distribution.Simple.Haddock + Distribution.Simple.Glob + Distribution.Simple.Glob.Internal + Distribution.Simple.Hpc + Distribution.Simple.Install + Distribution.Simple.InstallDirs + Distribution.Simple.InstallDirs.Internal + Distribution.Simple.LocalBuildInfo + Distribution.Simple.PackageDescription + Distribution.Simple.PackageIndex + Distribution.Simple.PreProcess + Distribution.Simple.PreProcess.Types + Distribution.Simple.PreProcess.Unlit + Distribution.Simple.Program + Distribution.Simple.Program.Ar + Distribution.Simple.Program.Builtin + Distribution.Simple.Program.Db + Distribution.Simple.Program.Find + Distribution.Simple.Program.GHC + Distribution.Simple.Program.HcPkg + Distribution.Simple.Program.Hpc + Distribution.Simple.Program.Internal + Distribution.Simple.Program.Ld + Distribution.Simple.Program.ResponseFile + Distribution.Simple.Program.Run + Distribution.Simple.Program.Script + Distribution.Simple.Program.Strip + Distribution.Simple.Program.Types + Distribution.Simple.Register + Distribution.Simple.Setup + Distribution.Simple.ShowBuildInfo + Distribution.Simple.SrcDist + Distribution.Simple.Test + Distribution.Simple.Test.ExeV10 + Distribution.Simple.Test.LibV09 + Distribution.Simple.Test.Log + Distribution.Simple.UHC + Distribution.Simple.UserHooks + Distribution.Simple.SetupHooks.Errors + Distribution.Simple.SetupHooks.Internal + Distribution.Simple.SetupHooks.Rule + Distribution.Simple.Utils + Distribution.TestSuite + Distribution.Types.AnnotatedId + Distribution.Types.ComponentInclude + Distribution.Types.DumpBuildInfo + Distribution.Types.PackageName.Magic + Distribution.Types.ComponentLocalBuildInfo + Distribution.Types.LocalBuildConfig + Distribution.Types.LocalBuildInfo + Distribution.Types.TargetInfo + Distribution.Types.GivenComponent + Distribution.Types.ParStrat + Distribution.Utils.Json + Distribution.Utils.NubList + Distribution.Utils.Progress + Distribution.Verbosity + Distribution.Verbosity.Internal - else - build-depends: unix >=2.8.6.0 && <2.9 + -- We reexport all of Cabal-syntax to aid in compatibility for downstream + -- users. In the future we may opt to deprecate some or all of these exports. + -- See haskell/Cabal#7974. + reexported-modules: + Distribution.Backpack, + Distribution.CabalSpecVersion, + Distribution.Compat.Binary, + Distribution.Compat.CharParsing, + Distribution.Compat.DList, + Distribution.Compat.Exception, + Distribution.Compat.Graph, + Distribution.Compat.Lens, + Distribution.Compat.MonadFail, + Distribution.Compat.Newtype, + Distribution.Compat.NonEmptySet, + Distribution.Compat.Parsing, + Distribution.Compat.Prelude, + Distribution.Compat.Semigroup, + Distribution.Compiler, + Distribution.FieldGrammar, + Distribution.FieldGrammar.Class, + Distribution.FieldGrammar.FieldDescrs, + Distribution.FieldGrammar.Newtypes, + Distribution.FieldGrammar.Parsec, + Distribution.FieldGrammar.Pretty, + Distribution.Fields, + Distribution.Fields.ConfVar, + Distribution.Fields.Field, + Distribution.Fields.Lexer, + Distribution.Fields.LexerMonad, + Distribution.Fields.ParseResult, + Distribution.Fields.Parser, + Distribution.Fields.Pretty, + Distribution.InstalledPackageInfo, + Distribution.License, + Distribution.ModuleName, + Distribution.Package, + Distribution.PackageDescription, + Distribution.PackageDescription.Configuration, + Distribution.PackageDescription.FieldGrammar, + Distribution.PackageDescription.Parsec, + Distribution.PackageDescription.PrettyPrint, + Distribution.PackageDescription.Quirks, + Distribution.PackageDescription.Utils, + Distribution.Parsec, + Distribution.Parsec.Error, + Distribution.Parsec.FieldLineStream, + Distribution.Parsec.Position, + Distribution.Parsec.Warning, + Distribution.Pretty, + Distribution.SPDX, + Distribution.SPDX.License, + Distribution.SPDX.LicenseExceptionId, + Distribution.SPDX.LicenseExpression, + Distribution.SPDX.LicenseId, + Distribution.SPDX.LicenseListVersion, + Distribution.SPDX.LicenseReference, + Distribution.System, + Distribution.Text, + Distribution.Types.AbiDependency, + Distribution.Types.AbiHash, + Distribution.Types.Benchmark, + Distribution.Types.Benchmark.Lens, + Distribution.Types.BenchmarkInterface, + Distribution.Types.BenchmarkType, + Distribution.Types.BuildInfo, + Distribution.Types.BuildInfo.Lens, + Distribution.Types.BuildType, + Distribution.Types.Component, + Distribution.Types.ComponentId, + Distribution.Types.ComponentName, + Distribution.Types.ComponentRequestedSpec, + Distribution.Types.CondTree, + Distribution.Types.Condition, + Distribution.Types.ConfVar, + Distribution.Types.Dependency, + Distribution.Types.DependencyMap, + Distribution.Types.DependencySatisfaction, + Distribution.Types.ExeDependency, + Distribution.Types.Executable, + Distribution.Types.Executable.Lens, + Distribution.Types.ExecutableScope, + Distribution.Types.ExposedModule, + Distribution.Types.Flag, + Distribution.Types.ForeignLib, + Distribution.Types.ForeignLib.Lens, + Distribution.Types.ForeignLibOption, + Distribution.Types.ForeignLibType, + Distribution.Types.GenericPackageDescription, + Distribution.Types.GenericPackageDescription.Lens, + Distribution.Types.HookedBuildInfo, + Distribution.Types.IncludeRenaming, + Distribution.Types.InstalledPackageInfo, + Distribution.Types.InstalledPackageInfo.Lens, + Distribution.Types.InstalledPackageInfo.FieldGrammar, + Distribution.Types.LegacyExeDependency, + Distribution.Types.Lens, + Distribution.Types.Library, + Distribution.Types.Library.Lens, + Distribution.Types.LibraryName, + Distribution.Types.LibraryVisibility, + Distribution.Types.MissingDependency, + Distribution.Types.MissingDependencyReason, + Distribution.Types.Mixin, + Distribution.Types.Module, + Distribution.Types.ModuleReexport, + Distribution.Types.ModuleRenaming, + Distribution.Types.MungedPackageId, + Distribution.Types.MungedPackageName, + Distribution.Types.PackageDescription, + Distribution.Types.PackageDescription.Lens, + Distribution.Types.PackageId, + Distribution.Types.PackageId.Lens, + Distribution.Types.PackageName, + Distribution.Types.PackageVersionConstraint, + Distribution.Types.PkgconfigDependency, + Distribution.Types.PkgconfigName, + Distribution.Types.PkgconfigVersion, + Distribution.Types.PkgconfigVersionRange, + Distribution.Types.SetupBuildInfo, + Distribution.Types.SetupBuildInfo.Lens, + Distribution.Types.SourceRepo, + Distribution.Types.SourceRepo.Lens, + Distribution.Types.TestSuite, + Distribution.Types.TestSuite.Lens, + Distribution.Types.TestSuiteInterface, + Distribution.Types.TestType, + Distribution.Types.UnitId, + Distribution.Types.UnqualComponentName, + Distribution.Types.Version, + Distribution.Types.VersionInterval, + Distribution.Types.VersionInterval.Legacy, + Distribution.Types.VersionRange, + Distribution.Types.VersionRange.Internal, + Distribution.Utils.Base62, + Distribution.Utils.Generic, + Distribution.Utils.MD5, + Distribution.Utils.Path, + Distribution.Utils.ShortText, + Distribution.Utils.String, + Distribution.Utils.Structured, + Distribution.Version, + Language.Haskell.Extension - if flag(git-rev) - cpp-options: -DGIT_REV - build-depends: githash ^>=0.1.7.0 + -- Parsec parser-related modules + build-depends: + -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity + -- See also https://github.com/ekmett/transformers-compat/issues/35 + , transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.7) + , mtl >= 2.1 && < 2.4 + , parsec >= 3.1.13.0 && < 3.2 - if impl(ghc >=8.0) - ghc-options: -Wcompat -Wnoncanonical-monad-instances + other-modules: + Distribution.Backpack.PreExistingComponent + Distribution.Backpack.ReadyComponent + Distribution.Backpack.MixLink + Distribution.Backpack.ModuleScope + Distribution.Backpack.UnifyM + Distribution.Backpack.Id + Distribution.Utils.UnionFind + Distribution.Compat.Async + Distribution.Compat.CopyFile + Distribution.Compat.GetShortPathName + Distribution.Compat.SnocList + Distribution.GetOpt + Distribution.Lex + Distribution.PackageDescription.Check.Common + Distribution.PackageDescription.Check.Conditional + Distribution.PackageDescription.Check.Monad + Distribution.PackageDescription.Check.Paths + Distribution.PackageDescription.Check.Target + Distribution.PackageDescription.Check.Warning + Distribution.Simple.Build.Macros.Z + Distribution.Simple.Build.PackageInfoModule.Z + Distribution.Simple.Build.PathsModule.Z + Distribution.Simple.GHC.Build + Distribution.Simple.GHC.Build.ExtraSources + Distribution.Simple.GHC.Build.Link + Distribution.Simple.GHC.Build.Modules + Distribution.Simple.GHC.Build.Utils + Distribution.Simple.GHC.EnvironmentParser + Distribution.Simple.GHC.Internal + Distribution.Simple.GHC.ImplInfo + Distribution.Simple.ConfigureScript + Distribution.Simple.Setup.Benchmark + Distribution.Simple.Setup.Build + Distribution.Simple.Setup.Clean + Distribution.Simple.Setup.Common + Distribution.Simple.Setup.Config + Distribution.Simple.Setup.Copy + Distribution.Simple.Setup.Global + Distribution.Simple.Setup.Haddock + Distribution.Simple.Setup.Hscolour + Distribution.Simple.Setup.Install + Distribution.Simple.Setup.Register + Distribution.Simple.Setup.Repl + Distribution.Simple.Setup.SDist + Distribution.Simple.Setup.Test + Distribution.ZinzaPrelude + Paths_Cabal - if (impl(ghc >=8.0) && impl(ghc <8.8)) - ghc-options: -Wnoncanonical-monadfail-instances + autogen-modules: + Paths_Cabal - if impl(ghc >=9.14) - ghc-options: - -Wno-pattern-namespace-specifier -Wno-incomplete-record-selectors + other-extensions: + BangPatterns + CPP + DefaultSignatures + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + ExistentialQuantification + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + ImplicitParams + KindSignatures + LambdaCase + NondecreasingIndentation + OverloadedStrings + PatternSynonyms + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + Trustworthy + TypeFamilies + TypeOperators + TypeSynonymInstances + UndecidableInstances From c8c6f655adde70bcda4e3aecf3f3aa5058f21764 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 15 Oct 2025 12:30:23 +0800 Subject: [PATCH 54/83] restore previous debug behaviour --- Cabal-syntax/src/Distribution/Fields/Lexer.x | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Cabal-syntax/src/Distribution/Fields/Lexer.x b/Cabal-syntax/src/Distribution/Fields/Lexer.x index 85730608f8a..05e91f1f11d 100644 --- a/Cabal-syntax/src/Distribution/Fields/Lexer.x +++ b/Cabal-syntax/src/Distribution/Fields/Lexer.x @@ -230,6 +230,9 @@ lexToken = do setInput inp' let !len_bytes = B.length inp - B.length inp' t <- action pos len_bytes inp +#ifdef CABAL_PARSEC_DEBUG + traceShow t $ return tok +#endif return t From e3b6a66b6576ec314eea9ea6b6a733e32fa222e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 15 Oct 2025 14:07:49 +0800 Subject: [PATCH 55/83] refactor: don't use liftA2 and liftA3 --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index d21355523d2..65e9bf54cb3 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -33,7 +33,6 @@ module Distribution.Fields.Parser ) where {- FOURMOLU_ENABLE -} -import Control.Applicative (liftA3) import qualified Data.ByteString.Char8 as B8 import Data.Functor.Identity import Distribution.Compat.Prelude @@ -243,7 +242,7 @@ cabalStyleFile = do -- | Collect one or more comments after a parser succeeds commentsAfter :: Parser a -> Parser (a, [Field Position]) -commentsAfter p = liftA2 (,) p (many tokComment) +commentsAfter p = (,) <$> p <*> (many tokComment) -- Elements that live at the top level or inside a section, i.e. fields -- and sections content @@ -325,8 +324,9 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout closeBrace return $ preCmts <> [Field name ls] <> mconcat postCmtsGroups fieldLayout = inLexerMode (LexerMode in_field_layout) $ do - (firstPreCmts, l, firstPostCmts) <- - liftA3 (,,) (many tokComment) (optionMaybe fieldContent) (many tokComment) + firstPreCmts <- many tokComment + l <- optionMaybe fieldContent + firstPostCmts <- many tokComment (ls, postCmtsGroups) <- unzip <$> many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) return $ mconcat From b8829a5aebcfdba323aad4fc5cdcd26a470fa682 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 16:36:41 +0800 Subject: [PATCH 56/83] refactor annotation to ([Comment ann], ann) --- Cabal-syntax/src/Distribution/FieldGrammar.hs | 16 +-- .../src/Distribution/Fields/ConfVar.hs | 9 +- Cabal-syntax/src/Distribution/Fields/Field.hs | 21 +++- .../src/Distribution/Fields/Parser.hs | 110 ++++++++++-------- .../src/Distribution/Fields/Pretty.hs | 6 +- .../src/Distribution/InstalledPackageInfo.hs | 31 ++--- .../Distribution/PackageDescription/Parsec.hs | 14 ++- .../src/Data/TreeDiff/Instances/Cabal.hs | 3 +- 8 files changed, 117 insertions(+), 93 deletions(-) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar.hs b/Cabal-syntax/src/Distribution/FieldGrammar.hs index 286fc7bc274..804a2e8b01c 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar.hs @@ -40,7 +40,6 @@ import Distribution.Compat.Prelude import Prelude () import qualified Data.Bifunctor as Bi -import Data.ByteString (ByteString) import qualified Data.Map.Strict as Map import Distribution.FieldGrammar.Class @@ -100,7 +99,6 @@ partitionFields = finalize . foldl' f (PS mempty mempty mempty) | otherwise = reverse s : ss f (PS fs s ss) (Section name sargs sfields) = PS fs (MkSection name sargs sfields : s) ss - f ps (Comment{}) = ps -- | Take all fields from the front. -- Returns a tuple containing the comments, nameless fields, and sections @@ -112,14 +110,8 @@ takeFields = finalize . spanMaybe match match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs]) match _ = Nothing --- | Collect comments into a map. The second field of the output will have no comment -extractComments :: Ord ann => [Field ann] -> (Map.Map ann ByteString, [Field ann]) -extractComments = finalize . foldl' (flip go) (mempty, []) - where - finalize = Bi.second reverse +extractComments :: (Foldable f, Functor f) => [f (WithComments ann)] -> ([Comment ann], [f ann]) +extractComments = Bi.first mconcat . unzip . map extractCommentsStep - go (Comment cmt ann) = Bi.first $ Map.insert ann cmt - go (Section name args fs) = - let (cs', fs') = extractComments fs - in Bi.bimap (cs' <>) (Section name args fs' :) - go field = Bi.second (field :) +extractCommentsStep :: (Foldable f, Functor f) => f (WithComments ann) -> ([Comment ann], f ann) +extractCommentsStep f = (foldMap justComments f, fmap unComments f) diff --git a/Cabal-syntax/src/Distribution/Fields/ConfVar.hs b/Cabal-syntax/src/Distribution/Fields/ConfVar.hs index e5878db3df7..d95d41acf65 100644 --- a/Cabal-syntax/src/Distribution/Fields/ConfVar.hs +++ b/Cabal-syntax/src/Distribution/Fields/ConfVar.hs @@ -4,7 +4,7 @@ module Distribution.Fields.ConfVar (parseConditionConfVar, parseConditionConfVar import Distribution.Compat.CharParsing (char, integral) import Distribution.Compat.Prelude -import Distribution.Fields.Field (Field (..), SectionArg (..), sectionArgAnn) +import Distribution.Fields.Field (Field (..), SectionArg (..), sectionArgAnn, unComments) import Distribution.Fields.ParseResult import Distribution.Fields.Parser (readFields) import Distribution.Parsec (Parsec (..), runParsecParser) @@ -34,8 +34,11 @@ import qualified Text.Parsec.Error as P import qualified Text.Parsec.Pos as P parseConditionConfVarFromClause :: B8.ByteString -> Either P.ParseError (Condition ConfVar) -parseConditionConfVarFromClause x = - readFields x >>= \r -> case r of +parseConditionConfVarFromClause x = do + r <- readFields x + let r' :: [Field Position] + r' = map (fmap unComments) r + case r' of (Section _ xs _ : _) -> P.runParser (parser <* P.eof) () "" xs _ -> Left $ P.newErrorMessage (P.Message "No fields in clause") (P.initialPos "") diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index c66599db08c..593266b0b84 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -18,6 +18,12 @@ module Distribution.Fields.Field , SectionArg (..) , sectionArgAnn + -- * Comment + , Comment (..) + , WithComments + , justComments + , unComments + -- * Name , FieldName , Name (..) @@ -45,11 +51,21 @@ import qualified Data.Foldable1 as F1 -- Cabal file ------------------------------------------------------------------------------- +data Comment ann = Comment !ByteString !ann + deriving (Show, Generic) + +type WithComments ann = ([Comment ann], ann) + +unComments :: WithComments ann -> ann +unComments = snd + +justComments :: WithComments ann -> [Comment ann] +justComments = fst + -- | A Cabal-like file consists of a series of fields (@foo: bar@) and sections (@library ...@). data Field ann = Field !(Name ann) [FieldLine ann] | Section !(Name ann) [SectionArg ann] [Field ann] - | Comment !ByteString ann deriving (Eq, Show, Functor, Foldable, Traversable, Generic) -- | @since 3.12.0.0 @@ -59,7 +75,6 @@ deriving instance Ord ann => Ord (Field ann) fieldName :: Field ann -> Name ann fieldName (Field n _) = n fieldName (Section n _ _) = n -fieldName (Comment{}) = error "comment doesn't have a name" fieldAnn :: Field ann -> ann fieldAnn = nameAnn . fieldName @@ -70,7 +85,6 @@ fieldAnn = nameAnn . fieldName fieldUniverse :: Field ann -> [Field ann] fieldUniverse f@(Section _ _ fs) = f : concatMap fieldUniverse fs fieldUniverse f@(Field _ _) = [f] -fieldUniverse f@(Comment{}) = [f] -- | A line of text representing the value of a field from a Cabal file. -- A field may contain multiple lines. @@ -173,7 +187,6 @@ instance F1.Foldable1 Field where F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys) foldMap1 f (Section x ys zs) = F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys ++ map (F1.foldMap1 f) zs) - foldMap1 f (Comment _ ann) = f ann -- | @since 3.12.0.0 instance F1.Foldable1 FieldLine where diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 65e9bf54cb3..c38622ac995 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- @@ -33,6 +34,7 @@ module Distribution.Fields.Parser ) where {- FOURMOLU_ENABLE -} +import qualified Data.Bifunctor as Bi import qualified Data.ByteString.Char8 as B8 import Data.Functor.Identity import Distribution.Compat.Prelude @@ -134,7 +136,7 @@ tokOpenBrace = getTokenWithPos $ \t -> case t of L pos OpenBrace -> Just pos; _ tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing -tokComment :: Parser (Field Position) +tokComment :: Parser (Comment Position) tokComment = getTokenWithPos $ \t -> case t of L pos (TokComment c) -> Just (Comment c pos); _ -> Nothing colon, openBrace, closeBrace :: Parser () @@ -234,30 +236,42 @@ inLexerMode (LexerMode mode) p = -- Top level of a file using cabal syntax -- -cabalStyleFile :: Parser [Field Position] +cabalStyleFile :: Parser [Field (WithComments Position)] cabalStyleFile = do es <- elements zeroIndentLevel eof return es --- | Collect one or more comments after a parser succeeds -commentsAfter :: Parser a -> Parser (a, [Field Position]) -commentsAfter p = (,) <$> p <*> (many tokComment) +-- | Collect in annotation one or more comments after a parser succeeds +commentsAfter :: Functor f => Parser (f Position) -> Parser (f (WithComments Position)) +commentsAfter p = do + x <- p + postCmts <- many tokComment + pure $ fmap (postCmts,) x + +noComments :: Functor f => f ann -> f (WithComments ann) +noComments = fmap ([],) + +mapCommentsOfHead + :: Functor f + => ([Comment ann] -> [Comment ann]) + -> [f (WithComments ann)] + -> [f (WithComments ann)] +mapCommentsOfHead f xs = case xs of +-- FIXME(leana8959): this would map this everywhere, bad! + [] -> [] + (x : xs') -> fmap (Bi.first f) x : xs' -- Elements that live at the top level or inside a section, i.e. fields -- and sections content -- -- elements ::= comment* (element comment*)* -elements :: IndentLevel -> Parser [Field Position] +elements :: IndentLevel -> Parser [Field (WithComments Position)] elements ilevel = do preCmts <- many tokComment - (fs, postCmtsGroups) <- unzip <$> many (commentsAfter $ element ilevel) - pure $ - mconcat - [ preCmts - , mconcat fs - , mconcat postCmtsGroups - ] + fs <- many (element ilevel) + -- If there's no field, we drop the comments + pure $ mapCommentsOfHead (preCmts ++) fs -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on @@ -265,7 +279,7 @@ elements ilevel = do -- -- element ::= '\\n' name elementInLayoutContext -- | name elementInNonLayoutContext -element :: IndentLevel -> Parser [Field Position] +element :: IndentLevel -> Parser (Field (WithComments Position)) element ilevel = ( do ilevel' <- indentOfAtLeast ilevel @@ -274,7 +288,7 @@ element ilevel = ) <|> ( do name <- fieldSecName - (\f -> [f]) <$> elementInNonLayoutContext name + elementInNonLayoutContext name ) -- An element (field or section) that is valid in a layout context. @@ -283,13 +297,13 @@ element ilevel = -- -- elementInLayoutContext ::= ':' fieldLayoutOrBraces -- | arg* sectionLayoutOrBraces -elementInLayoutContext :: IndentLevel -> Name Position -> Parser [Field Position] +elementInLayoutContext :: IndentLevel -> Name Position -> Parser (Field (WithComments Position)) elementInLayoutContext ilevel name = (do colon; fieldLayoutOrBraces ilevel name) <|> ( do args <- many sectionArg elems <- sectionLayoutOrBraces ilevel - return [Section name args elems] + return (Section (noComments name) (fmap noComments args) elems) ) -- An element (field or section) that is valid in a non-layout context. @@ -298,7 +312,7 @@ elementInLayoutContext ilevel name = -- -- elementInNonLayoutContext ::= ':' FieldInlineOrBraces -- | arg* '\\n'? '{' elements '\\n'? '}' -elementInNonLayoutContext :: Name Position -> Parser (Field Position) +elementInNonLayoutContext :: Name Position -> Parser (Field (WithComments Position)) elementInNonLayoutContext name = (do colon; fieldInlineOrBraces name) <|> ( do @@ -307,42 +321,42 @@ elementInNonLayoutContext name = elems <- elements zeroIndentLevel optional tokIndent closeBrace - return (Section name args elems) + return (Section (noComments name) (fmap noComments args) elems) ) -- The body of a field, using either layout style or braces style. -- -- fieldLayoutOrBraces ::= '\\n'? '{' comment* (content comment*)* '}' -- | comment* line? comment* ('\\n' line comment*)* -fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser [Field Position] +fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser (Field (WithComments Position)) fieldLayoutOrBraces ilevel name = braces <|> fieldLayout where + braces :: Parser (Field (WithComments Position)) braces = do openBrace preCmts <- many tokComment - (ls, postCmtsGroups) <- unzip <$> inLexerMode (LexerMode in_field_braces) (many $ commentsAfter fieldContent) + ls <- inLexerMode (LexerMode in_field_braces) (many $ commentsAfter fieldContent) closeBrace - return $ preCmts <> [Field name ls] <> mconcat postCmtsGroups + return $ case ls of + [] -> Field (noComments name) [] + (l : ls') -> Field (noComments name) (mapCommentsOfHead (preCmts ++) $ l : ls') + + fieldLayout :: Parser (Field (WithComments Position)) fieldLayout = inLexerMode (LexerMode in_field_layout) $ do - firstPreCmts <- many tokComment - l <- optionMaybe fieldContent - firstPostCmts <- many tokComment - (ls, postCmtsGroups) <- unzip <$> many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) - return $ - mconcat - [ firstPreCmts - , case l of - Nothing -> [Field name ls] - Just l' -> [Field name (l' : ls)] - , firstPostCmts - , mconcat postCmtsGroups - ] + preCmts <- many tokComment + l <- optionMaybe (commentsAfter fieldContent) + ls <- many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) + return + ( case l of + Nothing -> (Field (noComments name) (mapCommentsOfHead (preCmts ++) ls)) + Just l' -> (Field (noComments name) (mapCommentsOfHead (preCmts ++) $ l' : ls)) + ) -- The body of a section, using either layout style or braces style. -- -- sectionLayoutOrBraces ::= '\\n'? '{' elements \\n? '}' -- | elements -sectionLayoutOrBraces :: IndentLevel -> Parser [Field Position] +sectionLayoutOrBraces :: IndentLevel -> Parser [Field (WithComments Position)] sectionLayoutOrBraces ilevel = ( do openBrace @@ -357,17 +371,17 @@ sectionLayoutOrBraces ilevel = -- -- fieldInlineOrBraces ::= '\\n'? '{' content '}' -- | content -fieldInlineOrBraces :: Name Position -> Parser (Field Position) +fieldInlineOrBraces :: Name Position -> Parser (Field (WithComments Position)) fieldInlineOrBraces name = ( do openBrace ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent) closeBrace - return (Field name ls) + return (Field (noComments name) (fmap noComments ls)) ) <|> ( do ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent)) - return (Field name ls) + return (Field (noComments name) (fmap noComments ls)) ) -- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST. @@ -396,11 +410,11 @@ fieldInlineOrBraces name = -- -- >>> readFields' "\xc2\xa0 foo: bar" -- Right ([Field (Name (Position 1 3) "foo") [FieldLine (Position 1 8) "bar"]],[LexWarning LexWarningNBSP (Position 1 1)]) -readFields :: B8.ByteString -> Either ParseError [Field Position] +readFields :: B8.ByteString -> Either ParseError [Field (WithComments Position)] readFields s = fmap fst (readFields' s) -- | Like 'readFields' but also return lexer warnings. -readFields' :: B8.ByteString -> Either ParseError ([Field Position], [LexWarning]) +readFields' :: B8.ByteString -> Either ParseError ([Field (WithComments Position)], [LexWarning]) readFields' s = do parse parser "the input" lexSt where @@ -419,18 +433,16 @@ readFields' s = do -- -- To catch during parsing we would need to parse first field/section of a section -- and then parse the following ones (softly) requiring the exactly the same indentation. -checkIndentation :: [Field Position] -> [LexWarning] -> [LexWarning] +checkIndentation :: [Field (WithComments Position)] -> [LexWarning] -> [LexWarning] checkIndentation [] = id -checkIndentation (Field name _ : fs') = checkIndentation' (nameAnn name) fs' -checkIndentation (Section name _ fs : fs') = checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation (Comment{} : fs') = checkIndentation fs' +checkIndentation (Field name _ : fs') = checkIndentation' (unComments $ nameAnn name) fs' +checkIndentation (Section name _ fs : fs') = checkIndentation fs . checkIndentation' (unComments $ nameAnn name) fs' -- | We compare adjacent fields to reduce the amount of reported indentation warnings. -checkIndentation' :: Position -> [Field Position] -> [LexWarning] -> [LexWarning] +checkIndentation' :: Position -> [Field (WithComments Position)] -> [LexWarning] -> [LexWarning] checkIndentation' _ [] = id -checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation' (nameAnn name) fs' -checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation fs . checkIndentation' (nameAnn name) fs' -checkIndentation' _ (Comment{} : _) = id +checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (unComments $ nameAnn name) . checkIndentation' (unComments $ nameAnn name) fs' +checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (unComments $ nameAnn name) . checkIndentation fs . checkIndentation' (unComments $ nameAnn name) fs' -- | Check that positions' columns are the same. checkIndentation'' :: Position -> Position -> [LexWarning] -> [LexWarning] diff --git a/Cabal-syntax/src/Distribution/Fields/Pretty.hs b/Cabal-syntax/src/Distribution/Fields/Pretty.hs index 7de0cec3dbc..d458ca41e80 100644 --- a/Cabal-syntax/src/Distribution/Fields/Pretty.hs +++ b/Cabal-syntax/src/Distribution/Fields/Pretty.hs @@ -181,14 +181,10 @@ genericFromParsecFields -> f [PrettyField ann] genericFromParsecFields f g = goMany where - goMany = traverse go . filter notComment + goMany = traverse go go (P.Field (P.Name ann name) fls) = PrettyField ann name <$> f name fls go (P.Section (P.Name ann name) secargs fs) = PrettySection ann name <$> g name secargs <*> goMany fs - go (P.Comment{}) = error "comment is filtered out" - - notComment (P.Comment{}) = False - notComment _ = True -- | Used in 'fromParsecFields'. prettyFieldLines :: FieldName -> [P.FieldLine ann] -> PP.Doc diff --git a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs index 350b9fee757..a9eb0746414 100644 --- a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs +++ b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs @@ -47,6 +47,7 @@ import Distribution.Backpack import Distribution.CabalSpecVersion (cabalSpecLatest) import Distribution.FieldGrammar import Distribution.FieldGrammar.FieldDescrs +import Distribution.Fields.Field import Distribution.Fields.ParseResult import Distribution.Fields.Pretty import Distribution.ModuleName @@ -99,19 +100,23 @@ parseInstalledPackageInfo -> Either (NonEmpty String) ([String], InstalledPackageInfo) parseInstalledPackageInfo s = case P.readFields s of Left err -> Left (show err :| []) - Right fs -> case partitionFields fs of - (fs', _) -> case P.runParseResult $ withSource PInstalledPackageInfo $ parseFieldGrammar cabalSpecLatest fs' ipiFieldGrammar of - (ws, Right x) -> x `deepseq` Right (ws', x) - where - ws' = - [ P.showPWarningWithSource (fmap renderInstalledPackageInfoSource w) - | w@(P.PWarningWithSource _ (P.PWarning wt _ _)) <- ws - , -- filter out warnings about experimental features - wt /= P.PWTExperimental - ] - (_, Left (_, errs)) -> Left errs' - where - errs' = fmap (P.showPErrorWithSource . fmap renderInstalledPackageInfoSource) errs + Right fs -> + let + fs' = map (fmap unComments) fs + in + case partitionFields fs' of + (fs'', _) -> case P.runParseResult $ withSource PInstalledPackageInfo $ parseFieldGrammar cabalSpecLatest fs'' ipiFieldGrammar of + (ws, Right x) -> x `deepseq` Right (ws', x) + where + ws' = + [ P.showPWarningWithSource (fmap renderInstalledPackageInfoSource w) + | w@(P.PWarningWithSource _ (P.PWarning wt _ _)) <- ws + , -- filter out warnings about experimental features + wt /= P.PWTExperimental + ] + (_, Left (_, errs)) -> Left errs' + where + errs' = fmap (P.showPErrorWithSource . fmap renderInstalledPackageInfoSource) errs -- ----------------------------------------------------------------------------- -- Pretty-printing diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 09f61bf7e09..c7b7a163da4 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -41,7 +41,7 @@ import Distribution.Compat.Lens import Distribution.FieldGrammar import Distribution.FieldGrammar.Parsec (NamelessField (..)) import Distribution.Fields.ConfVar (parseConditionConfVar) -import Distribution.Fields.Field (FieldName, getName, sectionArgAnn) +import Distribution.Fields.Field (Comment (..), FieldName, WithComments, getName, sectionArgAnn, unComments) import Distribution.Fields.LexerMonad (LexWarning, toPWarnings) import Distribution.Fields.ParseResult import Distribution.Fields.Parser @@ -152,14 +152,16 @@ parseGenericPackageDescription' :: Maybe CabalSpecVersion -> [LexWarning] -> Maybe Int - -> [Field Position] + -> [Field (WithComments Position)] -> ParseResult src GenericPackageDescription parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do parseWarnings (toPWarnings lexWarnings) for_ utf8WarnPos $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos - let (!comments, fs') = extractComments fs + let (comments, fs') = extractComments fs + !comments' = Map.fromList . map (\(Comment cmt pos) -> (pos, cmt)) $ comments + let (syntax, fs'') = sectionizeFields fs' let (fields, sectionFields) = takeFields fs'' @@ -205,7 +207,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do -- Sections let gpd = emptyGenericPackageDescription - { exactComments = comments + { exactComments = comments' } & L.packageDescription .~ pd gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty) @@ -254,7 +256,6 @@ goSections specVer = traverse_ process "Ignoring trailing fields after sections: " ++ show name process (Section name args secFields) = parseSection name args secFields - process (Comment _ _) = pure () snoc x xs = xs ++ [x] @@ -940,7 +941,8 @@ libFieldNames = fieldGrammarKnownFieldList (libraryFieldGrammar LMainLibName) parseHookedBuildInfo :: BS.ByteString -> ParseResult src HookedBuildInfo parseHookedBuildInfo bs = case readFields' bs of Right (fs, lexWarnings) -> do - parseHookedBuildInfo' lexWarnings fs + let fs' = map (fmap unComments) fs + parseHookedBuildInfo' lexWarnings fs' -- TODO: better marshalling of errors Left perr -> parseFatalFailure zeroPos (show perr) diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs index 79edd107d49..1cb3abce882 100644 --- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs +++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs @@ -13,7 +13,7 @@ import Data.TreeDiff.Instances.CabalVersion () import Distribution.Backpack (OpenModule, OpenUnitId) import Distribution.CabalSpecVersion (CabalSpecVersion) import Distribution.Compiler (CompilerFlavor, CompilerId, PerCompilerFlavor) -import Distribution.Fields.Field (Field, Name, FieldLine, SectionArg) +import Distribution.Fields.Field (Field, Name, FieldLine, SectionArg, Comment) import Distribution.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo) import Distribution.ModuleName (ModuleName) import Distribution.PackageDescription @@ -58,6 +58,7 @@ instance ToExpr (SymbolicPathX allowAbs from to) instance ToExpr a => ToExpr (InstallDirs a) +instance (ToExpr ann) => ToExpr (Comment ann) instance (ToExpr ann) => ToExpr (Field ann) instance (ToExpr ann) => ToExpr (FieldLine ann) instance (ToExpr ann) => ToExpr (Name ann) From d31411969d783670357a1bb0ace374dc33dbf096 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 17:41:04 +0800 Subject: [PATCH 57/83] attempt --- .../src/Distribution/Fields/Parser.hs | 49 ++++++++----------- 1 file changed, 20 insertions(+), 29 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index c38622ac995..990647211ad 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -252,26 +252,17 @@ commentsAfter p = do noComments :: Functor f => f ann -> f (WithComments ann) noComments = fmap ([],) -mapCommentsOfHead - :: Functor f - => ([Comment ann] -> [Comment ann]) - -> [f (WithComments ann)] - -> [f (WithComments ann)] -mapCommentsOfHead f xs = case xs of --- FIXME(leana8959): this would map this everywhere, bad! - [] -> [] - (x : xs') -> fmap (Bi.first f) x : xs' - -- Elements that live at the top level or inside a section, i.e. fields -- and sections content -- -- elements ::= comment* (element comment*)* elements :: IndentLevel -> Parser [Field (WithComments Position)] elements ilevel = do + -- We bundle the comments with the first element preCmts <- many tokComment - fs <- many (element ilevel) - -- If there's no field, we drop the comments - pure $ mapCommentsOfHead (preCmts ++) fs + f <- optionMaybe (element preCmts ilevel) + fs <- many (element [] ilevel) + pure $ maybe fs (:fs) f -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on @@ -279,16 +270,16 @@ elements ilevel = do -- -- element ::= '\\n' name elementInLayoutContext -- | name elementInNonLayoutContext -element :: IndentLevel -> Parser (Field (WithComments Position)) -element ilevel = +element :: [Comment Position] -> IndentLevel -> Parser (Field (WithComments Position)) +element cmts ilevel = ( do ilevel' <- indentOfAtLeast ilevel name <- fieldSecName - elementInLayoutContext (incIndentLevel ilevel') name + elementInLayoutContext (incIndentLevel ilevel') (fmap (cmts,) name) ) <|> ( do name <- fieldSecName - elementInNonLayoutContext name + elementInNonLayoutContext (fmap (cmts,) name) ) -- An element (field or section) that is valid in a layout context. @@ -297,13 +288,13 @@ element ilevel = -- -- elementInLayoutContext ::= ':' fieldLayoutOrBraces -- | arg* sectionLayoutOrBraces -elementInLayoutContext :: IndentLevel -> Name Position -> Parser (Field (WithComments Position)) +elementInLayoutContext :: IndentLevel -> Name (WithComments Position) -> Parser (Field (WithComments Position)) elementInLayoutContext ilevel name = (do colon; fieldLayoutOrBraces ilevel name) <|> ( do args <- many sectionArg elems <- sectionLayoutOrBraces ilevel - return (Section (noComments name) (fmap noComments args) elems) + return (Section name (fmap noComments args) elems) ) -- An element (field or section) that is valid in a non-layout context. @@ -312,7 +303,7 @@ elementInLayoutContext ilevel name = -- -- elementInNonLayoutContext ::= ':' FieldInlineOrBraces -- | arg* '\\n'? '{' elements '\\n'? '}' -elementInNonLayoutContext :: Name Position -> Parser (Field (WithComments Position)) +elementInNonLayoutContext :: Name (WithComments Position) -> Parser (Field (WithComments Position)) elementInNonLayoutContext name = (do colon; fieldInlineOrBraces name) <|> ( do @@ -321,14 +312,14 @@ elementInNonLayoutContext name = elems <- elements zeroIndentLevel optional tokIndent closeBrace - return (Section (noComments name) (fmap noComments args) elems) + return (Section name (fmap noComments args) elems) ) -- The body of a field, using either layout style or braces style. -- -- fieldLayoutOrBraces ::= '\\n'? '{' comment* (content comment*)* '}' -- | comment* line? comment* ('\\n' line comment*)* -fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser (Field (WithComments Position)) +fieldLayoutOrBraces :: IndentLevel -> Name (WithComments Position) -> Parser (Field (WithComments Position)) fieldLayoutOrBraces ilevel name = braces <|> fieldLayout where braces :: Parser (Field (WithComments Position)) @@ -338,8 +329,8 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout ls <- inLexerMode (LexerMode in_field_braces) (many $ commentsAfter fieldContent) closeBrace return $ case ls of - [] -> Field (noComments name) [] - (l : ls') -> Field (noComments name) (mapCommentsOfHead (preCmts ++) $ l : ls') + [] -> Field (fmap (Bi.first (++preCmts)) name) [] + (l : ls') -> Field (fmap (Bi.first (++preCmts)) name) (l : ls') fieldLayout :: Parser (Field (WithComments Position)) fieldLayout = inLexerMode (LexerMode in_field_layout) $ do @@ -348,8 +339,8 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout ls <- many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) return ( case l of - Nothing -> (Field (noComments name) (mapCommentsOfHead (preCmts ++) ls)) - Just l' -> (Field (noComments name) (mapCommentsOfHead (preCmts ++) $ l' : ls)) + Nothing -> (Field (fmap (Bi.first (++preCmts)) name) ls) + Just l' -> (Field (fmap (Bi.first (++preCmts)) name) (l' : ls)) ) -- The body of a section, using either layout style or braces style. @@ -371,17 +362,17 @@ sectionLayoutOrBraces ilevel = -- -- fieldInlineOrBraces ::= '\\n'? '{' content '}' -- | content -fieldInlineOrBraces :: Name Position -> Parser (Field (WithComments Position)) +fieldInlineOrBraces :: Name (WithComments Position) -> Parser (Field (WithComments Position)) fieldInlineOrBraces name = ( do openBrace ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent) closeBrace - return (Field (noComments name) (fmap noComments ls)) + return (Field name (fmap noComments ls)) ) <|> ( do ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent)) - return (Field (noComments name) (fmap noComments ls)) + return (Field name (fmap noComments ls)) ) -- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST. From d4b8b8cd457b7e05d1a95e38c6fa1b0e14994fc6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 17:44:17 +0800 Subject: [PATCH 58/83] test: update expects --- .../comments/layout-comment-in-fieldline.expr | 50 ++--- .../layout-complex-indented-comments.expr | 174 +++++++++--------- 2 files changed, 118 insertions(+), 106 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr b/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr index e1563128d97..806984ceaed 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr @@ -1,50 +1,58 @@ [ Section (Name - (Position 1 1) + (_×_ [] (Position 1 1)) "executable") [] [ Field - (Name (Position 2 5) "main-is") + (Name + (_×_ [] (Position 2 5)) + "main-is") [ FieldLine - (Position 2 26) + (_×_ [] (Position 2 26)) "Main.hs"], Field (Name - (Position 3 5) + (_×_ [] (Position 3 5)) "hs-source-dirs") [ - FieldLine (Position 4 9) "src"], + FieldLine + (_×_ [] (Position 4 9)) + "src"], Field (Name - (Position 5 5) + (_×_ [] (Position 5 5)) "ghc-options") [ FieldLine - (Position 5 18) + (_×_ [] (Position 5 18)) "-Wall"], Field (Name - (Position 6 5) + (_×_ [] (Position 6 5)) "build-depends") [ FieldLine - (Position 6 22) + (_×_ + [ + Comment + " -- , foo" + (Position 7 1), + Comment + " -- ^ This should be consumed after fieldContent" + (Position 8 1)] + (Position 6 22)) "base", FieldLine - (Position 9 22) + (_×_ + [ + Comment + " -- , comemnt" + (Position 10 1)] + (Position 9 22)) ", bar", FieldLine - (Position 11 22) - ", baz"], - Comment - " -- , foo" - (Position 7 1), - Comment - " -- ^ This should be consumed after fieldContent" - (Position 8 1), - Comment - " -- , comemnt" - (Position 10 1)]] + (_×_ [] (Position 11 22)) + ", baz"]]] diff --git a/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr index 070a0582e59..7aab18f61ed 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr @@ -1,132 +1,136 @@ [ - Comment - "-- This is the configuration file for the 'cabal' command line tool." - (Position 1 1), - Comment "--" (Position 2 1), - Comment - "-- The available configuration options are listed below." - (Position 3 1), Section (Name - (Position 6 1) + (_×_ + [ + Comment + "-- This is the configuration file for the 'cabal' command line tool." + (Position 1 1), + Comment "--" (Position 2 1), + Comment + "-- The available configuration options are listed below." + (Position 3 1)] + (Position 6 1)) "repository") [ SecArgName - (Position 6 12) + (_×_ [] (Position 6 12)) "hackage.haskell.org"] [ Field - (Name (Position 7 3) "url") + (Name + (_×_ [] (Position 7 3)) + "url") [ FieldLine - (Position 7 8) - "http://hackage.haskell.org/"], - Comment - " -- secure: True" - (Position 8 1), - Comment - " -- root-keys:" - (Position 9 1), - Comment - "-- ignore-expiry: False" - (Position 11 1), - Comment - "-- http-transport:" - (Position 12 1)], + (_×_ + [ + Comment + " -- secure: True" + (Position 8 1), + Comment + " -- root-keys:" + (Position 9 1), + Comment + "-- ignore-expiry: False" + (Position 11 1), + Comment + "-- http-transport:" + (Position 12 1)] + (Position 7 8)) + "http://hackage.haskell.org/"]], Field (Name - (Position 13 1) + (_×_ [] (Position 13 1)) "remote-repo-cache") [ FieldLine - (Position 13 20) + (_×_ + [ + Comment + "-- logs-dir: /home/foo/.cache/cabal/logs" + (Position 14 1), + Comment + "-- default-user-config:" + (Position 15 1)] + (Position 13 20)) "/home/foo/.cache/cabal/packages"], - Comment - "-- logs-dir: /home/foo/.cache/cabal/logs" - (Position 14 1), - Comment - "-- default-user-config:" - (Position 15 1), Field (Name - (Position 16 1) + (_×_ [] (Position 16 1)) "build-summary") [ FieldLine - (Position 16 16) + (_×_ + [ + Comment + "-- build-log:" + (Position 17 1)] + (Position 16 16)) "/home/foo/.cache/cabal/logs/build.log"], - Comment - "-- build-log:" - (Position 17 1), Field (Name - (Position 18 1) + (_×_ [] (Position 18 1)) "remote-build-reporting") [ FieldLine - (Position 18 25) + (_×_ + [ + Comment + "-- report-planning-failure: False" + (Position 19 1), + Comment + "-- per-component: True" + (Position 20 1)] + (Position 18 25)) "none"], - Comment - "-- report-planning-failure: False" - (Position 19 1), - Comment - "-- per-component: True" - (Position 20 1), Field - (Name (Position 21 1) "jobs") + (Name + (_×_ [] (Position 21 1)) + "jobs") [ FieldLine - (Position 21 7) + (_×_ + [ + Comment + "-- keep-going: False" + (Position 22 1), + Comment + "-- offline: False" + (Position 23 1)] + (Position 21 7)) "$ncpus"], - Comment - "-- keep-going: False" - (Position 22 1), - Comment - "-- offline: False" - (Position 23 1), Field (Name - (Position 24 1) + (_×_ [] (Position 24 1)) "installdir") [ FieldLine - (Position 24 13) + (_×_ + [ + Comment + "-- token:" + (Position 25 1), + Comment + "-- username:" + (Position 26 1)] + (Position 24 13)) "/home/foo/.local/bin"], - Comment - "-- token:" - (Position 25 1), - Comment - "-- username:" - (Position 26 1), Section - (Name (Position 28 1) "haddock") + (Name + (_×_ [] (Position 28 1)) + "haddock") [] - [ - Comment - " -- keep-temp-files: False" - (Position 29 1), - Comment - " -- hoogle: False" - (Position 30 1)], + [], Section - (Name (Position 32 1) "init") + (Name + (_×_ [] (Position 32 1)) + "init") [] - [ - Comment - " -- interactive: False" - (Position 33 1), - Comment - " -- quiet: False" - (Position 34 1)], + [], Section (Name - (Position 36 1) + (_×_ [] (Position 36 1)) "program-locations") [] - [ - Comment - " -- alex-location:" - (Position 37 1), - Comment - " -- ar-location:" - (Position 38 1)]] + []] From bf19609c8256ed52c9b4ebf80ba53b49c5109c61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 17:49:34 +0800 Subject: [PATCH 59/83] fix errors for Deprecated module --- .../src/Distribution/Deprecated/ParseUtils.hs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs index 7260131d8b9..48f6ed149d8 100644 --- a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs +++ b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs @@ -422,9 +422,10 @@ lineNo (Section n _ _ _) = n readFields :: BS.ByteString -> ParseResult [Field] readFields input = case Fields.readFields' input of Right (fs, ws) -> - ParseOk - [PWarning msg | Fields.PWarning _ _ msg <- Fields.toPWarnings ws] - (legacyFields fs) + let fs' = map (fmap Fields.unComments) fs + in ParseOk + [PWarning msg | Fields.PWarning _ _ msg <- Fields.toPWarnings ws] + (legacyFields fs') Left perr -> ParseFailed $ NoParse @@ -441,17 +442,13 @@ readFields input = case Fields.readFields' input of pos = PE.errorPos perr legacyFields :: [Fields.Field Parsec.Position] -> [Field] -legacyFields = map legacyField . filter notComment - where - notComment (Fields.Comment{}) = False - notComment _ = True +legacyFields = map legacyField legacyField :: Fields.Field Parsec.Position -> Field legacyField (Fields.Field (Fields.Name pos name) fls) = F (posToLineNo pos) (fromUTF8BS name) (Fields.fieldLinesToString fls) legacyField (Fields.Section (Fields.Name pos name) args fs) = Section (posToLineNo pos) (fromUTF8BS name) (Fields.sectionArgsToString args) (legacyFields fs) -legacyField (Fields.Comment{}) = error "there's no legacy comment field" posToLineNo :: Parsec.Position -> LineNo posToLineNo (Parsec.Position row _) = row From 7895cd5a3a3389372065d2bb502f6162282b3fa8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 17:57:47 +0800 Subject: [PATCH 60/83] fix compilation errors for integration tests --- .../src/Distribution/Client/BuildReports/Anonymous.hs | 6 ++++-- .../src/Distribution/Client/ProjectConfig/Parsec.hs | 5 +++-- cabal-install/src/Distribution/Client/ScriptUtils.hs | 6 +++++- 3 files changed, 12 insertions(+), 5 deletions(-) diff --git a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs index 7bc6bb8872b..bda8c905fd7 100644 --- a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs +++ b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs @@ -40,6 +40,7 @@ import Distribution.Client.Version (cabalInstallVersion) import Distribution.Compiler (CompilerId (..)) import Distribution.FieldGrammar import Distribution.Fields +import Distribution.Fields.Field import Distribution.Package (PackageIdentifier (..), mkPackageName) import Distribution.PackageDescription (FlagAssignment) import Distribution.Parsec @@ -146,8 +147,9 @@ parseBuildReport s = case snd $ runParseResult $ parseFields s of parseFields :: BS.ByteString -> ParseResult src BuildReport parseFields input = do fields <- either (parseFatalFailure zeroPos . show) pure $ readFields input - case partitionFields fields of - (fields', []) -> parseFieldGrammar CabalSpecV2_4 fields' fieldDescrs + let fields' = map (fmap unComments) fields + case partitionFields fields' of + (fields'', []) -> parseFieldGrammar CabalSpecV2_4 fields'' fieldDescrs _otherwise -> parseFatalFailure zeroPos "found sections in BuildReport" parseBuildReportList :: BS.ByteString -> [BuildReport] diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs index 06d9631e5f3..4d9d09478e8 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs @@ -30,7 +30,7 @@ import Distribution.FieldGrammar import Distribution.FieldGrammar.Parsec (NamelessField (..), namelessFieldAnn) import Distribution.Fields (Field (..), FieldLine (..), FieldName, Name (..), SectionArg (..), readFields') import Distribution.Fields.ConfVar (parseConditionConfVar) -import Distribution.Fields.Field (fieldLinesToString, sectionArgAnn) +import Distribution.Fields.Field (fieldLinesToString, sectionArgAnn, unComments) import Distribution.Fields.LexerMonad (toPWarnings) import Distribution.Fields.ParseResult import Distribution.Parsec (ParsecParser, eitherParsec, parsec, parsecFilePath, runParsecParser) @@ -75,7 +75,8 @@ readPreprocessFields bs = do parseWarnings (toPWarnings lexWarnings) for_ invalidUtf8 $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos - return fs + let fs' = map (fmap unComments) fs + return fs' Left perr -> parseFatalFailure pos (show perr) where ppos = Text.Parsec.errorPos perr diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 1c78d537c19..9e13a5983a2 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -100,6 +100,9 @@ import Distribution.Fields , parseFatalFailure , readFields ) +import Distribution.Fields.Field + ( unComments + ) import Distribution.PackageDescription ( ignoreConditions ) @@ -481,7 +484,8 @@ parseScriptBlock :: BS.ByteString -> ParseResult src Executable parseScriptBlock str = case readFields str of Right fs -> do - let (fields, _) = takeFields fs + let fs' = map (fmap unComments) fs + let (fields, _) = takeFields fs' parseFieldGrammar cabalSpecLatest fields (executableFieldGrammar "script") Left perr -> parseFatalFailure pos (show perr) where From 680e639c3cfdd496d67a05cd2b31484131e69256 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 18:35:06 +0800 Subject: [PATCH 61/83] fix grammar while incorrect output We need to look into how to wire the output for it to hold the comments in the right position. --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 990647211ad..1a35f201e12 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -261,7 +261,9 @@ elements ilevel = do -- We bundle the comments with the first element preCmts <- many tokComment f <- optionMaybe (element preCmts ilevel) - fs <- many (element [] ilevel) + -- FIXME(leana8959): the trailing comment here needs to be consumed + _ <- many tokComment + fs <- many (element [] ilevel <* many tokComment) pure $ maybe fs (:fs) f -- An individual element, ie a field or a section. These can either use From 308ba3e33d5f620a5e094a5bfde5402426e06aba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 22:30:28 +0800 Subject: [PATCH 62/83] refactor parser --- .../src/Distribution/Fields/Parser.hs | 41 +++++++++---------- 1 file changed, 19 insertions(+), 22 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 1a35f201e12..bae56a6c2fe 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -258,13 +258,10 @@ noComments = fmap ([],) -- elements ::= comment* (element comment*)* elements :: IndentLevel -> Parser [Field (WithComments Position)] elements ilevel = do - -- We bundle the comments with the first element + -- FIXME(leana8959): somehow tag the first field with this comment preCmts <- many tokComment - f <- optionMaybe (element preCmts ilevel) - -- FIXME(leana8959): the trailing comment here needs to be consumed - _ <- many tokComment - fs <- many (element [] ilevel <* many tokComment) - pure $ maybe fs (:fs) f + es <- many (element ilevel <* many tokComment) + pure $ es -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on @@ -272,16 +269,16 @@ elements ilevel = do -- -- element ::= '\\n' name elementInLayoutContext -- | name elementInNonLayoutContext -element :: [Comment Position] -> IndentLevel -> Parser (Field (WithComments Position)) -element cmts ilevel = +element :: IndentLevel -> Parser (Field (WithComments Position)) +element ilevel = ( do ilevel' <- indentOfAtLeast ilevel name <- fieldSecName - elementInLayoutContext (incIndentLevel ilevel') (fmap (cmts,) name) + elementInLayoutContext (incIndentLevel ilevel') name ) <|> ( do name <- fieldSecName - elementInNonLayoutContext (fmap (cmts,) name) + elementInNonLayoutContext name ) -- An element (field or section) that is valid in a layout context. @@ -290,13 +287,13 @@ element cmts ilevel = -- -- elementInLayoutContext ::= ':' fieldLayoutOrBraces -- | arg* sectionLayoutOrBraces -elementInLayoutContext :: IndentLevel -> Name (WithComments Position) -> Parser (Field (WithComments Position)) +elementInLayoutContext :: IndentLevel -> Name Position -> Parser (Field (WithComments Position)) elementInLayoutContext ilevel name = (do colon; fieldLayoutOrBraces ilevel name) <|> ( do args <- many sectionArg elems <- sectionLayoutOrBraces ilevel - return (Section name (fmap noComments args) elems) + return (Section (noComments name) (fmap noComments args) elems) ) -- An element (field or section) that is valid in a non-layout context. @@ -305,7 +302,7 @@ elementInLayoutContext ilevel name = -- -- elementInNonLayoutContext ::= ':' FieldInlineOrBraces -- | arg* '\\n'? '{' elements '\\n'? '}' -elementInNonLayoutContext :: Name (WithComments Position) -> Parser (Field (WithComments Position)) +elementInNonLayoutContext :: Name Position -> Parser (Field (WithComments Position)) elementInNonLayoutContext name = (do colon; fieldInlineOrBraces name) <|> ( do @@ -314,14 +311,14 @@ elementInNonLayoutContext name = elems <- elements zeroIndentLevel optional tokIndent closeBrace - return (Section name (fmap noComments args) elems) + return (Section (noComments name) (fmap noComments args) elems) ) -- The body of a field, using either layout style or braces style. -- -- fieldLayoutOrBraces ::= '\\n'? '{' comment* (content comment*)* '}' -- | comment* line? comment* ('\\n' line comment*)* -fieldLayoutOrBraces :: IndentLevel -> Name (WithComments Position) -> Parser (Field (WithComments Position)) +fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser (Field (WithComments Position)) fieldLayoutOrBraces ilevel name = braces <|> fieldLayout where braces :: Parser (Field (WithComments Position)) @@ -331,8 +328,8 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout ls <- inLexerMode (LexerMode in_field_braces) (many $ commentsAfter fieldContent) closeBrace return $ case ls of - [] -> Field (fmap (Bi.first (++preCmts)) name) [] - (l : ls') -> Field (fmap (Bi.first (++preCmts)) name) (l : ls') + [] -> Field (fmap (preCmts,) name) [] + (l : ls') -> Field (fmap (preCmts,) name) (l : ls') fieldLayout :: Parser (Field (WithComments Position)) fieldLayout = inLexerMode (LexerMode in_field_layout) $ do @@ -341,8 +338,8 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout ls <- many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) return ( case l of - Nothing -> (Field (fmap (Bi.first (++preCmts)) name) ls) - Just l' -> (Field (fmap (Bi.first (++preCmts)) name) (l' : ls)) + Nothing -> (Field (fmap (preCmts,) name) ls) + Just l' -> (Field (fmap (preCmts,) name) (l' : ls)) ) -- The body of a section, using either layout style or braces style. @@ -364,17 +361,17 @@ sectionLayoutOrBraces ilevel = -- -- fieldInlineOrBraces ::= '\\n'? '{' content '}' -- | content -fieldInlineOrBraces :: Name (WithComments Position) -> Parser (Field (WithComments Position)) +fieldInlineOrBraces :: Name Position -> Parser (Field (WithComments Position)) fieldInlineOrBraces name = ( do openBrace ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent) closeBrace - return (Field name (fmap noComments ls)) + return (Field (noComments name) (fmap noComments ls)) ) <|> ( do ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent)) - return (Field name (fmap noComments ls)) + return (Field (noComments name) (fmap noComments ls)) ) -- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST. From f276099ea31b129919966f5f37a90f35d1b5f6c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 22:30:47 +0800 Subject: [PATCH 63/83] style: run fourmolu --- cabal-install/src/Distribution/Deprecated/ParseUtils.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs index 48f6ed149d8..9ed9acbc8ef 100644 --- a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs +++ b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs @@ -422,8 +422,8 @@ lineNo (Section n _ _ _) = n readFields :: BS.ByteString -> ParseResult [Field] readFields input = case Fields.readFields' input of Right (fs, ws) -> - let fs' = map (fmap Fields.unComments) fs - in ParseOk + let fs' = map (fmap Fields.unComments) fs + in ParseOk [PWarning msg | Fields.PWarning _ _ msg <- Fields.toPWarnings ws] (legacyFields fs') Left perr -> From 6c68e1585dc882cd46efcb0e7e80fdded25248eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Mon, 20 Oct 2025 23:39:52 +0800 Subject: [PATCH 64/83] fix comment attach post processing --- .../src/Distribution/Fields/Parser.hs | 39 +++++++++++++++++-- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index bae56a6c2fe..9adb697012a 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -243,6 +243,8 @@ cabalStyleFile = do return es -- | Collect in annotation one or more comments after a parser succeeds +-- Careful with the 'Functor' instance! +-- If you use this with Field you might attach the same comments everywhere commentsAfter :: Functor f => Parser (f Position) -> Parser (f (WithComments Position)) commentsAfter p = do x <- p @@ -252,16 +254,47 @@ commentsAfter p = do noComments :: Functor f => f ann -> f (WithComments ann) noComments = fmap ([],) +prependCommentsFields :: [Comment ann] -> [Field (WithComments ann)] -> [Field (WithComments ann)] +prependCommentsFields cs fs = case fs of + [] -> [] -- drop + (f : fs') -> prependCommentsField cs f : fs' + +prependCommentsField :: [Comment ann] -> Field (WithComments ann) -> Field (WithComments ann) +prependCommentsField cs f = case f of + (Field name fls) -> Field (Bi.first (cs ++) <$> name) fls + (Section name args fs) -> Section (Bi.first (cs ++) <$> name) args fs + +appendCommentsFields :: [Comment ann] -> [Field (WithComments ann)] -> [Field (WithComments ann)] +appendCommentsFields cs fs = case fs of + [] -> [] -- drop + [f] -> [appendCommentsField cs f] + (f : fs') -> f : appendCommentsFields cs fs' + +appendCommentsField :: [Comment ann] -> Field (WithComments ann) -> Field (WithComments ann) +appendCommentsField cs f = case f of + (Field name []) -> Field (Bi.first (++ cs) <$> name) [] + (Field name fls) -> Field name (appendCommentsFieldLines cs fls) + (Section name args []) -> Section (Bi.first (++ cs) <$> name) args [] + (Section name args fs) -> Section name args (appendCommentsFields cs fs) + +appendCommentsFieldLines :: [Comment ann] -> [FieldLine (WithComments ann)] -> [FieldLine (WithComments ann)] +appendCommentsFieldLines cs fls = case fls of + [] -> [] + [fl] -> [Bi.first (++ cs) <$> fl] + (f : fls') -> f : appendCommentsFieldLines cs fls' + -- Elements that live at the top level or inside a section, i.e. fields -- and sections content -- -- elements ::= comment* (element comment*)* elements :: IndentLevel -> Parser [Field (WithComments Position)] elements ilevel = do - -- FIXME(leana8959): somehow tag the first field with this comment preCmts <- many tokComment - es <- many (element ilevel <* many tokComment) - pure $ es + es <- many $ do + e <- element ilevel + postCmts <- many tokComment + pure $ appendCommentsField postCmts e + pure $ prependCommentsFields preCmts es -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on From 772d35a93e8d99db7967aed6f30ff6a4634146ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 21 Oct 2025 09:37:42 +0800 Subject: [PATCH 65/83] refactor --- .../src/Distribution/Fields/Parser.hs | 4 +-- .../src/Distribution/InstalledPackageInfo.hs | 30 +++++++++---------- .../Distribution/PackageDescription/Parsec.hs | 4 +-- 3 files changed, 17 insertions(+), 21 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 9adb697012a..9572fa74d18 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -360,9 +360,7 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout preCmts <- many tokComment ls <- inLexerMode (LexerMode in_field_braces) (many $ commentsAfter fieldContent) closeBrace - return $ case ls of - [] -> Field (fmap (preCmts,) name) [] - (l : ls') -> Field (fmap (preCmts,) name) (l : ls') + return $ Field (fmap (preCmts,) name) ls fieldLayout :: Parser (Field (WithComments Position)) fieldLayout = inLexerMode (LexerMode in_field_layout) $ do diff --git a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs index a9eb0746414..550e514c224 100644 --- a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs +++ b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs @@ -101,22 +101,20 @@ parseInstalledPackageInfo parseInstalledPackageInfo s = case P.readFields s of Left err -> Left (show err :| []) Right fs -> - let - fs' = map (fmap unComments) fs - in - case partitionFields fs' of - (fs'', _) -> case P.runParseResult $ withSource PInstalledPackageInfo $ parseFieldGrammar cabalSpecLatest fs'' ipiFieldGrammar of - (ws, Right x) -> x `deepseq` Right (ws', x) - where - ws' = - [ P.showPWarningWithSource (fmap renderInstalledPackageInfoSource w) - | w@(P.PWarningWithSource _ (P.PWarning wt _ _)) <- ws - , -- filter out warnings about experimental features - wt /= P.PWTExperimental - ] - (_, Left (_, errs)) -> Left errs' - where - errs' = fmap (P.showPErrorWithSource . fmap renderInstalledPackageInfoSource) errs + let fs' = map (fmap unComments) fs + in case partitionFields fs' of + (fs'', _) -> case P.runParseResult $ withSource PInstalledPackageInfo $ parseFieldGrammar cabalSpecLatest fs'' ipiFieldGrammar of + (ws, Right x) -> x `deepseq` Right (ws', x) + where + ws' = + [ P.showPWarningWithSource (fmap renderInstalledPackageInfoSource w) + | w@(P.PWarningWithSource _ (P.PWarning wt _ _)) <- ws + , -- filter out warnings about experimental features + wt /= P.PWTExperimental + ] + (_, Left (_, errs)) -> Left errs' + where + errs' = fmap (P.showPErrorWithSource . fmap renderInstalledPackageInfoSource) errs -- ----------------------------------------------------------------------------- -- Pretty-printing diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index c7b7a163da4..529226507c4 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -160,7 +160,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos let (comments, fs') = extractComments fs - !comments' = Map.fromList . map (\(Comment cmt pos) -> (pos, cmt)) $ comments + !commentsMap = Map.fromList . map (\(Comment cmt pos) -> (pos, cmt)) $ comments let (syntax, fs'') = sectionizeFields fs' let (fields, sectionFields) = takeFields fs'' @@ -207,7 +207,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do -- Sections let gpd = emptyGenericPackageDescription - { exactComments = comments' + { exactComments = commentsMap } & L.packageDescription .~ pd gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty) From 7187c882d17601b421c6923d5414723cfd92aa6d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 21 Oct 2025 10:04:21 +0800 Subject: [PATCH 66/83] fix: only discard element comments at top level --- .../src/Distribution/Fields/Parser.hs | 67 ++++++++++++------- 1 file changed, 44 insertions(+), 23 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 9572fa74d18..c74ea863b8e 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -240,7 +240,9 @@ cabalStyleFile :: Parser [Field (WithComments Position)] cabalStyleFile = do es <- elements zeroIndentLevel eof - return es + case es of + Left _ -> pure [] -- We discard the comments here, because it is not a valid cabal file + Right es' -> pure es' -- | Collect in annotation one or more comments after a parser succeeds -- Careful with the 'Functor' instance! @@ -254,47 +256,61 @@ commentsAfter p = do noComments :: Functor f => f ann -> f (WithComments ann) noComments = fmap ([],) -prependCommentsFields :: [Comment ann] -> [Field (WithComments ann)] -> [Field (WithComments ann)] +-- | Returns 'Nothing' when there is no field to attach the comments to. +prependCommentsFields :: [Comment ann] -> [Field (WithComments ann)] -> Maybe [Field (WithComments ann)] prependCommentsFields cs fs = case fs of - [] -> [] -- drop - (f : fs') -> prependCommentsField cs f : fs' + [] -> Nothing + (f : fs') -> Just $ prependCommentsField cs f : fs' +-- | We attach the comments to the name (foremost child) of 'Field', this hence cannot fail. prependCommentsField :: [Comment ann] -> Field (WithComments ann) -> Field (WithComments ann) prependCommentsField cs f = case f of (Field name fls) -> Field (Bi.first (cs ++) <$> name) fls (Section name args fs) -> Section (Bi.first (cs ++) <$> name) args fs -appendCommentsFields :: [Comment ann] -> [Field (WithComments ann)] -> [Field (WithComments ann)] +-- | Returns 'Nothing' when there is no field to attach the comments to. +appendCommentsFields :: [Comment ann] -> [Field (WithComments ann)] -> Maybe [Field (WithComments ann)] appendCommentsFields cs fs = case fs of - [] -> [] -- drop - [f] -> [appendCommentsField cs f] - (f : fs') -> f : appendCommentsFields cs fs' + [] -> Nothing + [f] -> Just [appendCommentsField cs f] + (f : fs') -> (f :) <$> appendCommentsFields cs fs' appendCommentsField :: [Comment ann] -> Field (WithComments ann) -> Field (WithComments ann) appendCommentsField cs f = case f of - (Field name []) -> Field (Bi.first (++ cs) <$> name) [] - (Field name fls) -> Field name (appendCommentsFieldLines cs fls) - (Section name args []) -> Section (Bi.first (++ cs) <$> name) args [] - (Section name args fs) -> Section name args (appendCommentsFields cs fs) - -appendCommentsFieldLines :: [Comment ann] -> [FieldLine (WithComments ann)] -> [FieldLine (WithComments ann)] + (Field name fls) -> case appendCommentsFieldLines cs fls of + Nothing -> Field (Bi.first (++ cs) <$> name) [] + Just fls' -> Field name fls' + (Section name args fs) -> case appendCommentsFields cs fs of + Nothing -> Section (Bi.first (++ cs) <$> name) args [] + Just fs' -> Section name args fs' + +-- | Returns 'Nothing' when there is no field to attach the comments to. +appendCommentsFieldLines :: [Comment ann] -> [FieldLine (WithComments ann)] -> Maybe [FieldLine (WithComments ann)] appendCommentsFieldLines cs fls = case fls of - [] -> [] - [fl] -> [Bi.first (++ cs) <$> fl] - (f : fls') -> f : appendCommentsFieldLines cs fls' + [] -> Nothing + [fl] -> Just [Bi.first (++ cs) <$> fl] + (f : fls') -> (f :) <$> appendCommentsFieldLines cs fls' -- Elements that live at the top level or inside a section, i.e. fields --- and sections content +-- and sections content. +-- +-- This returns either many fields with their comments attached, or just the +-- comments if there are no fields to attach them to. Only at the top level it +-- is deemed correct to discard these comments, because in that case having no +-- elements isn't a valid cabal file. -- -- elements ::= comment* (element comment*)* -elements :: IndentLevel -> Parser [Field (WithComments Position)] +elements :: IndentLevel -> Parser (Either [Comment Position] [Field (WithComments Position)]) elements ilevel = do preCmts <- many tokComment es <- many $ do e <- element ilevel postCmts <- many tokComment pure $ appendCommentsField postCmts e - pure $ prependCommentsFields preCmts es + + case prependCommentsFields preCmts es of + Nothing -> pure $ Left preCmts + Just es' -> pure $ Right es' -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on @@ -326,7 +342,9 @@ elementInLayoutContext ilevel name = <|> ( do args <- many sectionArg elems <- sectionLayoutOrBraces ilevel - return (Section (noComments name) (fmap noComments args) elems) + case elems of + Left elementCmts -> return (Section (fmap (elementCmts,) name) (fmap noComments args) []) + Right elems' -> return (Section (noComments name) (fmap noComments args) elems') ) -- An element (field or section) that is valid in a non-layout context. @@ -344,7 +362,10 @@ elementInNonLayoutContext name = elems <- elements zeroIndentLevel optional tokIndent closeBrace - return (Section (noComments name) (fmap noComments args) elems) + + case elems of + Left elementCmts -> return (Section (fmap (elementCmts,) name) (fmap noComments args) []) + Right elems' -> return (Section (noComments name) (fmap noComments args) elems') ) -- The body of a field, using either layout style or braces style. @@ -377,7 +398,7 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout -- -- sectionLayoutOrBraces ::= '\\n'? '{' elements \\n? '}' -- | elements -sectionLayoutOrBraces :: IndentLevel -> Parser [Field (WithComments Position)] +sectionLayoutOrBraces :: IndentLevel -> Parser (Either [Comment Position] [Field (WithComments Position)]) sectionLayoutOrBraces ilevel = ( do openBrace From 836553fc1fdd134dc00ffd6de41345dc35c7edd0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 21 Oct 2025 10:07:56 +0800 Subject: [PATCH 67/83] test: update expected --- .../layout-complex-indented-comments.expr | 30 +++++++++++++++++-- 1 file changed, 27 insertions(+), 3 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr index 7aab18f61ed..b270185a73d 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr @@ -118,19 +118,43 @@ "/home/foo/.local/bin"], Section (Name - (_×_ [] (Position 28 1)) + (_×_ + [ + Comment + " -- keep-temp-files: False" + (Position 29 1), + Comment + " -- hoogle: False" + (Position 30 1)] + (Position 28 1)) "haddock") [] [], Section (Name - (_×_ [] (Position 32 1)) + (_×_ + [ + Comment + " -- interactive: False" + (Position 33 1), + Comment + " -- quiet: False" + (Position 34 1)] + (Position 32 1)) "init") [] [], Section (Name - (_×_ [] (Position 36 1)) + (_×_ + [ + Comment + " -- alex-location:" + (Position 37 1), + Comment + " -- ar-location:" + (Position 38 1)] + (Position 36 1)) "program-locations") [] []] From 602787639056ac3deca0aa3e7759bb4467f6d6a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 21 Oct 2025 11:34:24 +0800 Subject: [PATCH 68/83] fix: derive Eq instance for Comment This fixes builds for old GHC --- Cabal-syntax/src/Distribution/Fields/Field.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index 593266b0b84..d56006fead6 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -52,7 +52,7 @@ import qualified Data.Foldable1 as F1 ------------------------------------------------------------------------------- data Comment ann = Comment !ByteString !ann - deriving (Show, Generic) + deriving (Show, Eq, Generic) type WithComments ann = ([Comment ann], ann) From fdbd970c820b1ec10793168936da186a43523462 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 22 Oct 2025 08:17:30 +0800 Subject: [PATCH 69/83] use strict either for parser --- .../src/Distribution/Fields/Parser.hs | 25 +++++++++++-------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index c74ea863b8e..35c136cd87e 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -79,6 +79,11 @@ instance Stream LexState' Identity LToken where L _ EOF -> return Nothing _ -> return (Just (tok, st')) +-- | A strict either for parser performance +data Either' a b + = Left' !a + | Right' !b + -- | Get lexer warnings accumulated so far getLexerWarnings :: Parser [LexWarning] getLexerWarnings = do @@ -241,8 +246,8 @@ cabalStyleFile = do es <- elements zeroIndentLevel eof case es of - Left _ -> pure [] -- We discard the comments here, because it is not a valid cabal file - Right es' -> pure es' + Left' _ -> pure [] -- We discard the comments here, because it is not a valid cabal file + Right' es' -> pure es' -- | Collect in annotation one or more comments after a parser succeeds -- Careful with the 'Functor' instance! @@ -300,7 +305,7 @@ appendCommentsFieldLines cs fls = case fls of -- elements isn't a valid cabal file. -- -- elements ::= comment* (element comment*)* -elements :: IndentLevel -> Parser (Either [Comment Position] [Field (WithComments Position)]) +elements :: IndentLevel -> Parser (Either' [Comment Position] [Field (WithComments Position)]) elements ilevel = do preCmts <- many tokComment es <- many $ do @@ -309,8 +314,8 @@ elements ilevel = do pure $ appendCommentsField postCmts e case prependCommentsFields preCmts es of - Nothing -> pure $ Left preCmts - Just es' -> pure $ Right es' + Nothing -> pure $ Left' preCmts + Just es' -> pure $ Right' es' -- An individual element, ie a field or a section. These can either use -- layout style or braces style. For layout style then it must start on @@ -343,8 +348,8 @@ elementInLayoutContext ilevel name = args <- many sectionArg elems <- sectionLayoutOrBraces ilevel case elems of - Left elementCmts -> return (Section (fmap (elementCmts,) name) (fmap noComments args) []) - Right elems' -> return (Section (noComments name) (fmap noComments args) elems') + Left' elementCmts -> return (Section (fmap (elementCmts,) name) (fmap noComments args) []) + Right' elems' -> return (Section (noComments name) (fmap noComments args) elems') ) -- An element (field or section) that is valid in a non-layout context. @@ -364,8 +369,8 @@ elementInNonLayoutContext name = closeBrace case elems of - Left elementCmts -> return (Section (fmap (elementCmts,) name) (fmap noComments args) []) - Right elems' -> return (Section (noComments name) (fmap noComments args) elems') + Left' elementCmts -> return (Section (fmap (elementCmts,) name) (fmap noComments args) []) + Right' elems' -> return (Section (noComments name) (fmap noComments args) elems') ) -- The body of a field, using either layout style or braces style. @@ -398,7 +403,7 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout -- -- sectionLayoutOrBraces ::= '\\n'? '{' elements \\n? '}' -- | elements -sectionLayoutOrBraces :: IndentLevel -> Parser (Either [Comment Position] [Field (WithComments Position)]) +sectionLayoutOrBraces :: IndentLevel -> Parser (Either' [Comment Position] [Field (WithComments Position)]) sectionLayoutOrBraces ilevel = ( do openBrace From 8372444ed05b8860ec04e06e2bb264006967a744 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 22 Oct 2025 22:29:13 +0800 Subject: [PATCH 70/83] fix: doctest --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 35c136cd87e..615239f03ec 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -437,7 +437,7 @@ fieldInlineOrBraces name = -- Therefore bytestrings inside returned 'Field' will be invalid as UTF8 if the input were. -- -- >>> readFields "foo: \223" --- Right [Field (Name (Position 1 1) "foo") [FieldLine (Position 1 6) "\223"]] +-- Right [Field (Name ([],Position 1 1) "foo") [FieldLine ([],Position 1 6) "\223"]] -- -- 'readFields' won't (necessarily) fail on invalid UTF8 data, but the reported positions may be off. -- @@ -451,12 +451,12 @@ fieldInlineOrBraces name = -- If there are just latin1 non-breaking spaces, they become part of the name: -- -- >>> readFields "\xa0\&foo: bar" --- Right [Field (Name (Position 1 1) "\160foo") [FieldLine (Position 1 7) "bar"]] +-- Right [Field (Name ([],Position 1 1) "\160foo") [FieldLine ([],Position 1 7) "bar"]] -- -- The UTF8 non-breaking space is accepted as an indentation character (but warned about by 'readFields''). -- -- >>> readFields' "\xc2\xa0 foo: bar" --- Right ([Field (Name (Position 1 3) "foo") [FieldLine (Position 1 8) "bar"]],[LexWarning LexWarningNBSP (Position 1 1)]) +-- Right ([Field (Name ([],Position 1 3) "foo") [FieldLine ([],Position 1 8) "bar"]],[LexWarning LexWarningNBSP (Position 1 1)]) readFields :: B8.ByteString -> Either ParseError [Field (WithComments Position)] readFields s = fmap fst (readFields' s) From 0ea26ddddb8bb92123542394d4b52f4cb4660c74 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 10:56:05 +0800 Subject: [PATCH 71/83] define proper WithComments data type --- Cabal-syntax/src/Distribution/Fields/Field.hs | 23 +++++++++------ .../src/Distribution/Fields/Parser.hs | 29 +++++++++---------- 2 files changed, 28 insertions(+), 24 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index d56006fead6..6dd9a2af26b 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} @@ -20,9 +21,9 @@ module Distribution.Fields.Field -- * Comment , Comment (..) - , WithComments - , justComments - , unComments + , WithComments (..) + , mapComments + , mapCommentedData -- * Name , FieldName @@ -52,15 +53,19 @@ import qualified Data.Foldable1 as F1 ------------------------------------------------------------------------------- data Comment ann = Comment !ByteString !ann - deriving (Show, Eq, Generic) + deriving (Show, Generic, Eq, Ord, Functor) -type WithComments ann = ([Comment ann], ann) +data WithComments ann = WithComments + { justComments :: ![Comment ann] + , unComments :: !ann + } + deriving (Show, Generic, Eq, Ord, Functor) -unComments :: WithComments ann -> ann -unComments = snd +mapComments :: ([Comment ann] -> [Comment ann]) -> WithComments ann -> WithComments ann +mapComments f (WithComments cs x) = WithComments (f cs) x -justComments :: WithComments ann -> [Comment ann] -justComments = fst +mapCommentedData :: (ann -> ann) -> WithComments ann -> WithComments ann +mapCommentedData f (WithComments cs x) = WithComments cs (f x) -- | A Cabal-like file consists of a series of fields (@foo: bar@) and sections (@library ...@). data Field ann diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 615239f03ec..d33f54848a6 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -34,7 +34,6 @@ module Distribution.Fields.Parser ) where {- FOURMOLU_ENABLE -} -import qualified Data.Bifunctor as Bi import qualified Data.ByteString.Char8 as B8 import Data.Functor.Identity import Distribution.Compat.Prelude @@ -256,10 +255,10 @@ commentsAfter :: Functor f => Parser (f Position) -> Parser (f (WithComments Pos commentsAfter p = do x <- p postCmts <- many tokComment - pure $ fmap (postCmts,) x + pure $ fmap (WithComments postCmts) x noComments :: Functor f => f ann -> f (WithComments ann) -noComments = fmap ([],) +noComments = fmap (WithComments mempty) -- | Returns 'Nothing' when there is no field to attach the comments to. prependCommentsFields :: [Comment ann] -> [Field (WithComments ann)] -> Maybe [Field (WithComments ann)] @@ -270,8 +269,8 @@ prependCommentsFields cs fs = case fs of -- | We attach the comments to the name (foremost child) of 'Field', this hence cannot fail. prependCommentsField :: [Comment ann] -> Field (WithComments ann) -> Field (WithComments ann) prependCommentsField cs f = case f of - (Field name fls) -> Field (Bi.first (cs ++) <$> name) fls - (Section name args fs) -> Section (Bi.first (cs ++) <$> name) args fs + (Field name fls) -> Field (mapComments (cs ++) <$> name) fls + (Section name args fs) -> Section (mapComments (cs ++) <$> name) args fs -- | Returns 'Nothing' when there is no field to attach the comments to. appendCommentsFields :: [Comment ann] -> [Field (WithComments ann)] -> Maybe [Field (WithComments ann)] @@ -283,17 +282,17 @@ appendCommentsFields cs fs = case fs of appendCommentsField :: [Comment ann] -> Field (WithComments ann) -> Field (WithComments ann) appendCommentsField cs f = case f of (Field name fls) -> case appendCommentsFieldLines cs fls of - Nothing -> Field (Bi.first (++ cs) <$> name) [] + Nothing -> Field (mapComments (++ cs) <$> name) [] Just fls' -> Field name fls' (Section name args fs) -> case appendCommentsFields cs fs of - Nothing -> Section (Bi.first (++ cs) <$> name) args [] + Nothing -> Section (mapComments (++ cs) <$> name) args [] Just fs' -> Section name args fs' -- | Returns 'Nothing' when there is no field to attach the comments to. appendCommentsFieldLines :: [Comment ann] -> [FieldLine (WithComments ann)] -> Maybe [FieldLine (WithComments ann)] appendCommentsFieldLines cs fls = case fls of [] -> Nothing - [fl] -> Just [Bi.first (++ cs) <$> fl] + [fl] -> Just [mapComments (++ cs) <$> fl] (f : fls') -> (f :) <$> appendCommentsFieldLines cs fls' -- Elements that live at the top level or inside a section, i.e. fields @@ -348,8 +347,8 @@ elementInLayoutContext ilevel name = args <- many sectionArg elems <- sectionLayoutOrBraces ilevel case elems of - Left' elementCmts -> return (Section (fmap (elementCmts,) name) (fmap noComments args) []) - Right' elems' -> return (Section (noComments name) (fmap noComments args) elems') + Left' elementCmts -> return (Section (WithComments elementCmts <$> name) (noComments <$> args) []) + Right' elems' -> return (Section (noComments name) (noComments <$> args) elems') ) -- An element (field or section) that is valid in a non-layout context. @@ -369,8 +368,8 @@ elementInNonLayoutContext name = closeBrace case elems of - Left' elementCmts -> return (Section (fmap (elementCmts,) name) (fmap noComments args) []) - Right' elems' -> return (Section (noComments name) (fmap noComments args) elems') + Left' elementCmts -> return (Section (WithComments elementCmts <$> name) (noComments <$> args) []) + Right' elems' -> return (Section (noComments name) (noComments <$> args) elems') ) -- The body of a field, using either layout style or braces style. @@ -386,7 +385,7 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout preCmts <- many tokComment ls <- inLexerMode (LexerMode in_field_braces) (many $ commentsAfter fieldContent) closeBrace - return $ Field (fmap (preCmts,) name) ls + return $ Field (WithComments preCmts <$> name) ls fieldLayout :: Parser (Field (WithComments Position)) fieldLayout = inLexerMode (LexerMode in_field_layout) $ do @@ -395,8 +394,8 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout ls <- many (do _ <- indentOfAtLeast ilevel; commentsAfter fieldContent) return ( case l of - Nothing -> (Field (fmap (preCmts,) name) ls) - Just l' -> (Field (fmap (preCmts,) name) (l' : ls)) + Nothing -> (Field (WithComments preCmts <$> name) ls) + Just l' -> (Field (WithComments preCmts <$> name) (l' : ls)) ) -- The body of a section, using either layout style or braces style. From 9a9c05caedaed96116721c68731a6d8a19582ce2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 11:07:57 +0800 Subject: [PATCH 72/83] remove exactComment field in GenericPackageDescription --- .../PackageDescription/Configuration.hs | 4 ++-- .../src/Distribution/PackageDescription/Parsec.hs | 6 +----- .../PackageDescription/PrettyPrint.hs | 1 - .../Types/AnnotatedGenericPackageDescription.hs | 15 +++++++++++++++ .../Types/GenericPackageDescription.hs | 9 ++------- .../Types/GenericPackageDescription/Lens.hs | 3 +-- Cabal-tests/tests/ParserTests.hs | 8 ++++---- .../src/Data/TreeDiff/Instances/Cabal.hs | 3 ++- .../src/Distribution/PackageDescription/Check.hs | 1 - 9 files changed, 27 insertions(+), 23 deletions(-) create mode 100644 Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs index 5b5b24d6b91..d23ac5cbf51 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs @@ -458,7 +458,7 @@ finalizePD (Platform arch os) impl constraints - (GenericPackageDescription pkg _ver flags mb_lib0 sub_libs0 flibs0 exes0 tests0 bms0 _exactComments) = do + (GenericPackageDescription pkg _ver flags mb_lib0 sub_libs0 flibs0 exes0 tests0 bms0) = do (targetSet, flagVals) <- resolveWithFlags flagChoices enabled os arch impl constraints condTrees check let @@ -542,7 +542,7 @@ resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribu -- function. flattenPackageDescription :: GenericPackageDescription -> PackageDescription flattenPackageDescription - (GenericPackageDescription pkg _ _ mlib0 sub_libs0 flibs0 exes0 tests0 bms0 _exactComments) = + (GenericPackageDescription pkg _ _ mlib0 sub_libs0 flibs0 exes0 tests0 bms0) = pkg { library = mlib , subLibraries = reverse sub_libs diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 529226507c4..281b7978626 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -205,11 +205,7 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do maybeWarnCabalVersion syntax pd -- Sections - let gpd = - emptyGenericPackageDescription - { exactComments = commentsMap - } - & L.packageDescription .~ pd + let gpd = emptyGenericPackageDescription & L.packageDescription .~ pd gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty) let gpd2 = postProcessInternalDeps specVer gpd1 diff --git a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs index 4017920cbee..15c2c15fe09 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs @@ -237,7 +237,6 @@ pdToGpd pd = , condExecutables = mkCondTree' exeName <$> executables pd , condTestSuites = mkCondTree' testName <$> testSuites pd , condBenchmarks = mkCondTree' benchmarkName <$> benchmarks pd - , exactComments = mempty -- We preserve the behaviour of "drop all comments" for now } where -- We set CondTree's [Dependency] to an empty list, as it diff --git a/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs new file mode 100644 index 00000000000..9f5f5f65f97 --- /dev/null +++ b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs @@ -0,0 +1,15 @@ +-- | Contains 'AnnotatedGenericPackageDescription', useful for exact print +-- We split this from 'GenericPackageDescription' type notably because the +-- exact comments breaks its 'Eq' instance. +module Distribution.Types.AnnotatedGenericPackageDescription where + + +import Distribution.Types.GenericPackageDescription + +data AnnotatedGenericPackageDescription = AnnotatedGenericPackageDescription + { unannotateGpd :: GenericPackageDescription + , exactComments :: ExactComments Position + } + deriving (Show, Data, Generic) + +type ExactComments ann = Map ann ByteString diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index d05264e364c..7e2e42940c5 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -5,7 +5,6 @@ module Distribution.Types.GenericPackageDescription ( GenericPackageDescription (..) - , ExactComments , emptyGenericPackageDescription ) where @@ -74,12 +73,9 @@ data GenericPackageDescription = GenericPackageDescription , CondTree ConfVar [Dependency] Benchmark ) ] - , exactComments :: ExactComments Position } deriving (Show, Eq, Data, Generic) -type ExactComments ann = Map ann ByteString - instance Package GenericPackageDescription where packageId = packageId . packageDescription @@ -88,13 +84,13 @@ instance Structured GenericPackageDescription instance NFData GenericPackageDescription where rnf = genericRnf emptyGenericPackageDescription :: GenericPackageDescription -emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing [] [] [] [] [] mempty +emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing [] [] [] [] [] -- ----------------------------------------------------------------------------- -- Traversal Instances instance L.HasBuildInfos GenericPackageDescription where - traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 comments) = + traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) = GenericPackageDescription <$> L.traverseBuildInfos f p <*> pure v @@ -105,7 +101,6 @@ instance L.HasBuildInfos GenericPackageDescription where <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x4 <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x5 <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x6 - <*> pure comments -- We use this traversal to keep [Dependency] field in CondTree up to date. traverseCondTreeBuildInfo diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs index 461252f3006..213c97128f9 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs @@ -81,7 +81,7 @@ allCondTrees ) -> GenericPackageDescription -> f GenericPackageDescription -allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 comments) = +allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) = GenericPackageDescription <$> pure p <*> pure v @@ -92,7 +92,6 @@ allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6 comments) = <*> (traverse . _2) f x4 <*> (traverse . _2) f x5 <*> (traverse . _2) f x6 - <*> pure comments ------------------------------------------------------------------------------- -- Flag diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 106797184ad..8c6119e5e93 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -15,7 +15,7 @@ import Data.Algorithm.Diff (PolyDiff (..), getGroupedDif import Data.Maybe (isNothing) import Distribution.Fields (pwarning) import Distribution.Fields.Parser (readFields', formatError) -import Distribution.PackageDescription (GenericPackageDescription(exactComments)) +import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.Parsec (PWarnType (..), PWarning (..), showPErrorWithSource, showPWarningWithSource) @@ -146,7 +146,8 @@ commentTest fname = ediffGolden goldenTest fname exprFile $ do ) case x of - Right output -> pure $ toExpr (exactComments output) + -- TODO(leana8959): teste the proper output of Exact comment + Right output -> pure $ toExpr output Left (v, errs) -> fail $ unlines $ ("VERSION: " ++ show v) : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) @@ -314,8 +315,7 @@ formatRoundTripTest fp = testCase "roundtrip" $ do -- previously we mangled licenses a bit let y' = y {- FOURMOLU_DISABLE -} - -- we disable comparison on exactComments for now because we can't print it yet - unless (x { exactComments = mempty } == y') $ + unless (x == y') $ #ifdef MIN_VERSION_tree_diff assertFailure $ unlines [ "re-parsed doesn't match" diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs index 1cb3abce882..0c722b6a40a 100644 --- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs +++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs @@ -13,7 +13,7 @@ import Data.TreeDiff.Instances.CabalVersion () import Distribution.Backpack (OpenModule, OpenUnitId) import Distribution.CabalSpecVersion (CabalSpecVersion) import Distribution.Compiler (CompilerFlavor, CompilerId, PerCompilerFlavor) -import Distribution.Fields.Field (Field, Name, FieldLine, SectionArg, Comment) +import Distribution.Fields.Field (Field, Name, FieldLine, SectionArg, Comment, WithComments) import Distribution.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo) import Distribution.ModuleName (ModuleName) import Distribution.PackageDescription @@ -59,6 +59,7 @@ instance ToExpr (SymbolicPathX allowAbs from to) instance ToExpr a => ToExpr (InstallDirs a) instance (ToExpr ann) => ToExpr (Comment ann) +instance (ToExpr ann) => ToExpr (WithComments ann) instance (ToExpr ann) => ToExpr (Field ann) instance (ToExpr ann) => ToExpr (FieldLine ann) instance (ToExpr ann) => ToExpr (Name ann) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 3432567ffe3..0593ce8d905 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -232,7 +232,6 @@ checkGenericPackageDescription condExecutables_ condTestSuites_ condBenchmarks_ - _exactComments ) = do -- § Description and names. From 798115e465c8720bacf29790c020fe42995a1967 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 11:17:41 +0800 Subject: [PATCH 73/83] add Lens functions for AnnotatedGenericPackageDescription --- Cabal-syntax/Cabal-syntax.cabal | 2 ++ .../Types/AnnotatedGenericPackageDescription.hs | 16 +++++++++++++--- .../AnnotatedGenericPackageDescription/Lens.hs | 10 ++++++++++ Cabal-syntax/src/Distribution/Types/Lens.hs | 2 ++ 4 files changed, 27 insertions(+), 3 deletions(-) create mode 100644 Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription/Lens.hs diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal index 04ccd237f64..b438f5d7e7a 100644 --- a/Cabal-syntax/Cabal-syntax.cabal +++ b/Cabal-syntax/Cabal-syntax.cabal @@ -158,6 +158,8 @@ library Distribution.Types.ForeignLibOption Distribution.Types.ForeignLibType Distribution.Types.GenericPackageDescription + Distribution.Types.AnnotatedGenericPackageDescription + Distribution.Types.AnnotatedGenericPackageDescription.Lens Distribution.Types.GenericPackageDescription.Lens Distribution.Types.HookedBuildInfo Distribution.Types.IncludeRenaming diff --git a/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs index 9f5f5f65f97..644e04daa0b 100644 --- a/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs @@ -1,14 +1,24 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + -- | Contains 'AnnotatedGenericPackageDescription', useful for exact print -- We split this from 'GenericPackageDescription' type notably because the -- exact comments breaks its 'Eq' instance. -module Distribution.Types.AnnotatedGenericPackageDescription where +module Distribution.Types.AnnotatedGenericPackageDescription + ( AnnotatedGenericPackageDescription (..) + , ExactComments + ) where +import Distribution.Compat.Prelude +import Prelude () +import Data.ByteString +import Distribution.Parsec.Position (Position) import Distribution.Types.GenericPackageDescription data AnnotatedGenericPackageDescription = AnnotatedGenericPackageDescription - { unannotateGpd :: GenericPackageDescription - , exactComments :: ExactComments Position + { exactComments :: ExactComments Position + , unannotatedGpd :: GenericPackageDescription } deriving (Show, Data, Generic) diff --git a/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription/Lens.hs new file mode 100644 index 00000000000..4f8124b2fda --- /dev/null +++ b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription/Lens.hs @@ -0,0 +1,10 @@ +module Distribution.Types.AnnotatedGenericPackageDescription.Lens where + +import Distribution.Compat.Lens +import Distribution.Compat.Prelude +import Prelude () +import qualified Distribution.Types.GenericPackageDescription as T +import qualified Distribution.Types.AnnotatedGenericPackageDescription as T + +unannotatedGpd :: Lens' T.AnnotatedGenericPackageDescription T.GenericPackageDescription +unannotatedGpd f s = fmap (\x -> s{T.unannotatedGpd = x}) (f (T.unannotatedGpd s)) diff --git a/Cabal-syntax/src/Distribution/Types/Lens.hs b/Cabal-syntax/src/Distribution/Types/Lens.hs index 2934d722fbd..89a319a7c48 100644 --- a/Cabal-syntax/src/Distribution/Types/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/Lens.hs @@ -3,6 +3,7 @@ module Distribution.Types.Lens , module Distribution.Types.BuildInfo.Lens , module Distribution.Types.Executable.Lens , module Distribution.Types.ForeignLib.Lens + , module Distribution.Types.AnnotatedGenericPackageDescription.Lens , module Distribution.Types.GenericPackageDescription.Lens , module Distribution.Types.Library.Lens , module Distribution.Types.PackageDescription.Lens @@ -16,6 +17,7 @@ import Distribution.Types.Benchmark.Lens import Distribution.Types.BuildInfo.Lens import Distribution.Types.Executable.Lens import Distribution.Types.ForeignLib.Lens +import Distribution.Types.AnnotatedGenericPackageDescription.Lens import Distribution.Types.GenericPackageDescription.Lens import Distribution.Types.Library.Lens import Distribution.Types.PackageDescription.Lens From f0757677e156c6722479bf9f006bc6ee51f2e885 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 11:35:40 +0800 Subject: [PATCH 74/83] test AnnotatedGenericPackageDescription instead --- .../src/Distribution/PackageDescription.hs | 4 ++- .../Distribution/PackageDescription/Parsec.hs | 28 +++++++++++++------ Cabal-tests/tests/ParserTests.hs | 12 ++++---- .../src/Data/TreeDiff/Instances/Cabal.hs | 1 + 4 files changed, 31 insertions(+), 14 deletions(-) diff --git a/Cabal-syntax/src/Distribution/PackageDescription.hs b/Cabal-syntax/src/Distribution/PackageDescription.hs index 47d46673e5f..789fb006e16 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription.hs @@ -12,7 +12,8 @@ -- about @.cabal@ files. module Distribution.PackageDescription ( -- * PD and GPD - module Distribution.Types.PackageDescription + module Distribution.Types.PackageDescription + , module Distribution.Types.AnnotatedGenericPackageDescription , module Distribution.Types.GenericPackageDescription -- * Components @@ -103,6 +104,7 @@ import Distribution.Types.Flag import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibOption import Distribution.Types.ForeignLibType +import Distribution.Types.AnnotatedGenericPackageDescription import Distribution.Types.GenericPackageDescription import Distribution.Types.HookedBuildInfo import Distribution.Types.IncludeRenaming diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 281b7978626..921e00a40e1 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -17,6 +17,8 @@ module Distribution.PackageDescription.Parsec ( -- * Package descriptions parseGenericPackageDescription , parseGenericPackageDescriptionMaybe + , parseAnnotatedGenericPackageDescription + , parseAnnotatedGenericPackageDescriptionMaybe -- ** Parsing , ParseResult @@ -45,6 +47,7 @@ import Distribution.Fields.Field (Comment (..), FieldName, WithComments, getName import Distribution.Fields.LexerMonad (LexWarning, toPWarnings) import Distribution.Fields.ParseResult import Distribution.Fields.Parser +import Distribution.Types.AnnotatedGenericPackageDescription import Distribution.PackageDescription import Distribution.PackageDescription.Configuration (freeVars, transformAllBuildInfos) import Distribution.PackageDescription.FieldGrammar @@ -78,7 +81,10 @@ import qualified Text.Parsec as P -- In Cabal 1.2 the syntax for package descriptions was changed to a format -- with sections and possibly indented property descriptions. parseGenericPackageDescription :: BS.ByteString -> ParseResult src GenericPackageDescription -parseGenericPackageDescription bs = do +parseGenericPackageDescription = fmap unannotatedGpd . parseAnnotatedGenericPackageDescription + +parseAnnotatedGenericPackageDescription :: BS.ByteString -> ParseResult src AnnotatedGenericPackageDescription +parseAnnotatedGenericPackageDescription bs = do -- set scanned version setCabalSpecVersion ver @@ -99,7 +105,7 @@ parseGenericPackageDescription bs = do when patched $ parseWarning zeroPos PWTQuirkyCabalFile "Legacy cabal file" -- UTF8 is validated in a prepass step, afterwards parsing is lenient. - parseGenericPackageDescription' csv lexWarnings invalidUtf8 fs + parseAnnotatedGenericPackageDescription' csv lexWarnings invalidUtf8 fs -- TODO: better marshalling of errors Left perr -> parseFatalFailure pos (show perr) where @@ -118,8 +124,11 @@ parseGenericPackageDescription bs = do -- | 'Maybe' variant of 'parseGenericPackageDescription' parseGenericPackageDescriptionMaybe :: BS.ByteString -> Maybe GenericPackageDescription -parseGenericPackageDescriptionMaybe = - either (const Nothing) Just . snd . runParseResult . parseGenericPackageDescription +parseGenericPackageDescriptionMaybe = fmap unannotatedGpd . parseAnnotatedGenericPackageDescriptionMaybe + +parseAnnotatedGenericPackageDescriptionMaybe :: BS.ByteString -> Maybe AnnotatedGenericPackageDescription +parseAnnotatedGenericPackageDescriptionMaybe = + either (const Nothing) Just . snd . runParseResult . parseAnnotatedGenericPackageDescription fieldlinesToBS :: [FieldLine ann] -> BS.ByteString fieldlinesToBS = BS.intercalate "\n" . map (\(FieldLine _ bs) -> bs) @@ -148,13 +157,13 @@ stateCommonStanzas f (SectionS gpd cs) = SectionS gpd <$> f cs -- * first we parse fields of PackageDescription -- * then we parse sections (libraries, executables, etc) -parseGenericPackageDescription' +parseAnnotatedGenericPackageDescription' :: Maybe CabalSpecVersion -> [LexWarning] -> Maybe Int -> [Field (WithComments Position)] - -> ParseResult src GenericPackageDescription -parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do + -> ParseResult src AnnotatedGenericPackageDescription +parseAnnotatedGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do parseWarnings (toPWarnings lexWarnings) for_ utf8WarnPos $ \pos -> parseWarning zeroPos PWTUTF $ "UTF8 encoding problem at byte offset " ++ show pos @@ -217,7 +226,10 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do -- TODO: re-benchmark, whether `deepseq` is important (both cabal-benchmarks and solver-benchmarks) -- TODO: remove the need for deepseq if `deepseq` in fact matters -- NOTE: IIRC it does affect (maximal) memory usage, which causes less GC pressure - gpd2 `deepseq` return gpd2 + gpd2 `deepseq` return AnnotatedGenericPackageDescription + { exactComments = commentsMap + , unannotatedGpd = gpd2 + } where safeLast :: [a] -> Maybe a safeLast = listToMaybe . reverse diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 8c6119e5e93..bb349b5b867 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -15,8 +15,11 @@ import Data.Algorithm.Diff (PolyDiff (..), getGroupedDif import Data.Maybe (isNothing) import Distribution.Fields (pwarning) import Distribution.Fields.Parser (readFields', formatError) -import Distribution.PackageDescription (GenericPackageDescription) -import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) +import Distribution.PackageDescription (GenericPackageDescription, exactComments) +import Distribution.PackageDescription.Parsec + ( parseGenericPackageDescription + , parseAnnotatedGenericPackageDescription + ) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.Parsec (PWarnType (..), PWarning (..), showPErrorWithSource, showPWarningWithSource) import Distribution.Pretty (prettyShow) @@ -138,7 +141,7 @@ readFieldTest fname = ediffGolden goldenTest fname exprFile $ do commentTest :: FilePath -> TestTree commentTest fname = ediffGolden goldenTest fname exprFile $ do contents <- BS.readFile input - let res = withSource (PCabalFile (input, contents)) $ parseGenericPackageDescription contents + let res = withSource (PCabalFile (input, contents)) $ parseAnnotatedGenericPackageDescription contents let (warns, x) = runParseResult res unless (null warns) (fail $ @@ -146,8 +149,7 @@ commentTest fname = ediffGolden goldenTest fname exprFile $ do ) case x of - -- TODO(leana8959): teste the proper output of Exact comment - Right output -> pure $ toExpr output + Right output -> pure $ toExpr (exactComments output) Left (v, errs) -> fail $ unlines $ ("VERSION: " ++ show v) : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs index 0c722b6a40a..9050b1defbe 100644 --- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs +++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs @@ -88,6 +88,7 @@ instance ToExpr FlagName instance ToExpr ForeignLib instance ToExpr ForeignLibOption instance ToExpr ForeignLibType +instance ToExpr AnnotatedGenericPackageDescription instance ToExpr GenericPackageDescription instance ToExpr HaddockTarget instance ToExpr IncludeRenaming From 6428ac4b22ccfad7492f06ff9df36fc8ced529eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 11:36:36 +0800 Subject: [PATCH 75/83] run fourmolu --- Cabal-syntax/src/Distribution/PackageDescription.hs | 4 ++-- .../src/Distribution/PackageDescription/Parsec.hs | 12 +++++++----- .../Types/AnnotatedGenericPackageDescription.hs | 2 +- .../Types/AnnotatedGenericPackageDescription/Lens.hs | 4 ++-- 4 files changed, 12 insertions(+), 10 deletions(-) diff --git a/Cabal-syntax/src/Distribution/PackageDescription.hs b/Cabal-syntax/src/Distribution/PackageDescription.hs index 789fb006e16..1f788872283 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription.hs @@ -12,7 +12,7 @@ -- about @.cabal@ files. module Distribution.PackageDescription ( -- * PD and GPD - module Distribution.Types.PackageDescription + module Distribution.Types.PackageDescription , module Distribution.Types.AnnotatedGenericPackageDescription , module Distribution.Types.GenericPackageDescription @@ -87,6 +87,7 @@ import Prelude () -- import Distribution.Compat.Prelude +import Distribution.Types.AnnotatedGenericPackageDescription import Distribution.Types.Benchmark import Distribution.Types.BenchmarkInterface import Distribution.Types.BenchmarkType @@ -104,7 +105,6 @@ import Distribution.Types.Flag import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibOption import Distribution.Types.ForeignLibType -import Distribution.Types.AnnotatedGenericPackageDescription import Distribution.Types.GenericPackageDescription import Distribution.Types.HookedBuildInfo import Distribution.Types.IncludeRenaming diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 921e00a40e1..b0abab3e5e7 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -47,7 +47,6 @@ import Distribution.Fields.Field (Comment (..), FieldName, WithComments, getName import Distribution.Fields.LexerMonad (LexWarning, toPWarnings) import Distribution.Fields.ParseResult import Distribution.Fields.Parser -import Distribution.Types.AnnotatedGenericPackageDescription import Distribution.PackageDescription import Distribution.PackageDescription.Configuration (freeVars, transformAllBuildInfos) import Distribution.PackageDescription.FieldGrammar @@ -57,6 +56,7 @@ import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) import Distribution.Parsec.Position (Position (..), incPos, zeroPos) import Distribution.Parsec.Warning (PWarnType (..)) import Distribution.Pretty (prettyShow) +import Distribution.Types.AnnotatedGenericPackageDescription import Distribution.Utils.Generic (breakMaybe, fromUTF8BS, toUTF8BS, unfoldrM, validateUTF8) import Distribution.Version (Version, mkVersion, versionNumbers) @@ -226,10 +226,12 @@ parseAnnotatedGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = -- TODO: re-benchmark, whether `deepseq` is important (both cabal-benchmarks and solver-benchmarks) -- TODO: remove the need for deepseq if `deepseq` in fact matters -- NOTE: IIRC it does affect (maximal) memory usage, which causes less GC pressure - gpd2 `deepseq` return AnnotatedGenericPackageDescription - { exactComments = commentsMap - , unannotatedGpd = gpd2 - } + gpd2 `deepseq` + return + AnnotatedGenericPackageDescription + { exactComments = commentsMap + , unannotatedGpd = gpd2 + } where safeLast :: [a] -> Maybe a safeLast = listToMaybe . reverse diff --git a/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs index 644e04daa0b..1f515fe5aa9 100644 --- a/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription.hs @@ -4,7 +4,7 @@ -- | Contains 'AnnotatedGenericPackageDescription', useful for exact print -- We split this from 'GenericPackageDescription' type notably because the -- exact comments breaks its 'Eq' instance. -module Distribution.Types.AnnotatedGenericPackageDescription +module Distribution.Types.AnnotatedGenericPackageDescription ( AnnotatedGenericPackageDescription (..) , ExactComments ) where diff --git a/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription/Lens.hs index 4f8124b2fda..0d025c56165 100644 --- a/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/AnnotatedGenericPackageDescription/Lens.hs @@ -2,9 +2,9 @@ module Distribution.Types.AnnotatedGenericPackageDescription.Lens where import Distribution.Compat.Lens import Distribution.Compat.Prelude -import Prelude () -import qualified Distribution.Types.GenericPackageDescription as T import qualified Distribution.Types.AnnotatedGenericPackageDescription as T +import qualified Distribution.Types.GenericPackageDescription as T +import Prelude () unannotatedGpd :: Lens' T.AnnotatedGenericPackageDescription T.GenericPackageDescription unannotatedGpd f s = fmap (\x -> s{T.unannotatedGpd = x}) (f (T.unannotatedGpd s)) From a02d925f3a2b7e124d10c16ef506dd47418b3a7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 11:37:41 +0800 Subject: [PATCH 76/83] run hlint --- Cabal-syntax/src/Distribution/Fields/Field.hs | 1 - Cabal-syntax/src/Distribution/Fields/Parser.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index 6dd9a2af26b..4038347d236 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index d33f54848a6..7905ccc8bd6 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- From e840182563e9964d8ac5a80639fb8af6ce5e4c28 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 11:44:33 +0800 Subject: [PATCH 77/83] remove redundant imports --- Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs | 1 - .../src/Distribution/Types/GenericPackageDescription.hs | 3 --- 2 files changed, 4 deletions(-) diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index b0abab3e5e7..ef5a3646fdb 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -56,7 +56,6 @@ import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) import Distribution.Parsec.Position (Position (..), incPos, zeroPos) import Distribution.Parsec.Warning (PWarnType (..)) import Distribution.Pretty (prettyShow) -import Distribution.Types.AnnotatedGenericPackageDescription import Distribution.Utils.Generic (breakMaybe, fromUTF8BS, toUTF8BS, unfoldrM, validateUTF8) import Distribution.Version (Version, mkVersion, versionNumbers) diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index 7e2e42940c5..97f4ed8cccb 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -11,9 +11,6 @@ module Distribution.Types.GenericPackageDescription import Distribution.Compat.Prelude import Prelude () -import Data.ByteString -import Distribution.Parsec.Position (Position) - -- lens import Distribution.Compat.Lens as L import qualified Distribution.Types.BuildInfo.Lens as L From c1cfd6c084fc70863f7730f7baeac2e9d20b3205 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 11:49:02 +0800 Subject: [PATCH 78/83] tests: test hasktorch --- Cabal-tests/tests/ParserTests.hs | 4 + .../ParserTests/comments/hasktorch.cabal | 558 ++++++++++++++++++ .../tests/ParserTests/comments/hasktorch.expr | 98 +++ 3 files changed, 660 insertions(+) create mode 100644 Cabal-tests/tests/ParserTests/comments/hasktorch.cabal create mode 100644 Cabal-tests/tests/ParserTests/comments/hasktorch.expr diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index bb349b5b867..003ff4082f0 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -120,6 +120,10 @@ commentTests = testGroup "comments" , commentTest "layout-many-sections.cabal" , commentTest "layout-interleaved-in-section.cabal" , commentTest "layout-fieldline-is-flag.cabal" + + -- Imported from regression test + -- This one has a lot of comments + , commentTest "hasktorch.cabal" ] -- Use this test to bypass the more sophisticated checks of whether a cabal file is valid diff --git a/Cabal-tests/tests/ParserTests/comments/hasktorch.cabal b/Cabal-tests/tests/ParserTests/comments/hasktorch.cabal new file mode 100644 index 00000000000..d9ca0a6c037 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/hasktorch.cabal @@ -0,0 +1,558 @@ +cabal-version: 2.2 +-- ================================================================ -- +-- ======== This cabal file has been modified from dhall ========== -- +-- ======== This constitutes the 0.0.1.0 release. ========== -- +-- ======== Dhall can generate this file, but will never ========== -- +-- ======== be able to upload to hackage. For more, see: ========== -- +-- ==== https://github.com/haskell/hackage-server/issues/795 ====== -- +-- ================================================================ -- +name: hasktorch +version: 0.0.1.0 +license: BSD-3-Clause +maintainer: Sam Stites , Austin Huang - cipher:ROT13 +author: Hasktorch dev team +homepage: https://github.com/hasktorch/hasktorch#readme +bug-reports: https://github.com/hasktorch/hasktorch/issues +synopsis: Torch for tensors and neural networks in Haskell +description: + Hasktorch is a library for tensors and neural networks in Haskell. It is an independent open source community project which leverages the core C libraries shared by Torch and PyTorch. This library leverages @cabal v2-build@ and @backpack@. *Note that this project is in early development and should only be used by contributing developers. Expect substantial changes to the library API as it evolves. Contributions and PRs are welcome (see details on github).* +category: Tensors, Machine Learning, AI +build-type: Simple + +source-repository head + type: git + location: https://github.com/hasktorch/hasktorch + +flag cuda + description: + build with THC support + default: False + +flag lite + description: + only build with Double and Long support + default: False + +library + exposed-modules: + Torch.Core.Exceptions + Torch.Core.Random + Torch.Core.LogAdd + reexported-modules: Torch.Types.Numeric, + Torch.Long, + Torch.Long.Dynamic, + Torch.Long.Storage, + Torch.Double, + Torch.Double.Dynamic, + Torch.Double.Storage, + Torch.Double.NN, + Torch.Double.NN.Activation, + Torch.Double.NN.Backprop, + Torch.Double.NN.Conv1d, + Torch.Double.NN.Conv2d, + Torch.Double.NN.Criterion, + Torch.Double.NN.Layers, + Torch.Double.NN.Linear, + Torch.Double.NN.Math, + Torch.Double.NN.Padding, + Torch.Double.NN.Pooling, + Torch.Double.NN.Sampling, + Torch.Double.Dynamic.NN, + Torch.Double.Dynamic.NN.Activation, + Torch.Double.Dynamic.NN.Pooling, + Torch.Double.Dynamic.NN.Criterion + hs-source-dirs: utils + default-language: Haskell2010 + default-extensions: LambdaCase DataKinds TypeFamilies + TypeSynonymInstances ScopedTypeVariables FlexibleContexts CPP + build-depends: + base (==4.7 || >4.7) && <5, + -- containers ==0.5.10 || >0.5.10, + -- deepseq ==1.3.0 || >1.3.0, + dimensions ==1.0 || >1.0, + -- managed (==1.0.0 || >1.0.0) && <1.1, + -- microlens ==0.4.8 || >0.4.8, + -- numeric-limits ==0.1.0 || >0.1.0, + safe-exceptions ==0.1.0 || >0.1.0, + singletons ==2.2 || >2.2, + text ==1.2.2 || >1.2.2, + -- typelits-witnesses ==0.2.3 || >0.2.3, + hasktorch-cpu -any, + hasktorch-ffi-th (==0.0.1 || >0.0.1) && <0.0.2, + hasktorch-types-th (==0.0.1 || >0.0.1) && <0.0.2 + + -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -- + -- BEGIN EDITS + -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -- + if !flag(lite) + reexported-modules: + Torch.Byte, + Torch.Byte.Dynamic, + Torch.Byte.Storage, + Torch.Char, + Torch.Char.Dynamic, + Torch.Char.Storage, + Torch.Short, + Torch.Short.Dynamic, + Torch.Short.Storage, + Torch.Int, + Torch.Int.Dynamic, + Torch.Int.Storage, + Torch.Float, + Torch.Float.Dynamic, + Torch.Float.Storage + + if flag(cuda) + build-depends: + hasktorch-gpu -any + reexported-modules: + Torch.Cuda.Long, + Torch.Cuda.Long.Dynamic, + Torch.Cuda.Long.Storage, + Torch.Cuda.Double, + Torch.Cuda.Double.Dynamic, + Torch.Cuda.Double.Storage, + Torch.Cuda.Double.NN, + Torch.Cuda.Double.NN.Activation, + Torch.Cuda.Double.NN.Backprop, + Torch.Cuda.Double.NN.Conv1d, + Torch.Cuda.Double.NN.Conv2d, + Torch.Cuda.Double.NN.Criterion, + Torch.Cuda.Double.NN.Layers, + Torch.Cuda.Double.NN.Linear, + Torch.Cuda.Double.NN.Math, + Torch.Cuda.Double.NN.Padding, + Torch.Cuda.Double.NN.Pooling, + Torch.Cuda.Double.NN.Sampling, + Torch.Cuda.Double.Dynamic.NN, + Torch.Cuda.Double.Dynamic.NN.Activation, + Torch.Cuda.Double.Dynamic.NN.Pooling, + Torch.Cuda.Double.Dynamic.NN.Criterion + if !flag(lite) + reexported-modules: + Torch.Cuda.Byte, + Torch.Cuda.Byte.Dynamic, + Torch.Cuda.Byte.Storage, + Torch.Cuda.Char, + Torch.Cuda.Char.Dynamic, + Torch.Cuda.Char.Storage, + Torch.Cuda.Short, + Torch.Cuda.Short.Dynamic, + Torch.Cuda.Short.Storage, + Torch.Cuda.Int, + Torch.Cuda.Int.Dynamic, + Torch.Cuda.Int.Storage, + Torch.Cuda.Float, + Torch.Cuda.Float.Dynamic, + Torch.Cuda.Float.Storage + -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -- + -- END EDITS + -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -- + +library hasktorch-cpu + exposed-modules: + Torch.Long + Torch.Long.Dynamic + Torch.Long.Storage + Torch.Double + Torch.Double.Dynamic + Torch.Double.Storage + reexported-modules: Torch.Double.NN, + Torch.Double.NN.Activation, + Torch.Double.NN.Backprop, + Torch.Double.NN.Conv1d, + Torch.Double.NN.Conv2d, + Torch.Double.NN.Criterion, + Torch.Double.NN.Layers, + Torch.Double.NN.Linear, + Torch.Double.NN.Math, + Torch.Double.NN.Padding, + Torch.Double.NN.Pooling, + Torch.Double.NN.Sampling, + Torch.Double.Dynamic.NN, + Torch.Double.Dynamic.NN.Activation, + Torch.Double.Dynamic.NN.Pooling, + Torch.Double.Dynamic.NN.Criterion, + Torch.Float.NN, + Torch.Float.NN.Activation, + Torch.Float.NN.Backprop, + Torch.Float.NN.Conv1d, + Torch.Float.NN.Conv2d, + Torch.Float.NN.Criterion, + Torch.Float.NN.Layers, + Torch.Float.NN.Linear, + Torch.Float.NN.Math, + Torch.Float.NN.Padding, + Torch.Float.NN.Pooling, + Torch.Float.NN.Sampling, + Torch.Float.Dynamic.NN, + Torch.Float.Dynamic.NN.Activation, + Torch.Float.Dynamic.NN.Pooling, + Torch.Float.Dynamic.NN.Criterion + hs-source-dirs: utils src + other-modules: + Torch.Core.Exceptions + Torch.Core.Random + Torch.Core.LogAdd + default-language: Haskell2010 + default-extensions: LambdaCase DataKinds TypeFamilies + TypeSynonymInstances ScopedTypeVariables FlexibleContexts CPP + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch-types-th (==0.0.1 || >0.0.1) && <0.0.2, + -- containers ==0.5.10 || >0.5.10, + -- deepseq ==1.3.0 || >1.3.0, + dimensions ==1.0 || >1.0, + hasktorch-ffi-th (==0.0.1 || >0.0.1) && <0.0.2, + hasktorch-types-th (==0.0.1 || >0.0.1) && <0.0.2, + -- managed (==1.0.0 || >1.0.0) && <1.1, + -- microlens ==0.4.8 || >0.4.8, + -- numeric-limits ==0.1.0 || >0.1.0, + safe-exceptions ==0.1.0 || >0.1.0, + singletons ==2.2 || >2.2, + text ==1.2.2 || >1.2.2, + -- typelits-witnesses ==0.2.3 || >0.2.3, + hasktorch-indef-floating -any, + hasktorch-indef-signed -any + mixins: hasktorch-indef-signed (Torch.Indef.Storage as Torch.Indef.Long.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Long.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Long.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Long.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Long.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Long.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Long.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Long.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Long.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Long.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Long.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Long.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Long.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Long.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Long.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Long.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Long.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Long.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Long.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Long.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Long.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Long.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Long.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Long.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Long.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Long.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Long.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Long.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Long.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Long.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Long.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Long.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Long.Types, Torch.Indef.Index as Torch.Long.Index, Torch.Indef.Mask as Torch.Long.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Long.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Long.Dynamic.Tensor.Math.Pointwise.Signed) requires (Torch.Sig.Index.Tensor as Torch.FFI.TH.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.TH.Long.FreeTensor, Torch.Sig.Mask.Tensor as Torch.FFI.TH.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.TH.Byte.FreeTensor, Torch.Sig.Mask.MathReduce as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.State as Torch.Types.TH, Torch.Sig.Types.Global as Torch.Types.TH, Torch.Sig.Types as Torch.Types.TH.Long, Torch.Sig.Storage as Torch.FFI.TH.Long.Storage, Torch.Sig.Storage.Copy as Torch.FFI.TH.Long.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.TH.Long.FreeStorage, Torch.Sig.Tensor as Torch.FFI.TH.Long.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.TH.Long.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.TH.Long.FreeTensor, Torch.Sig.Tensor.Index as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Masked as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Math as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Math.Scan as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Mode as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.ScatterGather as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Sort as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.TopK as Torch.FFI.TH.Long.TensorMath, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.TH.Long.TensorMath), + hasktorch-indef-floating (Torch.Indef.Storage as Torch.Indef.Double.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Double.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Double.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Double.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Double.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Double.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Double.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Double.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Double.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Double.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Double.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Double.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Double.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Double.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Double.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Double.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Double.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Double.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Double.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Double.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Double.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Double.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Double.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Double.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Double.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Double.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Double.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Double.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Double.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Double.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Double.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Double.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Double.Types, Torch.Indef.Index as Torch.Double.Index, Torch.Indef.Mask as Torch.Double.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Double.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Double.Dynamic.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Blas as Torch.Indef.Double.Dynamic.Tensor.Math.Blas, Torch.Indef.Dynamic.Tensor.Math.Lapack as Torch.Indef.Double.Dynamic.Tensor.Math.Lapack, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Floating as Torch.Indef.Double.Dynamic.Tensor.Math.Pointwise.Floating, Torch.Indef.Dynamic.Tensor.Math.Reduce.Floating as Torch.Indef.Double.Dynamic.Tensor.Math.Reduce.Floating, Torch.Indef.Dynamic.Tensor.Math.Floating as Torch.Indef.Double.Dynamic.Tensor.Math.Floating, Torch.Indef.Static.Tensor.Math.Blas as Torch.Indef.Double.Tensor.Math.Blas, Torch.Indef.Static.Tensor.Math.Lapack as Torch.Indef.Double.Tensor.Math.Lapack, Torch.Indef.Static.Tensor.Math.Pointwise.Floating as Torch.Indef.Double.Tensor.Math.Pointwise.Floating, Torch.Indef.Static.Tensor.Math.Reduce.Floating as Torch.Indef.Double.Tensor.Math.Reduce.Floating, Torch.Indef.Static.Tensor.Math.Floating as Torch.Indef.Double.Tensor.Math.Floating, Torch.Indef.Static.Tensor.Random.TH as Torch.Indef.Double.Tensor.Random.TH, Torch.Indef.Static.Tensor.Math.Random.TH as Torch.Indef.Double.Tensor.Math.Random.TH, Torch.Indef.Dynamic.Tensor.Random.TH as Torch.Indef.Double.Dynamic.Tensor.Random.TH, Torch.Indef.Dynamic.Tensor.Math.Random.TH as Torch.Indef.Double.Dynamic.Tensor.Math.Random.TH, Torch.Undefined.Tensor.Random.THC as Torch.Undefined.Double.Tensor.Random.THC, Torch.Indef.Storage as Torch.Indef.Double.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Double.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Double.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Double.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Double.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Double.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Double.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Double.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Double.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Double.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Double.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Double.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Double.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Double.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Double.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Double.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Double.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Double.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Double.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Double.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Double.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Double.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Double.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Double.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Double.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Double.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Double.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Double.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Double.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Double.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Double.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Double.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Double.Types, Torch.Indef.Index as Torch.Double.Index, Torch.Indef.Mask as Torch.Double.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Double.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Double.Dynamic.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.NN as Torch.Double.Dynamic.NN, Torch.Indef.Dynamic.NN.Activation as Torch.Double.Dynamic.NN.Activation, Torch.Indef.Dynamic.NN.Pooling as Torch.Double.Dynamic.NN.Pooling, Torch.Indef.Dynamic.NN.Criterion as Torch.Double.Dynamic.NN.Criterion, Torch.Indef.Static.NN as Torch.Double.NN, Torch.Indef.Static.NN as Torch.Double.NN, Torch.Indef.Static.NN.Activation as Torch.Double.NN.Activation, Torch.Indef.Static.NN.Backprop as Torch.Double.NN.Backprop, Torch.Indef.Static.NN.Conv1d as Torch.Double.NN.Conv1d, Torch.Indef.Static.NN.Conv2d as Torch.Double.NN.Conv2d, Torch.Indef.Static.NN.Criterion as Torch.Double.NN.Criterion, Torch.Indef.Static.NN.Layers as Torch.Double.NN.Layers, Torch.Indef.Static.NN.Linear as Torch.Double.NN.Linear, Torch.Indef.Static.NN.Math as Torch.Double.NN.Math, Torch.Indef.Static.NN.Padding as Torch.Double.NN.Padding, Torch.Indef.Static.NN.Pooling as Torch.Double.NN.Pooling, Torch.Indef.Static.NN.Sampling as Torch.Double.NN.Sampling) requires (Torch.Sig.Index.Tensor as Torch.FFI.TH.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.TH.Long.FreeTensor, Torch.Sig.Mask.Tensor as Torch.FFI.TH.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.TH.Byte.FreeTensor, Torch.Sig.Mask.MathReduce as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.State as Torch.Types.TH, Torch.Sig.Types.Global as Torch.Types.TH, Torch.Sig.Types as Torch.Types.TH.Double, Torch.Sig.Storage as Torch.FFI.TH.Double.Storage, Torch.Sig.Storage.Copy as Torch.FFI.TH.Double.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.TH.Double.FreeStorage, Torch.Sig.Tensor as Torch.FFI.TH.Double.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.TH.Double.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.TH.Double.FreeTensor, Torch.Sig.Tensor.Index as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Masked as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Scan as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Mode as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.ScatterGather as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Sort as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.TopK as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Pointwise.Floating as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Reduce.Floating as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Floating as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Blas as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Math.Lapack as Torch.FFI.TH.Double.TensorLapack, Torch.Sig.NN as Torch.FFI.TH.NN.Double, Torch.Sig.Types.NN as Torch.Types.TH, Torch.Sig.Tensor.Math.Random.TH as Torch.FFI.TH.Double.TensorMath, Torch.Sig.Tensor.Random.TH as Torch.FFI.TH.Double.TensorRandom, Torch.Sig.Tensor.Random.THC as Torch.Undefined.Double.Tensor.Random.THC) + + if flag(lite) + else + exposed-modules: + Torch.Byte + Torch.Byte.Dynamic + Torch.Byte.Storage + Torch.Char + Torch.Char.Dynamic + Torch.Char.Storage + Torch.Short + Torch.Short.Dynamic + Torch.Short.Storage + Torch.Int + Torch.Int.Dynamic + Torch.Int.Storage + Torch.Float + Torch.Float.Dynamic + Torch.Float.Storage + build-depends: + hasktorch-indef-unsigned -any + mixins: hasktorch-indef-unsigned (Torch.Indef.Storage as Torch.Indef.Byte.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Byte.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Byte.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Byte.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Byte.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Byte.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Byte.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Byte.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Byte.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Byte.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Byte.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Byte.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Byte.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Byte.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Byte.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Byte.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Byte.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Byte.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Byte.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Byte.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Byte.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Byte.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Byte.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Byte.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Byte.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Byte.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Byte.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Byte.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Byte.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Byte.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Byte.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Byte.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Byte.Types, Torch.Indef.Index as Torch.Byte.Index, Torch.Indef.Mask as Torch.Byte.Mask) requires (Torch.Sig.Index.Tensor as Torch.FFI.TH.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.TH.Long.FreeTensor, Torch.Sig.Mask.Tensor as Torch.FFI.TH.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.TH.Byte.FreeTensor, Torch.Sig.Mask.MathReduce as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.State as Torch.Types.TH, Torch.Sig.Types.Global as Torch.Types.TH, Torch.Sig.Types as Torch.Types.TH.Byte, Torch.Sig.Storage as Torch.FFI.TH.Byte.Storage, Torch.Sig.Storage.Copy as Torch.FFI.TH.Byte.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.TH.Byte.FreeStorage, Torch.Sig.Tensor as Torch.FFI.TH.Byte.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.TH.Byte.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.TH.Byte.FreeTensor, Torch.Sig.Tensor.Index as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Masked as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Math as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Math.Scan as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Mode as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.ScatterGather as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.Sort as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.Tensor.TopK as Torch.FFI.TH.Byte.TensorMath), + hasktorch-indef-unsigned (Torch.Indef.Storage as Torch.Indef.Char.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Char.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Char.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Char.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Char.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Char.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Char.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Char.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Char.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Char.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Char.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Char.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Char.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Char.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Char.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Char.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Char.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Char.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Char.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Char.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Char.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Char.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Char.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Char.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Char.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Char.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Char.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Char.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Char.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Char.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Char.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Char.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Char.Types, Torch.Indef.Index as Torch.Char.Index, Torch.Indef.Mask as Torch.Char.Mask) requires (Torch.Sig.Index.Tensor as Torch.FFI.TH.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.TH.Long.FreeTensor, Torch.Sig.Mask.Tensor as Torch.FFI.TH.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.TH.Byte.FreeTensor, Torch.Sig.Mask.MathReduce as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.State as Torch.Types.TH, Torch.Sig.Types.Global as Torch.Types.TH, Torch.Sig.Types as Torch.Types.TH.Char, Torch.Sig.Storage as Torch.FFI.TH.Char.Storage, Torch.Sig.Storage.Copy as Torch.FFI.TH.Char.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.TH.Char.FreeStorage, Torch.Sig.Tensor as Torch.FFI.TH.Char.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.TH.Char.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.TH.Char.FreeTensor, Torch.Sig.Tensor.Index as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Masked as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Math as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Math.Scan as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Mode as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.ScatterGather as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.Sort as Torch.FFI.TH.Char.TensorMath, Torch.Sig.Tensor.TopK as Torch.FFI.TH.Char.TensorMath), + hasktorch-indef-signed (Torch.Indef.Storage as Torch.Indef.Short.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Short.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Short.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Short.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Short.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Short.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Short.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Short.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Short.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Short.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Short.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Short.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Short.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Short.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Short.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Short.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Short.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Short.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Short.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Short.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Short.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Short.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Short.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Short.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Short.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Short.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Short.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Short.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Short.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Short.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Short.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Short.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Short.Types, Torch.Indef.Index as Torch.Short.Index, Torch.Indef.Mask as Torch.Short.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Short.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Short.Dynamic.Tensor.Math.Pointwise.Signed) requires (Torch.Sig.Index.Tensor as Torch.FFI.TH.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.TH.Long.FreeTensor, Torch.Sig.Mask.Tensor as Torch.FFI.TH.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.TH.Byte.FreeTensor, Torch.Sig.Mask.MathReduce as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.State as Torch.Types.TH, Torch.Sig.Types.Global as Torch.Types.TH, Torch.Sig.Types as Torch.Types.TH.Short, Torch.Sig.Storage as Torch.FFI.TH.Short.Storage, Torch.Sig.Storage.Copy as Torch.FFI.TH.Short.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.TH.Short.FreeStorage, Torch.Sig.Tensor as Torch.FFI.TH.Short.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.TH.Short.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.TH.Short.FreeTensor, Torch.Sig.Tensor.Index as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Masked as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Math as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Math.Scan as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Mode as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.ScatterGather as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Sort as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.TopK as Torch.FFI.TH.Short.TensorMath, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.TH.Short.TensorMath), + hasktorch-indef-signed (Torch.Indef.Storage as Torch.Indef.Int.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Int.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Int.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Int.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Int.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Int.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Int.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Int.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Int.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Int.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Int.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Int.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Int.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Int.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Int.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Int.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Int.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Int.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Int.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Int.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Int.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Int.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Int.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Int.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Int.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Int.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Int.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Int.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Int.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Int.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Int.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Int.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Int.Types, Torch.Indef.Index as Torch.Int.Index, Torch.Indef.Mask as Torch.Int.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Int.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Int.Dynamic.Tensor.Math.Pointwise.Signed) requires (Torch.Sig.Index.Tensor as Torch.FFI.TH.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.TH.Long.FreeTensor, Torch.Sig.Mask.Tensor as Torch.FFI.TH.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.TH.Byte.FreeTensor, Torch.Sig.Mask.MathReduce as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.State as Torch.Types.TH, Torch.Sig.Types.Global as Torch.Types.TH, Torch.Sig.Types as Torch.Types.TH.Int, Torch.Sig.Storage as Torch.FFI.TH.Int.Storage, Torch.Sig.Storage.Copy as Torch.FFI.TH.Int.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.TH.Int.FreeStorage, Torch.Sig.Tensor as Torch.FFI.TH.Int.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.TH.Int.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.TH.Int.FreeTensor, Torch.Sig.Tensor.Index as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Masked as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Math as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Math.Scan as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Mode as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.ScatterGather as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Sort as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.TopK as Torch.FFI.TH.Int.TensorMath, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.TH.Int.TensorMath), + hasktorch-indef-floating (Torch.Indef.Storage as Torch.Indef.Float.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Float.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Float.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Float.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Float.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Float.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Float.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Float.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Float.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Float.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Float.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Float.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Float.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Float.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Float.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Float.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Float.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Float.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Float.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Float.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Float.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Float.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Float.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Float.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Float.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Float.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Float.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Float.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Float.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Float.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Float.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Float.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Float.Types, Torch.Indef.Index as Torch.Float.Index, Torch.Indef.Mask as Torch.Float.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Float.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Float.Dynamic.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Blas as Torch.Indef.Float.Dynamic.Tensor.Math.Blas, Torch.Indef.Dynamic.Tensor.Math.Lapack as Torch.Indef.Float.Dynamic.Tensor.Math.Lapack, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Floating as Torch.Indef.Float.Dynamic.Tensor.Math.Pointwise.Floating, Torch.Indef.Dynamic.Tensor.Math.Reduce.Floating as Torch.Indef.Float.Dynamic.Tensor.Math.Reduce.Floating, Torch.Indef.Dynamic.Tensor.Math.Floating as Torch.Indef.Float.Dynamic.Tensor.Math.Floating, Torch.Indef.Static.Tensor.Math.Blas as Torch.Indef.Float.Tensor.Math.Blas, Torch.Indef.Static.Tensor.Math.Lapack as Torch.Indef.Float.Tensor.Math.Lapack, Torch.Indef.Static.Tensor.Math.Pointwise.Floating as Torch.Indef.Float.Tensor.Math.Pointwise.Floating, Torch.Indef.Static.Tensor.Math.Reduce.Floating as Torch.Indef.Float.Tensor.Math.Reduce.Floating, Torch.Indef.Static.Tensor.Math.Floating as Torch.Indef.Float.Tensor.Math.Floating, Torch.Indef.Static.Tensor.Random.TH as Torch.Indef.Float.Tensor.Random.TH, Torch.Indef.Static.Tensor.Math.Random.TH as Torch.Indef.Float.Tensor.Math.Random.TH, Torch.Indef.Dynamic.Tensor.Random.TH as Torch.Indef.Float.Dynamic.Tensor.Random.TH, Torch.Indef.Dynamic.Tensor.Math.Random.TH as Torch.Indef.Float.Dynamic.Tensor.Math.Random.TH, Torch.Undefined.Tensor.Random.THC as Torch.Undefined.Float.Tensor.Random.THC, Torch.Indef.Storage as Torch.Indef.Float.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Float.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Float.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Float.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Float.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Float.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Float.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Float.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Float.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Float.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Float.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Float.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Float.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Float.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Float.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Float.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Float.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Float.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Float.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Float.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Float.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Float.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Float.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Float.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Float.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Float.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Float.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Float.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Float.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Float.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Float.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Float.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Float.Types, Torch.Indef.Index as Torch.Float.Index, Torch.Indef.Mask as Torch.Float.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Float.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Float.Dynamic.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.NN as Torch.Float.Dynamic.NN, Torch.Indef.Dynamic.NN.Activation as Torch.Float.Dynamic.NN.Activation, Torch.Indef.Dynamic.NN.Pooling as Torch.Float.Dynamic.NN.Pooling, Torch.Indef.Dynamic.NN.Criterion as Torch.Float.Dynamic.NN.Criterion, Torch.Indef.Static.NN as Torch.Float.NN, Torch.Indef.Static.NN as Torch.Float.NN, Torch.Indef.Static.NN.Activation as Torch.Float.NN.Activation, Torch.Indef.Static.NN.Backprop as Torch.Float.NN.Backprop, Torch.Indef.Static.NN.Conv1d as Torch.Float.NN.Conv1d, Torch.Indef.Static.NN.Conv2d as Torch.Float.NN.Conv2d, Torch.Indef.Static.NN.Criterion as Torch.Float.NN.Criterion, Torch.Indef.Static.NN.Layers as Torch.Float.NN.Layers, Torch.Indef.Static.NN.Linear as Torch.Float.NN.Linear, Torch.Indef.Static.NN.Math as Torch.Float.NN.Math, Torch.Indef.Static.NN.Padding as Torch.Float.NN.Padding, Torch.Indef.Static.NN.Pooling as Torch.Float.NN.Pooling, Torch.Indef.Static.NN.Sampling as Torch.Float.NN.Sampling) requires (Torch.Sig.Index.Tensor as Torch.FFI.TH.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.TH.Long.FreeTensor, Torch.Sig.Mask.Tensor as Torch.FFI.TH.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.TH.Byte.FreeTensor, Torch.Sig.Mask.MathReduce as Torch.FFI.TH.Byte.TensorMath, Torch.Sig.State as Torch.Types.TH, Torch.Sig.Types.Global as Torch.Types.TH, Torch.Sig.Types as Torch.Types.TH.Float, Torch.Sig.Storage as Torch.FFI.TH.Float.Storage, Torch.Sig.Storage.Copy as Torch.FFI.TH.Float.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.TH.Float.FreeStorage, Torch.Sig.Tensor as Torch.FFI.TH.Float.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.TH.Float.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.TH.Float.FreeTensor, Torch.Sig.Tensor.Index as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Masked as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Scan as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Mode as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.ScatterGather as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Sort as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.TopK as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Pointwise.Floating as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Reduce.Floating as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Floating as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Blas as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Math.Lapack as Torch.FFI.TH.Float.TensorLapack, Torch.Sig.NN as Torch.FFI.TH.NN.Float, Torch.Sig.Types.NN as Torch.Types.TH, Torch.Sig.Tensor.Math.Random.TH as Torch.FFI.TH.Float.TensorMath, Torch.Sig.Tensor.Random.TH as Torch.FFI.TH.Float.TensorRandom, Torch.Sig.Tensor.Random.THC as Torch.Undefined.Float.Tensor.Random.THC) + +library hasktorch-gpu + exposed-modules: + Torch.Cuda.Long + Torch.Cuda.Long.Dynamic + Torch.Cuda.Long.Storage + Torch.Cuda.Double + Torch.Cuda.Double.Dynamic + Torch.Cuda.Double.Storage + reexported-modules: Torch.Cuda.Double.NN, + Torch.Cuda.Double.NN.Activation, + Torch.Cuda.Double.NN.Backprop, + Torch.Cuda.Double.NN.Conv1d, + Torch.Cuda.Double.NN.Conv2d, + Torch.Cuda.Double.NN.Criterion, + Torch.Cuda.Double.NN.Layers, + Torch.Cuda.Double.NN.Linear, + Torch.Cuda.Double.NN.Math, + Torch.Cuda.Double.NN.Padding, + Torch.Cuda.Double.NN.Pooling, + Torch.Cuda.Double.NN.Sampling, + Torch.Cuda.Double.Dynamic.NN, + Torch.Cuda.Double.Dynamic.NN.Activation, + Torch.Cuda.Double.Dynamic.NN.Pooling, + Torch.Cuda.Double.Dynamic.NN.Criterion + cpp-options: -DCUDA -DHASKTORCH_INTERNAL_CUDA + hs-source-dirs: utils src + other-modules: + Torch.Core.Exceptions + Torch.Core.Random + Torch.Core.LogAdd + default-language: Haskell2010 + default-extensions: LambdaCase DataKinds TypeFamilies + TypeSynonymInstances ScopedTypeVariables FlexibleContexts CPP + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch-types-th (==0.0.1 || >0.0.1) && <0.0.2, + -- containers ==0.5.10 || >0.5.10, + -- deepseq ==1.3.0 || >1.3.0, + dimensions ==1.0 || >1.0, + hasktorch-ffi-th (==0.0.1 || >0.0.1) && <0.0.2, + hasktorch-types-th (==0.0.1 || >0.0.1) && <0.0.2, + -- managed (==1.0.0 || >1.0.0) && <1.1, + -- microlens ==0.4.8 || >0.4.8, + -- numeric-limits ==0.1.0 || >0.1.0, + safe-exceptions ==0.1.0 || >0.1.0, + singletons ==2.2 || >2.2, + text ==1.2.2 || >1.2.2, + -- typelits-witnesses ==0.2.3 || >0.2.3, + hasktorch-indef-floating -any, + hasktorch-indef-signed -any, + hasktorch-ffi-thc (==0.0.1 || >0.0.1) && <0.0.2, + hasktorch-types-thc (==0.0.1 || >0.0.1) && <0.0.2 + mixins: hasktorch-indef-signed (Torch.Indef.Storage as Torch.Indef.Cuda.Long.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Cuda.Long.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Cuda.Long.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Cuda.Long.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Cuda.Long.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Cuda.Long.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Cuda.Long.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Cuda.Long.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Cuda.Long.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Cuda.Long.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Cuda.Long.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Cuda.Long.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Cuda.Long.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Cuda.Long.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Cuda.Long.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Cuda.Long.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Cuda.Long.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Cuda.Long.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Cuda.Long.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Cuda.Long.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Cuda.Long.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Cuda.Long.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Cuda.Long.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Cuda.Long.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Cuda.Long.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Cuda.Long.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Cuda.Long.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Cuda.Long.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Cuda.Long.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Cuda.Long.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Cuda.Long.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Cuda.Long.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Cuda.Long.Types, Torch.Indef.Index as Torch.Cuda.Long.Index, Torch.Indef.Mask as Torch.Cuda.Long.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Long.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Long.Dynamic.Tensor.Math.Pointwise.Signed) requires (Torch.Sig.Index.Tensor as Torch.FFI.THC.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.THC.Long.Tensor, Torch.Sig.Mask.Tensor as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.MathReduce as Torch.FFI.THC.Byte.TensorMathReduce, Torch.Sig.State as Torch.FFI.THC.State, Torch.Sig.Types.Global as Torch.Types.THC, Torch.Sig.Types as Torch.Types.THC.Long, Torch.Sig.Storage as Torch.FFI.THC.Long.Storage, Torch.Sig.Storage.Copy as Torch.FFI.THC.Long.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.THC.Long.Storage, Torch.Sig.Tensor as Torch.FFI.THC.Long.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.THC.Long.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.THC.Long.Tensor, Torch.Sig.Tensor.Index as Torch.FFI.THC.Long.TensorIndex, Torch.Sig.Tensor.Masked as Torch.FFI.THC.Long.TensorMasked, Torch.Sig.Tensor.Math as Torch.FFI.THC.Long.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.THC.Long.TensorMathCompare, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.THC.Long.TensorMathCompareT, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.THC.Long.TensorMathPairwise, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.THC.Long.TensorMathPointwise, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.THC.Long.TensorMathReduce, Torch.Sig.Tensor.Math.Scan as Torch.FFI.THC.Long.TensorMathScan, Torch.Sig.Tensor.Mode as Torch.FFI.THC.Long.TensorMode, Torch.Sig.Tensor.ScatterGather as Torch.FFI.THC.Long.TensorScatterGather, Torch.Sig.Tensor.Sort as Torch.FFI.THC.Long.TensorSort, Torch.Sig.Tensor.TopK as Torch.FFI.THC.Long.TensorTopK, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.THC.Long.TensorMathPointwise), + hasktorch-indef-floating (Torch.Indef.Storage as Torch.Indef.Cuda.Double.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Cuda.Double.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Cuda.Double.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Cuda.Double.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Cuda.Double.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Cuda.Double.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Cuda.Double.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Cuda.Double.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Cuda.Double.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Cuda.Double.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Cuda.Double.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Cuda.Double.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Cuda.Double.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Cuda.Double.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Cuda.Double.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Cuda.Double.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Cuda.Double.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Cuda.Double.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Cuda.Double.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Cuda.Double.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Cuda.Double.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Cuda.Double.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Cuda.Double.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Cuda.Double.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Cuda.Double.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Cuda.Double.Types, Torch.Indef.Index as Torch.Cuda.Double.Index, Torch.Indef.Mask as Torch.Cuda.Double.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Double.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Blas as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Blas, Torch.Indef.Dynamic.Tensor.Math.Lapack as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Lapack, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Floating as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Pointwise.Floating, Torch.Indef.Dynamic.Tensor.Math.Reduce.Floating as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Reduce.Floating, Torch.Indef.Dynamic.Tensor.Math.Floating as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Floating, Torch.Indef.Static.Tensor.Math.Blas as Torch.Indef.Cuda.Double.Tensor.Math.Blas, Torch.Indef.Static.Tensor.Math.Lapack as Torch.Indef.Cuda.Double.Tensor.Math.Lapack, Torch.Indef.Static.Tensor.Math.Pointwise.Floating as Torch.Indef.Cuda.Double.Tensor.Math.Pointwise.Floating, Torch.Indef.Static.Tensor.Math.Reduce.Floating as Torch.Indef.Cuda.Double.Tensor.Math.Reduce.Floating, Torch.Indef.Static.Tensor.Math.Floating as Torch.Indef.Cuda.Double.Tensor.Math.Floating, Torch.Undefined.Tensor.Random.TH as Torch.Undefined.Cuda.Double.Tensor.Random.TH, Torch.Undefined.Tensor.Math.Random.TH as Torch.Undefined.Cuda.Double.Tensor.Math.Random.TH, Torch.Indef.Static.Tensor.Random.THC as Torch.Indef.Cuda.Double.Tensor.Random.THC, Torch.Indef.Dynamic.Tensor.Random.THC as Torch.Indef.Cuda.Double.Dynamic.Tensor.Random.THC, Torch.Indef.Storage as Torch.Indef.Cuda.Double.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Cuda.Double.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Cuda.Double.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Cuda.Double.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Cuda.Double.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Cuda.Double.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Cuda.Double.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Cuda.Double.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Cuda.Double.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Cuda.Double.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Cuda.Double.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Cuda.Double.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Cuda.Double.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Cuda.Double.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Cuda.Double.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Cuda.Double.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Cuda.Double.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Cuda.Double.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Cuda.Double.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Cuda.Double.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Cuda.Double.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Cuda.Double.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Cuda.Double.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Cuda.Double.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Cuda.Double.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Cuda.Double.Types, Torch.Indef.Index as Torch.Cuda.Double.Index, Torch.Indef.Mask as Torch.Cuda.Double.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Double.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Double.Dynamic.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.NN as Torch.Cuda.Double.Dynamic.NN, Torch.Indef.Dynamic.NN.Activation as Torch.Cuda.Double.Dynamic.NN.Activation, Torch.Indef.Dynamic.NN.Pooling as Torch.Cuda.Double.Dynamic.NN.Pooling, Torch.Indef.Dynamic.NN.Criterion as Torch.Cuda.Double.Dynamic.NN.Criterion, Torch.Indef.Static.NN as Torch.Cuda.Double.NN, Torch.Indef.Static.NN as Torch.Cuda.Double.NN, Torch.Indef.Static.NN.Activation as Torch.Cuda.Double.NN.Activation, Torch.Indef.Static.NN.Backprop as Torch.Cuda.Double.NN.Backprop, Torch.Indef.Static.NN.Conv1d as Torch.Cuda.Double.NN.Conv1d, Torch.Indef.Static.NN.Conv2d as Torch.Cuda.Double.NN.Conv2d, Torch.Indef.Static.NN.Criterion as Torch.Cuda.Double.NN.Criterion, Torch.Indef.Static.NN.Layers as Torch.Cuda.Double.NN.Layers, Torch.Indef.Static.NN.Linear as Torch.Cuda.Double.NN.Linear, Torch.Indef.Static.NN.Math as Torch.Cuda.Double.NN.Math, Torch.Indef.Static.NN.Padding as Torch.Cuda.Double.NN.Padding, Torch.Indef.Static.NN.Pooling as Torch.Cuda.Double.NN.Pooling, Torch.Indef.Static.NN.Sampling as Torch.Cuda.Double.NN.Sampling) requires (Torch.Sig.Index.Tensor as Torch.FFI.THC.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.THC.Long.Tensor, Torch.Sig.Mask.Tensor as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.MathReduce as Torch.FFI.THC.Byte.TensorMathReduce, Torch.Sig.State as Torch.FFI.THC.State, Torch.Sig.Types.Global as Torch.Types.THC, Torch.Sig.Types as Torch.Types.THC.Double, Torch.Sig.Storage as Torch.FFI.THC.Double.Storage, Torch.Sig.Storage.Copy as Torch.FFI.THC.Double.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.THC.Double.Storage, Torch.Sig.Tensor as Torch.FFI.THC.Double.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.THC.Double.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.THC.Double.Tensor, Torch.Sig.Tensor.Index as Torch.FFI.THC.Double.TensorIndex, Torch.Sig.Tensor.Masked as Torch.FFI.THC.Double.TensorMasked, Torch.Sig.Tensor.Math as Torch.FFI.THC.Double.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.THC.Double.TensorMathCompare, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.THC.Double.TensorMathCompareT, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.THC.Double.TensorMathPairwise, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.THC.Double.TensorMathPointwise, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.THC.Double.TensorMathReduce, Torch.Sig.Tensor.Math.Scan as Torch.FFI.THC.Double.TensorMathScan, Torch.Sig.Tensor.Mode as Torch.FFI.THC.Double.TensorMode, Torch.Sig.Tensor.ScatterGather as Torch.FFI.THC.Double.TensorScatterGather, Torch.Sig.Tensor.Sort as Torch.FFI.THC.Double.TensorSort, Torch.Sig.Tensor.TopK as Torch.FFI.THC.Double.TensorTopK, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.THC.Double.TensorMathPointwise, Torch.Sig.Tensor.Math.Pointwise.Floating as Torch.FFI.THC.Double.TensorMathPointwise, Torch.Sig.Tensor.Math.Reduce.Floating as Torch.FFI.THC.Double.TensorMathReduce, Torch.Sig.Tensor.Math.Floating as Torch.FFI.THC.Double.TensorMath, Torch.Sig.Tensor.Math.Blas as Torch.FFI.THC.Double.TensorMathBlas, Torch.Sig.Tensor.Math.Lapack as Torch.FFI.THC.Double.TensorMathMagma, Torch.Sig.NN as Torch.FFI.THC.NN.Double, Torch.Sig.Types.NN as Torch.Types.THC, Torch.Sig.Tensor.Math.Random.TH as Torch.Undefined.Cuda.Double.Tensor.Math.Random.TH, Torch.Sig.Tensor.Random.TH as Torch.Undefined.Cuda.Double.Tensor.Random.TH, Torch.Sig.Tensor.Random.THC as Torch.FFI.THC.Double.TensorRandom) + + if flag(lite) + else + exposed-modules: + Torch.Cuda.Byte + Torch.Cuda.Byte.Dynamic + Torch.Cuda.Byte.Storage + Torch.Cuda.Char + Torch.Cuda.Char.Dynamic + Torch.Cuda.Char.Storage + Torch.Cuda.Short + Torch.Cuda.Short.Dynamic + Torch.Cuda.Short.Storage + Torch.Cuda.Int + Torch.Cuda.Int.Dynamic + Torch.Cuda.Int.Storage + build-depends: + hasktorch-indef-unsigned -any + mixins: hasktorch-indef-unsigned (Torch.Indef.Storage as Torch.Indef.Cuda.Byte.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Cuda.Byte.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Cuda.Byte.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Cuda.Byte.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Cuda.Byte.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Cuda.Byte.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Cuda.Byte.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Cuda.Byte.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Cuda.Byte.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Cuda.Byte.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Cuda.Byte.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Cuda.Byte.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Cuda.Byte.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Cuda.Byte.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Cuda.Byte.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Cuda.Byte.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Cuda.Byte.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Cuda.Byte.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Cuda.Byte.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Cuda.Byte.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Cuda.Byte.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Cuda.Byte.Types, Torch.Indef.Index as Torch.Cuda.Byte.Index, Torch.Indef.Mask as Torch.Cuda.Byte.Mask) requires (Torch.Sig.Index.Tensor as Torch.FFI.THC.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.THC.Long.Tensor, Torch.Sig.Mask.Tensor as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.MathReduce as Torch.FFI.THC.Byte.TensorMathReduce, Torch.Sig.State as Torch.FFI.THC.State, Torch.Sig.Types.Global as Torch.Types.THC, Torch.Sig.Types as Torch.Types.THC.Byte, Torch.Sig.Storage as Torch.FFI.THC.Byte.Storage, Torch.Sig.Storage.Copy as Torch.FFI.THC.Byte.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.THC.Byte.Storage, Torch.Sig.Tensor as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.THC.Byte.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Tensor.Index as Torch.FFI.THC.Byte.TensorIndex, Torch.Sig.Tensor.Masked as Torch.FFI.THC.Byte.TensorMasked, Torch.Sig.Tensor.Math as Torch.FFI.THC.Byte.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.THC.Byte.TensorMathCompare, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.THC.Byte.TensorMathCompareT, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.THC.Byte.TensorMathPairwise, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.THC.Byte.TensorMathPointwise, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.THC.Byte.TensorMathReduce, Torch.Sig.Tensor.Math.Scan as Torch.FFI.THC.Byte.TensorMathScan, Torch.Sig.Tensor.Mode as Torch.FFI.THC.Byte.TensorMode, Torch.Sig.Tensor.ScatterGather as Torch.FFI.THC.Byte.TensorScatterGather, Torch.Sig.Tensor.Sort as Torch.FFI.THC.Byte.TensorSort, Torch.Sig.Tensor.TopK as Torch.FFI.THC.Byte.TensorTopK), + hasktorch-indef-unsigned (Torch.Indef.Storage as Torch.Indef.Cuda.Char.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Cuda.Char.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Cuda.Char.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Cuda.Char.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Cuda.Char.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Cuda.Char.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Cuda.Char.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Cuda.Char.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Cuda.Char.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Cuda.Char.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Cuda.Char.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Cuda.Char.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Cuda.Char.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Cuda.Char.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Cuda.Char.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Cuda.Char.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Cuda.Char.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Cuda.Char.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Cuda.Char.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Cuda.Char.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Cuda.Char.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Cuda.Char.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Cuda.Char.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Cuda.Char.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Cuda.Char.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Cuda.Char.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Cuda.Char.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Cuda.Char.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Cuda.Char.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Cuda.Char.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Cuda.Char.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Cuda.Char.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Cuda.Char.Types, Torch.Indef.Index as Torch.Cuda.Char.Index, Torch.Indef.Mask as Torch.Cuda.Char.Mask) requires (Torch.Sig.Index.Tensor as Torch.FFI.THC.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.THC.Long.Tensor, Torch.Sig.Mask.Tensor as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.MathReduce as Torch.FFI.THC.Byte.TensorMathReduce, Torch.Sig.State as Torch.FFI.THC.State, Torch.Sig.Types.Global as Torch.Types.THC, Torch.Sig.Types as Torch.Types.THC.Char, Torch.Sig.Storage as Torch.FFI.THC.Char.Storage, Torch.Sig.Storage.Copy as Torch.FFI.THC.Char.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.THC.Char.Storage, Torch.Sig.Tensor as Torch.FFI.THC.Char.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.THC.Char.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.THC.Char.Tensor, Torch.Sig.Tensor.Index as Torch.FFI.THC.Char.TensorIndex, Torch.Sig.Tensor.Masked as Torch.FFI.THC.Char.TensorMasked, Torch.Sig.Tensor.Math as Torch.FFI.THC.Char.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.THC.Char.TensorMathCompare, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.THC.Char.TensorMathCompareT, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.THC.Char.TensorMathPairwise, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.THC.Char.TensorMathPointwise, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.THC.Char.TensorMathReduce, Torch.Sig.Tensor.Math.Scan as Torch.FFI.THC.Char.TensorMathScan, Torch.Sig.Tensor.Mode as Torch.FFI.THC.Char.TensorMode, Torch.Sig.Tensor.ScatterGather as Torch.FFI.THC.Char.TensorScatterGather, Torch.Sig.Tensor.Sort as Torch.FFI.THC.Char.TensorSort, Torch.Sig.Tensor.TopK as Torch.FFI.THC.Char.TensorTopK), + hasktorch-indef-signed (Torch.Indef.Storage as Torch.Indef.Cuda.Short.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Cuda.Short.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Cuda.Short.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Cuda.Short.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Cuda.Short.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Cuda.Short.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Cuda.Short.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Cuda.Short.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Cuda.Short.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Cuda.Short.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Cuda.Short.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Cuda.Short.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Cuda.Short.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Cuda.Short.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Cuda.Short.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Cuda.Short.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Cuda.Short.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Cuda.Short.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Cuda.Short.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Cuda.Short.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Cuda.Short.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Cuda.Short.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Cuda.Short.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Cuda.Short.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Cuda.Short.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Cuda.Short.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Cuda.Short.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Cuda.Short.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Cuda.Short.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Cuda.Short.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Cuda.Short.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Cuda.Short.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Cuda.Short.Types, Torch.Indef.Index as Torch.Cuda.Short.Index, Torch.Indef.Mask as Torch.Cuda.Short.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Short.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Short.Dynamic.Tensor.Math.Pointwise.Signed) requires (Torch.Sig.Index.Tensor as Torch.FFI.THC.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.THC.Long.Tensor, Torch.Sig.Mask.Tensor as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.MathReduce as Torch.FFI.THC.Byte.TensorMathReduce, Torch.Sig.State as Torch.FFI.THC.State, Torch.Sig.Types.Global as Torch.Types.THC, Torch.Sig.Types as Torch.Types.THC.Short, Torch.Sig.Storage as Torch.FFI.THC.Short.Storage, Torch.Sig.Storage.Copy as Torch.FFI.THC.Short.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.THC.Short.Storage, Torch.Sig.Tensor as Torch.FFI.THC.Short.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.THC.Short.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.THC.Short.Tensor, Torch.Sig.Tensor.Index as Torch.FFI.THC.Short.TensorIndex, Torch.Sig.Tensor.Masked as Torch.FFI.THC.Short.TensorMasked, Torch.Sig.Tensor.Math as Torch.FFI.THC.Short.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.THC.Short.TensorMathCompare, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.THC.Short.TensorMathCompareT, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.THC.Short.TensorMathPairwise, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.THC.Short.TensorMathPointwise, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.THC.Short.TensorMathReduce, Torch.Sig.Tensor.Math.Scan as Torch.FFI.THC.Short.TensorMathScan, Torch.Sig.Tensor.Mode as Torch.FFI.THC.Short.TensorMode, Torch.Sig.Tensor.ScatterGather as Torch.FFI.THC.Short.TensorScatterGather, Torch.Sig.Tensor.Sort as Torch.FFI.THC.Short.TensorSort, Torch.Sig.Tensor.TopK as Torch.FFI.THC.Short.TensorTopK, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.THC.Short.TensorMathPointwise), + hasktorch-indef-signed (Torch.Indef.Storage as Torch.Indef.Cuda.Int.Storage, Torch.Indef.Storage.Copy as Torch.Indef.Cuda.Int.Storage.Copy, Torch.Indef.Static.Tensor as Torch.Indef.Cuda.Int.Tensor, Torch.Indef.Static.Tensor.Copy as Torch.Indef.Cuda.Int.Tensor.Copy, Torch.Indef.Static.Tensor.Index as Torch.Indef.Cuda.Int.Tensor.Index, Torch.Indef.Static.Tensor.Masked as Torch.Indef.Cuda.Int.Tensor.Masked, Torch.Indef.Static.Tensor.Math as Torch.Indef.Cuda.Int.Tensor.Math, Torch.Indef.Static.Tensor.Math.Compare as Torch.Indef.Cuda.Int.Tensor.Math.Compare, Torch.Indef.Static.Tensor.Math.CompareT as Torch.Indef.Cuda.Int.Tensor.Math.CompareT, Torch.Indef.Static.Tensor.Math.Pairwise as Torch.Indef.Cuda.Int.Tensor.Math.Pairwise, Torch.Indef.Static.Tensor.Math.Pointwise as Torch.Indef.Cuda.Int.Tensor.Math.Pointwise, Torch.Indef.Static.Tensor.Math.Reduce as Torch.Indef.Cuda.Int.Tensor.Math.Reduce, Torch.Indef.Static.Tensor.Math.Scan as Torch.Indef.Cuda.Int.Tensor.Math.Scan, Torch.Indef.Static.Tensor.Mode as Torch.Indef.Cuda.Int.Tensor.Mode, Torch.Indef.Static.Tensor.ScatterGather as Torch.Indef.Cuda.Int.Tensor.ScatterGather, Torch.Indef.Static.Tensor.Sort as Torch.Indef.Cuda.Int.Tensor.Sort, Torch.Indef.Static.Tensor.TopK as Torch.Indef.Cuda.Int.Tensor.TopK, Torch.Indef.Dynamic.Tensor as Torch.Indef.Cuda.Int.Dynamic.Tensor, Torch.Indef.Dynamic.Tensor.Copy as Torch.Indef.Cuda.Int.Dynamic.Tensor.Copy, Torch.Indef.Dynamic.Tensor.Index as Torch.Indef.Cuda.Int.Dynamic.Tensor.Index, Torch.Indef.Dynamic.Tensor.Masked as Torch.Indef.Cuda.Int.Dynamic.Tensor.Masked, Torch.Indef.Dynamic.Tensor.Math as Torch.Indef.Cuda.Int.Dynamic.Tensor.Math, Torch.Indef.Dynamic.Tensor.Math.Compare as Torch.Indef.Cuda.Int.Dynamic.Tensor.Math.Compare, Torch.Indef.Dynamic.Tensor.Math.CompareT as Torch.Indef.Cuda.Int.Dynamic.Tensor.Math.CompareT, Torch.Indef.Dynamic.Tensor.Math.Pairwise as Torch.Indef.Cuda.Int.Dynamic.Tensor.Math.Pairwise, Torch.Indef.Dynamic.Tensor.Math.Pointwise as Torch.Indef.Cuda.Int.Dynamic.Tensor.Math.Pointwise, Torch.Indef.Dynamic.Tensor.Math.Reduce as Torch.Indef.Cuda.Int.Dynamic.Tensor.Math.Reduce, Torch.Indef.Dynamic.Tensor.Math.Scan as Torch.Indef.Cuda.Int.Dynamic.Tensor.Math.Scan, Torch.Indef.Dynamic.Tensor.Mode as Torch.Indef.Cuda.Int.Dynamic.Tensor.Mode, Torch.Indef.Dynamic.Tensor.ScatterGather as Torch.Indef.Cuda.Int.Dynamic.Tensor.ScatterGather, Torch.Indef.Dynamic.Tensor.Sort as Torch.Indef.Cuda.Int.Dynamic.Tensor.Sort, Torch.Indef.Dynamic.Tensor.TopK as Torch.Indef.Cuda.Int.Dynamic.Tensor.TopK, Torch.Indef.Types as Torch.Cuda.Int.Types, Torch.Indef.Index as Torch.Cuda.Int.Index, Torch.Indef.Mask as Torch.Cuda.Int.Mask, Torch.Indef.Static.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Int.Tensor.Math.Pointwise.Signed, Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed as Torch.Indef.Cuda.Int.Dynamic.Tensor.Math.Pointwise.Signed) requires (Torch.Sig.Index.Tensor as Torch.FFI.THC.Long.Tensor, Torch.Sig.Index.TensorFree as Torch.FFI.THC.Long.Tensor, Torch.Sig.Mask.Tensor as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.TensorFree as Torch.FFI.THC.Byte.Tensor, Torch.Sig.Mask.MathReduce as Torch.FFI.THC.Byte.TensorMathReduce, Torch.Sig.State as Torch.FFI.THC.State, Torch.Sig.Types.Global as Torch.Types.THC, Torch.Sig.Types as Torch.Types.THC.Int, Torch.Sig.Storage as Torch.FFI.THC.Int.Storage, Torch.Sig.Storage.Copy as Torch.FFI.THC.Int.StorageCopy, Torch.Sig.Storage.Memory as Torch.FFI.THC.Int.Storage, Torch.Sig.Tensor as Torch.FFI.THC.Int.Tensor, Torch.Sig.Tensor.Copy as Torch.FFI.THC.Int.TensorCopy, Torch.Sig.Tensor.Memory as Torch.FFI.THC.Int.Tensor, Torch.Sig.Tensor.Index as Torch.FFI.THC.Int.TensorIndex, Torch.Sig.Tensor.Masked as Torch.FFI.THC.Int.TensorMasked, Torch.Sig.Tensor.Math as Torch.FFI.THC.Int.TensorMath, Torch.Sig.Tensor.Math.Compare as Torch.FFI.THC.Int.TensorMathCompare, Torch.Sig.Tensor.Math.CompareT as Torch.FFI.THC.Int.TensorMathCompareT, Torch.Sig.Tensor.Math.Pairwise as Torch.FFI.THC.Int.TensorMathPairwise, Torch.Sig.Tensor.Math.Pointwise as Torch.FFI.THC.Int.TensorMathPointwise, Torch.Sig.Tensor.Math.Reduce as Torch.FFI.THC.Int.TensorMathReduce, Torch.Sig.Tensor.Math.Scan as Torch.FFI.THC.Int.TensorMathScan, Torch.Sig.Tensor.Mode as Torch.FFI.THC.Int.TensorMode, Torch.Sig.Tensor.ScatterGather as Torch.FFI.THC.Int.TensorScatterGather, Torch.Sig.Tensor.Sort as Torch.FFI.THC.Int.TensorSort, Torch.Sig.Tensor.TopK as Torch.FFI.THC.Int.TensorTopK, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.FFI.THC.Int.TensorMathPointwise) + +library hasktorch-indef-unsigned + reexported-modules: Torch.Indef.Index, + Torch.Indef.Mask, + Torch.Indef.Types, + Torch.Indef.Storage, + Torch.Indef.Storage.Copy, + Torch.Indef.Dynamic.Print, + Torch.Indef.Dynamic.Tensor, + Torch.Indef.Dynamic.Tensor.Copy, + Torch.Indef.Dynamic.Tensor.Index, + Torch.Indef.Dynamic.Tensor.Masked, + Torch.Indef.Dynamic.Tensor.Math, + Torch.Indef.Dynamic.Tensor.Math.Compare, + Torch.Indef.Dynamic.Tensor.Math.CompareT, + Torch.Indef.Dynamic.Tensor.Math.Pairwise, + Torch.Indef.Dynamic.Tensor.Math.Pointwise, + Torch.Indef.Dynamic.Tensor.Math.Reduce, + Torch.Indef.Dynamic.Tensor.Math.Scan, + Torch.Indef.Dynamic.Tensor.Mode, + Torch.Indef.Dynamic.Tensor.ScatterGather, + Torch.Indef.Dynamic.Tensor.Sort, + Torch.Indef.Dynamic.Tensor.TopK, + Torch.Indef.Static.Tensor, + Torch.Indef.Static.Tensor.Copy, + Torch.Indef.Static.Tensor.Index, + Torch.Indef.Static.Tensor.Masked, + Torch.Indef.Static.Tensor.Math, + Torch.Indef.Static.Tensor.Math.Compare, + Torch.Indef.Static.Tensor.Math.CompareT, + Torch.Indef.Static.Tensor.Math.Pairwise, + Torch.Indef.Static.Tensor.Math.Pointwise, + Torch.Indef.Static.Tensor.Math.Reduce, + Torch.Indef.Static.Tensor.Math.Scan, + Torch.Indef.Static.Tensor.Mode, + Torch.Indef.Static.Tensor.ScatterGather, + Torch.Indef.Static.Tensor.Sort, + Torch.Indef.Static.Tensor.TopK + default-language: Haskell2010 + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch-signatures-partial (==0.0.1 || >0.0.1) && <0.0.2, + hasktorch-indef -any + mixins: hasktorch-indef requires (Torch.Sig.NN as Torch.Undefined.NN, Torch.Sig.Types.NN as Torch.Undefined.Types.NN, Torch.Sig.Tensor.Math.Blas as Torch.Undefined.Tensor.Math.Blas, Torch.Sig.Tensor.Math.Floating as Torch.Undefined.Tensor.Math.Floating, Torch.Sig.Tensor.Math.Lapack as Torch.Undefined.Tensor.Math.Lapack, Torch.Sig.Tensor.Math.Pointwise.Signed as Torch.Undefined.Tensor.Math.Pointwise.Signed, Torch.Sig.Tensor.Math.Pointwise.Floating as Torch.Undefined.Tensor.Math.Pointwise.Floating, Torch.Sig.Tensor.Math.Reduce.Floating as Torch.Undefined.Tensor.Math.Reduce.Floating, Torch.Sig.Tensor.Math.Random.TH as Torch.Undefined.Tensor.Math.Random.TH, Torch.Sig.Tensor.Random.TH as Torch.Undefined.Tensor.Random.TH, Torch.Sig.Tensor.Random.THC as Torch.Undefined.Tensor.Random.THC) + +library hasktorch-indef-signed + reexported-modules: Torch.Indef.Index, + Torch.Indef.Mask, + Torch.Indef.Types, + Torch.Indef.Storage, + Torch.Indef.Storage.Copy, + Torch.Indef.Dynamic.Print, + Torch.Indef.Dynamic.Tensor, + Torch.Indef.Dynamic.Tensor.Copy, + Torch.Indef.Dynamic.Tensor.Index, + Torch.Indef.Dynamic.Tensor.Masked, + Torch.Indef.Dynamic.Tensor.Math, + Torch.Indef.Dynamic.Tensor.Math.Compare, + Torch.Indef.Dynamic.Tensor.Math.CompareT, + Torch.Indef.Dynamic.Tensor.Math.Pairwise, + Torch.Indef.Dynamic.Tensor.Math.Pointwise, + Torch.Indef.Dynamic.Tensor.Math.Reduce, + Torch.Indef.Dynamic.Tensor.Math.Scan, + Torch.Indef.Dynamic.Tensor.Mode, + Torch.Indef.Dynamic.Tensor.ScatterGather, + Torch.Indef.Dynamic.Tensor.Sort, + Torch.Indef.Dynamic.Tensor.TopK, + Torch.Indef.Static.Tensor, + Torch.Indef.Static.Tensor.Copy, + Torch.Indef.Static.Tensor.Index, + Torch.Indef.Static.Tensor.Masked, + Torch.Indef.Static.Tensor.Math, + Torch.Indef.Static.Tensor.Math.Compare, + Torch.Indef.Static.Tensor.Math.CompareT, + Torch.Indef.Static.Tensor.Math.Pairwise, + Torch.Indef.Static.Tensor.Math.Pointwise, + Torch.Indef.Static.Tensor.Math.Reduce, + Torch.Indef.Static.Tensor.Math.Scan, + Torch.Indef.Static.Tensor.Mode, + Torch.Indef.Static.Tensor.ScatterGather, + Torch.Indef.Static.Tensor.Sort, + Torch.Indef.Static.Tensor.TopK, + Torch.Indef.Static.Tensor.Math.Pointwise.Signed, + Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed + default-language: Haskell2010 + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch-signatures-partial (==0.0.1 || >0.0.1) && <0.0.2, + hasktorch-indef -any + mixins: hasktorch-indef requires (Torch.Sig.NN as Torch.Undefined.NN, Torch.Sig.Types.NN as Torch.Undefined.Types.NN, Torch.Sig.Tensor.Math.Blas as Torch.Undefined.Tensor.Math.Blas, Torch.Sig.Tensor.Math.Floating as Torch.Undefined.Tensor.Math.Floating, Torch.Sig.Tensor.Math.Lapack as Torch.Undefined.Tensor.Math.Lapack, Torch.Sig.Tensor.Math.Pointwise.Floating as Torch.Undefined.Tensor.Math.Pointwise.Floating, Torch.Sig.Tensor.Math.Reduce.Floating as Torch.Undefined.Tensor.Math.Reduce.Floating, Torch.Sig.Tensor.Math.Random.TH as Torch.Undefined.Tensor.Math.Random.TH, Torch.Sig.Tensor.Random.TH as Torch.Undefined.Tensor.Random.TH, Torch.Sig.Tensor.Random.THC as Torch.Undefined.Tensor.Random.THC) + +library hasktorch-indef-floating + reexported-modules: Torch.Indef.Index, + Torch.Indef.Mask, + Torch.Indef.Types, + Torch.Indef.Storage, + Torch.Indef.Storage.Copy, + Torch.Indef.Dynamic.Print, + Torch.Indef.Dynamic.Tensor, + Torch.Indef.Dynamic.Tensor.Copy, + Torch.Indef.Dynamic.Tensor.Index, + Torch.Indef.Dynamic.Tensor.Masked, + Torch.Indef.Dynamic.Tensor.Math, + Torch.Indef.Dynamic.Tensor.Math.Compare, + Torch.Indef.Dynamic.Tensor.Math.CompareT, + Torch.Indef.Dynamic.Tensor.Math.Pairwise, + Torch.Indef.Dynamic.Tensor.Math.Pointwise, + Torch.Indef.Dynamic.Tensor.Math.Reduce, + Torch.Indef.Dynamic.Tensor.Math.Scan, + Torch.Indef.Dynamic.Tensor.Mode, + Torch.Indef.Dynamic.Tensor.ScatterGather, + Torch.Indef.Dynamic.Tensor.Sort, + Torch.Indef.Dynamic.Tensor.TopK, + Torch.Indef.Static.Tensor, + Torch.Indef.Static.Tensor.Copy, + Torch.Indef.Static.Tensor.Index, + Torch.Indef.Static.Tensor.Masked, + Torch.Indef.Static.Tensor.Math, + Torch.Indef.Static.Tensor.Math.Compare, + Torch.Indef.Static.Tensor.Math.CompareT, + Torch.Indef.Static.Tensor.Math.Pairwise, + Torch.Indef.Static.Tensor.Math.Pointwise, + Torch.Indef.Static.Tensor.Math.Reduce, + Torch.Indef.Static.Tensor.Math.Scan, + Torch.Indef.Static.Tensor.Mode, + Torch.Indef.Static.Tensor.ScatterGather, + Torch.Indef.Static.Tensor.Sort, + Torch.Indef.Static.Tensor.TopK, + Torch.Indef.Static.Tensor.Math.Pointwise.Signed, + Torch.Indef.Dynamic.Tensor.Math.Pointwise.Signed, + Torch.Indef.Dynamic.Tensor.Math.Blas, + Torch.Indef.Dynamic.Tensor.Math.Floating, + Torch.Indef.Dynamic.Tensor.Math.Lapack, + Torch.Indef.Dynamic.Tensor.Math.Pointwise.Floating, + Torch.Indef.Dynamic.Tensor.Math.Reduce.Floating, + Torch.Indef.Dynamic.Tensor.Random.TH, + Torch.Indef.Dynamic.Tensor.Random.THC, + Torch.Indef.Dynamic.Tensor.Math.Random.TH, + Torch.Indef.Static.Tensor.Math.Blas, + Torch.Indef.Static.Tensor.Math.Floating, + Torch.Indef.Static.Tensor.Math.Lapack, + Torch.Indef.Static.Tensor.Math.Pointwise.Floating, + Torch.Indef.Static.Tensor.Math.Reduce.Floating, + Torch.Indef.Static.Tensor.Random.TH, + Torch.Indef.Static.Tensor.Random.THC, + Torch.Indef.Static.Tensor.Math.Random.TH, + Torch.Indef.Dynamic.NN, + Torch.Indef.Dynamic.NN.Activation, + Torch.Indef.Dynamic.NN.Pooling, + Torch.Indef.Dynamic.NN.Criterion, + Torch.Indef.Static.NN, + Torch.Indef.Static.NN.Activation, + Torch.Indef.Static.NN.Backprop, + Torch.Indef.Static.NN.Conv1d, + Torch.Indef.Static.NN.Conv2d, + Torch.Indef.Static.NN.Criterion, + Torch.Indef.Static.NN.Layers, + Torch.Indef.Static.NN.Linear, + Torch.Indef.Static.NN.Math, + Torch.Indef.Static.NN.Padding, + Torch.Indef.Static.NN.Pooling, + Torch.Indef.Static.NN.Sampling, + Torch.Undefined.Tensor.Math.Random.TH, + Torch.Undefined.Tensor.Random.TH, + Torch.Undefined.Tensor.Random.THC + default-language: Haskell2010 + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch-indef -any, + hasktorch-signatures-partial (==0.0.1 || >0.0.1) && <0.0.2 + +executable isdefinite-cpu + main-is: Noop.hs + hs-source-dirs: exe + default-language: Haskell2010 + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch-cpu -any + +executable isdefinite-gpu + main-is: Noop.hs + hs-source-dirs: exe + default-language: Haskell2010 + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch-gpu -any + +executable isdefinite + main-is: Noop.hs + hs-source-dirs: exe + default-language: Haskell2010 + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch -any + +executable memcheck + main-is: Memcheck.hs + hs-source-dirs: exe + default-language: Haskell2010 + build-depends: + base (==4.7 || >4.7) && <5, + hasktorch -any + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: tests + other-modules: + Orphans + MemorySpec + RawLapackSVDSpec + GarbageCollectionSpec + Torch.Prelude.Extras + Torch.Core.LogAddSpec + Torch.Core.RandomSpec + Torch.Static.NN.AbsSpec + Torch.Static.NN.LinearSpec + default-language: Haskell2010 + default-extensions: LambdaCase DataKinds TypeFamilies + TypeSynonymInstances ScopedTypeVariables FlexibleContexts CPP + build-depends: + QuickCheck ==2.11 || >2.11, + backprop ==0.2.5 || >0.2.5, + base (==4.7 || >4.7) && <5, + dimensions ==1.0 || >1.0, + ghc-typelits-natnormalise -any, + hasktorch -any, + hspec ==2.4.4 || >2.4.4, + singletons ==2.2 || >2.2, + -- text ==1.2.2 || >1.2.2, + mtl ==2.2.2 || >2.2.2, + microlens-platform ==0.3.10 || >0.3.10, + monad-loops ==0.4.3 || >0.4.3, + time ==1.8.0 || >1.8.0, + transformers ==0.5.5 || >0.5.5, + generic-lens -any + diff --git a/Cabal-tests/tests/ParserTests/comments/hasktorch.expr b/Cabal-tests/tests/ParserTests/comments/hasktorch.expr new file mode 100644 index 00000000000..247f593f9c1 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/comments/hasktorch.expr @@ -0,0 +1,98 @@ +Map.fromList + [ + _×_ + (Position 2 1) + "-- ================================================================ --", + _×_ + (Position 3 1) + "-- ======== This cabal file has been modified from dhall ========== --", + _×_ + (Position 4 1) + "-- ======== This constitutes the 0.0.1.0 release. ========== --", + _×_ + (Position 5 1) + "-- ======== Dhall can generate this file, but will never ========== --", + _×_ + (Position 6 1) + "-- ======== be able to upload to hackage. For more, see: ========== --", + _×_ + (Position 7 1) + "-- ==== https://github.com/haskell/hackage-server/issues/795 ====== --", + _×_ + (Position 8 1) + "-- ================================================================ --", + _×_ + (Position 70 1) + " -- containers ==0.5.10 || >0.5.10,", + _×_ + (Position 71 1) + " -- deepseq ==1.3.0 || >1.3.0,", + _×_ + (Position 73 1) + " -- managed (==1.0.0 || >1.0.0) && <1.1,", + _×_ + (Position 74 1) + " -- microlens ==0.4.8 || >0.4.8,", + _×_ + (Position 75 1) + " -- numeric-limits ==0.1.0 || >0.1.0,", + _×_ + (Position 79 1) + " -- typelits-witnesses ==0.2.3 || >0.2.3,", + _×_ + (Position 84 1) + " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", + _×_ + (Position 85 1) + " -- BEGIN EDITS", + _×_ + (Position 86 1) + " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", + _×_ + (Position 148 1) + " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", + _×_ + (Position 149 1) + " -- END EDITS", + _×_ + (Position 150 1) + " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", + _×_ + (Position 203 1) + " -- containers ==0.5.10 || >0.5.10,", + _×_ + (Position 204 1) + " -- deepseq ==1.3.0 || >1.3.0,", + _×_ + (Position 208 1) + " -- managed (==1.0.0 || >1.0.0) && <1.1,", + _×_ + (Position 209 1) + " -- microlens ==0.4.8 || >0.4.8,", + _×_ + (Position 210 1) + " -- numeric-limits ==0.1.0 || >0.1.0,", + _×_ + (Position 214 1) + " -- typelits-witnesses ==0.2.3 || >0.2.3,", + _×_ + (Position 282 1) + " -- containers ==0.5.10 || >0.5.10,", + _×_ + (Position 283 1) + " -- deepseq ==1.3.0 || >1.3.0,", + _×_ + (Position 287 1) + " -- managed (==1.0.0 || >1.0.0) && <1.1,", + _×_ + (Position 288 1) + " -- microlens ==0.4.8 || >0.4.8,", + _×_ + (Position 289 1) + " -- numeric-limits ==0.1.0 || >0.1.0,", + _×_ + (Position 293 1) + " -- typelits-witnesses ==0.2.3 || >0.2.3,", + _×_ + (Position 551 1) + " -- text ==1.2.2 || >1.2.2,"] From b378d969943fa08de80a13f8f680ef0864bcab5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 11:50:30 +0800 Subject: [PATCH 79/83] tests: update expected --- .../comments/layout-comment-in-fieldline.expr | 51 ++++++--- .../layout-complex-indented-comments.expr | 107 ++++++++++-------- .../ParserTests/regressions/Octree-0.5.expr | 7 +- .../ParserTests/regressions/anynone.expr | 3 +- .../ParserTests/regressions/big-version.expr | 7 +- .../regressions/common-conditional.expr | 8 +- .../tests/ParserTests/regressions/common.expr | 7 +- .../ParserTests/regressions/common2.expr | 11 +- .../ParserTests/regressions/common3.expr | 10 +- .../tests/ParserTests/regressions/elif.expr | 3 +- .../tests/ParserTests/regressions/elif2.expr | 3 +- .../ParserTests/regressions/encoding-0.8.expr | 16 +-- .../ParserTests/regressions/generics-sop.expr | 7 +- .../ParserTests/regressions/hasktorch.expr | 101 +---------------- .../regressions/hidden-main-lib.expr | 3 +- .../ParserTests/regressions/indentation.expr | 3 +- .../ParserTests/regressions/indentation2.expr | 3 +- .../ParserTests/regressions/indentation3.expr | 3 +- .../ParserTests/regressions/issue-5055.expr | 10 +- .../ParserTests/regressions/issue-5846.expr | 3 +- .../ParserTests/regressions/issue-6083-a.expr | 7 +- .../ParserTests/regressions/issue-6083-b.expr | 7 +- .../ParserTests/regressions/issue-6083-c.expr | 7 +- .../regressions/issue-6083-pkg-pkg.expr | 7 +- .../ParserTests/regressions/issue-774.expr | 13 +-- .../regressions/jaeger-flamegraph.expr | 7 +- .../regressions/leading-comma-2.expr | 7 +- .../regressions/leading-comma.expr | 3 +- .../tests/ParserTests/regressions/libpq1.expr | 29 +---- .../tests/ParserTests/regressions/libpq2.expr | 29 +---- .../ParserTests/regressions/mixin-1.expr | 3 +- .../ParserTests/regressions/mixin-2.expr | 13 +-- .../ParserTests/regressions/mixin-3.expr | 13 +-- .../ParserTests/regressions/monad-param.expr | 3 +- .../regressions/multiple-libs-2.expr | 3 +- .../ParserTests/regressions/noVersion.expr | 3 +- .../regressions/nothing-unicode.expr | 3 +- .../tests/ParserTests/regressions/shake.expr | 16 +-- .../tests/ParserTests/regressions/spdx-1.expr | 3 +- .../tests/ParserTests/regressions/spdx-2.expr | 3 +- .../tests/ParserTests/regressions/spdx-3.expr | 3 +- .../regressions/th-lift-instances.expr | 3 +- .../ParserTests/regressions/version-sets.expr | 3 +- .../regressions/wl-pprint-indef.expr | 3 +- 44 files changed, 138 insertions(+), 419 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr b/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr index 806984ceaed..30d078ec9dd 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-comment-in-fieldline.expr @@ -1,58 +1,77 @@ [ Section (Name - (_×_ [] (Position 1 1)) + WithComments { + justComments = [], + unComments = Position 1 1} "executable") [] [ Field (Name - (_×_ [] (Position 2 5)) + WithComments { + justComments = [], + unComments = Position 2 5} "main-is") [ FieldLine - (_×_ [] (Position 2 26)) + WithComments { + justComments = [], + unComments = Position 2 26} "Main.hs"], Field (Name - (_×_ [] (Position 3 5)) + WithComments { + justComments = [], + unComments = Position 3 5} "hs-source-dirs") [ FieldLine - (_×_ [] (Position 4 9)) + WithComments { + justComments = [], + unComments = Position 4 9} "src"], Field (Name - (_×_ [] (Position 5 5)) + WithComments { + justComments = [], + unComments = Position 5 5} "ghc-options") [ FieldLine - (_×_ [] (Position 5 18)) + WithComments { + justComments = [], + unComments = Position 5 18} "-Wall"], Field (Name - (_×_ [] (Position 6 5)) + WithComments { + justComments = [], + unComments = Position 6 5} "build-depends") [ FieldLine - (_×_ + WithComments { + justComments = [ Comment " -- , foo" (Position 7 1), Comment " -- ^ This should be consumed after fieldContent" - (Position 8 1)] - (Position 6 22)) + (Position 8 1)], + unComments = Position 6 22} "base", FieldLine - (_×_ - [ + WithComments { + justComments = [ Comment " -- , comemnt" - (Position 10 1)] - (Position 9 22)) + (Position 10 1)], + unComments = Position 9 22} ", bar", FieldLine - (_×_ [] (Position 11 22)) + WithComments { + justComments = [], + unComments = Position 11 22} ", baz"]]] diff --git a/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr index b270185a73d..9a8538a518a 100644 --- a/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr +++ b/Cabal-tests/tests/ParserTests/comments/layout-complex-indented-comments.expr @@ -1,7 +1,8 @@ [ Section (Name - (_×_ + WithComments { + justComments = [ Comment "-- This is the configuration file for the 'cabal' command line tool." @@ -9,22 +10,26 @@ Comment "--" (Position 2 1), Comment "-- The available configuration options are listed below." - (Position 3 1)] - (Position 6 1)) + (Position 3 1)], + unComments = Position 6 1} "repository") [ SecArgName - (_×_ [] (Position 6 12)) + WithComments { + justComments = [], + unComments = Position 6 12} "hackage.haskell.org"] [ Field (Name - (_×_ [] (Position 7 3)) + WithComments { + justComments = [], + unComments = Position 7 3} "url") [ FieldLine - (_×_ - [ + WithComments { + justComments = [ Comment " -- secure: True" (Position 8 1), @@ -36,125 +41,135 @@ (Position 11 1), Comment "-- http-transport:" - (Position 12 1)] - (Position 7 8)) + (Position 12 1)], + unComments = Position 7 8} "http://hackage.haskell.org/"]], Field (Name - (_×_ [] (Position 13 1)) + WithComments { + justComments = [], + unComments = Position 13 1} "remote-repo-cache") [ FieldLine - (_×_ - [ + WithComments { + justComments = [ Comment "-- logs-dir: /home/foo/.cache/cabal/logs" (Position 14 1), Comment "-- default-user-config:" - (Position 15 1)] - (Position 13 20)) + (Position 15 1)], + unComments = Position 13 20} "/home/foo/.cache/cabal/packages"], Field (Name - (_×_ [] (Position 16 1)) + WithComments { + justComments = [], + unComments = Position 16 1} "build-summary") [ FieldLine - (_×_ - [ + WithComments { + justComments = [ Comment "-- build-log:" - (Position 17 1)] - (Position 16 16)) + (Position 17 1)], + unComments = Position 16 16} "/home/foo/.cache/cabal/logs/build.log"], Field (Name - (_×_ [] (Position 18 1)) + WithComments { + justComments = [], + unComments = Position 18 1} "remote-build-reporting") [ FieldLine - (_×_ - [ + WithComments { + justComments = [ Comment "-- report-planning-failure: False" (Position 19 1), Comment "-- per-component: True" - (Position 20 1)] - (Position 18 25)) + (Position 20 1)], + unComments = Position 18 25} "none"], Field (Name - (_×_ [] (Position 21 1)) + WithComments { + justComments = [], + unComments = Position 21 1} "jobs") [ FieldLine - (_×_ - [ + WithComments { + justComments = [ Comment "-- keep-going: False" (Position 22 1), Comment "-- offline: False" - (Position 23 1)] - (Position 21 7)) + (Position 23 1)], + unComments = Position 21 7} "$ncpus"], Field (Name - (_×_ [] (Position 24 1)) + WithComments { + justComments = [], + unComments = Position 24 1} "installdir") [ FieldLine - (_×_ - [ + WithComments { + justComments = [ Comment "-- token:" (Position 25 1), Comment "-- username:" - (Position 26 1)] - (Position 24 13)) + (Position 26 1)], + unComments = Position 24 13} "/home/foo/.local/bin"], Section (Name - (_×_ - [ + WithComments { + justComments = [ Comment " -- keep-temp-files: False" (Position 29 1), Comment " -- hoogle: False" - (Position 30 1)] - (Position 28 1)) + (Position 30 1)], + unComments = Position 28 1} "haddock") [] [], Section (Name - (_×_ - [ + WithComments { + justComments = [ Comment " -- interactive: False" (Position 33 1), Comment " -- quiet: False" - (Position 34 1)] - (Position 32 1)) + (Position 34 1)], + unComments = Position 32 1} "init") [] [], Section (Name - (_×_ - [ + WithComments { + justComments = [ Comment " -- alex-location:" (Position 37 1), Comment " -- ar-location:" - (Position 38 1)] - (Position 36 1)) + (Position 38 1)], + unComments = Position 36 1} "program-locations") [] []] diff --git a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr index d0d83ef636d..3ddf33fb1df 100644 --- a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr +++ b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr @@ -401,9 +401,4 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 40 1) - " -- We have a symlink: README.lhs -> README.md"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/anynone.expr b/Cabal-tests/tests/ParserTests/regressions/anynone.expr index 08dfe7c2068..e2504a9be74 100644 --- a/Cabal-tests/tests/ParserTests/regressions/anynone.expr +++ b/Cabal-tests/tests/ParserTests/regressions/anynone.expr @@ -118,5 +118,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/big-version.expr b/Cabal-tests/tests/ParserTests/regressions/big-version.expr index 13a4ed20b8e..4764da0d35e 100644 --- a/Cabal-tests/tests/ParserTests/regressions/big-version.expr +++ b/Cabal-tests/tests/ParserTests/regressions/big-version.expr @@ -111,9 +111,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 3 1) - "-- 9 digits"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr index eb1beac92c5..6e1c25f7c66 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr @@ -713,10 +713,4 @@ GenericPackageDescription { condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condBranchIfFalse = Nothing}]}], - condBenchmarks = [], - exactComments = - Map.fromList - [ - _×_ - (Position 37 1) - " -- buildable fields verify that we don't have duplicate field warnings"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/common.expr b/Cabal-tests/tests/ParserTests/regressions/common.expr index 2d0d28e3b75..67e4584eb12 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common.expr @@ -209,9 +209,4 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 7 1) - "-- note: empty field"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/common2.expr b/Cabal-tests/tests/ParserTests/regressions/common2.expr index 619105e1778..3305120e552 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common2.expr @@ -750,13 +750,4 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = Nothing}]}], - condBenchmarks = [], - exactComments = - Map.fromList - [ - _×_ - (Position 31 1) - "-- .expr should show libVisible: False", - _×_ - (Position 44 1) - " -- buildable fields verify that we don't have duplicate field warnings"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/common3.expr b/Cabal-tests/tests/ParserTests/regressions/common3.expr index 5d7b52aabc7..e8fb48890f2 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common3.expr @@ -233,12 +233,4 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 7 1) - "-- note: empty field", - _×_ - (Position 23 1) - " -- not first: will be omitted and generate warning"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/elif.expr b/Cabal-tests/tests/ParserTests/regressions/elif.expr index 9b73557514a..66ce6c0177d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/elif.expr +++ b/Cabal-tests/tests/ParserTests/regressions/elif.expr @@ -199,5 +199,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/elif2.expr b/Cabal-tests/tests/ParserTests/regressions/elif2.expr index 1adda5b8df8..8e3adc55f10 100644 --- a/Cabal-tests/tests/ParserTests/regressions/elif2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/elif2.expr @@ -412,5 +412,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr index 96b0566376e..ac6faddb538 100644 --- a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr +++ b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr @@ -145,18 +145,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 5 1) - "-- double-dash files", - _×_ - (Position 7 1) - " -- this is comment", - _×_ - (Position 17 1) - " -- version range round trip is better", - _×_ - (Position 23 1) - " -- options with spaces"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr index d3077802425..83123587f31 100644 --- a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr +++ b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr @@ -852,9 +852,4 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 58 1) - " -- exposed via Generics.SOP:"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr index ef7c0b4ace2..80c5927a1a1 100644 --- a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr +++ b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr @@ -10245,103 +10245,4 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}], - condBenchmarks = [], - exactComments = - Map.fromList - [ - _×_ - (Position 2 1) - "-- ================================================================ --", - _×_ - (Position 3 1) - "-- ======== This cabal file has been modified from dhall ========== --", - _×_ - (Position 4 1) - "-- ======== This constitutes the 0.0.1.0 release. ========== --", - _×_ - (Position 5 1) - "-- ======== Dhall can generate this file, but will never ========== --", - _×_ - (Position 6 1) - "-- ======== be able to upload to hackage. For more, see: ========== --", - _×_ - (Position 7 1) - "-- ==== https://github.com/haskell/hackage-server/issues/795 ====== --", - _×_ - (Position 8 1) - "-- ================================================================ --", - _×_ - (Position 70 1) - " -- containers ==0.5.10 || >0.5.10,", - _×_ - (Position 71 1) - " -- deepseq ==1.3.0 || >1.3.0,", - _×_ - (Position 73 1) - " -- managed (==1.0.0 || >1.0.0) && <1.1,", - _×_ - (Position 74 1) - " -- microlens ==0.4.8 || >0.4.8,", - _×_ - (Position 75 1) - " -- numeric-limits ==0.1.0 || >0.1.0,", - _×_ - (Position 79 1) - " -- typelits-witnesses ==0.2.3 || >0.2.3,", - _×_ - (Position 84 1) - " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", - _×_ - (Position 85 1) - " -- BEGIN EDITS", - _×_ - (Position 86 1) - " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", - _×_ - (Position 148 1) - " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", - _×_ - (Position 149 1) - " -- END EDITS", - _×_ - (Position 150 1) - " -- <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> --", - _×_ - (Position 203 1) - " -- containers ==0.5.10 || >0.5.10,", - _×_ - (Position 204 1) - " -- deepseq ==1.3.0 || >1.3.0,", - _×_ - (Position 208 1) - " -- managed (==1.0.0 || >1.0.0) && <1.1,", - _×_ - (Position 209 1) - " -- microlens ==0.4.8 || >0.4.8,", - _×_ - (Position 210 1) - " -- numeric-limits ==0.1.0 || >0.1.0,", - _×_ - (Position 214 1) - " -- typelits-witnesses ==0.2.3 || >0.2.3,", - _×_ - (Position 282 1) - " -- containers ==0.5.10 || >0.5.10,", - _×_ - (Position 283 1) - " -- deepseq ==1.3.0 || >1.3.0,", - _×_ - (Position 287 1) - " -- managed (==1.0.0 || >1.0.0) && <1.1,", - _×_ - (Position 288 1) - " -- microlens ==0.4.8 || >0.4.8,", - _×_ - (Position 289 1) - " -- numeric-limits ==0.1.0 || >0.1.0,", - _×_ - (Position 293 1) - " -- typelits-witnesses ==0.2.3 || >0.2.3,", - _×_ - (Position 551 1) - " -- text ==1.2.2 || >1.2.2,"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr index b2ee9153325..47647f9b9cf 100644 --- a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr +++ b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr @@ -120,5 +120,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation.expr b/Cabal-tests/tests/ParserTests/regressions/indentation.expr index 451c2095290..9164dace33a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation.expr @@ -121,5 +121,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr index dc752d3adb0..3f7612ef50f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr @@ -114,5 +114,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr index 87336f54222..87d3376c648 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr @@ -116,5 +116,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr index bc77dbc2767..5fcae0b709b 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr @@ -286,12 +286,4 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = Nothing}]}], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 16 1) - " -- TODO: fix so `type` can be on the top level", - _×_ - (Position 25 1) - " -- type: exitcode-stdio-1.0"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr index 8e58a5e40fe..44d61d1d795 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr @@ -181,5 +181,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr index ba8980ea840..876c944b620 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr @@ -382,9 +382,4 @@ GenericPackageDescription { "sublib")]))], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 7 1) - " -- This should be parsed as the main lib"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr index 87747149e4a..14eb64397df 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr @@ -392,9 +392,4 @@ GenericPackageDescription { "sublib")]))], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 7 1) - " -- This should be parsed as the main lib"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr index 90fd4acb275..4d4450a78cb 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr @@ -206,9 +206,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 7 1) - " -- This should be parsed as the main lib"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr index 1d2235dd53a..c38bd51f941 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr @@ -125,9 +125,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 7 1) - " -- This should be parsed as the main lib"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr index 18257cbc664..31ea274249e 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr @@ -123,15 +123,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 12 1) - "-- we test that check warns about this", - _×_ - (Position 19 1) - " -- Test for round-trip of ghc-options here too", - _×_ - (Position 20 1) - " -- See https://github.com/haskell/cabal/issues/2661"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr index 28f4e2c285f..bf3803b9417 100644 --- a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr +++ b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr @@ -477,9 +477,4 @@ GenericPackageDescription { (mkVersion [0, 10])) mainLibSet], condTreeComponents = []}], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 32 1) - "-- https://www.haskell.org/cabal/users-guide/cabal-projectindex.html"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr index 38db86582b9..e8d07f99d94 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr @@ -167,9 +167,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 10 1) - " -- empty field on purpose"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr index cb87026befb..15d01d4703d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr @@ -160,5 +160,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr index 89f1a0a8114..e3f93b194a4 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr @@ -766,31 +766,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = - Map.fromList - [ - _×_ - (Position 42 1) - "-- If true, use pkg-config, otherwise use the pg_config based build", - _×_ - (Position 43 1) - "-- configuration", - _×_ - (Position 69 1) - " -- Due to https://sourceware.org/bugzilla/show_bug.cgi?id=22948,", - _×_ - (Position 70 1) - " -- if we specify pq instead of libpq, then ld might link against", - _×_ - (Position 71 1) - " -- libpq.dll directly, which can lead to segfaults. As a temporary hack,", - _×_ - (Position 72 1) - " -- we force ld to link against the libpq.lib import library directly", - _×_ - (Position 73 1) - " -- by specifying libpq here.", - _×_ - (Position 80 1) - " -- Other-modules:"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr index bfce7bbf678..0e0403dd8c0 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr @@ -768,31 +768,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = - Map.fromList - [ - _×_ - (Position 42 1) - "-- If true, use pkg-config, otherwise use the pg_config based build", - _×_ - (Position 43 1) - "-- configuration", - _×_ - (Position 69 1) - " -- Due to https://sourceware.org/bugzilla/show_bug.cgi?id=22948,", - _×_ - (Position 70 1) - " -- if we specify pq instead of libpq, then ld might link against", - _×_ - (Position 71 1) - " -- libpq.dll directly, which can lead to segfaults. As a temporary hack,", - _×_ - (Position 72 1) - " -- we force ld to link against the libpq.lib import library directly", - _×_ - (Position 73 1) - " -- by specifying libpq here.", - _×_ - (Position 80 1) - " -- Other-modules:"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr index f27e11ee6d9..1b9640c92a5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr @@ -162,5 +162,4 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr index 0bbdc6c4593..decc098f78f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr @@ -162,15 +162,4 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 5 1) - "-- mixin field:", - _×_ - (Position 6 1) - "-- in 2.2 we got leading/trailing commas", - _×_ - (Position 7 1) - "-- in 3.0 we got lax space parsing"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr index b1537200ba2..e5278af9017 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr @@ -145,15 +145,4 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 5 1) - "-- mixin field:", - _×_ - (Position 6 1) - "-- in 2.2 we got leading/trailing commas", - _×_ - (Position 7 1) - "-- in 3.0 we got lax space parsing"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr index df6264144f3..8ab441164a5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr +++ b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr @@ -159,5 +159,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr index 1d694553cc0..d9b82eb2aec 100644 --- a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr @@ -200,5 +200,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr index 38d257b86e9..1384c3eef4a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr +++ b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr @@ -120,5 +120,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr index 52232668957..0bbfcbbbbac 100644 --- a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr +++ b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr @@ -198,5 +198,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/shake.expr b/Cabal-tests/tests/ParserTests/regressions/shake.expr index 17cb4e52735..46b3bfa2729 100644 --- a/Cabal-tests/tests/ParserTests/regressions/shake.expr +++ b/Cabal-tests/tests/ParserTests/regressions/shake.expr @@ -2501,18 +2501,4 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}, condBranchIfFalse = Nothing}]}], - condBenchmarks = [], - exactComments = Map.fromList - [ - _×_ - (Position 83 1) - " -- dot directory on own row", - _×_ - (Position 176 1) - " -- GHC bug 7646 means -threaded causes errors", - _×_ - (Position 274 1) - " -- space leak introduced by -O1 in 7.4, see #445", - _×_ - (Position 277 1) - " -- GHC bug 7646 (fixed in 7.8) means -threaded causes errors"]} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr index 735c5142bf0..d3a3797c1c9 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr @@ -110,5 +110,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr index 9e66a2553fc..a9c2370712b 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr @@ -114,5 +114,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr index 057c88025eb..83d37fc29d5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr @@ -114,5 +114,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr index 9c61f0a940b..5cd098d5a94 100644 --- a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr +++ b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr @@ -599,5 +599,4 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = Nothing}]}], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr index a2738e2e433..6242af7cb32 100644 --- a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr +++ b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr @@ -264,5 +264,4 @@ GenericPackageDescription { condForeignLibs = [], condExecutables = [], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr index d928d51ae60..3c9821a1185 100644 --- a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr +++ b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr @@ -243,5 +243,4 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}], condTestSuites = [], - condBenchmarks = [], - exactComments = Map.fromList []} + condBenchmarks = []} From f60fcc94394c3bafcb84d066edd7debeca579445 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 12:02:24 +0800 Subject: [PATCH 80/83] tests: fix integration tests --- Cabal-tests/tests/HackageTests.hs | 3 +-- Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs | 2 +- .../src/Distribution/Solver/Modular/IndexConversion.hs | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/Cabal-tests/tests/HackageTests.hs b/Cabal-tests/tests/HackageTests.hs index 97f4160d0a9..0290c9cf382 100644 --- a/Cabal-tests/tests/HackageTests.hs +++ b/Cabal-tests/tests/HackageTests.hs @@ -20,7 +20,6 @@ import Data.Foldable (traverse_) import Data.List (isPrefixOf, isSuffixOf) import Data.Maybe (mapMaybe) import Data.Monoid (Sum (..)) -import Distribution.PackageDescription (GenericPackageDescription(exactComments)) import Distribution.PackageDescription.Check (PackageCheck (..), checkPackage) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.PackageDescription.Quirks (patchQuirks) @@ -289,7 +288,7 @@ roundtripTest testFieldsTransform fpath bs = do exitFailure -- we disable comparison on exactComments for now because we can't print it yet - assertEqual' bs' x y = unless (x { exactComments = mempty } == y || fpath == "ixset/1.0.4/ixset.cabal") $ do + assertEqual' bs' x y = unless (x == y || fpath == "ixset/1.0.4/ixset.cabal") $ do putStrLn fpath #ifdef MIN_VERSION_tree_diff putStrLn "====== tree-diff:" diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index bfcb706ac63..129f8d0d85c 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -29,7 +29,7 @@ md5Check proxy md5Int = structureHash proxy @?= md5FromInteger md5Int md5CheckGenericPackageDescription :: Proxy GenericPackageDescription -> Assertion md5CheckGenericPackageDescription proxy = md5Check proxy - 0x72eddc4ff39a369afefa1347aae6184e + 0xc039c6741dead5203ad2b33bd3bf4dc8 md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion md5CheckLocalBuildInfo proxy = md5Check proxy diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs index 4dab32883e2..72d0b8193e3 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs @@ -176,7 +176,7 @@ convGPD :: OS -> Arch -> CompilerInfo -> [LabeledPackageConstraint] -> StrongFlags -> SolveExecutables -> PN -> GenericPackageDescription -> PInfo convGPD os arch cinfo constraints strfl solveExes pn - (GenericPackageDescription pkg scannedVersion flags mlib sub_libs flibs exes tests benchs _comments) = + (GenericPackageDescription pkg scannedVersion flags mlib sub_libs flibs exes tests benchs) = let fds = flagInfo strfl flags From d918f6b190b59edebea4cfaa37cf2c27c99f349c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 12:24:31 +0800 Subject: [PATCH 81/83] tests: fix nothunks test --- .../Distribution/PackageDescription/Parsec.hs | 39 ++++++++++++------- 1 file changed, 25 insertions(+), 14 deletions(-) diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index ef5a3646fdb..4f9c40048fa 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -75,12 +75,26 @@ import qualified Text.Parsec as P ------------------------------------------------------------------------------ +-- Deep Evaluation +-- ~~~~~~~~~~~~~~~ +-- +-- See nothunks test, without this deepseq we get (at least): +-- Thunk in ThunkInfo {thunkContext = ["GenericPackageDescription"]} +-- +-- TODO: re-benchmark, whether `deepseq` is important (both cabal-benchmarks and solver-benchmarks) +-- TODO: remove the need for deepseq if `deepseq` in fact matters +-- NOTE: IIRC it does affect (maximal) memory usage, which causes less GC pressure + -- | Parses the given file into a 'GenericPackageDescription'. -- -- In Cabal 1.2 the syntax for package descriptions was changed to a format -- with sections and possibly indented property descriptions. parseGenericPackageDescription :: BS.ByteString -> ParseResult src GenericPackageDescription -parseGenericPackageDescription = fmap unannotatedGpd . parseAnnotatedGenericPackageDescription +parseGenericPackageDescription bs = do + gpd <- parseAnnotatedGenericPackageDescription bs + let gpd' = unannotatedGpd gpd + -- See "Deep Evaluation" note + gpd' `deepseq` return gpd' parseAnnotatedGenericPackageDescription :: BS.ByteString -> ParseResult src AnnotatedGenericPackageDescription parseAnnotatedGenericPackageDescription bs = do @@ -123,7 +137,11 @@ parseAnnotatedGenericPackageDescription bs = do -- | 'Maybe' variant of 'parseGenericPackageDescription' parseGenericPackageDescriptionMaybe :: BS.ByteString -> Maybe GenericPackageDescription -parseGenericPackageDescriptionMaybe = fmap unannotatedGpd . parseAnnotatedGenericPackageDescriptionMaybe +parseGenericPackageDescriptionMaybe bs = do + gpd <- parseAnnotatedGenericPackageDescriptionMaybe bs + let gpd' = unannotatedGpd gpd + -- See "Deep Evaluation" note + gpd' `deepseq` return gpd' parseAnnotatedGenericPackageDescriptionMaybe :: BS.ByteString -> Maybe AnnotatedGenericPackageDescription parseAnnotatedGenericPackageDescriptionMaybe = @@ -219,18 +237,11 @@ parseAnnotatedGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = let gpd2 = postProcessInternalDeps specVer gpd1 checkForUndefinedFlags gpd2 checkForUndefinedCustomSetup gpd2 - -- See nothunks test, without this deepseq we get (at least): - -- Thunk in ThunkInfo {thunkContext = ["PackageIdentifier","PackageDescription","GenericPackageDescription"]} - -- - -- TODO: re-benchmark, whether `deepseq` is important (both cabal-benchmarks and solver-benchmarks) - -- TODO: remove the need for deepseq if `deepseq` in fact matters - -- NOTE: IIRC it does affect (maximal) memory usage, which causes less GC pressure - gpd2 `deepseq` - return - AnnotatedGenericPackageDescription - { exactComments = commentsMap - , unannotatedGpd = gpd2 - } + return + AnnotatedGenericPackageDescription + { exactComments = commentsMap + , unannotatedGpd = gpd2 + } where safeLast :: [a] -> Maybe a safeLast = listToMaybe . reverse From 20a17b97d338adaea0789fb2b60481a66aa01c70 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 12:26:12 +0800 Subject: [PATCH 82/83] run fourmolu --- Cabal-syntax/src/Distribution/Types/Lens.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-syntax/src/Distribution/Types/Lens.hs b/Cabal-syntax/src/Distribution/Types/Lens.hs index 89a319a7c48..8bcd0ca355d 100644 --- a/Cabal-syntax/src/Distribution/Types/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/Lens.hs @@ -13,11 +13,11 @@ module Distribution.Types.Lens , module Distribution.Types.TestSuite.Lens ) where +import Distribution.Types.AnnotatedGenericPackageDescription.Lens import Distribution.Types.Benchmark.Lens import Distribution.Types.BuildInfo.Lens import Distribution.Types.Executable.Lens import Distribution.Types.ForeignLib.Lens -import Distribution.Types.AnnotatedGenericPackageDescription.Lens import Distribution.Types.GenericPackageDescription.Lens import Distribution.Types.Library.Lens import Distribution.Types.PackageDescription.Lens From 2a109321f1763857d542721fc7ddb3a633fbc021 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 11 Nov 2025 14:14:03 +0800 Subject: [PATCH 83/83] fix doctests --- Cabal-syntax/src/Distribution/Fields/Parser.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs index 7905ccc8bd6..39e5a71614d 100644 --- a/Cabal-syntax/src/Distribution/Fields/Parser.hs +++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs @@ -435,7 +435,7 @@ fieldInlineOrBraces name = -- Therefore bytestrings inside returned 'Field' will be invalid as UTF8 if the input were. -- -- >>> readFields "foo: \223" --- Right [Field (Name ([],Position 1 1) "foo") [FieldLine ([],Position 1 6) "\223"]] +-- Right [Field (Name (WithComments {justComments = [], unComments = Position 1 1}) "foo") [FieldLine (WithComments {justComments = [], unComments = Position 1 6}) "\223"]] -- -- 'readFields' won't (necessarily) fail on invalid UTF8 data, but the reported positions may be off. -- @@ -449,12 +449,12 @@ fieldInlineOrBraces name = -- If there are just latin1 non-breaking spaces, they become part of the name: -- -- >>> readFields "\xa0\&foo: bar" --- Right [Field (Name ([],Position 1 1) "\160foo") [FieldLine ([],Position 1 7) "bar"]] +-- Right [Field (Name (WithComments {justComments = [], unComments = Position 1 1}) "\160foo") [FieldLine (WithComments {justComments = [], unComments = Position 1 7}) "bar"]] -- -- The UTF8 non-breaking space is accepted as an indentation character (but warned about by 'readFields''). -- -- >>> readFields' "\xc2\xa0 foo: bar" --- Right ([Field (Name ([],Position 1 3) "foo") [FieldLine ([],Position 1 8) "bar"]],[LexWarning LexWarningNBSP (Position 1 1)]) +-- Right ([Field (Name (WithComments {justComments = [], unComments = Position 1 3}) "foo") [FieldLine (WithComments {justComments = [], unComments = Position 1 8}) "bar"]],[LexWarning LexWarningNBSP (Position 1 1)]) readFields :: B8.ByteString -> Either ParseError [Field (WithComments Position)] readFields s = fmap fst (readFields' s)