From c266734448544a118ed80e47deaa2590131c7f84 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sun, 19 Sep 2021 12:09:51 -0700
Subject: Use pretty-simple to format native output.

Previously we used our own homespun formatting.  But this
produces over-long lines that aren't ideal for diffs in tests.
Easier to use something off-the-shelf and standard.

Closes #7580.

Performance is slower by about a factor of 10, but this isn't
really a problem because native isn't suitable as a serialization
format. (For serialization you should use json, because the reader
is so much faster than native.)
---
 src/Text/Pandoc/Writers/Native.hs | 88 +++++++--------------------------------
 1 file changed, 15 insertions(+), 73 deletions(-)

(limited to 'src')

diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index 9c2ce805d..67af39a31 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -12,82 +12,24 @@ Conversion of a 'Pandoc' document to a string representation.
 -}
 module Text.Pandoc.Writers.Native ( writeNative )
 where
-import Data.List (intersperse)
 import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
 import Text.Pandoc.Class.PandocMonad (PandocMonad)
 import Text.Pandoc.Definition
-import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))
-import Text.DocLayout
-
-prettyList :: [Doc Text] -> Doc Text
-prettyList ds =
-  "[" <>
-  mconcat (intersperse (cr <> ",") $ map (nest 1) ds) <> "]"
-
--- | Prettyprint Pandoc block element.
-prettyBlock :: Block -> Doc Text
-prettyBlock (LineBlock lines') =
-  "LineBlock" $$ prettyList (map (text . show) lines')
-prettyBlock (BlockQuote blocks) =
-  "BlockQuote" $$ prettyList (map prettyBlock blocks)
-prettyBlock (OrderedList attribs blockLists) =
-  "OrderedList" <> space <> text (show attribs) $$
-  prettyList (map (prettyList . map prettyBlock) blockLists)
-prettyBlock (BulletList blockLists) =
-  "BulletList" $$
-  prettyList (map (prettyList . map prettyBlock) blockLists)
-prettyBlock (DefinitionList items) = "DefinitionList" $$
-  prettyList (map deflistitem items)
-    where deflistitem (term, defs) = "(" <> text (show term) <> "," <> cr <>
-           nest 1 (prettyList $ map (prettyList . map prettyBlock) defs) <> ")"
-prettyBlock (Table attr blkCapt specs thead tbody tfoot) =
-  mconcat [ "Table "
-          , text (show attr)
-          , " "
-          , prettyCaption blkCapt ] $$
-  prettyList (map (text . show) specs) $$
-  prettyHead thead $$
-  prettyBodies tbody $$
-  prettyFoot tfoot
-  where prettyRows = prettyList . map prettyRow
-        prettyRow (Row a body) =
-          text ("Row " <> show a) $$ prettyList (map prettyCell body)
-        prettyCell (Cell a ma h w b) =
-          mconcat [ "Cell "
-                  , text (show a)
-                  , " "
-                  , text (show ma)
-                  , " ("
-                  , text (show h)
-                  , ") ("
-                  , text (show w)
-                  , ")" ] $$
-          prettyList (map prettyBlock b)
-        prettyCaption (Caption mshort body) =
-          "(Caption " <> text (showsPrec 11 mshort "") $$ prettyList (map prettyBlock body) <> ")"
-        prettyHead (TableHead thattr body)
-          = "(TableHead " <> text (show thattr) $$ prettyRows body <> ")"
-        prettyBody (TableBody tbattr rhc hd bd)
-          = mconcat [ "(TableBody "
-                    , text (show tbattr)
-                    , " ("
-                    , text (show rhc)
-                    , ")" ] $$ prettyRows hd $$ prettyRows bd <> ")"
-        prettyBodies = prettyList . map prettyBody
-        prettyFoot (TableFoot tfattr body)
-          = "(TableFoot " <> text (show tfattr) $$ prettyRows body <> ")"
-prettyBlock (Div attr blocks) =
-  text ("Div " <> show attr) $$ prettyList (map prettyBlock blocks)
-prettyBlock block = text $ show block
+import Text.Pandoc.Options (WriterOptions (..))
+import Text.Pretty.Simple (pShowOpt, defaultOutputOptionsNoColor,
+                           OutputOptions(..), StringOutputStyle(..))
 
 -- | Prettyprint Pandoc document.
 writeNative :: PandocMonad m => WriterOptions -> Pandoc -> m Text
-writeNative opts (Pandoc meta blocks) = return $
-  let colwidth = if writerWrapText opts == WrapAuto
-                    then Just $ writerColumns opts
-                    else Nothing
-      withHead = case writerTemplate opts of
-                      Just _  -> \bs -> text ("Pandoc (" ++ show meta ++ ")") $$
-                                  bs $$ cr
-                      Nothing -> id
-  in  render colwidth $ withHead $ prettyList $ map prettyBlock blocks
+writeNative opts (Pandoc meta blocks) = do
+  let popts = defaultOutputOptionsNoColor{
+               outputOptionsIndentAmount = 2,
+               outputOptionsPageWidth = writerColumns opts,
+               outputOptionsCompact = True,
+               outputOptionsCompactParens = False,
+               outputOptionsStringStyle = Literal }
+  return $
+    case writerTemplate opts of
+      Just _  -> TL.toStrict $ pShowOpt popts (Pandoc meta blocks) <> "\n"
+      Nothing -> TL.toStrict $ pShowOpt popts blocks
-- 
cgit v1.2.3