From 810e3336dc61e08f7454de3a9aa38ea2c61ca341 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Thu, 20 Jan 2011 08:41:53 -0800
Subject: Improved native writer using Pretty.

2-3X speed improvement and more consistent layout.
---
 src/Text/Pandoc/Writers/Native.hs | 80 ++++++++++++++++-----------------------
 1 file changed, 32 insertions(+), 48 deletions(-)

(limited to 'src/Text/Pandoc/Writers')

diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index cbda71555..1ca38594b 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-
 Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
 
@@ -30,60 +31,43 @@ Utility functions and definitions used by the various Pandoc modules.
 module Text.Pandoc.Writers.Native ( writeNative )
 where
 import Text.Pandoc.Shared ( WriterOptions(..) )
-import Data.List ( intercalate )
+import Data.List ( intersperse )
 import Text.Pandoc.Definition
+import Text.Pandoc.Pretty
 
--- | Indent string as a block.
-indentBy :: Int    -- ^ Number of spaces to indent the block 
-         -> Int    -- ^ Number of spaces (rel to block) to indent first line
-         -> String -- ^ Contents of block to indent
-         -> String
-indentBy _ _ [] = ""
-indentBy num first str = 
-  let (firstLine:restLines) = lines str 
-      firstLineIndent = num + first
-  in  (replicate firstLineIndent ' ') ++ firstLine ++ "\n" ++ 
-      (intercalate "\n" $ map ((replicate num ' ') ++ ) restLines)
-
--- | Prettyprint list of Pandoc blocks elements.
-prettyBlockList :: Int       -- ^ Number of spaces to indent list of blocks
-                -> [Block]   -- ^ List of blocks
-                -> String
-prettyBlockList indent [] = indentBy indent 0 "[]"
-prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++ 
-  (intercalate "\n, " (map prettyBlock blocks)) ++ " ]"
+prettyList :: [Doc] -> Doc
+prettyList ds =
+  "[ " <> (cat $ intersperse (cr <> ", ") $ map (nest 2) ds) <> " ]"
 
 -- | Prettyprint Pandoc block element.
-prettyBlock :: Block -> String
-prettyBlock (BlockQuote blocks) = "BlockQuote\n  " ++ 
-                                  (prettyBlockList 2 blocks) 
+prettyBlock :: Block -> Doc
+prettyBlock (BlockQuote blocks) =
+  "BlockQuote" $$ prettyList (map prettyBlock blocks)
 prettyBlock (OrderedList attribs blockLists) = 
-  "OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++ 
-  (intercalate ", " $ map (\blocks -> prettyBlockList 2 blocks)
-  blockLists)) ++ " ]"
-prettyBlock (BulletList blockLists) = "BulletList\n" ++ 
-  indentBy 2 0 ("[ " ++ (intercalate ", "
-  (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]" 
-prettyBlock (DefinitionList items) = "DefinitionList\n" ++ 
-  indentBy 2 0 ("[ " ++ (intercalate "\n, "
-  (map (\(term, defs) -> "(" ++ show term ++ ",\n" ++ 
-  indentBy 3 0 ("[ " ++ (intercalate ", "
-  (map (\blocks -> prettyBlockList 2 blocks) defs)) ++ "]") ++
-   ")") items))) ++ " ]" 
+  "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 caption aligns widths header rows) = 
-  "Table " ++ show caption ++ " " ++ show aligns ++ " " ++ 
-  show widths ++ "\n" ++ prettyRow header ++ " [\n" ++  
-  (intercalate ",\n" (map prettyRow rows)) ++ " ]"
-  where prettyRow cols = indentBy 2 0 ("[ " ++ (intercalate ", "
-                         (map (\blocks -> prettyBlockList 2 blocks) 
-                         cols))) ++ " ]"
-prettyBlock block = show block
+  "Table " <> text (show caption) <> " " <> text (show aligns) <> " " <>
+  text (show widths) $$ nest 2 (prettyRow header) <>
+  prettyList (map prettyRow rows)
+    where prettyRow cols = prettyList (map (prettyList . map prettyBlock) cols)
+prettyBlock block = text $ show block
 
 -- | Prettyprint Pandoc document.
 writeNative :: WriterOptions -> Pandoc -> String
-writeNative opts (Pandoc meta blocks) | writerStandalone opts =
-  "Pandoc " ++ "(" ++ show meta ++ ")\n  " ++ prettyBlockList 2 blocks
--- -- writeNative _ (Pandoc _ [Plain [x]]) = show x
--- writeNative _ (Pandoc _ [Plain xs])  = show xs
--- writeNative _ (Pandoc _ [x])         = prettyBlock x
-writeNative _ (Pandoc _ xs)          = prettyBlockList 0 xs
+writeNative opts (Pandoc meta blocks) =
+  let colwidth = if writerWrapText opts
+                    then Just $ writerColumns opts
+                    else Nothing
+      withHead = if writerStandalone opts
+                    then \bs -> text ("Pandoc " ++ "(" ++ show meta ++ ")") $$
+                           bs <> cr
+                    else id
+  in  render colwidth $ withHead $ prettyList $ map prettyBlock blocks
-- 
cgit v1.2.3