f075b0e · typeable/pandoc

38import Text.Pandoc.Shared ( tabFilter, readDataFileUTF8, readDataFile,

39 safeRead, headerShift, normalize, err, warn,

40 openURL )

41−import Text.Pandoc.MediaBag ( mediaDirectory, extractMediaBag )

41+import Text.Pandoc.MediaBag ( mediaDirectory, extractMediaBag, MediaBag )

42import Text.Pandoc.XML ( toEntities )

43import Text.Pandoc.SelfContained ( makeSelfContained )

44import Text.Pandoc.Process (pipeProcess)

45import Text.Highlighting.Kate ( languages, Style, tango, pygments,

46 espresso, zenburn, kate, haddock, monochrome )

47−import System.Environment ( getArgs, getProgName )

47+import System.Environment ( getArgs, getProgName, getEnvironment )

48import System.Exit ( exitWith, ExitCode (..) )

49import System.FilePath

50import System.Console.GetOpt

71import Text.Pandoc.Readers.Txt2Tags (getT2TMeta)

72import Data.Monoid

73

74+type Transform = Pandoc -> Pandoc

75+

74copyrightMessage :: String

76copyrightMessage :: String

76 "Web: http://johnmacfarlane.net/pandoc\n" ++

78 "Web: http://johnmacfarlane.net/pandoc\n" ++

101

103

102externalFilter :: FilePath -> [String] -> Pandoc -> IO Pandoc

104externalFilter :: FilePath -> [String] -> Pandoc -> IO Pandoc

103externalFilter f args' d = do

105externalFilter f args' d = do

106+ mbPath <- lookup "PATH" <$> getEnvironment

107+ mbexe <- if '/' `elem` f || mbPath == Nothing

104− mbexe <- if '/' `elem` f -- don't check PATH if filter name it has a path

108+ -- don't check PATH if filter name has a path, or

109+ -- if the PATH is not set

105 then return Nothing

110 then return Nothing

106 else findExecutable f

111 else findExecutable f

107 (f', args'') <- case mbexe of

112 (f', args'') <- case mbexe of

141 , optWriter :: String -- ^ Writer format

146 , optWriter :: String -- ^ Writer format

142 , optParseRaw :: Bool -- ^ Parse unconvertable HTML and TeX

147 , optParseRaw :: Bool -- ^ Parse unconvertable HTML and TeX

143 , optTableOfContents :: Bool -- ^ Include table of contents

148 , optTableOfContents :: Bool -- ^ Include table of contents

144− , optTransforms :: [Pandoc -> Pandoc] -- ^ Doc transforms to apply

149+ , optTransforms :: [Transform] -- ^ Doc transforms to apply

145 , optTemplate :: Maybe FilePath -- ^ Custom template

150 , optTemplate :: Maybe FilePath -- ^ Custom template

146 , optVariables :: [(String,String)] -- ^ Template variables to set

151 , optVariables :: [(String,String)] -- ^ Template variables to set

147 , optMetadata :: M.Map String MetaValue -- ^ Metadata fields to set

152 , optMetadata :: M.Map String MetaValue -- ^ Metadata fields to set

934 ['.',y] | y `elem` ['1'..'9'] -> "man"

939 ['.',y] | y `elem` ['1'..'9'] -> "man"

935 _ -> "html"

940 _ -> "html"

936

941

942+-- Transformations of a Pandoc document post-parsing:

943+

944+extractMedia :: MediaBag -> FilePath -> Pandoc -> IO Pandoc

945+extractMedia media dir d =

946+ case [fp | (fp, _, _) <- mediaDirectory media] of

947+ [] -> return d

948+ fps -> do

949+ extractMediaBag True dir media

950+ return $ walk (adjustImagePath dir fps) d

951+

952+adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline

953+adjustImagePath dir paths (Image lab (src, tit))

954+ | src `elem` paths = Image lab (dir ++ "/" ++ src, tit)

955+adjustImagePath _ _ x = x

956+

957+adjustMetadata :: M.Map String MetaValue -> Pandoc -> IO Pandoc

958+adjustMetadata metadata d = return $ M.foldWithKey setMeta d metadata

959+

960+applyTransforms :: [Transform] -> Pandoc -> IO Pandoc

961+applyTransforms transforms d = return $ foldr ($) d transforms

962+

963+applyFilters :: [FilePath] -> [String] -> Pandoc -> IO Pandoc

964+applyFilters filters args d =

965+ foldrM ($) d $ map (flip externalFilter args) filters

966+

937main :: IO ()

967main :: IO ()

938main = do

968main = do

939

969

1026 all (\f -> takeBaseName f /= "pandoc-citeproc")

1056 all (\f -> takeBaseName f /= "pandoc-citeproc")

1027 filters -> "pandoc-citeproc" : filters

1057 filters -> "pandoc-citeproc" : filters

1028 _ -> filters

1058 _ -> filters

1029− let plugins = map externalFilter filters'

1030

1059

1031 let sources = if ignoreArgs then [] else args

1060 let sources = if ignoreArgs then [] else args

1032

1061

1143 , readerTrackChanges = trackChanges

1172 , readerTrackChanges = trackChanges

1144 }

1173 }

