1{-# LANGUAGE CPP                 #-}
2{-# LANGUAGE LambdaCase          #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE TupleSections       #-}
5{-# LANGUAGE OverloadedStrings   #-}
6{-# LANGUAGE FlexibleContexts    #-}
7{- |
8   Module      : Text.Pandoc.App.CommandLineOptions
9   Copyright   : Copyright (C) 2006-2021 John MacFarlane
10   License     : GNU GPL, version 2 or above
11
12   Maintainer  : John MacFarlane <jgm@berkeley@edu>
13   Stability   : alpha
14   Portability : portable
15
16Does a pandoc conversion based on command-line options.
17-}
18module Text.Pandoc.App.CommandLineOptions (
19            parseOptions
20          , options
21          , engines
22          , lookupHighlightStyle
23          , setVariable
24          ) where
25import Control.Monad
26import Control.Monad.Trans
27import Control.Monad.Except (throwError)
28import Control.Monad.State.Strict
29import Data.Aeson.Encode.Pretty (encodePretty', Config(..), keyOrder,
30         defConfig, Indent(..), NumberFormat(..))
31import Data.Bifunctor (second)
32import Data.Char (toLower)
33import Data.List (intercalate, sort)
34#ifdef _WINDOWS
35#if MIN_VERSION_base(4,12,0)
36import Data.List (isPrefixOf)
37#endif
38#endif
39import Data.Maybe (fromMaybe, isJust)
40import Data.Text (Text)
41import Safe (tailDef)
42import Skylighting (Style, Syntax (..), defaultSyntaxMap, parseTheme)
43import System.Console.GetOpt
44import System.Environment (getArgs, getProgName)
45import System.Exit (exitSuccess)
46import System.FilePath
47import System.IO (stdout)
48import Text.DocTemplates (Context (..), ToContext (toVal), Val (..))
49import Text.Pandoc
50import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), IpynbOutput (..),
51                            DefaultsState (..), addMeta, applyDefaults,
52                            fullDefaultsPath)
53import Text.Pandoc.Filter (Filter (..))
54import Text.Pandoc.Highlighting (highlightingStyles)
55import Text.Pandoc.Shared (ordNub, elemText, safeStrRead, defaultUserDataDirs)
56import Text.Printf
57
58#ifdef EMBED_DATA_FILES
59import Text.Pandoc.Data (dataFiles)
60#else
61import Paths_pandoc (getDataDir)
62import System.Directory (getDirectoryContents)
63#endif
64
65import qualified Control.Exception as E
66import qualified Data.ByteString as BS
67import qualified Data.ByteString.Lazy as B
68import qualified Data.Map as M
69import qualified Data.Text as T
70import qualified Text.Pandoc.UTF8 as UTF8
71
72parseOptions :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt
73parseOptions options' defaults = do
74  rawArgs <- map UTF8.decodeArg <$> getArgs
75  prg <- getProgName
76
77  let (actions, args, unrecognizedOpts, errors) =
78           getOpt' Permute options' rawArgs
79
80  let unknownOptionErrors =
81       foldr (handleUnrecognizedOption . takeWhile (/= '=')) []
82       unrecognizedOpts
83
84  unless (null errors && null unknownOptionErrors) $
85     E.throwIO $ PandocOptionError $ T.pack $
86        concat errors ++ unlines unknownOptionErrors ++
87        ("Try " ++ prg ++ " --help for more information.")
88
89  -- thread option data structure through all supplied option actions
90  opts <- foldl (>>=) (return defaults) actions
91  let mbArgs = case args of
92                 [] -> Nothing
93                 xs -> Just xs
94  return $ opts{ optInputFiles =
95                   map normalizePath <$> (optInputFiles opts <> mbArgs)
96               , optStandalone = -- certain other options imply standalone
97                   optStandalone opts ||
98                     isJust (optTemplate opts) ||
99                     optSelfContained opts ||
100                     not (null (optIncludeInHeader opts)) ||
101                     not (null (optIncludeBeforeBody opts)) ||
102                     not (null (optIncludeAfterBody opts)) }
103
104latexEngines :: [String]
105latexEngines  = ["pdflatex", "lualatex", "xelatex", "latexmk", "tectonic"]
106
107htmlEngines :: [String]
108htmlEngines  = ["wkhtmltopdf", "weasyprint", "prince"]
109
110engines :: [(Text, String)]
111engines = map ("html",) htmlEngines ++
112          map ("html5",) htmlEngines ++
113          map ("latex",) latexEngines ++
114          map ("beamer",) latexEngines ++
115          [ ("ms", "pdfroff")
116          , ("context", "context")
117          ]
118
119pdfEngines :: [String]
120pdfEngines = ordNub $ map snd engines
121
122-- | A list of functions, each transforming the options data structure
123--   in response to a command-line option.
124options :: [OptDescr (Opt -> IO Opt)]
125options =
126    [ Option "fr" ["from","read"]
127                 (ReqArg
128                  (\arg opt -> return opt { optFrom =
129                                              Just (T.toLower $ T.pack arg) })
130                  "FORMAT")
131                 ""
132
133    , Option "tw" ["to","write"]
134                 (ReqArg
135                  (\arg opt -> return opt { optTo = Just $ T.pack arg })
136                  "FORMAT")
137                 ""
138
139    , Option "o" ["output"]
140                 (ReqArg
141                  (\arg opt -> return opt { optOutputFile =
142                                             Just (normalizePath arg) })
143                  "FILE")
144                 "" -- "Name of output file"
145
146    , Option "" ["data-dir"]
147                 (ReqArg
148                  (\arg opt -> return opt { optDataDir =
149                                  Just (normalizePath arg) })
150                 "DIRECTORY") -- "Directory containing pandoc data files."
151                ""
152
153    , Option "M" ["metadata"]
154                 (ReqArg
155                  (\arg opt -> do
156                     let (key, val) = splitField arg
157                     return opt{ optMetadata = addMeta key val $
158                                                 optMetadata opt })
159                  "KEY[:VALUE]")
160                 ""
161
162    , Option "" ["metadata-file"]
163                 (ReqArg
164                  (\arg opt -> return opt{ optMetadataFiles =
165                      optMetadataFiles opt ++ [normalizePath arg] })
166                  "FILE")
167                 ""
168
169    , Option "d" ["defaults"]
170                 (ReqArg
171                  (\arg opt -> runIOorExplode $ do
172                     let defsState = DefaultsState { curDefaults = Nothing,
173                                                     inheritanceGraph = [] }
174                     fp <- fullDefaultsPath (optDataDir opt) arg
175                     evalStateT (applyDefaults opt fp) defsState
176                  )
177                  "FILE")
178                ""
179
180    , Option "" ["file-scope"]
181                 (NoArg
182                  (\opt -> return opt { optFileScope = True }))
183                 "" -- "Parse input files before combining"
184
185    , Option "s" ["standalone"]
186                 (NoArg
187                  (\opt -> return opt { optStandalone = True }))
188                 "" -- "Include needed header and footer on output"
189
190    , Option "" ["template"]
191                 (ReqArg
192                  (\arg opt ->
193                     return opt{ optTemplate = Just (normalizePath arg) })
194                  "FILE")
195                 "" -- "Use custom template"
196
197    , Option "V" ["variable"]
198                 (ReqArg
199                  (\arg opt -> do
200                     let (key, val) = splitField arg
201                     return opt{ optVariables =
202                                  setVariable (T.pack key) (T.pack val) $
203                                    optVariables opt })
204                  "KEY[:VALUE]")
205                 ""
206
207    , Option "" ["wrap"]
208                 (ReqArg
209                  (\arg opt ->
210                    case arg of
211                      "auto" -> return opt{ optWrap = WrapAuto }
212                      "none" -> return opt{ optWrap = WrapNone }
213                      "preserve" -> return opt{ optWrap = WrapPreserve }
214                      _      -> E.throwIO $ PandocOptionError
215                                 "--wrap must be auto, none, or preserve")
216                 "auto|none|preserve")
217                 "" -- "Option for wrapping text in output"
218
219    , Option "" ["ascii"]
220                 (NoArg
221                  (\opt -> return opt { optAscii = True }))
222                 ""  -- "Prefer ASCII output"
223
224    , Option "" ["toc", "table-of-contents"]
225                (NoArg
226                 (\opt -> return opt { optTableOfContents = True }))
227               "" -- "Include table of contents"
228
229    , Option "" ["toc-depth"]
230                 (ReqArg
231                  (\arg opt ->
232                      case safeStrRead arg of
233                           Just t | t >= 1 && t <= 6 ->
234                                    return opt { optTOCDepth = t }
235                           _ -> E.throwIO $ PandocOptionError
236                                "TOC level must be a number 1-6")
237                 "NUMBER")
238                 "" -- "Number of levels to include in TOC"
239
240    , Option "N" ["number-sections"]
241                 (NoArg
242                  (\opt -> return opt { optNumberSections = True }))
243                 "" -- "Number sections"
244
245    , Option "" ["number-offset"]
246                 (ReqArg
247                  (\arg opt ->
248                      case safeStrRead ("[" <> arg <> "]") of
249                           Just ns -> return opt { optNumberOffset = ns,
250                                                   optNumberSections = True }
251                           _      -> E.throwIO $ PandocOptionError
252                                       "could not parse number-offset")
253                 "NUMBERS")
254                 "" -- "Starting number for sections, subsections, etc."
255
256    , Option "" ["top-level-division"]
257                 (ReqArg
258                  (\arg opt ->
259                      case arg of
260                        "section" -> return opt{ optTopLevelDivision =
261                                        TopLevelSection }
262                        "chapter" -> return opt{ optTopLevelDivision =
263                                        TopLevelChapter }
264                        "part"    -> return opt{ optTopLevelDivision =
265                                        TopLevelPart }
266                        "default" -> return opt{ optTopLevelDivision =
267                                        TopLevelDefault }
268                        _ -> E.throwIO $ PandocOptionError $
269                                "Top-level division must be " <>
270                                "section,  chapter, part, or default" )
271                   "section|chapter|part")
272                 "" -- "Use top-level division type in LaTeX, ConTeXt, DocBook"
273
274    , Option "" ["extract-media"]
275                 (ReqArg
276                  (\arg opt ->
277                    return opt { optExtractMedia =
278                                  Just (normalizePath arg) })
279                  "PATH")
280                 "" -- "Directory to which to extract embedded media"
281
282    , Option "" ["resource-path"]
283                (ReqArg
284                  (\arg opt -> return opt { optResourcePath =
285                                   splitSearchPath arg })
286                   "SEARCHPATH")
287                  "" -- "Paths to search for images and other resources"
288
289    , Option "H" ["include-in-header"]
290                 (ReqArg
291                  (\arg opt -> return opt{ optIncludeInHeader =
292                                             optIncludeInHeader opt ++
293                                             [normalizePath arg] })
294                  "FILE")
295                 "" -- "File to include at end of header (implies -s)"
296
297    , Option "B" ["include-before-body"]
298                 (ReqArg
299                  (\arg opt -> return opt{ optIncludeBeforeBody =
300                                            optIncludeBeforeBody opt ++
301                                            [normalizePath arg] })
302                  "FILE")
303                 "" -- "File to include before document body"
304
305    , Option "A" ["include-after-body"]
306                 (ReqArg
307                  (\arg opt -> return opt{ optIncludeAfterBody =
308                                            optIncludeAfterBody opt ++
309                                            [normalizePath arg] })
310                  "FILE")
311                 "" -- "File to include after document body"
312
313    , Option "" ["no-highlight"]
314                (NoArg
315                 (\opt -> return opt { optHighlightStyle = Nothing }))
316                 "" -- "Don't highlight source code"
317
318    , Option "" ["highlight-style"]
319                (ReqArg
320                 (\arg opt ->
321                     return opt{ optHighlightStyle = Just $
322                                 T.pack $ normalizePath arg })
323                 "STYLE|FILE")
324                 "" -- "Style for highlighted code"
325
326    , Option "" ["syntax-definition"]
327                (ReqArg
328                 (\arg opt -> do
329                   let tr c d = map (\x -> if x == c then d else x)
330                   let arg' = case arg of -- see #4836
331                                   -- HXT confuses Windows path with URI
332                                   _:':':'\\':_ ->
333                                       "file:///" ++ tr '\\' '/' arg
334                                   _ -> normalizePath arg
335                   return opt{ optSyntaxDefinitions = arg' :
336                                optSyntaxDefinitions opt })
337                 "FILE")
338                "" -- "Syntax definition (xml) file"
339
340    , Option "" ["dpi"]
341                 (ReqArg
342                  (\arg opt ->
343                    case safeStrRead arg of
344                         Just t | t > 0 -> return opt { optDpi = t }
345                         _              -> E.throwIO $ PandocOptionError
346                                        "dpi must be a number greater than 0")
347                  "NUMBER")
348                 "" -- "Dpi (default 96)"
349
350    , Option "" ["eol"]
351                 (ReqArg
352                  (\arg opt ->
353                    case toLower <$> arg of
354                      "crlf"   -> return opt { optEol = CRLF }
355                      "lf"     -> return opt { optEol = LF }
356                      "native" -> return opt { optEol = Native }
357                      -- mac-syntax (cr) is not supported in ghc-base.
358                      _      -> E.throwIO $ PandocOptionError
359                                "--eol must be crlf, lf, or native")
360                  "crlf|lf|native")
361                 "" -- "EOL (default OS-dependent)"
362
363    , Option "" ["columns"]
364                 (ReqArg
365                  (\arg opt ->
366                      case safeStrRead arg of
367                           Just t | t > 0 -> return opt { optColumns = t }
368                           _              -> E.throwIO $ PandocOptionError
369                                   "columns must be a number greater than 0")
370                 "NUMBER")
371                 "" -- "Length of line in characters"
372
373    , Option "p" ["preserve-tabs"]
374                 (NoArg
375                  (\opt -> return opt { optPreserveTabs = True }))
376                 "" -- "Preserve tabs instead of converting to spaces"
377
378    , Option "" ["tab-stop"]
379                 (ReqArg
380                  (\arg opt ->
381                      case safeStrRead arg of
382                           Just t | t > 0 -> return opt { optTabStop = t }
383                           _              -> E.throwIO $ PandocOptionError
384                                  "tab-stop must be a number greater than 0")
385                  "NUMBER")
386                 "" -- "Tab stop (default 4)"
387
388    , Option "" ["pdf-engine"]
389                 (ReqArg
390                  (\arg opt -> do
391                     let b = takeBaseName arg
392                     if b `elem` pdfEngines
393                        then return opt { optPdfEngine = Just arg }
394                        else E.throwIO $ PandocOptionError $ T.pack $ "pdf-engine must be one of "
395                               ++ intercalate ", " pdfEngines)
396                  "PROGRAM")
397                 "" -- "Name of program to use in generating PDF"
398
399    , Option "" ["pdf-engine-opt"]
400                 (ReqArg
401                  (\arg opt -> do
402                      let oldArgs = optPdfEngineOpts opt
403                      return opt { optPdfEngineOpts = oldArgs ++ [arg]})
404                  "STRING")
405                 "" -- "Flags to pass to the PDF-engine, all instances of this option are accumulated and used"
406
407    , Option "" ["reference-doc"]
408                 (ReqArg
409                  (\arg opt ->
410                    return opt { optReferenceDoc = Just $ normalizePath arg })
411                  "FILE")
412                 "" -- "Path of custom reference doc"
413
414    , Option "" ["self-contained"]
415                 (NoArg
416                  (\opt -> return opt { optSelfContained = True }))
417                 "" -- "Make slide shows include all the needed js and css"
418
419    , Option "" ["request-header"]
420                 (ReqArg
421                  (\arg opt -> do
422                     let (key, val) = splitField arg
423                     return opt{ optRequestHeaders =
424                       (T.pack key, T.pack val) : optRequestHeaders opt })
425                  "NAME:VALUE")
426                 ""
427
428    , Option "" ["no-check-certificate"]
429                (NoArg
430                 (\opt -> return opt { optNoCheckCertificate = True }))
431                "" -- "Disable certificate validation"
432
433    , Option "" ["abbreviations"]
434                (ReqArg
435                 (\arg opt -> return opt { optAbbreviations =
436                                            Just $ normalizePath arg })
437                "FILE")
438                "" -- "Specify file for custom abbreviations"
439
440    , Option "" ["indented-code-classes"]
441                  (ReqArg
442                   (\arg opt -> return opt { optIndentedCodeClasses = T.words $
443                                             T.map (\c -> if c == ',' then ' ' else c) $
444                                             T.pack arg })
445                   "STRING")
446                  "" -- "Classes (whitespace- or comma-separated) to use for indented code-blocks"
447
448    , Option "" ["default-image-extension"]
449                 (ReqArg
450                  (\arg opt -> return opt { optDefaultImageExtension = T.pack arg })
451                   "extension")
452                  "" -- "Default extension for extensionless images"
453
454    , Option "F" ["filter"]
455                 (ReqArg
456                  (\arg opt -> return opt { optFilters =
457                      optFilters opt ++ [JSONFilter (normalizePath arg)] })
458                  "PROGRAM")
459                 "" -- "External JSON filter"
460
461    , Option "L" ["lua-filter"]
462                 (ReqArg
463                  (\arg opt -> return opt { optFilters =
464                      optFilters opt ++ [LuaFilter (normalizePath arg)] })
465                  "SCRIPTPATH")
466                 "" -- "Lua filter"
467
468    , Option "" ["shift-heading-level-by"]
469                 (ReqArg
470                  (\arg opt ->
471                      case safeStrRead arg of
472                           Just t ->
473                               return opt{ optShiftHeadingLevelBy = t }
474                           _              -> E.throwIO $ PandocOptionError
475                                               "shift-heading-level-by takes an integer argument")
476                  "NUMBER")
477                 "" -- "Shift heading level"
478
479    , Option "" ["base-header-level"]
480                 (ReqArg
481                  (\arg opt -> do
482                      deprecatedOption "--base-header-level"
483                        "Use --shift-heading-level-by instead."
484                      case safeStrRead arg of
485                           Just t | t > 0 && t < 6 ->
486                               return opt{ optShiftHeadingLevelBy = t - 1 }
487                           _              -> E.throwIO $ PandocOptionError
488                                               "base-header-level must be 1-5")
489                  "NUMBER")
490                 "" -- "Headers base level"
491
492    , Option "" ["strip-empty-paragraphs"]
493                 (NoArg
494                  (\opt -> do
495                      deprecatedOption "--strip-empty-paragraphs"
496                        "Use +empty_paragraphs extension."
497                      return opt{ optStripEmptyParagraphs = True }))
498                 "" -- "Strip empty paragraphs"
499
500    , Option "" ["track-changes"]
501                 (ReqArg
502                  (\arg opt -> do
503                     action <- case arg of
504                            "accept" -> return AcceptChanges
505                            "reject" -> return RejectChanges
506                            "all"    -> return AllChanges
507                            _        -> E.throwIO $ PandocOptionError $ T.pack
508                               ("Unknown option for track-changes: " ++ arg)
509                     return opt { optTrackChanges = action })
510                  "accept|reject|all")
511                 "" -- "Accepting or reject MS Word track-changes.""
512
513    , Option "" ["strip-comments"]
514                (NoArg
515                 (\opt -> return opt { optStripComments = True }))
516               "" -- "Strip HTML comments"
517
518    , Option "" ["reference-links"]
519                 (NoArg
520                  (\opt -> return opt { optReferenceLinks = True } ))
521                 "" -- "Use reference links in parsing HTML"
522
523    , Option "" ["reference-location"]
524                 (ReqArg
525                  (\arg opt -> do
526                     action <- case arg of
527                            "block"    -> return EndOfBlock
528                            "section"  -> return EndOfSection
529                            "document" -> return EndOfDocument
530                            _        -> E.throwIO $ PandocOptionError $ T.pack
531                               ("Unknown option for reference-location: " ++ arg)
532                     return opt { optReferenceLocation = action })
533                  "block|section|document")
534                 "" -- "Accepting or reject MS Word track-changes.""
535
536    , Option "" ["atx-headers"]
537                 (NoArg
538                  (\opt -> do
539                    deprecatedOption "--atx-headers"
540                      "Use --markdown-headings=atx instead."
541                    return opt { optSetextHeaders = False } ))
542                 "" -- "Use atx-style headers for markdown"
543
544    , Option "" ["markdown-headings"]
545                  (ReqArg
546                    (\arg opt -> do
547                      headingFormat <- case arg of
548                        "setext" -> pure True
549                        "atx" -> pure False
550                        _ -> E.throwIO $ PandocOptionError $ T.pack
551                          ("Unknown markdown heading format: " ++ arg ++
552                            ". Expecting atx or setext")
553                      pure opt { optSetextHeaders = headingFormat }
554                    )
555                  "setext|atx")
556                  ""
557
558    , Option "" ["listings"]
559                 (NoArg
560                  (\opt -> return opt { optListings = True }))
561                 "" -- "Use listings package for LaTeX code blocks"
562
563    , Option "i" ["incremental"]
564                 (NoArg
565                  (\opt -> return opt { optIncremental = True }))
566                 "" -- "Make list items display incrementally in Slidy/Slideous/S5"
567
568    , Option "" ["slide-level"]
569                 (ReqArg
570                  (\arg opt ->
571                      case safeStrRead arg of
572                           Just t | t >= 1 && t <= 6 ->
573                                    return opt { optSlideLevel = Just t }
574                           _      -> E.throwIO $ PandocOptionError
575                                    "slide level must be a number between 1 and 6")
576                 "NUMBER")
577                 "" -- "Force header level for slides"
578
579    , Option "" ["section-divs"]
580                 (NoArg
581                  (\opt -> return opt { optSectionDivs = True }))
582                 "" -- "Put sections in div tags in HTML"
583
584    , Option "" ["html-q-tags"]
585                 (NoArg
586                  (\opt ->
587                     return opt { optHtmlQTags = True }))
588                 "" -- "Use <q> tags for quotes in HTML"
589
590    , Option "" ["email-obfuscation"]
591                 (ReqArg
592                  (\arg opt -> do
593                     method <- case arg of
594                            "references" -> return ReferenceObfuscation
595                            "javascript" -> return JavascriptObfuscation
596                            "none"       -> return NoObfuscation
597                            _            -> E.throwIO $ PandocOptionError $ T.pack
598                               ("Unknown obfuscation method: " ++ arg)
599                     return opt { optEmailObfuscation = method })
600                  "none|javascript|references")
601                 "" -- "Method for obfuscating email in HTML"
602
603     , Option "" ["id-prefix"]
604                  (ReqArg
605                   (\arg opt -> return opt { optIdentifierPrefix = T.pack arg })
606                   "STRING")
607                  "" -- "Prefix to add to automatically generated HTML identifiers"
608
609    , Option "T" ["title-prefix"]
610                 (ReqArg
611                  (\arg opt ->
612                    return opt {
613                       optVariables =
614                         setVariable "title-prefix" (T.pack arg) $
615                           optVariables opt,
616                       optStandalone = True })
617                  "STRING")
618                 "" -- "String to prefix to HTML window title"
619
620    , Option "c" ["css"]
621                 (ReqArg
622                  (\arg opt -> return opt{ optCss = optCss opt ++ [arg] })
623                  -- add new link to end, so it is included in proper order
624                  "URL")
625                 "" -- "Link to CSS style sheet"
626
627    , Option "" ["epub-subdirectory"]
628             (ReqArg
629                  (\arg opt ->
630                     return opt { optEpubSubdirectory = arg })
631                  "DIRNAME")
632                 "" -- "Name of subdirectory for epub content in OCF container"
633
634    , Option "" ["epub-cover-image"]
635                 (ReqArg
636                  (\arg opt ->
637                     return opt { optVariables =
638                       setVariable "epub-cover-image"
639                         (T.pack $ normalizePath arg) $
640                         optVariables opt })
641                  "FILE")
642                 "" -- "Path of epub cover image"
643
644    , Option "" ["epub-metadata"]
645                 (ReqArg
646                  (\arg opt -> return opt { optEpubMetadata = Just $
647                                             normalizePath arg })
648                  "FILE")
649                 "" -- "Path of epub metadata file"
650
651    , Option "" ["epub-embed-font"]
652                 (ReqArg
653                  (\arg opt ->
654                     return opt{ optEpubFonts = normalizePath arg :
655                                                optEpubFonts opt })
656                  "FILE")
657                 "" -- "Directory of fonts to embed"
658
659    , Option "" ["epub-chapter-level"]
660                 (ReqArg
661                  (\arg opt ->
662                      case safeStrRead arg of
663                           Just t | t >= 1 && t <= 6 ->
664                                    return opt { optEpubChapterLevel = t }
665                           _      -> E.throwIO $ PandocOptionError
666                                    "chapter level must be a number between 1 and 6")
667                 "NUMBER")
668                 "" -- "Header level at which to split chapters in EPUB"
669
670    , Option "" ["ipynb-output"]
671                 (ReqArg
672                  (\arg opt ->
673                    case arg of
674                      "all" -> return opt{ optIpynbOutput = IpynbOutputAll }
675                      "best" -> return opt{ optIpynbOutput = IpynbOutputBest }
676                      "none" -> return opt{ optIpynbOutput = IpynbOutputNone }
677                      _ -> E.throwIO $ PandocOptionError
678                             "ipynb-output must be all, none, or best")
679                 "all|none|best")
680                 "" -- "Starting number for sections, subsections, etc."
681
682    , Option "C" ["citeproc"]
683                 (NoArg
684                  (\opt -> return opt { optFilters =
685                      optFilters opt ++ [CiteprocFilter] }))
686                 "" -- "Process citations"
687
688    , Option "" ["bibliography"]
689                 (ReqArg
690                  (\arg opt -> return opt{ optMetadata =
691                                            addMeta "bibliography"
692                                              (normalizePath arg) $
693                                              optMetadata opt })
694                   "FILE")
695                 ""
696
697     , Option "" ["csl"]
698                 (ReqArg
699                  (\arg opt ->
700                     return opt{ optMetadata =
701                                   addMeta "csl" (normalizePath arg) $
702                                   optMetadata opt })
703                   "FILE")
704                 ""
705
706     , Option "" ["citation-abbreviations"]
707                 (ReqArg
708                  (\arg opt ->
709                     return opt{ optMetadata =
710                                  addMeta "citation-abbreviations"
711                                    (normalizePath arg) $ optMetadata opt })
712                   "FILE")
713                 ""
714
715    , Option "" ["natbib"]
716                 (NoArg
717                  (\opt -> return opt { optCiteMethod = Natbib }))
718                 "" -- "Use natbib cite commands in LaTeX output"
719
720    , Option "" ["biblatex"]
721                 (NoArg
722                  (\opt -> return opt { optCiteMethod = Biblatex }))
723                 "" -- "Use biblatex cite commands in LaTeX output"
724
725    , Option "" ["mathml"]
726                 (NoArg
727                  (\opt ->
728                      return opt { optHTMLMathMethod = MathML }))
729                 "" -- "Use mathml for HTML math"
730
731    , Option "" ["webtex"]
732                 (OptArg
733                  (\arg opt -> do
734                      let url' = fromMaybe "https://latex.codecogs.com/png.latex?" arg
735                      return opt { optHTMLMathMethod = WebTeX $ T.pack url' })
736                  "URL")
737                 "" -- "Use web service for HTML math"
738
739    , Option "" ["mathjax"]
740                 (OptArg
741                  (\arg opt -> do
742                      let url' = maybe defaultMathJaxURL T.pack arg
743                      return opt { optHTMLMathMethod = MathJax url'})
744                  "URL")
745                 "" -- "Use MathJax for HTML math"
746
747    , Option "" ["katex"]
748                 (OptArg
749                  (\arg opt ->
750                      return opt
751                        { optHTMLMathMethod = KaTeX $
752                           maybe defaultKaTeXURL T.pack arg })
753                  "URL")
754                  "" -- Use KaTeX for HTML Math
755
756    , Option "" ["gladtex"]
757                 (NoArg
758                  (\opt ->
759                      return opt { optHTMLMathMethod = GladTeX }))
760                 "" -- "Use gladtex for HTML math"
761
762    , Option "" ["trace"]
763                 (NoArg
764                  (\opt -> return opt { optTrace = True }))
765                 "" -- "Turn on diagnostic tracing in readers."
766
767    , Option "" ["dump-args"]
768                 (NoArg
769                  (\opt -> return opt { optDumpArgs = True }))
770                 "" -- "Print output filename and arguments to stdout."
771
772    , Option "" ["ignore-args"]
773                 (NoArg
774                  (\opt -> return opt { optIgnoreArgs = True }))
775                 "" -- "Ignore command-line arguments."
776
777    , Option "" ["verbose"]
778                 (NoArg
779                  (\opt -> return opt { optVerbosity = INFO }))
780                 "" -- "Verbose diagnostic output."
781
782    , Option "" ["quiet"]
783                 (NoArg
784                  (\opt -> return opt { optVerbosity = ERROR }))
785                 "" -- "Suppress warnings."
786
787    , Option "" ["fail-if-warnings"]
788                 (NoArg
789                  (\opt -> return opt { optFailIfWarnings = True }))
790                 "" -- "Exit with error status if there were  warnings."
791
792    , Option "" ["log"]
793                 (ReqArg
794                  (\arg opt -> return opt{ optLogFile = Just $
795                                            normalizePath arg })
796                "FILE")
797                "" -- "Log messages in JSON format to this file."
798
799    , Option "" ["bash-completion"]
800                 (NoArg
801                  (\_ -> do
802                     datafiles <- getDataFileNames
803                     tpl <- runIOorExplode $
804                              UTF8.toString <$>
805                                readDefaultDataFile "bash_completion.tpl"
806                     let optnames (Option shorts longs _ _) =
807                           map (\c -> ['-',c]) shorts ++
808                           map ("--" ++) longs
809                     let allopts = unwords (concatMap optnames options)
810                     UTF8.hPutStrLn stdout $ printf tpl allopts
811                         (unwords readersNames)
812                         (unwords writersNames)
813                         (unwords $ map (T.unpack . fst) highlightingStyles)
814                         (unwords datafiles)
815                     exitSuccess ))
816                 "" -- "Print bash completion script"
817
818    , Option "" ["list-input-formats"]
819                 (NoArg
820                  (\_ -> do
821                     mapM_ (UTF8.hPutStrLn stdout) readersNames
822                     exitSuccess ))
823                 ""
824
825    , Option "" ["list-output-formats"]
826                 (NoArg
827                  (\_ -> do
828                     mapM_ (UTF8.hPutStrLn stdout) writersNames
829                     exitSuccess ))
830                 ""
831
832    , Option "" ["list-extensions"]
833                 (OptArg
834                  (\arg _ -> do
835                     let extList :: [Extension]
836                         extList = [minBound..maxBound]
837                     let allExts =
838                           case arg of
839                             Nothing  -> extensionsFromList extList
840                             Just fmt -> getAllExtensions $ T.pack fmt
841                     let defExts =
842                           case arg of
843                             Nothing   -> getDefaultExtensions
844                                           "markdown"
845                             Just fmt  -> getDefaultExtensions $ T.pack fmt
846                     let showExt x =
847                           (if extensionEnabled x defExts
848                               then '+'
849                               else if extensionEnabled x allExts
850                                       then '-'
851                                       else ' ') : drop 4 (show x)
852                     mapM_ (UTF8.hPutStrLn stdout . showExt)
853                       [ex | ex <- extList, extensionEnabled ex allExts]
854                     exitSuccess )
855                  "FORMAT")
856                 ""
857
858    , Option "" ["list-highlight-languages"]
859                 (NoArg
860                  (\_ -> do
861                     let langs = [ T.unpack (T.toLower (sShortname s))
862                                 | s <- M.elems defaultSyntaxMap
863                                 , sShortname s `notElem`
864                                    [T.pack "Alert", T.pack "Alert_indent"]
865                                 ]
866                     mapM_ (UTF8.hPutStrLn stdout) (sort langs)
867                     exitSuccess ))
868                 ""
869
870    , Option "" ["list-highlight-styles"]
871                 (NoArg
872                  (\_ -> do
873                     mapM_ (UTF8.hPutStrLn stdout . T.unpack . fst) highlightingStyles
874                     exitSuccess ))
875                 ""
876
877    , Option "D" ["print-default-template"]
878                 (ReqArg
879                  (\arg opt -> do
880                     let write = case optOutputFile opt of
881                                        Just f  -> UTF8.writeFile f
882                                        Nothing -> UTF8.hPutStr stdout
883                     templ <- runIO $ do
884                                setUserDataDir Nothing
885                                getDefaultTemplate (T.pack arg)
886                     case templ of
887                          Right t
888                            | T.null t -> -- e.g. for docx, odt, json:
889                                E.throwIO $ PandocCouldNotFindDataFileError $ T.pack
890                                  ("templates/default." ++ arg)
891                            | otherwise -> write . T.unpack $ t
892                          Left e  -> E.throwIO e
893                     exitSuccess)
894                  "FORMAT")
895                 "" -- "Print default template for FORMAT"
896
897    , Option "" ["print-default-data-file"]
898                 (ReqArg
899                  (\arg opt -> do
900                     let write = case optOutputFile opt of
901                                        Just f  -> BS.writeFile f
902                                        Nothing -> BS.hPutStr stdout
903                     runIOorExplode $
904                       readDefaultDataFile arg >>= liftIO . write
905                     exitSuccess)
906                  "FILE")
907                  "" -- "Print default data file"
908
909    , Option "" ["print-highlight-style"]
910                 (ReqArg
911                  (\arg opt -> do
912                     let write = maybe B.putStr B.writeFile $ optOutputFile opt
913                     sty <- runIOorExplode $ lookupHighlightStyle arg
914                     write $ encodePretty'
915                       defConfig{confIndent = Spaces 4
916                                ,confCompare = keyOrder
917                                  (map T.pack
918                                   ["text-color"
919                                   ,"background-color"
920                                   ,"line-number-color"
921                                   ,"line-number-background-color"
922                                   ,"bold"
923                                   ,"italic"
924                                   ,"underline"
925                                   ,"text-styles"])
926                                ,confNumFormat = Generic
927                                ,confTrailingNewline = True} sty
928                     exitSuccess)
929                  "STYLE|FILE")
930                 "" -- "Print default template for FORMAT"
931
932
933    , Option "v" ["version"]
934                 (NoArg
935                  (\_ -> do
936                     prg <- getProgName
937                     defaultDatadirs <- defaultUserDataDirs
938                     UTF8.hPutStrLn stdout (prg ++ " " ++ T.unpack pandocVersion ++
939                       compileInfo ++
940                       "\nUser data directory: " ++
941                       intercalate " or " defaultDatadirs ++
942                       ('\n':copyrightMessage))
943                     exitSuccess ))
944                 "" -- "Print version"
945
946    , Option "h" ["help"]
947                 (NoArg
948                  (\_ -> do
949                     prg <- getProgName
950                     UTF8.hPutStr stdout (usageMessage prg options)
951                     exitSuccess ))
952                 "" -- "Show help"
953    ]
954
955getDataFileNames :: IO [FilePath]
956getDataFileNames = do
957#ifdef EMBED_DATA_FILES
958  let allDataFiles = map fst dataFiles
959#else
960  allDataFiles <- filter (\x -> x /= "." && x /= "..") <$>
961                      (getDataDir >>= getDirectoryContents)
962#endif
963  return $ "reference.docx" : "reference.odt" : "reference.pptx" : allDataFiles
964
965-- Returns usage message
966usageMessage :: String -> [OptDescr (Opt -> IO Opt)] -> String
967usageMessage programName = usageInfo (programName ++ " [OPTIONS] [FILES]")
968
969copyrightMessage :: String
970copyrightMessage = intercalate "\n" [
971 "Copyright (C) 2006-2021 John MacFarlane. Web:  https://pandoc.org",
972 "This is free software; see the source for copying conditions. There is no",
973 "warranty, not even for merchantability or fitness for a particular purpose." ]
974
975compileInfo :: String
976compileInfo =
977  "\nCompiled with pandoc-types " ++ VERSION_pandoc_types ++
978  ", texmath " ++ VERSION_texmath ++ ", skylighting " ++
979  VERSION_skylighting ++ ",\nciteproc " ++ VERSION_citeproc ++
980  ", ipynb " ++ VERSION_ipynb
981
982handleUnrecognizedOption :: String -> [String] -> [String]
983handleUnrecognizedOption "--smart" =
984  (("--smart/-S has been removed.  Use +smart or -smart extension instead.\n" ++
985    "For example: pandoc -f markdown+smart -t markdown-smart.") :)
986handleUnrecognizedOption "--normalize" =
987  ("--normalize has been removed.  Normalization is now automatic." :)
988handleUnrecognizedOption "-S" = handleUnrecognizedOption "--smart"
989handleUnrecognizedOption "--old-dashes" =
990  ("--old-dashes has been removed.  Use +old_dashes extension instead." :)
991handleUnrecognizedOption "--no-wrap" =
992  ("--no-wrap has been removed.  Use --wrap=none instead." :)
993handleUnrecognizedOption "--latex-engine" =
994  ("--latex-engine has been removed.  Use --pdf-engine instead." :)
995handleUnrecognizedOption "--latex-engine-opt" =
996  ("--latex-engine-opt has been removed.  Use --pdf-engine-opt instead." :)
997handleUnrecognizedOption "--chapters" =
998  ("--chapters has been removed. Use --top-level-division=chapter instead." :)
999handleUnrecognizedOption "--reference-docx" =
1000  ("--reference-docx has been removed. Use --reference-doc instead." :)
1001handleUnrecognizedOption "--reference-odt" =
1002  ("--reference-odt has been removed. Use --reference-doc instead." :)
1003handleUnrecognizedOption "--parse-raw" =
1004  ("--parse-raw/-R has been removed. Use +raw_html or +raw_tex extension.\n" :)
1005handleUnrecognizedOption "--epub-stylesheet" =
1006  ("--epub-stylesheet has been removed. Use --css instead.\n" :)
1007handleUnrecognizedOption "-R" = handleUnrecognizedOption "--parse-raw"
1008handleUnrecognizedOption x =
1009  (("Unknown option " ++ x ++ ".") :)
1010
1011readersNames :: [String]
1012readersNames = sort (map (T.unpack . fst) (readers :: [(Text, Reader PandocIO)]))
1013
1014writersNames :: [String]
1015writersNames = sort
1016  ("pdf" : map (T.unpack . fst) (writers :: [(Text, Writer PandocIO)]))
1017
1018splitField :: String -> (String, String)
1019splitField = second (tailDef "true") . break (`elemText` ":=")
1020
1021lookupHighlightStyle :: PandocMonad m => String -> m Style
1022lookupHighlightStyle s
1023  | takeExtension s == ".theme" = -- attempt to load KDE theme
1024    do contents <- readFileLazy s
1025       case parseTheme contents of
1026            Left _    -> throwError $ PandocOptionError $ T.pack $
1027                           "Could not read highlighting theme " ++ s
1028            Right sty -> return sty
1029  | otherwise =
1030  case lookup (T.toLower $ T.pack s) highlightingStyles of
1031       Just sty -> return sty
1032       Nothing  -> throwError $ PandocOptionError $ T.pack $
1033                      "Unknown highlight-style " ++ s
1034
1035deprecatedOption :: String -> String -> IO ()
1036deprecatedOption o msg =
1037  runIO (report $ Deprecated (T.pack o) (T.pack msg)) >>=
1038    \case
1039       Right () -> return ()
1040       Left e   -> E.throwIO e
1041
1042-- | Set text value in text context.
1043setVariable :: Text -> Text -> Context Text -> Context Text
1044setVariable key val (Context ctx) = Context $ M.alter go key ctx
1045  where go Nothing             = Just $ toVal val
1046        go (Just (ListVal xs)) = Just $ ListVal $ xs ++ [toVal val]
1047        go (Just x)            = Just $ ListVal [x, toVal val]
1048
1049-- On Windows with ghc 8.6+, we need to rewrite paths
1050-- beginning with \\ to \\?\UNC\. -- See #5127.
1051normalizePath :: FilePath -> FilePath
1052#ifdef _WINDOWS
1053#if MIN_VERSION_base(4,12,0)
1054normalizePath fp =
1055  if "\\\\" `isPrefixOf` fp && not ("\\\\?\\" `isPrefixOf` fp)
1056    then "\\\\?\\UNC\\" ++ drop 2 fp
1057    else fp
1058#else
1059normalizePath = id
1060#endif
1061#else
1062normalizePath = id
1063#endif
1064