1 files changed, 11 insertions, 73 deletions
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index 9c2ce805d..264b9c498 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -12,82 +12,20 @@ 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 as T
 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.Show.Pretty (ppDoc)
+import Text.PrettyPrint (renderStyle, Style(..), style, char)
 
 -- | 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 style' = style{ lineLength = writerColumns opts,
+                      ribbonsPerLine = 1.2 }
+  return $ T.pack $ renderStyle style' $
+    case writerTemplate opts of
+      Just _  -> ppDoc (Pandoc meta blocks) <> char '\n'
+      Nothing -> ppDoc blocks