Added new prettyprinting module.

* Added Text.Pandoc.Pretty.
  This is better suited for pandoc than the 'pretty' package.
  One advantage is that we now get proper wrapping; Emph [Inline]
  is no longer treated as a big unwrappable unit. Previously
  we only got breaks for spaces at the "outer level." We can also
  more easily avoid doubled blank lines.  Performance is
  significantly better as well.

* Removed Text.Pandoc.Blocks.
  Text.Pandoc.Pretty allows you to define blocks and concatenate
  them.

* Modified markdown, RST, org readers to use Text.Pandoc.Pretty
  instead of Text.PrettyPrint.HughesPJ.

* Text.Pandoc.Shared:  Added writerColumns to WriterOptions.

* Markdown, RST, Org writers now break text at writerColumns.

* Added --columns command-line option, which sets stColumns
  and writerColumns.

* Table parsing:  If the size of the header > stColumns,
  use the header size as 100% for purposes of calculating
  relative widths of columns.

1 files changed, 69 insertions, 79 deletions

diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 862628f9d..59f7e14f5 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-
 Copyright (C) 2006-2010 Puneeth Chaganti <punchagan@gmail.com>
 
@@ -32,10 +33,9 @@ Org-Mode:  <http://orgmode.org>
 module Text.Pandoc.Writers.Org ( writeOrg) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Shared 
-import Text.Pandoc.Blocks
+import Text.Pandoc.Pretty
 import Text.Pandoc.Templates (renderTemplate)
 import Data.List ( intersect, intersperse, transpose )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
 import Control.Monad.State
 import Control.Applicative ( (<$>) )
 
@@ -66,13 +66,16 @@ pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do
   notes <- liftM (reverse . stNotes) get >>= notesToOrg
   -- note that the notes may contain refs, so we do them first
   hasMath <- liftM stHasMath get
-  let main = render $ foldl ($+$) empty $ [body, notes]
+  let colwidth = if writerWrapText opts
+                    then Just $ writerColumns opts
+                    else Nothing
+  let main = render colwidth $ foldl ($+$) empty $ [body, notes]
   let context = writerVariables opts ++
                 [ ("body", main)
-                , ("title", render title)
-                , ("date", render date) ] ++
+                , ("title", render Nothing title)
+                , ("date", render Nothing date) ] ++
                 [ ("math", "yes") | hasMath ] ++
-                [ ("author", render a) | a <- authors ]
+                [ ("author", render Nothing a) | a <- authors ]
   if writerStandalone opts
      then return $ renderTemplate context $ writerTemplate opts
      else return main
@@ -81,22 +84,14 @@ pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do
 notesToOrg :: [[Block]] -> State WriterState Doc
 notesToOrg notes = 
   mapM (\(num, note) -> noteToOrg num note) (zip [1..] notes) >>= 
-  return . vcat
+  return . vsep
 
 -- | Return Org representation of a note.
 noteToOrg :: Int -> [Block] -> State WriterState Doc
 noteToOrg num note = do
   contents <- blockListToOrg note
-  let marker = text "[" <> text (show num) <> text "] "
-  return $ marker <> contents
-
--- | Take list of inline elements and return wrapped doc.
-wrappedOrg :: WriterOptions -> [Inline] -> State WriterState Doc
-wrappedOrg opts inlines = do
-  lineBreakDoc <- inlineToOrg LineBreak  
-  chunks <- mapM (wrapIfNeeded opts inlineListToOrg)
-                 (splitBy LineBreak inlines)
-  return $ vcat $ intersperse lineBreakDoc chunks
+  let marker = "[" ++ show num ++ "] "
+  return $ hang (length marker) (text marker) contents
 
 -- | Escape special characters for Org.
 escapeString :: String -> String
@@ -106,32 +101,28 @@ titleToOrg :: [Inline] -> State WriterState Doc
 titleToOrg [] = return empty
 titleToOrg lst = do
   contents <- inlineListToOrg lst
-  let titleName = text "#+TITLE: "
-  return $ titleName <> contents 
+  return $ "#+TITLE: " <> contents 
 
 -- | Convert Pandoc block element to Org. 
 blockToOrg :: Block         -- ^ Block element
            -> State WriterState Doc 
 blockToOrg Null = return empty
-blockToOrg (Plain inlines) = do
-  opts <- get >>= (return . stOptions)
-  wrappedOrg opts inlines
+blockToOrg (Plain inlines) = inlineListToOrg inlines
 blockToOrg (Para [Image txt (src,tit)]) = do
   capt <- inlineListToOrg txt
   img <- inlineToOrg (Image txt (src,tit))
-  return $ text "#+CAPTION: " <> capt <> text "\n" $$ img 
+  return $ "#+CAPTION: " <> capt <> blankline <> img
 blockToOrg (Para inlines) = do
-  opts <- get >>= (return . stOptions)
-  contents <- wrappedOrg opts inlines
-  return $ contents <> text "\n"
+  contents <- inlineListToOrg inlines
+  return $ contents <> blankline
 blockToOrg (RawHtml str) = 
-  return $ (text "\n#+BEGIN_HTML\n") $$ (nest 2 $ vcat $ map text (lines str)) 
-         $$ (text "\n#+END_HTML\n")
-blockToOrg HorizontalRule = return $ text "--------------\n"
+  return $ blankline $$ "#+BEGIN_HTML" $$
+           nest 2 (text str) $$ "#+END_HTML" $$ blankline
+blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline
 blockToOrg (Header level inlines) = do
   contents <- inlineListToOrg inlines
   let headerStr = text $ if level > 999 then " " else replicate level '*'
-  return $ headerStr <> text " " <> contents <> text "\n"
+  return $ headerStr <> " " <> contents <> blankline
 blockToOrg (CodeBlock (_,classes,_) str) = do
   opts <- stOptions <$> get
   let tabstop = writerTabStop opts
@@ -143,31 +134,30 @@ blockToOrg (CodeBlock (_,classes,_) str) = do
   let (beg, end) = if null at
                       then ("#+BEGIN_EXAMPLE", "#+END_EXAMPLE")
                       else ("#+BEGIN_SRC" ++ head at, "#+END_SRC")
-  return $ text beg $+$ (nest tabstop $ vcat $ map text (lines str)) 
-         $+$ text end
+  return $ text beg $$ nest tabstop (text str) $$ text end $$ blankline
 blockToOrg (BlockQuote blocks) = do
   contents <- blockListToOrg blocks 
