Commit e4298a3c authored by Oleg Grenrus's avatar Oleg Grenrus

Implement #5971. Free text fields preserve indentation

Starting with `cabal-version: 3.0` free text fields
preserve indentation and blank lines.
In other words, we don't need single dots to indicate blank line.

IPI is not versioned. So we default to latest variant always.
This is little harm, as old GHC use old Cabal to print
IPIs. And free text fields are only informative.

Fixes #5938
parent 15f48f4a
......@@ -84,6 +84,7 @@ import Distribution.Fields.Field
import Distribution.Fields.ParseResult
import Distribution.Parsec
import Distribution.Parsec.FieldLineStream
import Distribution.Parsec.Position (positionRow, positionCol)
-------------------------------------------------------------------------------
-- Auxiliary types
......@@ -214,10 +215,10 @@ instance FieldGrammar ParsecFieldGrammar where
warnMultipleSingularFields fn xs
last <$> traverse (parseOne v) xs
-- TODO: check if this `pos` is the position of field name.
parseOne _v (MkNamelessField _pos fls)
| null fls = pure Nothing
| otherwise = pure (Just (fieldlinesToFreeText fls))
parseOne v (MkNamelessField pos fls)
| null fls = pure Nothing
| v >= CabalSpecV3_0 = pure (Just (fieldlinesToFreeText3 pos fls))
| otherwise = pure (Just (fieldlinesToFreeText fls))
freeTextFieldDef fn _ = ParsecFG (Set.singleton fn) Set.empty parser where
parser v fields = case Map.lookup fn fields of
......@@ -228,10 +229,10 @@ instance FieldGrammar ParsecFieldGrammar where
warnMultipleSingularFields fn xs
last <$> traverse (parseOne v) xs
-- TODO: check if this `pos` is the position of field name.
parseOne _v (MkNamelessField _pos fls)
| null fls = pure ""
| otherwise = pure (fieldlinesToFreeText fls)
parseOne v (MkNamelessField pos fls)
| null fls = pure ""
| v >= CabalSpecV3_0 = pure (fieldlinesToFreeText3 pos fls)
| otherwise = pure (fieldlinesToFreeText fls)
monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser
where
......@@ -362,6 +363,42 @@ fieldlinesToFreeText fls = intercalate "\n" (map go fls)
trim :: String -> String
trim = dropWhile isSpace . dropWhileEnd isSpace
fieldlinesToFreeText3 :: Position -> [FieldLine Position] -> String
fieldlinesToFreeText3 _ [] = ""
fieldlinesToFreeText3 _ [FieldLine _ bs] = fromUTF8BS bs
fieldlinesToFreeText3 pos (FieldLine pos1 bs1 : fls2@(FieldLine pos2 _ : _))
-- if first line is on the same line with field name:
-- don't count indentation of the first line
| positionRow pos == positionRow pos1 = concat
$ fromUTF8BS bs1
: mealy (mk mcol1) pos1 fls2
-- otherwise, also indent the first line
| otherwise = concat
$ replicate (positionCol pos1 - mcol2) ' '
: fromUTF8BS bs1
: mealy (mk mcol2) pos1 fls2
where
mcol1 = foldl' (\a b -> min a $ positionCol $ fieldLineAnn b) (positionCol pos2) fls2
mcol2 = foldl' (\a b -> min a $ positionCol $ fieldLineAnn b) (positionCol pos1) fls2
mk :: Int -> Position -> FieldLine Position -> (Position, String)
mk col p (FieldLine q bs) =
( q
, replicate newlines '\n'
++ replicate indent ' '
++ fromUTF8BS bs
)
where
newlines = positionRow q - positionRow p
indent = positionCol q - col
mealy :: (s -> a -> (s, b)) -> s -> [a] -> [b]
mealy f = go where
go _ [] = []
go s (x : xs) = let ~(s', y) = f s x in y : go s' xs
fieldLinesToStream :: [FieldLine ann] -> FieldLineStream
fieldLinesToStream [] = fieldLineStreamEnd
fieldLinesToStream [FieldLine _ bs] = FLSLast bs
......
......@@ -10,7 +10,7 @@ import Distribution.Compat.Newtype
import Distribution.Compat.Prelude
import Distribution.Fields.Field (FieldName)
import Distribution.Fields.Pretty (PrettyField (..))
import Distribution.Pretty (Pretty (..), showFreeText)
import Distribution.Pretty (Pretty (..), showFreeText, showFreeTextV3)
import Distribution.Simple.Utils (toUTF8BS)
import Prelude ()
import Text.PrettyPrint (Doc)
......@@ -62,11 +62,15 @@ instance FieldGrammar PrettyFieldGrammar where
x = aview l s
freeTextField fn l = PrettyFG pp where
pp _v s = maybe mempty (ppField fn . showFreeText) (aview l s)
pp v s = maybe mempty (ppField fn . showFT) (aview l s) where
showFT | v >= CabalSpecV3_0 = showFreeTextV3
| otherwise = showFreeText
-- it's ok to just show, as showFreeText of empty string is empty.
freeTextFieldDef fn l = PrettyFG pp where
pp _v s = ppField fn (showFreeText (aview l s))
pp v s = ppField fn (showFT (aview l s)) where
showFT | v >= CabalSpecV3_0 = showFreeTextV3
| otherwise = showFreeText
monoidalFieldAla fn _pack l = PrettyFG pp
where
......
......@@ -11,6 +11,8 @@ module Distribution.Fields.Field (
fieldAnn,
fieldUniverse,
FieldLine (..),
fieldLineAnn,
fieldLineBS,
SectionArg (..),
sectionArgAnn,
-- * Name
......@@ -60,6 +62,14 @@ fieldUniverse f@(Field _ _) = [f]
data FieldLine ann = FieldLine !ann !ByteString
deriving (Eq, Show, Functor, Foldable, Traversable)
-- | @since 3.0.0.0
fieldLineAnn :: FieldLine ann -> ann
fieldLineAnn (FieldLine ann _) = ann
-- | @since 3.0.0.0
fieldLineBS :: FieldLine ann -> ByteString
fieldLineBS (FieldLine _ bs) = bs
-- | Section arguments, e.g. name of the library
data SectionArg ann
= SecArgName !ann !ByteString
......
......@@ -7,6 +7,7 @@ module Distribution.Pretty (
showFilePath,
showToken,
showFreeText,
showFreeTextV3,
-- * Deprecated
Separator,
) where
......@@ -83,6 +84,14 @@ showFreeText :: String -> PP.Doc
showFreeText "" = mempty
showFreeText s = PP.vcat [ PP.text (if null l then "." else l) | l <- lines_ s ]
-- | Pretty-print free-format text.
-- Since @cabal-version: 3.0@ we don't replace blank lines with dots.
--
-- @since 3.0.0.0
showFreeTextV3 :: String -> PP.Doc
showFreeTextV3 "" = mempty
showFreeTextV3 s = PP.vcat [ PP.text l | l <- lines_ s ]
-- | 'lines_' breaks a string up into a list of strings at newline
-- characters. The resulting strings do not contain newlines.
lines_ :: String -> [String]
......
......@@ -723,7 +723,7 @@ of field/value pairs, with a syntax roughly like mail message headers.
- Tabs are *not* allowed as indentation characters due to a missing
standard interpretation of tab width.
- To get a blank line in a field value, use an indented "``.``"
- Before Cabal 3.0, to get a blank line in a field value, use an indented "``.``"
The syntax of the value depends on the field. Field types include:
......
......@@ -26,6 +26,9 @@ relative to the respective preceding *published* version.
variants of dynamic flavours. It is :pkg-field:`extra-library-flavours` but for
shared libraries. Mainly useful for GHC's RTS library.
* Free text fields (e.g. :pkg-field:`description`) preserve empty lines
and indentation. In other words, you don't need to add dots for blank lines.
* License fields use identifiers from SPDX License List version
``3.5 2019-04-02``
......
......@@ -15,16 +15,16 @@ InstalledPackageInfo
"Polymorphism\\\", by Mark P Jones,\n",
"in /Advanced School of Functional Programming/, 1995\n",
"(<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>).\n",
"\n",
".\n",
"This package contains:\n",
"\n",
".\n",
"* the monad transformer class (in \"Control.Monad.Trans.Class\")\n",
"and IO monad class (in \"Control.Monad.IO.Class\")\n",
"\n",
".\n",
"* concrete functor and monad transformers, each with associated\n",
"operations and functions to lift operations associated with other\n",
"transformers.\n",
"\n",
".\n",
"The package can be used on its own in portable Haskell code, in\n",
"which case operations need to be manually lifted through transformer\n",
"stacks (see \"Control.Monad.Trans.Class\" for some examples).\n",
......
......@@ -15,16 +15,16 @@ InstalledPackageInfo
"Polymorphism\\\", by Mark P Jones,\n",
"in /Advanced School of Functional Programming/, 1995\n",
"(<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>).\n",
"\n",
".\n",
"This package contains:\n",
"\n",
".\n",
"* the monad transformer class (in \"Control.Monad.Trans.Class\")\n",
"and IO monad class (in \"Control.Monad.IO.Class\")\n",
"\n",
".\n",
"* concrete functor and monad transformers, each with associated\n",
"operations and functions to lift operations associated with other\n",
"transformers.\n",
"\n",
".\n",
"The package can be used on its own in portable Haskell code, in\n",
"which case operations need to be manually lifted through transformer\n",
"stacks (see \"Control.Monad.Trans.Class\" for some examples).\n",
......
......@@ -71,11 +71,14 @@ GenericPackageDescription
dataFiles = [],
description = concat
["* foo\n",
"* foo-bar\n",
"* foo-baz\n",
"\n",
" * foo-bar\n",
"\n",
" * foo-baz\n",
"\n",
".\n",
".\n",
".\n",
"some dots"],
executables = [],
extraDocFiles = [],
......
......@@ -3,8 +3,11 @@ name: indentation
version: 0
description:
* foo
* foo-bar
* foo-baz
* foo-bar
* foo-baz
.
.
.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment