Format more text literals as multi-line strings (#1508)

sjakobi · mergify[bot] · commit e931451a2b28 · 2019-11-04T03:31:49.000Z
This causes text literals to be formatted as multi-line strings whenever they contain at least one newline and at least one non-newline character. "Spacers" like `"\n\n"` continue be formatted as single-line strings. If the heuristic turns out to be too eager to choose a multi-line layout, we can refine it later. This partially addresses #1496. Also * update some variable names * use 80-column "smart" layout consistently
diff --git a/dhall-json/json-to-dhall/Main.hs b/dhall-json/json-to-dhall/Main.hs
@@ -146,7 +146,7 @@ main = do
 
                 let document = Dhall.Pretty.prettyCharacterSet characterSet result
 
-                let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document
+                let stream = Dhall.Pretty.layout document
 
                 case output of
                     Nothing -> do
diff --git a/dhall-json/src/Dhall/JSON.hs b/dhall-json/src/Dhall/JSON.hs
@@ -234,7 +234,6 @@ import qualified Data.List
 import qualified Data.Map
 import qualified Data.Ord
 import qualified Data.Text
-import qualified Data.Text.Prettyprint.Doc             as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
 import qualified Data.Vector                           as Vector
 import qualified Dhall.Core                            as Core
@@ -393,8 +392,7 @@ _ERROR :: Data.Text.Text
 _ERROR = Dhall.Util._ERROR
 
 insert :: Pretty a => a -> Text
-insert =
-    Pretty.renderStrict . Pretty.layoutPretty Dhall.Pretty.layoutOpts . Dhall.Util.insert
+insert = Pretty.renderStrict . Dhall.Pretty.layout . Dhall.Util.insert
 
 instance Exception CompileError
 
diff --git a/dhall-json/yaml-to-dhall/Main.hs b/dhall-json/yaml-to-dhall/Main.hs
@@ -137,7 +137,7 @@ main = do
 
                 let document = Dhall.Pretty.prettyCharacterSet characterSet result
 
-                let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document
+                let stream = Dhall.Pretty.layout document
 
                 case output of
                     Nothing -> do
diff --git a/dhall-lsp-server/src/Dhall/LSP/Backend/Formatting.hs b/dhall-lsp-server/src/Dhall/LSP/Backend/Formatting.hs
@@ -2,7 +2,8 @@ module Dhall.LSP.Backend.Formatting (formatExpr, formatExprWithHeader) where
 
 import Dhall.Core (Expr)
 import Dhall.Parser (Header(..))
-import Dhall.Pretty (CharacterSet(..), layoutOpts, prettyCharacterSet)
+import Dhall.Pretty (CharacterSet(..), prettyCharacterSet)
+import qualified Dhall.Pretty
 import Dhall.Src (Src)
 
 import Data.Monoid ((<>))
@@ -18,7 +19,7 @@ formatExpr expr = formatExprWithHeader expr (Header "")
 --   (usually consisting of comments and whitespace).
 formatExprWithHeader :: Pretty.Pretty b => Expr Src b -> Header -> Text
 formatExprWithHeader expr (Header header) = Pretty.renderStrict
-  (Pretty.layoutSmart layoutOpts doc)
+  (Dhall.Pretty.layout doc)
   where
     doc =
       Pretty.pretty header
diff --git a/dhall-try/src/Main.hs b/dhall-try/src/Main.hs
@@ -80,7 +80,7 @@ main = do
 
     let prettyExpression =
               Pretty.renderStrict
-            . Pretty.layoutSmart Dhall.Pretty.layoutOpts
+            . Dhall.Pretty.layout
             . Dhall.Pretty.prettyExpr
 
     let interpret = do
diff --git a/dhall/src/Dhall/Format.hs b/dhall/src/Dhall/Format.hs
@@ -13,7 +13,7 @@ module Dhall.Format
 
 import Control.Exception (Exception)
 import Data.Monoid ((<>))
-import Dhall.Pretty (CharacterSet(..), annToAnsiStyle, layoutOpts)
+import Dhall.Pretty (CharacterSet(..), annToAnsiStyle)
 import Dhall.Util (Censor, Input(..))
 
 import qualified Data.Text.Prettyprint.Doc                 as Pretty
@@ -63,7 +63,7 @@ format (Format {..}) =
                             <>  "\n"
 
                     System.IO.withFile file System.IO.WriteMode (\handle -> do
-                        Pretty.Terminal.renderIO handle (Pretty.layoutSmart layoutOpts doc))
+                        Pretty.Terminal.renderIO handle (Dhall.Pretty.layout doc))
                 StandardInput -> do
                     (Dhall.Util.Header header, expr) <-
                         Dhall.Util.getExpressionAndHeader censor StandardInput
@@ -78,11 +78,11 @@ format (Format {..}) =
                       then
                         Pretty.Terminal.renderIO
                           System.IO.stdout
-                          (fmap annToAnsiStyle (Pretty.layoutSmart layoutOpts doc))
+                          (fmap annToAnsiStyle (Dhall.Pretty.layout doc))
                       else
                         Pretty.Terminal.renderIO
                           System.IO.stdout
-                          (Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc))
+                          (Dhall.Pretty.layout (Pretty.unAnnotate doc))
         Check {..} -> do
             originalText <- case path of
                 InputFile file -> Data.Text.IO.readFile file
@@ -97,7 +97,7 @@ format (Format {..}) =
                     <>  "\n"
 
             let formattedText =
-                    Pretty.Text.renderStrict (Pretty.layoutSmart layoutOpts doc)
+                    Pretty.Text.renderStrict (Dhall.Pretty.layout doc)
 
             if originalText == formattedText
                 then return ()
diff --git a/dhall/src/Dhall/Freeze.hs b/dhall/src/Dhall/Freeze.hs
@@ -17,7 +17,7 @@ module Dhall.Freeze
 import Data.Monoid ((<>))
 import Data.Text
 import Dhall.Parser (Src)
-import Dhall.Pretty (CharacterSet, annToAnsiStyle, layoutOpts, prettyCharacterSet)
+import Dhall.Pretty (CharacterSet, annToAnsiStyle, prettyCharacterSet)
 import Dhall.Syntax (Expr(..), Import(..), ImportHashed(..), ImportType(..))
 import Dhall.Util (Censor, Input(..))
 import System.Console.ANSI (hSupportsANSI)
@@ -30,6 +30,7 @@ import qualified Data.Text.IO
 import qualified Dhall.Core
 import qualified Dhall.Import
 import qualified Dhall.Optics
+import qualified Dhall.Pretty
 import qualified Dhall.TypeCheck
 import qualified Dhall.Util
 import qualified System.FilePath
@@ -88,7 +89,7 @@ writeExpr inplace (header, expr) characterSet = do
     let doc =  Pretty.pretty header
             <> Dhall.Pretty.prettyCharacterSet characterSet expr
 
-    let unAnnotated = Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc)
+    let unAnnotated = Dhall.Pretty.layout (Pretty.unAnnotate doc)
 
     case inplace of
         InputFile f ->
@@ -100,7 +101,7 @@ writeExpr inplace (header, expr) characterSet = do
             supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
             if supportsANSI
                then
-                 Pretty.renderIO System.IO.stdout (annToAnsiStyle <$> Pretty.layoutSmart layoutOpts doc)
+                 Pretty.renderIO System.IO.stdout (annToAnsiStyle <$> Dhall.Pretty.layout doc)
                else
                  Pretty.renderIO System.IO.stdout unAnnotated
 
diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs
@@ -32,7 +32,7 @@ import Dhall.Core (Expr(Annot), Import, pretty)
 import Dhall.Freeze (Intent(..), Scope(..))
 import Dhall.Import (Imported(..), Depends(..), SemanticCacheMode(..), _semanticCacheMode)
 import Dhall.Parser (Src)
