1{-# LANGUAGE CPP #-} 2{-# LANGUAGE FlexibleContexts #-} 3{-# LANGUAGE OverloadedStrings #-} 4{-# LANGUAGE ScopedTypeVariables #-} 5{-# LANGUAGE TupleSections #-} 6{- | 7 Module : Text.Pandoc.App 8 Copyright : Copyright (C) 2006-2021 John MacFarlane 9 License : GNU GPL, version 2 or above 10 11 Maintainer : John MacFarlane <jgm@berkeley@edu> 12 Stability : alpha 13 Portability : portable 14 15Does a pandoc conversion based on command-line options. 16-} 17module Text.Pandoc.App.OutputSettings 18 ( OutputSettings (..) 19 , optToOutputSettings 20 ) where 21import qualified Data.Map as M 22import qualified Data.Text as T 23import Text.DocTemplates (toVal, Context(..), Val(..)) 24import qualified Control.Exception as E 25import Control.Monad 26import Control.Monad.Except (throwError) 27import Control.Monad.Trans 28import Data.Char (toLower) 29import Data.List (find) 30import Data.Maybe (fromMaybe) 31import Skylighting (defaultSyntaxMap) 32import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition) 33import System.Directory (getCurrentDirectory) 34import System.Exit (exitSuccess) 35import System.FilePath 36import System.IO (stdout) 37import Text.Pandoc 38import Text.Pandoc.App.FormatHeuristics (formatFromFilePaths) 39import Text.Pandoc.App.Opt (Opt (..)) 40import Text.Pandoc.App.CommandLineOptions (engines, lookupHighlightStyle, 41 setVariable) 42import qualified Text.Pandoc.UTF8 as UTF8 43 44readUtf8File :: PandocMonad m => FilePath -> m T.Text 45readUtf8File = fmap UTF8.toText . readFileStrict 46 47-- | Settings specifying how document output should be produced. 48data OutputSettings = OutputSettings 49 { outputFormat :: T.Text 50 , outputWriter :: Writer PandocIO 51 , outputWriterName :: T.Text 52 , outputWriterOptions :: WriterOptions 53 , outputPdfProgram :: Maybe String 54 } 55 56-- | Get output settings from command line options. 57optToOutputSettings :: Opt -> PandocIO OutputSettings 58optToOutputSettings opts = do 59 let outputFile = fromMaybe "-" (optOutputFile opts) 60 61 when (optDumpArgs opts) . liftIO $ do 62 UTF8.hPutStrLn stdout (T.pack outputFile) 63 mapM_ (UTF8.hPutStrLn stdout . T.pack) (fromMaybe [] $ optInputFiles opts) 64 exitSuccess 65 66 epubMetadata <- traverse readUtf8File $ optEpubMetadata opts 67 68 let pdfOutput = map toLower (takeExtension outputFile) == ".pdf" || 69 optTo opts == Just "pdf" 70 (writerName, maybePdfProg) <- 71 if pdfOutput 72 then liftIO $ pdfWriterAndProg 73 (case optTo opts of 74 Just "pdf" -> Nothing 75 x -> x) 76 (optPdfEngine opts) 77 else case optTo opts of 78 Just f -> return (f, Nothing) 79 Nothing 80 | outputFile == "-" -> return ("html", Nothing) 81 | otherwise -> 82 case formatFromFilePaths [outputFile] of 83 Nothing -> do 84 report $ CouldNotDeduceFormat 85 [T.pack $ takeExtension outputFile] "html" 86 return ("html", Nothing) 87 Just f -> return (f, Nothing) 88 89 let format = if ".lua" `T.isSuffixOf` writerName 90 then writerName 91 else T.toLower $ baseWriterName writerName 92 93 (writer :: Writer PandocIO, writerExts) <- 94 if ".lua" `T.isSuffixOf` format 95 then return (TextWriter 96 (\o d -> writeCustom (T.unpack writerName) o d) 97 :: Writer PandocIO, mempty) 98 else getWriter (T.toLower writerName) 99 100 let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput 101 102 let addSyntaxMap existingmap f = do 103 res <- liftIO (parseSyntaxDefinition f) 104 case res of 105 Left errstr -> throwError $ PandocSyntaxMapError $ T.pack errstr 106 Right syn -> return $ addSyntaxDefinition syn existingmap 107 108 syntaxMap <- foldM addSyntaxMap defaultSyntaxMap 109 (optSyntaxDefinitions opts) 110 111 hlStyle <- traverse (lookupHighlightStyle . T.unpack) $ optHighlightStyle opts 112 113 let setVariableM k v = return . setVariable k v 114 115 let setListVariableM _ [] ctx = return ctx 116 setListVariableM k vs ctx = do 117 let ctxMap = unContext ctx 118 return $ Context $ 119 case M.lookup k ctxMap of 120 Just (ListVal xs) -> M.insert k 121 (ListVal $ xs ++ map toVal vs) ctxMap 122 Just v -> M.insert k 123 (ListVal $ v : map toVal vs) ctxMap 124 Nothing -> M.insert k (toVal vs) ctxMap 125 126 let getTextContents fp = UTF8.toText . fst <$> fetchItem (T.pack fp) 127 128 let setFilesVariableM k fps ctx = do 129 xs <- mapM getTextContents fps 130 setListVariableM k xs ctx 131 132 curdir <- liftIO getCurrentDirectory 133 134 variables <- 135 return (optVariables opts) 136 >>= 137 setListVariableM "sourcefile" 138 (maybe ["-"] (fmap T.pack) (optInputFiles opts)) 139 >>= 140 setVariableM "outputfile" (T.pack outputFile) 141 >>= 142 setFilesVariableM "include-before" (optIncludeBeforeBody opts) 143 >>= 144 setFilesVariableM "include-after" (optIncludeAfterBody opts) 145 >>= 146 setFilesVariableM "header-includes" (optIncludeInHeader opts) 147 >>= 148 setListVariableM "css" (map T.pack $ optCss opts) 149 >>= 150 maybe return (setVariableM "title-prefix") (optTitlePrefix opts) 151 >>= 152 maybe return (setVariableM "epub-cover-image") 153 (T.pack <$> optEpubCoverImage opts) 154 >>= 155 setVariableM "curdir" (T.pack curdir) 156 >>= 157 (\vars -> if format == "dzslides" 158 then do 159 dztempl <- UTF8.toText <$> readDataFile 160 ("dzslides" </> "template.html") 161 let dzline = "<!-- {{{{ dzslides core" 162 let dzcore = T.unlines 163 $ dropWhile (not . (dzline `T.isPrefixOf`)) 164 $ T.lines dztempl 165 setVariableM "dzslides-core" dzcore vars 166 else return vars) 167 168 templ <- case optTemplate opts of 169 _ | not standalone -> return Nothing 170 Nothing -> Just <$> compileDefaultTemplate format 171 Just tp -> do 172 -- strip off extensions 173 let tp' = case takeExtension tp of 174 "" -> tp <.> T.unpack format 175 _ -> tp 176 res <- getTemplate tp' >>= runWithPartials . compileTemplate tp' 177 case res of 178 Left e -> throwError $ PandocTemplateError $ T.pack e 179 Right t -> return $ Just t 180 181 let writerOpts = def { 182 writerTemplate = templ 183 , writerVariables = variables 184 , writerTabStop = optTabStop opts 185 , writerTableOfContents = optTableOfContents opts 186 , writerHTMLMathMethod = optHTMLMathMethod opts 187 , writerIncremental = optIncremental opts 188 , writerCiteMethod = optCiteMethod opts 189 , writerNumberSections = optNumberSections opts 190 , writerNumberOffset = optNumberOffset opts 191 , writerSectionDivs = optSectionDivs opts 192 , writerExtensions = writerExts 193 , writerReferenceLinks = optReferenceLinks opts 194 , writerReferenceLocation = optReferenceLocation opts 195 , writerDpi = optDpi opts 196 , writerWrapText = optWrap opts 197 , writerColumns = optColumns opts 198 , writerEmailObfuscation = optEmailObfuscation opts 199 , writerIdentifierPrefix = optIdentifierPrefix opts 200 , writerHtmlQTags = optHtmlQTags opts 201 , writerTopLevelDivision = optTopLevelDivision opts 202 , writerListings = optListings opts 203 , writerSlideLevel = optSlideLevel opts 204 , writerHighlightStyle = hlStyle 205 , writerSetextHeaders = optSetextHeaders opts 206 , writerEpubSubdirectory = T.pack $ optEpubSubdirectory opts 207 , writerEpubMetadata = epubMetadata 208 , writerEpubFonts = optEpubFonts opts 209 , writerEpubChapterLevel = optEpubChapterLevel opts 210 , writerTOCDepth = optTOCDepth opts 211 , writerReferenceDoc = optReferenceDoc opts 212 , writerSyntaxMap = syntaxMap 213 , writerPreferAscii = optAscii opts 214 } 215 return $ OutputSettings 216 { outputFormat = format 217 , outputWriter = writer 218 , outputWriterName = writerName 219 , outputWriterOptions = writerOpts 220 , outputPdfProgram = maybePdfProg 221 } 222 223baseWriterName :: T.Text -> T.Text 224baseWriterName = T.takeWhile (\c -> c /= '+' && c /= '-') 225 226pdfWriterAndProg :: Maybe T.Text -- ^ user-specified writer name 227 -> Maybe String -- ^ user-specified pdf-engine 228 -> IO (T.Text, Maybe String) -- ^ IO (writerName, maybePdfEngineProg) 229pdfWriterAndProg mWriter mEngine = 230 case go mWriter mEngine of 231 Right (writ, prog) -> return (writ, Just prog) 232 Left err -> liftIO $ E.throwIO $ PandocAppError err 233 where 234 go Nothing Nothing = Right ("latex", "pdflatex") 235 go (Just writer) Nothing = (writer,) <$> engineForWriter writer 236 go Nothing (Just engine) = (,engine) <$> writerForEngine (takeBaseName engine) 237 go (Just writer) (Just engine) = 238 case find (== (baseWriterName writer, takeBaseName engine)) engines of 239 Just _ -> Right (writer, engine) 240 Nothing -> Left $ "pdf-engine " <> T.pack engine <> 241 " is not compatible with output format " <> writer 242 243 writerForEngine eng = case [f | (f,e) <- engines, e == eng] of 244 fmt : _ -> Right fmt 245 [] -> Left $ 246 "pdf-engine " <> T.pack eng <> " not known" 247 248 engineForWriter "pdf" = Left "pdf writer" 249 engineForWriter w = case [e | (f,e) <- engines, f == baseWriterName w] of 250 eng : _ -> Right eng 251 [] -> Left $ 252 "cannot produce pdf output from " <> w 253 254isTextFormat :: T.Text -> Bool 255isTextFormat s = 256 s `notElem` ["odt","docx","epub2","epub3","epub","pptx","pdf"] 257