diff options
| author | John MacFarlane <jgm@berkeley.edu> | 2021-09-19 12:09:51 -0700 |
|---|---|---|
| committer | John MacFarlane <jgm@berkeley.edu> | 2021-09-21 12:37:42 -0700 |
| commit | c266734448544a118ed80e47deaa2590131c7f84 (patch) | |
| tree | d5793b1dc732456894c96e8ee6829dab9d539388 /src/Text/Pandoc/Writers | |
| parent | 5f7e7f539a02818d0a94309b15d648d51d1eaee6 (diff) | |
| download | pandoc-c266734448544a118ed80e47deaa2590131c7f84.tar.gz | |
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.)
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/Native.hs | 88 |
1 files changed, 15 insertions, 73 deletions
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 |