Revised man writer to use new templates.

Note that now the "--after-body" will come after the "AUTHORS"
section, whereas before it would come before it.  This is a
slight break from backwards compatibility.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1733 788f1e2b-df1e-0410-8736-df70ead52e1b

1 files changed, 37 insertions, 42 deletions

diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 64fd24ad0..937d10b25 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -30,62 +30,56 @@ Conversion of 'Pandoc' documents to groff man page format.
 -}
 module Text.Pandoc.Writers.Man ( writeMan) where
 import Text.Pandoc.Definition
+import Text.Pandoc.Templates
 import Text.Pandoc.Shared
 import Text.Printf ( printf )
-import Data.List ( isPrefixOf, drop, nub, intersperse, intercalate )
+import Data.List ( isPrefixOf, drop, intersperse, intercalate )
 import Text.PrettyPrint.HughesPJ hiding ( Str )
 import Control.Monad.State
 import Control.Monad ( liftM )
 
 type Notes = [[Block]]
-type Preprocessors = [String] -- e.g. "t" for tbl
-type WriterState = (Notes, Preprocessors)
+data WriterState = WriterState { stNotes  :: Notes
+                               , stHasTables :: Bool }
 
 -- | Convert Pandoc to Man.
 writeMan :: WriterOptions -> Pandoc -> String
-writeMan opts document = render $ evalState (pandocToMan opts document) ([],[]) 
+writeMan opts document = evalState (pandocToMan opts document) (WriterState [] False) 
 
 -- | Return groff man representation of document.
-pandocToMan :: WriterOptions -> Pandoc -> State WriterState Doc
-pandocToMan opts (Pandoc meta blocks) = do
-  return empty -- TODO
---  let before  = writerIncludeBefore opts
---  let after   = writerIncludeAfter opts
---  let before' = if null before then empty else text before
---  let after'  = if null after then empty else text after
---  (head', foot) <- metaToMan opts meta
---  body <- blockListToMan opts blocks
---  (notes, preprocessors) <- get
---  let preamble = if null preprocessors || not (writerStandalone opts)
---                    then empty
---                    else text $ ".\\\" " ++ concat (nub preprocessors)
---  notes' <- notesToMan opts (reverse notes)
---  return $ preamble $$ head' $$ before' $$ body $$ notes' $$ foot $$ after'
-
--- | Insert bibliographic information into Man header and footer.
-metaToMan :: WriterOptions -- ^ Options, including Man header
-          -> Meta          -- ^ Meta with bibliographic information
-          -> State WriterState (Doc, Doc)
-metaToMan options (Meta title authors date) = do
-  titleText <- inlineListToMan options title
-  authorsText <- mapM (inlineListToMan options) authors
-  dateText <- inlineListToMan options date 
+pandocToMan :: WriterOptions -> Pandoc -> State WriterState String
+pandocToMan opts (Pandoc (Meta title authors date) blocks) = do
+  let before  = writerIncludeBefore opts
+  let after   = writerIncludeAfter opts
+  let before' = if null before then empty else text before
+  let after'  = if null after then empty else text after
+  titleText <- inlineListToMan opts title
+  authors' <- mapM (inlineListToMan opts) authors
+  date' <- inlineListToMan opts date 
   let (cmdName, rest) = break (== ' ') $ render titleText
   let (title', section) = case reverse cmdName of
                             (')':d:'(':xs) | d `elem` ['0'..'9'] -> 
                                   (text (reverse xs), char d)
                             xs -> (text (reverse xs), doubleQuotes empty)                    
-  let extras = map (doubleQuotes . text . removeLeadingTrailingSpace) $
-               splitBy '|' rest
-  let head' = (text ".TH") <+> title' <+> section <+> 
-             doubleQuotes dateText <+> hsep extras
-  let foot = case length authorsText of
-                0 -> empty
-                1 -> text ".SH AUTHOR" $$ (hcat $ intersperse (text ", ") authorsText)
-                _ -> text ".SH AUTHORS" $$ (hcat $ intersperse (text ", ") authorsText)
-  return $ if writerStandalone options
-              then (head', foot)
-              else (empty, empty)
+  let description = hsep $
+                    map (doubleQuotes . text . removeLeadingTrailingSpace) $
+                    splitBy '|' rest
+  body <- blockListToMan opts blocks
+  notes <- liftM stNotes get
+  notes' <- notesToMan opts (reverse notes)
+  let main = render $ before' $$ body $$ notes' $$ after'
+  hasTables <- liftM stHasTables get
+  let context  = writerVariables opts ++
+                 [ ("body", main)
+                 , ("title", render title')
+                 , ("section", render section)
+                 , ("date", render date')
+                 , ("description", render description) ] ++
+                 [ ("has-tables", "yes") | hasTables ] ++
+                 [ ("author", render a) | a <- authors' ]
+  if writerStandalone opts
+     then return $ renderTemplate context $ writerTemplate opts
+     else return main
 
 -- | Return man representation of notes.
 notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc
@@ -173,7 +167,7 @@ blockToMan opts (Table caption alignments widths headers rows) =
       aligncode AlignDefault = "l"
   in do
   caption' <- inlineListToMan opts caption
-  modify (\(notes, preprocessors) -> (notes, "t":preprocessors))
+  modify $ \st -> st{ stHasTables = True }
   let iwidths = if all (== 0) widths
                    then repeat ""
                    else map (printf "w(%0.2fn)" . (70 *)) widths
@@ -332,8 +326,9 @@ inlineToMan opts (Image alternate (source, tit)) = do
   linkPart <- inlineToMan opts (Link txt (source, tit)) 
   return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'
 inlineToMan _ (Note contents) = do 
-  modify (\(notes, prep) -> (contents:notes, prep)) -- add to notes in state
-  (notes, _) <- get
+  -- add to notes in state
+  modify $ \st -> st{ stNotes = contents : stNotes st }
+  notes <- liftM stNotes get
   let ref = show $ (length notes)
   return $ char '[' <> text ref <> char ']'