Retain comments in field parser

Cabal-syntax/Cabal-syntax.cabal

@@ -86,6 +86,7 @@ library
     Distribution.Fields
     Distribution.Fields.ConfVar
     Distribution.Fields.Field
+    Distribution.Fields.Field.Lens
     Distribution.Fields.Lexer
     Distribution.Fields.LexerMonad
     Distribution.Fields.ParseResult

Cabal-syntax/src/Distribution/Fields/Field.hs

@@ -15,6 +15,10 @@ module Distribution.Fields.Field
   , SectionArg (..)
   , sectionArgAnn
 
+    -- * Comment
+  , Comment (..)
+  , WithComments (..)
+
     -- * Name
   , FieldName
   , Name (..)
@@ -42,11 +46,24 @@ import qualified Data.Foldable1 as F1
 -- Cabal file
 -------------------------------------------------------------------------------
 
+-- | Store a line comment from field syntax files. @ann@ is usually instantiated as 'Position'.
+data Comment ann = Comment !ByteString !ann
+  deriving (Show, Generic, Eq, Ord, Functor)
+
+-- | Hold a list of comments along side some annotation.
+data WithComments ann = WithComments
+  { justComments :: ![Comment ann]
+  -- ^ Extract the comments.
+  , unComments :: !ann
+  -- ^ Extract the annotation.
+  }
+  deriving (Show, Generic, Eq, Ord, Functor)
+
 -- | 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]
-  deriving (Eq, Show, Functor, Foldable, Traversable)
+  deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
 
 -- | @since 3.12.0.0
 deriving instance Ord ann => Ord (Field ann)
@@ -71,7 +88,7 @@ fieldUniverse f@(Field _ _) = [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)
 
 -- | @since 3.12.0.0
 deriving instance Ord ann => Ord (FieldLine ann)
@@ -92,7 +109,7 @@ 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)
 
 -- | @since 3.12.0.0
 deriving instance Ord ann => Ord (SectionArg ann)
@@ -113,7 +130,7 @@ 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)
 
 -- | @since 3.12.0.0
 deriving instance Ord ann => Ord (Name ann)

Cabal-syntax/src/Distribution/Fields/Field/Lens.hs

@@ -0,0 +1,12 @@
+module Distribution.Fields.Field.Lens where
+
+import Distribution.Compat.Lens
+import qualified Distribution.Fields.Field as T
+
+justComments :: Lens' (T.WithComments ann) [T.Comment ann]
+justComments f s = fmap (\x -> s{T.justComments = x}) (f (T.justComments s))
+{-# INLINE justComments #-}
+
+unComments :: Lens' (T.WithComments ann) ann
+unComments f s = fmap (\x -> s{T.unComments = x}) (f (T.unComments s))
+{-# INLINE unComments #-}

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
@@ -84,8 +83,9 @@ tokens :-
 <bol_section, bol_field_layout, bol_field_braces> {
   @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
+  $spacetab* "--" $comment*  { toki TokComment }
+  -- TODO: check the lack of @nl works here
+  -- including counting line numbers
 }
 
 <bol_section> {
@@ -105,9 +105,8 @@ tokens :-
 }
 
 <in_section> {
-  $spacetab+   ; --TODO: don't allow tab as leading space
-
-  "--" $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))) }
@@ -161,6 +160,7 @@ data Token = TokSym   !ByteString       -- ^ Haskell-like identifier, number or
            | Colon
            | OpenBrace
            | CloseBrace
+           | TokComment !ByteString
            | EOF
            | LexicalError InputStream --TODO: add separate string lexical error
   deriving Show
@@ -230,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
+        traceShow t $ return tok
+#endif
         return t
 
 
@@ -241,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
+        real_txt :: B.ByteString
+        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 ()
+      traceShow (take 3 (V.toList text_lines)) $
+      return ()
   where
     getDbgText = Lex $ \s@LexState{ dbgText = txt } -> LexResult s txt
 #else