git.iko.soy/typeable/pandoc
on e9dc5aa help sign in
550 lines 22 kB history raw
1{-
2Copyright (C) 2006-8 John MacFarlane <jgm@berkeley.edu>
4This program is free software; you can redistribute it and/or modify
5it under the terms of the GNU General Public License as published by
6the Free Software Foundation; either version 2 of the License, or
7(at your option) any later version.
9This program is distributed in the hope that it will be useful,
10but WITHOUT ANY WARRANTY; without even the implied warranty of
11MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12GNU General Public License for more details.
14You should have received a copy of the GNU General Public License
15along with this program; if not, write to the Free Software
16Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17-}
19{- |
20 Module : Main
21 Copyright : Copyright (C) 2006-8 John MacFarlane
22 License : GNU GPL, version 2 or above
24 Maintainer : John MacFarlane <jgm@berkeley@edu>
25 Stability : alpha
26 Portability : portable
28Parses command-line options and calls the appropriate readers and
29writers.
30-}
31module Main where
32import Text.Pandoc
33import Text.Pandoc.UTF8
34import Text.Pandoc.Shared ( joinWithSep, HTMLMathMethod (..) )
35import Text.Pandoc.Highlighting ( languages )
36import System.Environment ( getArgs, getProgName, getEnvironment )
37import System.Exit ( exitWith, ExitCode (..) )
38import System.FilePath ( takeExtension )
39import System.Console.GetOpt
40import System.IO
41import Data.Maybe ( fromMaybe )
42import Data.Char ( toLower )
43import Control.Monad ( (>>=) )
45copyrightMessage :: String
46copyrightMessage = "\nCopyright (C) 2006-7 John MacFarlane\n\
47 \Web: http://johnmacfarlane.net/pandoc\n\
48 \This is free software; see the source for copying conditions. There is no\n\
49 \warranty, not even for merchantability or fitness for a particular purpose."
51compileOptions :: String
52compileOptions =
53 if null languages
54 then "\nCompiled without syntax highlighting support."
55 else "\nCompiled with syntax highlighting support for the following languages:\n" ++
56 (unlines $ map unwords $ chunk 5 $
57 map (\s -> s ++ replicate (15 - length s) ' ') languages)
59-- | Splits a list into groups of at most n.
60chunk :: Int -> [a] -> [[a]]
61chunk size lst =
62 let (next, rest) = splitAt size lst
63 in if null rest then [next] else next : chunk size rest
65-- | Association list of formats and readers.
66readers :: [(String, ParserState -> String -> Pandoc)]
67readers = [("native" , readPandoc)
68 ,("markdown" , readMarkdown)
69 ,("rst" , readRST)
70 ,("html" , readHtml)
71 ,("latex" , readLaTeX)
72 ]
74-- | Reader for native Pandoc format.
75readPandoc :: ParserState -> String -> Pandoc
76readPandoc _ input = read input
78-- | Association list of formats and pairs of writers and default headers.
79writers :: [ ( String, ( WriterOptions -> Pandoc -> String, String ) ) ]
80writers = [("native" , (writeDoc, ""))
81 ,("html" , (writeHtmlString, ""))
82 ,("s5" , (writeS5String, defaultS5Header))
83 ,("docbook" , (writeDocbook, defaultDocbookHeader))
84 ,("opendocument" , (writeOpenDocument, defaultOpenDocumentHeader))
85 ,("latex" , (writeLaTeX, defaultLaTeXHeader))
86 ,("context" , (writeConTeXt, defaultConTeXtHeader))
87 ,("texinfo" , (writeTexinfo, ""))
88 ,("man" , (writeMan, ""))
89 ,("markdown" , (writeMarkdown, ""))
90 ,("rst" , (writeRST, ""))
91 ,("rtf" , (writeRTF, defaultRTFHeader))
92 ]
94-- | Writer for Pandoc native format.
95writeDoc :: WriterOptions -> Pandoc -> String
96writeDoc _ = prettyPandoc
98-- | Data structure for command line options.
99data Opt = Opt
100 { optPreserveTabs :: Bool -- ^ Convert tabs to spaces
101 , optTabStop :: Int -- ^ Number of spaces per tab
102 , optStandalone :: Bool -- ^ Include header, footer
103 , optReader :: String -- ^ Reader format
104 , optWriter :: String -- ^ Writer format
105 , optParseRaw :: Bool -- ^ Parse unconvertable HTML and TeX
106 , optCSS :: [String] -- ^ CSS file to link to
107 , optTableOfContents :: Bool -- ^ Include table of contents
108 , optIncludeInHeader :: String -- ^ File to include in header
109 , optIncludeBeforeBody :: String -- ^ File to include at top of body
110 , optIncludeAfterBody :: String -- ^ File to include at end of body
111 , optCustomHeader :: String -- ^ Custom header to use, or "DEFAULT"
112 , optTitlePrefix :: String -- ^ Optional prefix for HTML title
113 , optOutputFile :: String -- ^ Name of output file
114 , optNumberSections :: Bool -- ^ Number sections in LaTeX
115 , optIncremental :: Bool -- ^ Use incremental lists in S5
116 , optSmart :: Bool -- ^ Use smart typography
117 , optHTMLMathMethod :: HTMLMathMethod -- ^ Method to print HTML math
118 , optDumpArgs :: Bool -- ^ Output command-line arguments
119 , optIgnoreArgs :: Bool -- ^ Ignore command-line arguments
120 , optStrict :: Bool -- ^ Use strict markdown syntax
121 , optReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst
122 , optWrapText :: Bool -- ^ Wrap text
123 , optSanitizeHTML :: Bool -- ^ Sanitize HTML
124 }
126-- | Defaults for command-line options.
127defaultOpts :: Opt
128defaultOpts = Opt
129 { optPreserveTabs = False
130 , optTabStop = 4
131 , optStandalone = False
132 , optReader = "" -- null for default reader
133 , optWriter = "" -- null for default writer
134 , optParseRaw = False
135 , optCSS = []
136 , optTableOfContents = False
137 , optIncludeInHeader = ""
138 , optIncludeBeforeBody = ""
139 , optIncludeAfterBody = ""
140 , optCustomHeader = "DEFAULT"
141 , optTitlePrefix = ""
142 , optOutputFile = "-" -- "-" means stdout
143 , optNumberSections = False
144 , optIncremental = False
145 , optSmart = False
146 , optHTMLMathMethod = PlainMath
147 , optDumpArgs = False
148 , optIgnoreArgs = False
149 , optStrict = False
150 , optReferenceLinks = False
151 , optWrapText = True
152 , optSanitizeHTML = False
153 }
155-- | A list of functions, each transforming the options data structure
156-- in response to a command-line option.
157options :: [OptDescr (Opt -> IO Opt)]
158options =
159 [ Option "fr" ["from","read"]
160 (ReqArg
161 (\arg opt -> return opt { optReader = map toLower arg })
162 "FORMAT")
163 "" -- ("(" ++ (joinWithSep ", " $ map fst readers) ++ ")")
165 , Option "tw" ["to","write"]
166 (ReqArg
167 (\arg opt -> return opt { optWriter = map toLower arg })
168 "FORMAT")
169 "" -- ("(" ++ (joinWithSep ", " $ map fst writers) ++ ")")
171 , Option "s" ["standalone"]
172 (NoArg
173 (\opt -> return opt { optStandalone = True }))
174 "" -- "Include needed header and footer on output"
176 , Option "o" ["output"]
177 (ReqArg
178 (\arg opt -> return opt { optOutputFile = arg })
179 "FILENAME")
180 "" -- "Name of output file"
182 , Option "p" ["preserve-tabs"]
183 (NoArg
184 (\opt -> return opt { optPreserveTabs = True }))
185 "" -- "Preserve tabs instead of converting to spaces"
187 , Option "" ["tab-stop"]
188 (ReqArg
189 (\arg opt -> return opt { optTabStop = (read arg) } )
190 "TABSTOP")
191 "" -- "Tab stop (default 4)"
193 , Option "" ["strict"]
194 (NoArg
195 (\opt -> return opt { optStrict = True } ))
196 "" -- "Disable markdown syntax extensions"
198 , Option "" ["reference-links"]
199 (NoArg
200 (\opt -> return opt { optReferenceLinks = True } ))
201 "" -- "Use reference links in parsing HTML"
203 , Option "R" ["parse-raw"]
204 (NoArg
205 (\opt -> return opt { optParseRaw = True }))
206 "" -- "Parse untranslatable HTML codes and LaTeX environments as raw"
208 , Option "S" ["smart"]
209 (NoArg
210 (\opt -> return opt { optSmart = True }))
211 "" -- "Use smart quotes, dashes, and ellipses"
213 , Option "m" ["asciimathml"]
214 (OptArg
215 (\arg opt -> return opt { optHTMLMathMethod =
216 ASCIIMathML arg })
217 "URL")
218 "" -- "Use ASCIIMathML script in html output"
220 , Option "" ["mimetex"]
221 (OptArg
222 (\arg opt -> return opt { optHTMLMathMethod = MimeTeX
223 (fromMaybe "/cgi-bin/mimetex.cgi" arg)})
224 "URL")
225 "" -- "Use mimetex for HTML math"
227 , Option "" ["gladtex"]
228 (NoArg
229 (\opt -> return opt { optHTMLMathMethod = GladTeX }))
230 "" -- "Use gladtex for HTML math"
232 , Option "i" ["incremental"]
233 (NoArg
234 (\opt -> return opt { optIncremental = True }))
235 "" -- "Make list items display incrementally in S5"
237 , Option "N" ["number-sections"]
238 (NoArg
239 (\opt -> return opt { optNumberSections = True }))
240 "" -- "Number sections in LaTeX"
242 , Option "" ["no-wrap"]
243 (NoArg
244 (\opt -> return opt { optWrapText = False }))
245 "" -- "Do not wrap text in output"
247 , Option "" ["sanitize-html"]
248 (NoArg
249 (\opt -> return opt { optSanitizeHTML = True }))
250 "" -- "Sanitize HTML"
252 , Option "" ["toc", "table-of-contents"]
253 (NoArg
254 (\opt -> return opt { optTableOfContents = True }))
255 "" -- "Include table of contents"
257 , Option "c" ["css"]
258 (ReqArg
259 (\arg opt -> do
260 let old = optCSS opt
261 return opt { optCSS = old ++ [arg],
262 optStandalone = True })
263 "CSS")
264 "" -- "Link to CSS style sheet"
266 , Option "H" ["include-in-header"]
267 (ReqArg
268 (\arg opt -> do
269 let old = optIncludeInHeader opt
270 text <- readFile arg
271 return opt { optIncludeInHeader = old ++ fromUTF8 text,
272 optStandalone = True })
273 "FILENAME")
274 "" -- "File to include at end of header (implies -s)"
276 , Option "B" ["include-before-body"]
277 (ReqArg
278 (\arg opt -> do
279 let old = optIncludeBeforeBody opt
280 text <- readFile arg
281 return opt { optIncludeBeforeBody = old ++ fromUTF8 text })
282 "FILENAME")
283 "" -- "File to include before document body"
285 , Option "A" ["include-after-body"]
286 (ReqArg
287 (\arg opt -> do
288 let old = optIncludeAfterBody opt
289 text <- readFile arg
290 return opt { optIncludeAfterBody = old ++ fromUTF8 text })
291 "FILENAME")
292 "" -- "File to include after document body"
294 , Option "C" ["custom-header"]
295 (ReqArg
296 (\arg opt -> do
297 text <- readFile arg
298 return opt { optCustomHeader = fromUTF8 text,
299 optStandalone = True })
300 "FILENAME")
301 "" -- "File to use for custom header (implies -s)"
303 , Option "T" ["title-prefix"]
304 (ReqArg
305 (\arg opt -> return opt { optTitlePrefix = arg,
306 optStandalone = True })
307 "STRING")
308 "" -- "String to prefix to HTML window title"
310 , Option "D" ["print-default-header"]
311 (ReqArg
312 (\arg _ -> do
313 let header = case (lookup arg writers) of
314 Just (_, h) -> h
315 Nothing -> error ("Unknown reader: " ++ arg)
316 hPutStr stdout header
317 exitWith ExitSuccess)
318 "FORMAT")
319 "" -- "Print default header for FORMAT"
321 , Option "" ["dump-args"]
322 (NoArg
323 (\opt -> return opt { optDumpArgs = True }))
324 "" -- "Print output filename and arguments to stdout."
326 , Option "" ["ignore-args"]
327 (NoArg
328 (\opt -> return opt { optIgnoreArgs = True }))
329 "" -- "Ignore command-line arguments."
331 , Option "v" ["version"]
332 (NoArg
333 (\_ -> do
334 prg <- getProgName
335 hPutStrLn stderr (prg ++ " " ++ pandocVersion ++ compileOptions ++
336 copyrightMessage)
337 exitWith $ ExitFailure 4))
338 "" -- "Print version"
340 , Option "h" ["help"]
341 (NoArg
342 (\_ -> do
343 prg <- getProgName
344 hPutStr stderr (usageMessage prg options)
345 exitWith $ ExitFailure 2))
346 "" -- "Show help"
347 ]
349-- Returns usage message
350usageMessage :: String -> [OptDescr (Opt -> IO Opt)] -> String
351usageMessage programName opts = usageInfo
352 (programName ++ " [OPTIONS] [FILES]" ++ "\nInput formats: " ++
353 (joinWithSep ", " $ map fst readers) ++ "\nOutput formats: " ++
354 (joinWithSep ", " $ map fst writers) ++ "\nOptions:")
355 opts
357-- Determine default reader based on source file extensions
358defaultReaderName :: [FilePath] -> String
359defaultReaderName [] = "markdown"
360defaultReaderName (x:xs) =
361 case takeExtension (map toLower x) of
362 ".xhtml" -> "html"
363 ".html" -> "html"
364 ".htm" -> "html"
365 ".tex" -> "latex"
366 ".latex" -> "latex"
367 ".ltx" -> "latex"
368 ".rst" -> "rst"
369 ".native" -> "native"
370 _ -> defaultReaderName xs
372-- Determine default writer based on output file extension
373defaultWriterName :: FilePath -> String
374defaultWriterName "-" = "html" -- no output file
375defaultWriterName x =
376 case takeExtension (map toLower x) of
377 "" -> "markdown" -- empty extension
378 ".tex" -> "latex"
379 ".latex" -> "latex"
380 ".ltx" -> "latex"
381 ".context" -> "context"
382 ".ctx" -> "context"
383 ".rtf" -> "rtf"
384 ".rst" -> "rst"
385 ".s5" -> "s5"
386 ".native" -> "native"
387 ".txt" -> "markdown"
388 ".text" -> "markdown"
389 ".md" -> "markdown"
390 ".markdown" -> "markdown"
391 ".texi" -> "texinfo"
392 ".texinfo" -> "texinfo"
393 ".db" -> "docbook"
394 ".xml" -> "docbook"
395 ".sgml" -> "docbook"
396 ['.',y] | y `elem` ['1'..'9'] -> "man"
397 _ -> "html"
399main :: IO ()
400main = do
402 rawArgs <- getArgs
403 prg <- getProgName
404 let compatMode = (prg == "hsmarkdown")
406 let (actions, args, errors) = if compatMode
407 then ([], rawArgs, [])
408 else getOpt Permute options rawArgs
410 if (not (null errors))
411 then do
412 name <- getProgName
413 mapM (\e -> hPutStrLn stderr e) errors
414 hPutStr stderr (usageMessage name options)
415 exitWith $ ExitFailure 2
416 else
417 return ()
419 let defaultOpts' = if compatMode
420 then defaultOpts { optReader = "markdown"
421 , optWriter = "html"
422 , optStrict = True }
423 else defaultOpts
425 -- thread option data structure through all supplied option actions
426 opts <- foldl (>>=) (return defaultOpts') actions
428 let Opt { optPreserveTabs = preserveTabs
429 , optTabStop = tabStop
430 , optStandalone = standalone
431 , optReader = readerName
432 , optWriter = writerName
433 , optParseRaw = parseRaw
434 , optCSS = css
435 , optTableOfContents = toc
436 , optIncludeInHeader = includeHeader
437 , optIncludeBeforeBody = includeBefore
438 , optIncludeAfterBody = includeAfter
439 , optCustomHeader = customHeader
440 , optTitlePrefix = titlePrefix
441 , optOutputFile = outputFile
442 , optNumberSections = numberSections
443 , optIncremental = incremental
444 , optSmart = smart
445 , optHTMLMathMethod = mathMethod
446 , optDumpArgs = dumpArgs
447 , optIgnoreArgs = ignoreArgs
448 , optStrict = strict
449 , optReferenceLinks = referenceLinks
450 , optWrapText = wrap
451 , optSanitizeHTML = sanitize
452 } = opts
454 if dumpArgs
455 then do
456 hPutStrLn stdout outputFile
457 mapM (\arg -> hPutStrLn stdout arg) args
458 exitWith $ ExitSuccess
459 else return ()
461 let sources = if ignoreArgs then [] else args
463 -- assign reader and writer based on options and filenames
464 let readerName' = if null readerName
465 then defaultReaderName sources
466 else readerName
468 let writerName' = if null writerName
469 then defaultWriterName outputFile
470 else writerName
472 reader <- case (lookup readerName' readers) of
473 Just r -> return r
474 Nothing -> error ("Unknown reader: " ++ readerName')
476 (writer, defaultHeader) <- case (lookup writerName' writers) of
477 Just (w,h) -> return (w, h)
478 Nothing -> error ("Unknown writer: " ++ writerName')
480 output <- if (outputFile == "-")
481 then return stdout
482 else openFile outputFile WriteMode
484 environment <- getEnvironment
485 let columns = case lookup "COLUMNS" environment of
486 Just cols -> read cols
487 Nothing -> stateColumns defaultParserState
489 let tabFilter _ [] = ""
490 tabFilter _ ('\n':xs) = '\n':(tabFilter tabStop xs)
491 -- remove DOS line endings
492 tabFilter _ ('\r':'\n':xs) = '\n':(tabFilter tabStop xs)
493 tabFilter _ ('\r':xs) = '\n':(tabFilter tabStop xs)
494 tabFilter spsToNextStop ('\t':xs) =
495 if preserveTabs
496 then '\t':(tabFilter tabStop xs)
497 else replicate spsToNextStop ' ' ++ tabFilter tabStop xs
498 tabFilter 1 (x:xs) =
499 x:(tabFilter tabStop xs)
500 tabFilter spsToNextStop (x:xs) =
501 x:(tabFilter (spsToNextStop - 1) xs)
503 let startParserState =
504 defaultParserState { stateParseRaw = parseRaw,
505 stateTabStop = tabStop,
506 stateSanitizeHTML = sanitize,
507 stateStandalone = standalone && (not strict),
508 stateSmart = smart || writerName' `elem`
509 ["latex", "context"],
510 stateColumns = columns,
511 stateStrict = strict }
512 let csslink = if null css
513 then ""
514 else concatMap
515 (\f -> "<link rel=\"stylesheet\" href=\"" ++
516 f ++ "\" type=\"text/css\" media=\"all\" />\n")
517 css
518 let header = (if (customHeader == "DEFAULT")
519 then defaultHeader
520 else customHeader) ++ csslink ++ includeHeader
521 let writerOptions = WriterOptions { writerStandalone = standalone &&
522 (not strict),
523 writerHeader = header,
524 writerTitlePrefix = titlePrefix,
525 writerTabStop = tabStop,
526 writerTableOfContents = toc &&
527 (not strict) &&
528 writerName/="s5",
529 writerHTMLMathMethod = mathMethod,
530 writerS5 = (writerName=="s5"),
531 writerIgnoreNotes = False,
532 writerIncremental = incremental,
533 writerNumberSections = numberSections,
534 writerIncludeBefore = includeBefore,
535 writerIncludeAfter = includeAfter,
536 writerStrictMarkdown = strict,
537 writerReferenceLinks = referenceLinks,
538 writerWrapText = wrap }
540 (readSources sources) >>= (hPutStrLn output . toUTF8 .
541 (writer writerOptions) .
542 (reader startParserState) . tabFilter tabStop .
543 fromUTF8 . (joinWithSep "\n")) >>
544 hClose output
546 where
547 readSources [] = mapM readSource ["-"]
548 readSources sources = mapM readSource sources
549 readSource "-" = getContents
550 readSource source = readFile source