@@ -30,62 +30,56 @@ Conversion of 'Pandoc' documents to groff man page format.
31module Text.Pandoc.Writers.Man ( writeMan) where
31module Text.Pandoc.Writers.Man ( writeMan) where
32import Text.Pandoc.Definition
32import Text.Pandoc.Definition
33+import Text.Pandoc.Templates
33import Text.Pandoc.Shared
34import Text.Pandoc.Shared
34import Text.Printf ( printf )
35import Text.Printf ( printf )
35−import Data.List ( isPrefixOf, drop, nub, intersperse, intercalate )
36+import Data.List ( isPrefixOf, drop, intersperse, intercalate )
36import Text.PrettyPrint.HughesPJ hiding ( Str )
37import Text.PrettyPrint.HughesPJ hiding ( Str )
37import Control.Monad.State
38import Control.Monad.State
38import Control.Monad ( liftM )
39import Control.Monad ( liftM )
40type Notes = [[Block]]
41type Notes = [[Block]]
41−type Preprocessors = [String] -- e.g. "t" for tbl
42+data WriterState = WriterState { stNotes :: Notes
42−type WriterState = (Notes, Preprocessors)
43+ , stHasTables :: Bool }
44-- | Convert Pandoc to Man.
45-- | Convert Pandoc to Man.
45writeMan :: WriterOptions -> Pandoc -> String
46writeMan :: WriterOptions -> Pandoc -> String
46−writeMan opts document = render $ evalState (pandocToMan opts document) ([],[])
47+writeMan opts document = evalState (pandocToMan opts document) (WriterState [] False)
48-- | Return groff man representation of document.
49-- | Return groff man representation of document.
49−pandocToMan :: WriterOptions -> Pandoc -> State WriterState Doc
50+pandocToMan :: WriterOptions -> Pandoc -> State WriterState String
50−pandocToMan opts (Pandoc meta blocks) = do
51+pandocToMan opts (Pandoc (Meta title authors date) blocks) = do
52−-- let before = writerIncludeBefore opts
52+ let before = writerIncludeBefore opts
53−-- let after = writerIncludeAfter opts
53+ let after = writerIncludeAfter opts
54−-- let before' = if null before then empty else text before
54+ let before' = if null before then empty else text before
55−-- let after' = if null after then empty else text after
55+ let after' = if null after then empty else text after
56−-- (head', foot) <- metaToMan opts meta
57−-- body <- blockListToMan opts blocks
58−-- (notes, preprocessors) <- get
59−-- let preamble = if null preprocessors || not (writerStandalone opts)
61−-- else text $ ".\\\" " ++ concat (nub preprocessors)
62−-- notes' <- notesToMan opts (reverse notes)
63−-- return $ preamble $$ head' $$ before' $$ body $$ notes' $$ foot $$ after'
65−-- | Insert bibliographic information into Man header and footer.
66−metaToMan :: WriterOptions -- ^ Options, including Man header
67− -> Meta -- ^ Meta with bibliographic information
68− -> State WriterState (Doc, Doc)
69−metaToMan options (Meta title authors date) = do
70− titleText <- inlineListToMan options title
56+ titleText <- inlineListToMan opts title
71− authorsText <- mapM (inlineListToMan options) authors
57+ authors' <- mapM (inlineListToMan opts) authors
72− dateText <- inlineListToMan options date
58+ date' <- inlineListToMan opts date
73 let (cmdName, rest) = break (== ' ') $ render titleText
59 let (cmdName, rest) = break (== ' ') $ render titleText
74 let (title', section) = case reverse cmdName of
60 let (title', section) = case reverse cmdName of
75 (')':d:'(':xs) | d `elem` ['0'..'9'] ->
61 (')':d:'(':xs) | d `elem` ['0'..'9'] ->
76 (text (reverse xs), char d)
62 (text (reverse xs), char d)
77 xs -> (text (reverse xs), doubleQuotes empty)
63 xs -> (text (reverse xs), doubleQuotes empty)
64+ let description = hsep $
78− let extras = map (doubleQuotes . text . removeLeadingTrailingSpace) $
65+ map (doubleQuotes . text . removeLeadingTrailingSpace) $
79− splitBy '|' rest
66+ splitBy '|' rest
80− let head' = (text ".TH") <+> title' <+> section <+>
67+ body <- blockListToMan opts blocks
81− doubleQuotes dateText <+> hsep extras
68+ notes <- liftM stNotes get
82− let foot = case length authorsText of
69+ notes' <- notesToMan opts (reverse notes)
83− 0 -> empty
70+ let main = render $ before' $$ body $$ notes' $$ after'
84− 1 -> text ".SH AUTHOR" $$ (hcat $ intersperse (text ", ") authorsText)
71+ hasTables <- liftM stHasTables get
85− _ -> text ".SH AUTHORS" $$ (hcat $ intersperse (text ", ") authorsText)
72+ let context = writerVariables opts ++
74+ , ("title", render title')
75+ , ("section", render section)
76+ , ("date", render date')
77+ , ("description", render description) ] ++
78+ [ ("has-tables", "yes") | hasTables ] ++
79+ [ ("author", render a) | a <- authors' ]
86− return $ if writerStandalone options
80+ if writerStandalone opts
87− then (head', foot)
81+ then return $ renderTemplate context $ writerTemplate opts
88− else (empty, empty)
82+ else return main
90-- | Return man representation of notes.
84-- | Return man representation of notes.
91notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc
85notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc
@@ -173,7 +167,7 @@ blockToMan opts (Table caption alignments widths headers rows) =
173 aligncode AlignDefault = "l"
167 aligncode AlignDefault = "l"
175 caption' <- inlineListToMan opts caption
169 caption' <- inlineListToMan opts caption
176− modify (\(notes, preprocessors) -> (notes, "t":preprocessors))
170+ modify $ \st -> st{ stHasTables = True }
177 let iwidths = if all (== 0) widths
171 let iwidths = if all (== 0) widths
178 then repeat ""
172 then repeat ""
179 else map (printf "w(%0.2fn)" . (70 *)) widths
173 else map (printf "w(%0.2fn)" . (70 *)) widths
@@ -332,8 +326,9 @@ inlineToMan opts (Image alternate (source, tit)) = do
332 linkPart <- inlineToMan opts (Link txt (source, tit))
326 linkPart <- inlineToMan opts (Link txt (source, tit))
333 return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'
327 return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'
334inlineToMan _ (Note contents) = do
328inlineToMan _ (Note contents) = do
335− modify (\(notes, prep) -> (contents:notes, prep)) -- add to notes in state
329+ -- add to notes in state
330+ modify $ \st -> st{ stNotes = contents : stNotes st }
336− (notes, _) <- get
331+ notes <- liftM stNotes get
337 let ref = show $ (length notes)
332 let ref = show $ (length notes)
338 return $ char '[' <> text ref <> char ']'
333 return $ char '[' <> text ref <> char ']'