-import Dhall.Pretty (Ann, CharacterSet(..), annToAnsiStyle, layoutOpts)
+import Dhall.Pretty (Ann, CharacterSet(..), annToAnsiStyle)
 import Dhall.TypeCheck (Censored(..), DetailedTypeError(..), TypeError)
 import Dhall.Util (Censor(..), Header (..), Input(..), Output(..))
 import Dhall.Version (dhallVersionString)
@@ -469,7 +469,7 @@ command (Options {..}) = do
 
     let renderDoc :: Handle -> Doc Ann -> IO ()
         renderDoc h doc = do
-            let stream = Pretty.layoutSmart layoutOpts doc
+            let stream = Dhall.Pretty.layout doc
 
             supportsANSI <- System.Console.ANSI.hSupportsANSI h
             let ansiStream =
diff --git a/dhall/src/Dhall/Parser/Combinators.hs b/dhall/src/Dhall/Parser/Combinators.hs
@@ -24,7 +24,6 @@ import qualified Control.Monad.Fail
 import qualified Data.Char
 import qualified Data.Set
 import qualified Data.Text
-import qualified Data.Text.Prettyprint.Doc               as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
 import qualified Dhall.Map
 import qualified Dhall.Pretty
@@ -49,7 +48,7 @@ instance Show e => Show (SourcedException e) where
         <>  "\n"
         <>  "\n"
         <>  Pretty.renderString
-                (Pretty.layoutPretty Dhall.Pretty.layoutOpts (pretty source))
+                (Dhall.Pretty.layout (pretty source))
 
 -- | Doesn't force the 'Text' part
 laxSrcEq :: Src -> Src -> Bool
diff --git a/dhall/src/Dhall/Pretty.hs b/dhall/src/Dhall/Pretty.hs
@@ -10,14 +10,8 @@ module Dhall.Pretty
     , CharacterSet(..)
     , prettyCharacterSet
 
-    , layoutOpts
+    , Dhall.Pretty.Internal.layout
+    , Dhall.Pretty.Internal.layoutOpts
     ) where
 
 import Dhall.Pretty.Internal
