exactprint prototype, barbie approach

Cabal-described/src/Distribution/Described.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Distribution.Described (
@@ -56,6 +58,7 @@ import Test.Tasty.QuickCheck (testProperty)
 import Data.Semigroup                (Semigroup (..))
 import Distribution.Parsec           (Parsec, eitherParsec)
 import Distribution.Pretty           (Pretty, prettyShow)
+import qualified Distribution.Types.Modify as Mod
 
 import qualified Distribution.Utils.CharSet as CS
 import qualified RERE                       as RE
@@ -546,7 +549,7 @@ instance Described UnqualComponentName where
 -- Instances: Newtypes
 -------------------------------------------------------------------------------
 
-class Sep sep => DescribeSep sep where
+class Sep Mod.HasNoAnn sep => DescribeSep sep where
     describeSep :: Proxy sep -> GrammarRegex a -> GrammarRegex a
 
 instance DescribeSep CommaVCat   where describeSep _ = reCommaList

Cabal-syntax/Cabal-syntax.cabal

@@ -104,12 +104,14 @@ library
     Distribution.PackageDescription.Quirks
     Distribution.PackageDescription.Utils
     Distribution.Parsec
+    Distribution.Trivia
     Distribution.Parsec.Error
     Distribution.Parsec.FieldLineStream
     Distribution.Parsec.Position
     Distribution.Parsec.Warning
     Distribution.Parsec.Source
     Distribution.Pretty
+    Distribution.Pretty.ExactDoc
     Distribution.SPDX
     Distribution.SPDX.License
     Distribution.SPDX.LicenseExceptionId
@@ -126,6 +128,7 @@ library
     Distribution.Types.BenchmarkInterface
     Distribution.Types.BenchmarkType
     Distribution.Types.BuildInfo
+    Distribution.Types.Modify
     Distribution.Types.BuildInfo.Lens
     Distribution.Types.BuildType
     Distribution.Types.Component

Cabal-syntax/src/Distribution/Compat/CharParsing.hs

@@ -24,6 +24,7 @@ module Distribution.Compat.CharParsing
     oneOf -- :: CharParsing m => [Char] -> m Char
   , noneOf -- :: CharParsing m => [Char] -> m Char
   , spaces -- :: CharParsing m => m ()
+  , spaces' -- :: CharParsing m => m ()
   , space -- :: CharParsing m => m Char
   , newline -- :: CharParsing m => m Char
   , tab -- :: CharParsing m => m Char
@@ -90,6 +91,9 @@ spaces :: CharParsing m => m ()
 spaces = skipMany space <?> "white space"
 {-# INLINE spaces #-}
 
+spaces' :: CharParsing m => m String
+spaces' = many space <?> "white space"
+
 -- | Parses a white space character (any character which satisfies 'isSpace')
 -- Returns the parsed character.
 space :: CharParsing m => m Char

Cabal-syntax/src/Distribution/Compat/Parsing.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 -----------------------------------------------------------------------------
@@ -27,9 +29,13 @@ module Distribution.Compat.Parsing
   , some -- from Control.Applicative, parsec many1
   , many -- from Control.Applicative
   , sepBy
+  , sepByAnn
   , sepByNonEmpty
+  , sepByNonEmptyAnn
   , sepEndByNonEmpty
+  , sepEndByNonEmptyAnn
   , sepEndBy
+  , sepEndByAnn
   , endByNonEmpty
   , endBy
   , count
@@ -44,6 +50,7 @@ module Distribution.Compat.Parsing
   ) where
 
 import Distribution.Compat.Prelude
+import Distribution.Trivia
 import Prelude ()
 
 import Control.Applicative (optional, (<**>))
@@ -101,18 +108,42 @@ sepBy :: Alternative m => m a -> m sep -> m [a]
 sepBy p sep = toList <$> sepByNonEmpty p sep <|> pure []
 {-# INLINE sepBy #-}
 
+sepByAnn :: Alternative m => m (Ann SurroundingText a) -> m String -> m [Ann SurroundingText a]
+sepByAnn p sep = toList <$> sepByNonEmptyAnn p sep <|> pure []
+{-# INLINE sepByAnn #-}
+
 -- | @sepByNonEmpty p sep@ parses /one/ or more occurrences of @p@, separated
 -- by @sep@. Returns a non-empty list of values returned by @p@.
 sepByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a)
 sepByNonEmpty p sep = (:|) <$> p <*> many (sep *> p)
 {-# INLINE sepByNonEmpty #-}
 
+sepByNonEmptyAnn :: forall m a. Alternative m => m (Ann SurroundingText a) -> m String -> m (NonEmpty (Ann SurroundingText a))
+sepByNonEmptyAnn p sep =
+  (:|)
+    <$> p
+    <*> many
+      ( do
+          leading <- sep
+          x <- p
+          pure (mapAnn (preTrivia leading <>) x)
+      )
+
 -- | @sepEndByNonEmpty p sep@ parses /one/ or more occurrences of @p@,
 -- separated and optionally ended by @sep@. Returns a non-empty list of values
 -- returned by @p@.
 sepEndByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a)
 sepEndByNonEmpty p sep = (:|) <$> p <*> ((sep *> sepEndBy p sep) <|> pure [])
 
+sepEndByNonEmptyAnn :: Alternative m => m (Ann SurroundingText a) -> m String -> m (NonEmpty (Ann SurroundingText a))
+sepEndByNonEmptyAnn p sep = do
+  x <- p
+  (trailing, xs) <-
+    ( (,) <$> sep <*> sepEndByAnn p sep
+      )
+      <|> pure (mempty, [])
+  pure (mapAnn (<> postTrivia trailing) x :| xs)
+
 -- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,
 -- separated and optionally ended by @sep@, ie. haskell style
 -- statements. Returns a list of values returned by @p@.
@@ -122,6 +153,10 @@ sepEndBy :: Alternative m => m a -> m sep -> m [a]
 sepEndBy p sep = toList <$> sepEndByNonEmpty p sep <|> pure []
 {-# INLINE sepEndBy #-}
 
+-- | @sepEndByAnn@ is like @sepEndBy@, but it keeps the trivia.
+sepEndByAnn :: Alternative m => m (Ann SurroundingText a) -> m String -> m [Ann SurroundingText a]
+sepEndByAnn p sep = toList <$> sepEndByNonEmptyAnn p sep <|> pure []
+
 -- | @endByNonEmpty p sep@ parses /one/ or more occurrences of @p@, separated
 -- and ended by @sep@. Returns a non-empty list of values returned by @p@.
 endByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a)

Cabal-syntax/src/Distribution/ExactParsec.hs

@@ -0,0 +1,7 @@
+module Distribution.ExactParsec
+  ( ExactParsec (..)
+  )
+where
+
+import Distribution.Parsec
+import Distribution.Trivia

Cabal-syntax/src/Distribution/FieldGrammar.hs

@@ -1,24 +1,30 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 -- | This module provides a way to specify a grammar of @.cabal@ -like files.
 module Distribution.FieldGrammar
   ( -- * Field grammar type
-    FieldGrammar (..)
+    FieldGrammar
+  , FieldGrammarWith (..)
   , uniqueField
+  , uniqueField'
   , optionalField
   , optionalFieldDef
   , monoidalField
 
     -- * Concrete grammar implementations
   , ParsecFieldGrammar
   , ParsecFieldGrammar'
+  , ParsecFieldGrammarWith'
   , parseFieldGrammar
   , parseFieldGrammarCheckingStanzas
   , fieldGrammarKnownFieldList
   , PrettyFieldGrammar
   , PrettyFieldGrammar'
+  , PrettyFieldGrammarWith'
   , prettyFieldGrammar
 
     -- * Auxiliary
@@ -47,8 +53,13 @@ import Distribution.FieldGrammar.Pretty
 import Distribution.Fields.Field
 import Distribution.Utils.Generic (spanMaybe)
 
-type ParsecFieldGrammar' a = ParsecFieldGrammar a a
-type PrettyFieldGrammar' a = PrettyFieldGrammar a a
+import qualified Distribution.Types.Modify as Mod
+
+type ParsecFieldGrammarWith' (mod :: Mod.HasAnnotation) a = ParsecFieldGrammar mod a a
+type PrettyFieldGrammarWith' (mod :: Mod.HasAnnotation) a = PrettyFieldGrammar mod a a
+
+type ParsecFieldGrammar' a = ParsecFieldGrammar Mod.HasNoAnn a a
+type PrettyFieldGrammar' a = PrettyFieldGrammar Mod.HasNoAnn a a
 
 infixl 5 ^^^