1145

1174

1175+ when (not (isTextFormat writerName') && outputFile == "-") $

1176+ err 5 $ "Cannot write " ++ writerName' ++ " output to stdout.\n" ++

1177+ "Specify an output file using the -o option."

1178+

1179+ let readSources [] = mapM readSource ["-"]

1180+ readSources srcs = mapM readSource srcs

1181+ readSource "-" = UTF8.getContents

1182+ readSource src = case parseURI src of

1183+ Just u | uriScheme u `elem` ["http:","https:"] ->

1184+ readURI src

1185+ _ -> UTF8.readFile src

1186+ readURI src = do

1187+ res <- openURL src

1188+ case res of

1189+ Left e -> throwIO e

1190+ Right (bs,_) -> return $ UTF8.toString bs

1191+

1192+ let readFiles [] = error "Cannot read archive from stdin"

1193+ readFiles (x:_) = B.readFile x

1194+

1195+ let convertTabs = tabFilter (if (preserveTabs || readerName' == "t2t") then 0 else tabStop)

1196+

1197+ let handleIncludes' = if readerName' == "latex" || readerName' == "latex+lhs"

1198+ then handleIncludes

1199+ else return

1200+

1201+ (doc, media) <-

1202+ case reader of

1203+ StringReader r-> (, mempty) <$>

1204+ ( readSources >=>

1205+ handleIncludes' . convertTabs . intercalate "\n" >=>

1206+ r readerOpts ) sources

1207+ ByteStringReader r -> readFiles sources >>= r readerOpts

1208+

1146 let writerOptions = def { writerStandalone = standalone',

1209 let writerOptions = def { writerStandalone = standalone',

1147 writerTemplate = templ,

1210 writerTemplate = templ,

1148 writerVariables = variables'',

1211 writerVariables = variables'',

1178 writerEpubChapterLevel = epubChapterLevel,

1241 writerEpubChapterLevel = epubChapterLevel,

1179 writerTOCDepth = epubTOCDepth,

1242 writerTOCDepth = epubTOCDepth,

1180 writerReferenceODT = referenceODT,

1243 writerReferenceODT = referenceODT,

1181− writerReferenceDocx = referenceDocx

1244+ writerReferenceDocx = referenceDocx,

1245+ writerMediaBag = media

1182 }

1246 }

1183

1247

1184− when (not (isTextFormat writerName') && outputFile == "-") $

1185− err 5 $ "Cannot write " ++ writerName' ++ " output to stdout.\n" ++

1186− "Specify an output file using the -o option."

1187−

1188− let readSources [] = mapM readSource ["-"]

1189− readSources srcs = mapM readSource srcs

1190− readSource "-" = UTF8.getContents

1191− readSource src = case parseURI src of

1192− Just u | uriScheme u `elem` ["http:","https:"] ->

1193− readURI src

1194− _ -> UTF8.readFile src

1195− readURI src = do

1196− res <- openURL src

1197− case res of

1198− Left e -> throwIO e

1199− Right (bs,_) -> return $ UTF8.toString bs

1200−

1201− let readFiles [] = error "Cannot read archive from stdin"

1202− readFiles (x:_) = B.readFile x

1203−

1204− let convertTabs = tabFilter (if (preserveTabs || readerName' == "t2t") then 0 else tabStop)

1205−

1206− let handleIncludes' = if readerName' == "latex" || readerName' == "latex+lhs"

1207− then handleIncludes

1208− else return

1209−

1210− let adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline

1211− adjustImagePath dir paths (Image lab (src, tit))

1212− | src `elem` paths = Image lab (dir ++ "/" ++ src, tit)

1213− adjustImagePath _ _ x = x

1214−

1215− (doc, media) <-

1216− case reader of

1217− StringReader r-> (, mempty) <$>

1218− ( readSources >=>

1219− handleIncludes' . convertTabs . intercalate "\n" >=>

1220− r readerOpts ) sources

1221− ByteStringReader r -> readFiles sources >>= r readerOpts

1222−

1223− let writerOptions' = writerOptions{ writerMediaBag = media }

1224−

1225− let extractMedia d = do

1226− case mbExtractMedia of

1227− Just dir -> do

1228− case [fp | (fp, _, _) <- mediaDirectory media] of

1229− [] -> return d

1230− fps -> do

1231− extractMediaBag True dir media

1232− return $ walk (adjustImagePath dir fps) d

1233− _ -> return d

1234−

1235− let adjustMetadata d = return $ M.foldWithKey setMeta d metadata

1236−

1237− let applyTransforms d = return $ foldr ($) d transforms

1238−

1239− let applyPlugins d = foldrM ($) d $ map ($ [writerName']) plugins

1240

1248

1241− doc' <- (extractMedia >=>

1249+ doc' <- (maybe return (extractMedia media) mbExtractMedia >=>

1242− adjustMetadata >=>

1250+ adjustMetadata metadata >=>

1243− applyTransforms >=>

1251+ applyTransforms transforms >=>

1244− applyPlugins) doc

1252+ applyFilters filters' [writerName']) doc

1245

1253

1246 let writeBinary :: B.ByteString -> IO ()

1254 let writeBinary :: B.ByteString -> IO ()

1247 writeBinary = B.writeFile (UTF8.encodePath outputFile)

1255 writeBinary = B.writeFile (UTF8.encodePath outputFile)

1251 writerFn f = UTF8.writeFile f

1259 writerFn f = UTF8.writeFile f

1252

1260

1253 case writer of

1261 case writer of

1254− IOStringWriter f -> f writerOptions' doc' >>= writerFn outputFile

1262+ IOStringWriter f -> f writerOptions doc' >>= writerFn outputFile

1255− IOByteStringWriter f -> f writerOptions' doc' >>= writeBinary

1263+ IOByteStringWriter f -> f writerOptions doc' >>= writeBinary

1256 PureStringWriter f

1264 PureStringWriter f

1257 | pdfOutput -> do

1265 | pdfOutput -> do

1258 -- make sure writer is latex or beamer

1266 -- make sure writer is latex or beamer

1266 err 41 $ latexEngine ++ " not found. " ++

1274 err 41 $ latexEngine ++ " not found. " ++

1267 latexEngine ++ " is needed for pdf output."

1275 latexEngine ++ " is needed for pdf output."

1268

1276

1269− res <- makePDF latexEngine f writerOptions' doc'

1277+ res <- makePDF latexEngine f writerOptions doc'

1270 case res of

1278 case res of

1271 Right pdf -> writeBinary pdf

1279 Right pdf -> writeBinary pdf

1272 Left err' -> do

1280 Left err' -> do

1273 B.hPutStr stderr $ err'

1281 B.hPutStr stderr $ err'

1274 B.hPut stderr $ B.pack [10]

1282 B.hPut stderr $ B.pack [10]

1275 err 43 "Error producing PDF from TeX source"

1283 err 43 "Error producing PDF from TeX source"

1276− | otherwise -> selfcontain (f writerOptions' doc' ++

1284+ | otherwise -> selfcontain (f writerOptions doc' ++

1277 ['\n' | not standalone'])

1285 ['\n' | not standalone'])

1278 >>= writerFn outputFile . handleEntities

1286 >>= writerFn outputFile . handleEntities

1279 where htmlFormat = writerName' `elem`

1287 where htmlFormat = writerName' `elem`

1281 "s5","slidy","slideous","dzslides","revealjs"]

1289 "s5","slidy","slideous","dzslides","revealjs"]

1282 selfcontain = if selfContained && htmlFormat

1290 selfcontain = if selfContained && htmlFormat

1283 then makeSelfContained

1291 then makeSelfContained

1284− (writerMediaBag writerOptions')

1292+ (writerMediaBag writerOptions)

1285− (writerUserDataDir writerOptions')

1293+ (writerUserDataDir writerOptions)

1286 else return

1294 else return

1287 handleEntities = if htmlFormat && ascii

1295 handleEntities = if htmlFormat && ascii

1288 then toEntities

1296 then toEntities