-import qualified Data.Text.Prettyprint.Doc as Pretty
-
--- | Default layout options
-layoutOpts :: Pretty.LayoutOptions
-layoutOpts =
-    Pretty.defaultLayoutOptions
-        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }
diff --git a/dhall/src/Dhall/Pretty/Internal.hs b/dhall/src/Dhall/Pretty/Internal.hs
@@ -32,6 +32,8 @@ module Dhall.Pretty.Internal (
     , prettyDouble
     , prettyToStrictText
     , prettyToString
+    , layout
+    , layoutOpts
 
     , docToStrictText
 
@@ -1071,36 +1073,39 @@ prettyCharacterSet characterSet expression =
 
     prettyChunks :: Pretty a => Chunks Src a -> Doc Ann
     prettyChunks (Chunks a b) =
-        if any (\(builder, _) -> hasNewLine builder) a || hasNewLine b
-        then Pretty.flatAlt long short
+        if anyText (== '\n')
+        then
+            if anyText (/= '\n')
+            then long
+            else Pretty.flatAlt long short
         else short
       where
         long =
             Pretty.align
             (   literal ("''" <> Pretty.hardline)
             <>  Pretty.align
-                (foldMap prettyMultilineChunk a <> prettyMultilineBuilder b)
+                (foldMap prettyMultilineChunk a <> prettyMultilineText b)
             <>  literal "''"
             )
 
         short =
             literal "\"" <> foldMap prettyChunk a <> literal (prettyText b <> "\"")
 
-        hasNewLine = Text.any (== '\n')
+        anyText predicate = any (\(text, _) -> Text.any predicate text) a || Text.any predicate b
 
         prettyMultilineChunk (c, d) =
-                prettyMultilineBuilder c
+                prettyMultilineText c
             <>  dollar
             <>  lbrace
             <>  prettyExpression d
             <>  rbrace
 
-        prettyMultilineBuilder builder = literal (mconcat docs)
+        prettyMultilineText text = literal (mconcat docs)
           where
-            lazyLines = Text.splitOn "\n" (escapeSingleQuotedText builder)
+            lines_ = Text.splitOn "\n" (escapeSingleQuotedText text)
 
             docs =
-                Data.List.intersperse Pretty.hardline (fmap Pretty.pretty lazyLines)
+                Data.List.intersperse Pretty.hardline (fmap Pretty.pretty lines_)
 
         prettyChunk (c, d) =
                 prettyText c
@@ -1112,18 +1117,14 @@ prettyCharacterSet characterSet expression =
 
 -- | Pretty-print a value
 pretty_ :: Pretty a => a -> Text
-pretty_ = Pretty.renderStrict . Pretty.layoutPretty options . Pretty.pretty
-  where
-   options = Pretty.LayoutOptions { Pretty.layoutPageWidth = Pretty.Unbounded }
+pretty_ = prettyToStrictText
 
 -- | Escape a `Text` literal using Dhall's escaping rules for single-quoted
 --   @Text@
 escapeSingleQuotedText :: Text -> Text
-escapeSingleQuotedText inputBuilder = outputBuilder
+escapeSingleQuotedText inputText = outputText
   where
-    outputText = substitute "${" "''${" (substitute "''" "'''" inputBuilder)
-
-    outputBuilder = outputText
+    outputText = substitute "${" "''${" (substitute "''" "'''" inputText)
 
     substitute before after = Text.intercalate after . Text.splitOn before
 
@@ -1164,14 +1165,22 @@ escapeText_ text = Text.concatMap adapt text
 
 prettyToString :: Pretty a => a -> String
 prettyToString =
-    Pretty.renderString . Pretty.layoutPretty options . Pretty.pretty
-  where
-   options = Pretty.LayoutOptions { Pretty.layoutPageWidth = Pretty.Unbounded }
+    Pretty.renderString . layout . Pretty.pretty
 
 docToStrictText :: Doc ann -> Text.Text
-docToStrictText = Pretty.renderStrict . Pretty.layoutPretty options
-  where
-   options = Pretty.LayoutOptions { Pretty.layoutPageWidth = Pretty.Unbounded }
+docToStrictText = Pretty.renderStrict . layout
 
 prettyToStrictText :: Pretty a => a -> Text.Text
 prettyToStrictText = docToStrictText . Pretty.pretty
+
+-- | Layout using 'layoutOpts'
+--
+-- Tries hard to fit the document into 80 columns.
+layout :: Pretty.Doc ann -> Pretty.SimpleDocStream ann
+layout = Pretty.layoutSmart layoutOpts
+
+-- | Default layout options
+layoutOpts :: Pretty.LayoutOptions
+layoutOpts =
+    Pretty.defaultLayoutOptions
+        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }
diff --git a/dhall/src/Dhall/Repl.hs b/dhall/src/Dhall/Repl.hs
@@ -608,9 +608,7 @@ outputWithoutSpacing expr = do
   case outputHandle of
     Nothing     -> pure ()
     Just handle -> do
-      let stream =
-              Pretty.layoutSmart Dhall.Pretty.layoutOpts
-                  (Dhall.Pretty.prettyCharacterSet characterSet expr)
+      let stream = Dhall.Pretty.layout (Dhall.Pretty.prettyCharacterSet characterSet expr)
 
       supportsANSI <- liftIO (System.Console.ANSI.hSupportsANSI handle)
       let ansiStream =
diff --git a/dhall/src/Dhall/TypeCheck.hs b/dhall/src/Dhall/TypeCheck.hs
@@ -41,7 +41,7 @@ import Dhall.Context (Context)
 import Dhall.Syntax (Binding(..), Const(..), Chunks(..), Expr(..), Var(..))
 import Dhall.Eval
     (Environment(..), Names(..), Val(..), (~>))
-import Dhall.Pretty (Ann, layoutOpts)
+import Dhall.Pretty (Ann)
 import Dhall.Src (Src)
 import Lens.Family (over)
 
