@@ -0,0 +1,263 @@
1+{-
2+Copyright (C) 2006 John MacFarlane <jgm at berkeley dot edu>
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Writers.Man
21+ Copyright : Copyright (C) 2006 John MacFarlane
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
25+ Stability : alpha
26+ Portability : portable
27+
28+Conversion of 'Pandoc' documents to groff man page format.
29+
30+-}
31+module Text.Pandoc.Writers.Man (
32+ writeMan
33+ ) where
34+import Text.Pandoc.Definition
35+import Text.Pandoc.Shared
36+import Data.Char ( toUpper )
37+import Data.List ( group, isPrefixOf, drop, find )
38+import Text.PrettyPrint.HughesPJ hiding ( Str )
39+import Control.Monad.State
40+
41+type Notes = [[Block]]
42+type WriterState = Notes
43+
44+-- | Convert Pandoc to Man.
45+writeMan :: WriterOptions -> Pandoc -> String
46+writeMan opts document =
47+ render $ evalState (pandocToMan opts document) []
48+
49+-- | Return groff man representation of document.
50+pandocToMan :: WriterOptions -> Pandoc -> State WriterState Doc
51+pandocToMan opts (Pandoc meta blocks) = do
52+ let before = writerIncludeBefore opts
53+ let after = writerIncludeAfter opts
54+ before' = if null before then empty else text before
55+ after' = if null after then empty else text after
56+ (head, foot) <- metaToMan opts meta
57+ body <- blockListToMan opts blocks
58+ notes <- get
59+ notes' <- notesToMan opts (reverse notes)
60+ return $ head $$ before' $$ body $$ notes' $$ foot $$ after'
61+
62+-- | Insert bibliographic information into Man header and footer.
63+metaToMan :: WriterOptions -- ^ Options, including Man header
64+ -> Meta -- ^ Meta with bibliographic information
65+ -> State WriterState (Doc, Doc)
66+metaToMan options (Meta title authors date) = do
67+ title' <- inlineListToMan options title
68+ let head = (text ".TH \"") <> title' <> text ("\" 1 \"" ++ date ++
69+ "\" \"") <> title' <> text ("\" \"User Manuals\"")
70+ let foot = case length authors of
71+ 0 -> text $ ""
72+ 1 -> text $ ".SH AUTHOR\n" ++ joinWithSep "\n" authors
73+ 2 -> text $ ".SH AUTHORS\n" ++ joinWithSep "\n" authors
74+ return $ if writerStandalone options
75+ then (head, foot)
76+ else (empty, empty)
77+
78+-- | Return man representation of notes.
79+notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc
80+notesToMan opts notes =
81+ if null notes
82+ then return empty
83+ else mapM (\(num, note) -> noteToMan opts num note) (zip [1..] notes) >>=
84+ (return . (text ".SH NOTES\n" <>) . vcat)
85+
86+-- | Return man representation of a note.
87+noteToMan :: WriterOptions -> Int -> [Block] -> State WriterState Doc
88+noteToMan opts num note = do
89+ contents <- blockListToMan opts note
90+ let marker = text "\n.SS [" <> text (show num) <> text "]"
91+ return $ marker $$ contents
92+
93+wrappedMan :: WriterOptions -> [Inline] -> State WriterState Doc
94+wrappedMan opts sect = do
95+ let chunks = splitBy Space sect
96+ chunks' <- mapM (inlineListToMan opts) chunks
97+ return $ fsep chunks'
98+
99+-- | Escape nonbreaking space as \
100+escapeNbsp "" = ""
101+escapeNbsp ('\160':xs) = "\\ " ++ escapeNbsp xs
102+escapeNbsp str =
103+ let (a,b) = break (=='\160') str in
104+ a ++ escapeNbsp b
105+
106+-- | Escape special characters for Man.
107+escapeString :: String -> String
108+escapeString = escapeNbsp . backslashEscape "-\\"
109+
110+-- | Escape a literal (code) section for Man.
111+escapeCode :: String -> String
112+escapeCode = backslashEscape "-\\\t "
113+
114+-- | Convert Pandoc block element to man.
115+blockToMan :: WriterOptions -- ^ Options
116+ -> Block -- ^ Block element
117+ -> State WriterState Doc
118+blockToMan opts Null = return empty
119+blockToMan opts (Plain inlines) = wrappedMan opts inlines
120+blockToMan opts (Para inlines) = do
121+ contents <- wrappedMan opts inlines
122+ return $ text "\n.PP" $$ contents
123+blockToMan opts (RawHtml str) = return $ text str
124+blockToMan opts HorizontalRule = return $ text $ "\n.PP\n" ++ " * * * * *"
125+blockToMan opts (Header level inlines) = do
126+ contents <- inlineListToMan opts inlines
127+ let heading = case level of
128+ 1 -> "\n.SH "
129+ _ -> "\n.SS "
130+ return $ text heading <> contents
131+blockToMan opts (CodeBlock str) = return $
132+ text "\n\\f[B]" $$ text ((unlines . map (" " ++) . lines) (escapeCode str)) <>
133+ text "\\f[]"
134+blockToMan opts (BlockQuote blocks) = do
135+ contents <- blockListToMan opts blocks
136+ return $ text "\n.RS" $$ contents $$ text "\n.RE"
137+blockToMan opts (Table caption _ _ headers rows) = blockToMan opts
138+ (Para [Str "pandoc: TABLE unsupported in Man writer"])
139+
140+blockToMan opts (BulletList items) = do
141+ contents <- mapM (bulletListItemToMan opts) items
142+ return (vcat contents)
143+blockToMan opts (OrderedList items) = do
144+ contents <- mapM (\(item, num) -> orderedListItemToMan opts item num) $
145+ zip [1..] items
146+ return (vcat contents)
147+blockToMan opts (DefinitionList items) = do
148+ contents <- mapM (definitionListItemToMan opts) items
149+ return (vcat contents)
150+
151+-- | Convert bullet list item (list of blocks) to man.
152+bulletListItemToMan :: WriterOptions -> [Block] -> State WriterState Doc
153+bulletListItemToMan opts [] = return empty
154+bulletListItemToMan opts ((Para first):rest) =
155+ bulletListItemToMan opts ((Plain first):rest)
156+bulletListItemToMan opts ((Plain first):rest) = do
157+ first' <- blockToMan opts (Plain first)
158+ rest' <- blockListToMan opts rest
159+ let first'' = text "\n.IP \\[bu] 2" $$ first'
160+ let rest'' = if null rest
161+ then empty
162+ else text "\n.RS 2" $$ rest' $$ text "\n.RE"
163+ return (first'' $$ rest'')
164+bulletListItemToMan opts (first:rest) = do
165+ first' <- blockToMan opts first
166+ rest' <- blockListToMan opts rest
167+ return $ text "\n\\[bu] \n.RS 2" $$ first' $$ rest' $$ text "\n.RE"
168+
169+-- | Convert ordered list item (a list of blocks) to man.
170+orderedListItemToMan :: WriterOptions -- ^ options
171+ -> Int -- ^ ordinal number of list item
172+ -> [Block] -- ^ list item (list of blocks)
173+ -> State WriterState Doc
174+orderedListItemToMan _ _ [] = return empty
175+orderedListItemToMan opts num ((Para first):rest) =
176+ orderedListItemToMan opts num ((Plain first):rest)
177+orderedListItemToMan opts num ((Plain first):rest) = do
178+ first' <- blockToMan opts (Plain first)
179+ rest' <- blockListToMan opts rest
180+ let first'' = text ("\n.IP " ++ show num ++ "." ++ " 4") $$ first'
181+ let rest'' = if null rest
182+ then text "\n"
183+ else text "\n.RS 4" $$ rest' $$ text "\n.RE"
184+ return (first'' $$ rest'')
185+orderedListItemToMan opts num (first:rest) = do
186+ first' <- blockToMan opts first
187+ rest' <- blockListToMan opts rest
188+ return $ text ("\n.IP " ++ show num ++ "." ++ " 4") $$ first' $$
189+ rest' $$ text "\n.RE"
190+
191+-- | Convert definition list item (label, list of blocks) to man.
192+definitionListItemToMan :: WriterOptions
193+ -> ([Inline],[Block])
194+ -> State WriterState Doc
195+definitionListItemToMan opts (label, items) = do
196+ labelText <- inlineListToMan opts label
197+ contents <- if null items
198+ then return empty
199+ else do
200+ let (first, rest) = case items of
201+ ((Para x):y) -> (Plain x,y)
202+ (x:y) -> (x,y)
203+ rest' <- mapM (\item -> blockToMan opts item)
204+ rest >>= (return . vcat)
205+ first' <- blockToMan opts first
206+ return $ first' $$ text "\n.RS" $$ rest' $$ text "\n.RE"
207+ return $ text "\n.TP\n.B " <> labelText $+$ contents
208+
209+-- | Convert list of Pandoc block elements to man.
210+blockListToMan :: WriterOptions -- ^ Options
211+ -> [Block] -- ^ List of block elements
212+ -> State WriterState Doc
213+blockListToMan opts blocks =
214+ mapM (blockToMan opts) blocks >>= (return . vcat)
215+
216+-- | Convert list of Pandoc inline elements to man.
217+inlineListToMan :: WriterOptions -> [Inline] -> State WriterState Doc
218+inlineListToMan opts lst = mapM (inlineToMan opts) lst >>= (return . hcat)
219+
220+-- | Convert Pandoc inline element to man.
221+inlineToMan :: WriterOptions -> Inline -> State WriterState Doc
222+inlineToMan opts (Emph lst) = do
223+ contents <- inlineListToMan opts lst
224+ return $ text "\\f[I]" <> contents <> text "\\f[]"
225+inlineToMan opts (Strong lst) = do
226+ contents <- inlineListToMan opts lst
227+ return $ text "\\f[B]" <> contents <> text "\\f[]"
228+inlineToMan opts (Quoted SingleQuote lst) = do
229+ contents <- inlineListToMan opts lst
230+ return $ char '`' <> contents <> char '\''
231+inlineToMan opts (Quoted DoubleQuote lst) = do
232+ contents <- inlineListToMan opts lst
233+ return $ text "\\[lq]" <> contents <> text "\\[rq]"
234+inlineToMan opts EmDash = return $ text "\\[em]"
235+inlineToMan opts EnDash = return $ text "\\[en]"
236+inlineToMan opts Apostrophe = return $ char '\''
237+inlineToMan opts Ellipses = return $ text "\\&..."
238+inlineToMan opts (Code str) =
239+ return $ text $ "\\f[B]" ++ escapeCode str ++ "\\f[]"
240+inlineToMan opts (Str str) = return $ text $ escapeString str
241+inlineToMan opts (TeX str) = return $ text $ escapeCode str
242+inlineToMan opts (HtmlInline str) = return $ text $ escapeCode str
243+inlineToMan opts (LineBreak) = return $ text "\n.P\n"
244+inlineToMan opts Space = return $ char ' '
245+inlineToMan opts (Link txt (src, _)) = do
246+ linktext <- inlineListToMan opts txt
247+ let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
248+ return $ if txt == [Str srcSuffix]
249+ then char '<' <> text srcSuffix <> char '>'
250+ else linktext <> text " (" <> text src <> char ')'
251+inlineToMan opts (Image alternate (source, tit)) = do
252+ let txt = if (null alternate) || (alternate == [Str ""]) ||
253+ (alternate == [Str source]) -- to prevent autolinks
254+ then [Str "image"]
255+ else alternate
256+ linkPart <- inlineToMan opts (Link txt (source, tit))
257+ return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'
258+inlineToMan opts (Note contents) = do
259+ modify (\notes -> contents:notes) -- add to notes in state
260+ notes <- get
261+ let ref = show $ (length notes)
262+ return $ text "[^" <> text ref <> char ']'
263+