-  return $ (text "\n#+BEGIN_QUOTE\n") $$ (nest 2 contents) 
-         $$ (text "\n#+END_QUOTE\n")
+  return $ blankline $$ "#+BEGIN_QUOTE" $$
+           nest 2 contents $$ "#+END_QUOTE" $$ blankline
 blockToOrg (Table caption' _ _ headers rows) =  do
   caption'' <- inlineListToOrg caption'
   let caption = if null caption'
                    then empty
-                   else (text "#+CAPTION: " <> caption'')
+                   else ("#+CAPTION: " <> caption'')
   headers' <- mapM blockListToOrg headers
   rawRows <- mapM (mapM blockListToOrg) rows
-  let numChars = maximum . map (length . render)
+  let numChars = maximum . map offset
   -- FIXME: width is not being used. 
   let widthsInChars =
        map ((+2) . numChars) $ transpose (headers' : rawRows)
   -- FIXME: Org doesn't allow blocks with height more than 1. 
-  let hpipeBlocks blocks = hcatBlocks [beg, middle, end] 
-        where height = maximum (map heightOfBlock blocks)
-              sep'   = TextBlock 3 height (replicate height " | ")
-              beg    = TextBlock 2 height (replicate height "| ")
-              end    = TextBlock 2 height (replicate height " |")
-              middle = hcatBlocks $ intersperse sep' blocks
-  let makeRow = hpipeBlocks . zipWith docToBlock widthsInChars
+  let hpipeBlocks blocks = hcat [beg, middle, end] 
+        where h      = maximum (map height blocks)
+              sep'   = lblock 3 $ vcat (map text $ replicate h " | ")
+              beg    = lblock 2 $ vcat (map text $ replicate h "| ")
+              end    = lblock 2 $ vcat (map text $ replicate h " |")
+              middle = hcat $ intersperse sep' blocks
+  let makeRow = hpipeBlocks . zipWith lblock widthsInChars
   let head' = makeRow headers'
   rows' <- mapM (\row -> do cols <- mapM blockListToOrg row
                             return $ makeRow cols) rows
@@ -175,34 +165,37 @@ blockToOrg (Table caption' _ _ headers rows) =  do
                   (hcat $ intersperse (char ch <> char '+' <> char ch) $ 
                           map (\l -> text $ replicate l ch) widthsInChars) <>
                   char ch <> char '|'
-  let body = vcat $ map blockToDoc rows'
+  let body = vcat rows'
   let head'' = if all null headers
                   then empty
-                  else blockToDoc head' $+$ border '-'
-  return $ head'' $+$ body $$ caption $$ text ""
+                  else head' $$ border '-'
+  return $ head'' $$ body $$ caption $$ blankline
 blockToOrg (BulletList items) = do
   contents <- mapM bulletListItemToOrg items
   -- ensure that sublists have preceding blank line
-  return $ text "" $+$ vcat contents <> text "\n"
-blockToOrg (OrderedList (start, style', delim) items) = do
+  return $ blankline $+$ vcat contents $$ blankline
+blockToOrg (OrderedList (start, _, delim) items) = do
+  let delim' = case delim of
+                    TwoParens -> OneParen
+                    x         -> x
   let markers = take (length items) $ orderedListMarkers 
-                                      (start, style', delim)
+                                      (start, Decimal, delim')
   let maxMarkerLength = maximum $ map length markers
   let markers' = map (\m -> let s = maxMarkerLength - length m
                             in  m ++ replicate s ' ') markers
   contents <- mapM (\(item, num) -> orderedListItemToOrg item num) $
-              zip markers' items  
+              zip markers' items
   -- ensure that sublists have preceding blank line
-  return $ text "" $+$ vcat contents <> text "\n"
+  return $ blankline $$ vcat contents $$ blankline
 blockToOrg (DefinitionList items) = do
   contents <- mapM definitionListItemToOrg items
-  return $ (vcat contents) <> text "\n"
+  return $ vcat contents $$ blankline
 
 -- | Convert bullet list item (list of blocks) to Org.
 bulletListItemToOrg :: [Block] -> State WriterState Doc
 bulletListItemToOrg items = do
   contents <- blockListToOrg items
-  return $ (text "-  ") <> contents
+  return $ hang 3 "-  " (contents <> cr)
 
 -- | Convert ordered list item (a list of blocks) to Org.
 orderedListItemToOrg :: String   -- ^ marker for list item
@@ -210,14 +203,14 @@ orderedListItemToOrg :: String   -- ^ marker for list item
                      -> State WriterState Doc
 orderedListItemToOrg marker items = do
   contents <- blockListToOrg items
-  return $ (text marker <> char ' ') <> contents 
+  return $ hang (length marker + 1) (text marker <> space) (contents <> cr)
 
 -- | Convert defintion list item (label, list of blocks) to Org.
 definitionListItemToOrg :: ([Inline], [[Block]]) -> State WriterState Doc
 definitionListItemToOrg (label, defs) = do
   label' <- inlineListToOrg label
   contents <- liftM vcat $ mapM blockListToOrg defs
-  return $ (text "-  ") <> label' <> (text " :: ") <> contents
+  return $ hang 3 "-  " $ label' <> " :: " <> (contents <> cr)
 
 -- | Convert list of Pandoc block elements to Org.
 blockListToOrg :: [Block]       -- ^ List of block elements
@@ -232,60 +225,57 @@ inlineListToOrg lst = mapM inlineToOrg lst >>= return . hcat
 inlineToOrg :: Inline -> State WriterState Doc
 inlineToOrg (Emph lst) = do 
   contents <- inlineListToOrg lst
-  return $ char '/' <> contents <> char '/'
+  return $ "/" <> contents <> "/"
 inlineToOrg (Strong lst) = do
   contents <- inlineListToOrg lst
-  return $ text "*" <> contents <> text "*"
+  return $ "*" <> contents <> "*"
 inlineToOrg (Strikeout lst) = do 
   contents <- inlineListToOrg lst
-  return $ text "+" <> contents <> char '+'
+  return $ "+" <> contents <> "+"
 inlineToOrg (Superscript lst) = do 
   contents <- inlineListToOrg lst
-  return $ text "^{" <> contents <> text "}"
+  return $ "^{" <> contents <> "}"
 inlineToOrg (Subscript lst) = do 
   contents <- inlineListToOrg lst
-  return $ text "_{" <> contents <> text "}"
+  return $ "_{" <> contents <> "}"
 inlineToOrg (SmallCaps lst) = inlineListToOrg lst
 inlineToOrg (Quoted SingleQuote lst) = do
   contents <- inlineListToOrg lst
-  return $ char '\'' <> contents <> char '\''
+  return $ "'" <> contents <> "'"
 inlineToOrg (Quoted DoubleQuote lst) = do
   contents <- inlineListToOrg lst
-  return $ char '\"' <> contents <> char '\"'
-inlineToOrg (Cite _  lst) =
-  inlineListToOrg lst
-inlineToOrg EmDash = return $ text "---"
-inlineToOrg EnDash = return $ text "--"
-inlineToOrg Apostrophe = return $ char '\''
-inlineToOrg Ellipses = return $ text "..."
-inlineToOrg (Code str) = return $ text $ "=" ++ str ++ "="
+  return $ "\"" <> contents <> "\""
+inlineToOrg (Cite _  lst) = inlineListToOrg lst
+inlineToOrg EmDash = return "---"
+inlineToOrg EnDash = return "--"
+inlineToOrg Apostrophe = return "'"
+inlineToOrg Ellipses = return "..."
+inlineToOrg (Code str) = return $ "=" <> text str <> "="
 inlineToOrg (Str str) = return $ text $ escapeString str
 inlineToOrg (Math t str) = do
   modify $ \st -> st{ stHasMath = True }
   return $ if t == InlineMath
-              then text $ "$" ++ str ++ "$"
-              else text $ "$$" ++ str ++ "$$"
+              then "$" <> text str <> "$"
+              else "$$" <> text str <> "$$"
 inlineToOrg (TeX str) = return $ text str
 inlineToOrg (HtmlInline _) = return empty
-inlineToOrg (LineBreak) = do
-  return $ empty -- there's no line break in Org
-inlineToOrg Space = return $ char ' '
+inlineToOrg (LineBreak) = return cr -- there's no line break in Org
+inlineToOrg Space = return space
 inlineToOrg (Link txt (src, _)) = do
   case txt of
         [Code x] | x == src ->  -- autolink
              do modify $ \s -> s{ stLinks = True }
-                return $ text $ "[[" ++ x ++ "]]"
+                return $ "[[" <> text x <> "]]"
         _ -> do contents <- inlineListToOrg txt
                 modify $ \s -> s{ stLinks = True }
-                return $ text ("[[" ++ src ++ "][") <> contents <> 
-                         (text "]]")
+                return $ "[[" <> text src <> "][" <> contents <> "]]"
 inlineToOrg (Image _ (source', _)) = do
   let source = unescapeURI source'
   modify $ \s -> s{ stImages = True }
-  return $ text $ "[[" ++ source ++ "]]"
+  return $ "[[" <> text source <> "]]"
 inlineToOrg (Note contents) = do 
   -- add to notes in state
   notes <- get >>= (return . stNotes)
   modify $ \st -> st { stNotes = contents:notes }
   let ref = show $ (length notes) + 1
-  return $ text " [" <> text ref <> text "]"
+  return $ " [" <> text ref <> "]"