@@ -59,6 +59,7 @@ import qualified Dhall.Diff
 import qualified Dhall.Eval                              as Eval
 import qualified Dhall.Map
 import qualified Dhall.Set
+import qualified Dhall.Pretty
 import qualified Dhall.Pretty.Internal
 import qualified Dhall.Util
 import qualified Lens.Family
@@ -4251,7 +4252,7 @@ data TypeError s a = TypeError
     }
 
 instance (Eq a, Pretty s, Pretty a) => Show (TypeError s a) where
-    show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty
+    show = Pretty.renderString . Dhall.Pretty.layout . Pretty.pretty
 
 instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (TypeError s a)
 
@@ -4275,7 +4276,7 @@ data Censored
     | Censored (TypeError Src X)
 
 instance Show Censored where
-    show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty
+    show = Pretty.renderString . Dhall.Pretty.layout . Pretty.pretty
 
 instance Exception Censored
 
@@ -4424,7 +4425,7 @@ newtype DetailedTypeError s a = DetailedTypeError (TypeError s a)
     deriving (Typeable)
 
 instance (Eq a, Pretty s, Pretty a) => Show (DetailedTypeError s a) where
-    show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty
+    show = Pretty.renderString . Dhall.Pretty.layout . Pretty.pretty
 
 instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (DetailedTypeError s a)
 
diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs
@@ -77,7 +77,7 @@ snip text
 snipDoc :: Doc Ann -> Doc a
 snipDoc doc = Pretty.align (Pretty.pretty (snip text))
   where
-    stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts doc
+    stream = Dhall.Pretty.layout doc
 
     ansiStream = fmap Dhall.Pretty.annToAnsiStyle stream
 
diff --git a/dhall/tests/Dhall/Test/Diff.hs b/dhall/tests/Dhall/Test/Diff.hs
@@ -10,11 +10,11 @@ import Turtle (FilePath)
 
 import qualified Data.Text                             as Text
 import qualified Data.Text.IO                          as Text.IO
-import qualified Data.Text.Prettyprint.Doc             as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
 import qualified Dhall.Core                            as Core
 import qualified Dhall.Diff                            as Diff
 import qualified Dhall.Parser                          as Parser
+import qualified Dhall.Pretty
 import qualified Dhall.Test.Util                       as Test.Util
 import qualified Test.Tasty                            as Tasty
 import qualified Test.Tasty.HUnit                      as Tasty.HUnit
@@ -50,13 +50,8 @@ diffTest prefix =
         let actualDiffDocument =
                 Diff.doc (Diff.diffNormalized leftInput rightInput) <> "\n"
 
-        let options =
-                Pretty.LayoutOptions
-                    { Pretty.layoutPageWidth = Pretty.Unbounded }
-
-        let actualDiffText =
-                Pretty.Text.renderStrict
-                    (Pretty.layoutPretty options actualDiffDocument)
+        let actualDiffText = Pretty.Text.renderStrict
+                    (Dhall.Pretty.layout actualDiffDocument)
 
         let message = "The diffed expressions did not match the expected output"
 
diff --git a/dhall/tests/Dhall/Test/Format.hs b/dhall/tests/Dhall/Test/Format.hs
diff --git a/dhall/tests/Dhall/Test/Regression.hs b/dhall/tests/Dhall/Test/Regression.hs
diff --git a/dhall/tests/format/escapeSingleQuotedOpenInterpolationB.dhall b/dhall/tests/format/escapeSingleQuotedOpenInterpolationB.dhall
diff --git a/dhall/tests/format/innerMultilineB.dhall b/dhall/tests/format/innerMultilineB.dhall
diff --git a/dhall/tests/format/multilineB.dhall b/dhall/tests/format/multilineB.dhall
diff --git a/dhall/tests/format/textLitNewlinesOnlyA.dhall b/dhall/tests/format/textLitNewlinesOnlyA.dhall
diff --git a/dhall/tests/format/textLitNewlinesOnlyB.dhall b/dhall/tests/format/textLitNewlinesOnlyB.dhall
