T.P.App: cleanup code, extract internal functions

1 files changed, 75 insertions, 62 deletions

diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 42b541ae0..3e2ad6950 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -27,7 +28,7 @@ module Text.Pandoc.App (
           , applyFilters
           ) where
 import qualified Control.Exception as E
-import Control.Monad ( (>=>), when, forM_ )
+import Control.Monad ( (>=>), when, forM, forM_ )
 import Control.Monad.Trans ( MonadIO(..) )
 import Control.Monad.Catch ( MonadMask )
 import Control.Monad.Except (throwError)
@@ -83,7 +84,7 @@ convertWithOpts scriptingEngine opts = do
                     return $ if exists
                                 then Just d
                                 else Nothing
-                  Just _    -> return $ optDataDir opts
+                  mdatadir  -> return mdatadir
 
   when (optDumpArgs opts) $
     do UTF8.hPutStrLn stdout (T.pack outputFile)
@@ -122,20 +123,12 @@ convertWithOpts' :: (PandocMonad m, MonadIO m, MonadMask m)
                  -> Opt
                  -> m (PandocOutput, [LogMessage])
 convertWithOpts' scriptingEngine istty datadir opts = do
+  configureCommonState datadir opts
   let outputFile = fromMaybe "-" (optOutputFile opts)
   let filters = optFilters opts
-  let verbosity = optVerbosity opts
-
   let sources = case optInputFiles opts of
                      Just xs | not (optIgnoreArgs opts) -> xs
                      _ -> ["-"]
-  setTrace (optTrace opts)
-  setVerbosity verbosity
-  setUserDataDir datadir
-  setResourcePath (optResourcePath opts)
-
-  setInputFiles (fromMaybe ["-"] (optInputFiles opts))
-  setOutputFile (optOutputFile opts)
 
   -- assign reader and writer based on options and filenames
   readerName <- case optFrom opts of
@@ -180,8 +173,6 @@ convertWithOpts' scriptingEngine istty datadir opts = do
   outputSettings <- optToOutputSettings scriptingEngine opts
   let format = outputFormat outputSettings
   let writer = outputWriter outputSettings
-  let writerName = outputWriterName outputSettings
-  let writerNameBase = T.takeWhile (\c -> c /= '+' && c /= '-') writerName
   let writerOptions = outputWriterOptions outputSettings
 
   -- whether we are targeting PDF.
@@ -190,7 +181,9 @@ convertWithOpts' scriptingEngine istty datadir opts = do
   let bibOutput = format `elem` ["bibtex", "biblatex", "csljson"]
   let standalone = isJust (writerTemplate writerOptions) || bibOutput
 
-
+  --
+  -- Sanity checks
+  --
   when (pdfOutput && readerNameBase == "latex") $
     case optInputFiles opts of
       Just (inputFile:_) -> report $ UnusualConversion $ T.pack $
@@ -212,44 +205,25 @@ convertWithOpts' scriptingEngine istty datadir opts = do
             "Specify an output file using the -o option, or " <>
             "use '-o -' to force output to stdout."
 
+  when (readerNameBase == "markdown_github" ||
+        format == "markdown_github") $
+    report $ Deprecated "markdown_github" "Use gfm instead."
 
-  abbrevs <- Set.fromList . filter (not . T.null) . T.lines . UTF8.toText <$>
-             case optAbbreviations opts of
-                  Nothing -> readDataFile "abbreviations"
-                  Just f  -> readFileStrict f
-
-  case lookupMetaString "lang" (optMetadata opts) of
-         ""      -> setTranslations $ Lang "en" Nothing (Just "US") [] [] []
-         l       -> case parseLang l of
-                         Left _   -> report $ InvalidLang l
-                         Right l' -> setTranslations l'
-
+  abbrevs <- readAbbreviations (optAbbreviations opts)
   let readerOpts = def{
           readerStandalone = standalone
         , readerColumns = optColumns opts
         , readerTabStop = optTabStop opts
         , readerIndentedCodeClasses = optIndentedCodeClasses opts
-        , readerDefaultImageExtension =
-           optDefaultImageExtension opts
+        , readerDefaultImageExtension = optDefaultImageExtension opts
         , readerTrackChanges = optTrackChanges opts
         , readerAbbreviations = abbrevs
         , readerExtensions = readerExts
         , readerStripComments = optStripComments opts
         }
 
-  metadataFromFile <-
-    case optMetadataFiles opts of
-      []    -> return mempty
-      paths -> do
-        -- If format is markdown or commonmark, use the enabled extensions,
-        -- otherwise treat metadata as pandoc markdown (see #7926, #6832)
-        let readerOptsMeta =
-              if readerNameBase == "markdown" || readerNameBase == "commonmark"
-                 then readerOpts
-                 else readerOpts{ readerExtensions = pandocExtensions }
-        mconcat <$> mapM
-              (\path -> do raw <- readMetadataFile path
-                           yamlToMeta readerOptsMeta (Just path) raw) paths
+  metadataFromFile <- getMetadataFromFiles readerNameBase readerOpts
+                         (optMetadataFiles opts)
 
   let transforms = (case optShiftHeadingLevelBy opts of
                         0             -> id
@@ -275,14 +249,6 @@ convertWithOpts' scriptingEngine istty datadir opts = do
                                           _        -> Format format) :))
                    $ []
 
-  when (readerNameBase == "markdown_github" ||
-        writerNameBase == "markdown_github") $
-    report $ Deprecated "markdown_github" "Use gfm instead."
-
-  mapM_ (uncurry setRequestHeader) (optRequestHeaders opts)
-
-  setNoCheckCertificate (optNoCheckCertificate opts)
-
   let isPandocCiteproc (JSONFilter f) = takeBaseName f == "pandoc-citeproc"
       isPandocCiteproc _              = False
 
@@ -319,25 +285,14 @@ convertWithOpts' scriptingEngine istty datadir opts = do
             >=> applyFilters scriptingEngine filterEnv filters [T.unpack format]
             >=> (if not (optSandbox opts) &&
                     (isJust (optExtractMedia opts)
-                     || writerNameBase == "docx") -- for fallback pngs
+                     || format == "docx") -- for fallback pngs
                  then fillMediaBag
                  else return)
             >=> maybe return extractMedia (optExtractMedia opts)
             )
 
-  when (writerNameBase == "docx" && not (optSandbox opts)) $ do
-    -- create fallback pngs for svgs
-    items <- mediaItems <$> getMediaBag
-    forM_ items $ \(fp, mt, bs) ->
-      case T.takeWhile (/=';') mt of
-        "image/svg+xml" -> do
-          res <- svgToPng (writerDpi writerOptions) bs
-          case res of
-            Right bs' -> do
-              let fp' = fp <> ".png"
-              insertMedia fp' (Just "image/png") bs'
-            Left e -> report $ CouldNotConvertImage (T.pack fp) (tshow e)
-        _ -> return ()
+  when (format == "docx" && not (optSandbox opts)) $ do
+    createPngFallbacks (writerDpi writerOptions)
 
   output <- case writer of
     ByteStringWriter f -> BinaryOutput <$> f writerOptions doc
@@ -367,6 +322,64 @@ data PandocOutput = TextOutput Text | BinaryOutput BL.ByteString
 
 type Transform = Pandoc -> Pandoc
 
+-- | Configure the common state
+configureCommonState :: PandocMonad m => Maybe FilePath -> Opt -> m ()
+configureCommonState datadir opts = do
+  setUserDataDir datadir
+  setTrace (optTrace opts)
+  setVerbosity (optVerbosity opts)
+  setResourcePath (optResourcePath opts)
+  setInputFiles (fromMaybe ["-"] (optInputFiles opts))
+  setOutputFile (optOutputFile opts)
+  setNoCheckCertificate (optNoCheckCertificate opts)
+
+  mapM_ (uncurry setRequestHeader) (optRequestHeaders opts)
+
+  case lookupMetaString "lang" (optMetadata opts) of
+    ""      -> setTranslations $ Lang "en" Nothing (Just "US") [] [] []
+    l       -> case parseLang l of
+                 Left _   -> report $ InvalidLang l
+                 Right l' -> setTranslations l'
+
+-- | Retrieves the set of abbreviations to be used by pandoc. These currently
+-- only affect the Markdown reader.
+readAbbreviations :: PandocMonad m => Maybe FilePath -> m (Set.Set Text)
+readAbbreviations mbfilepath =
+  Set.fromList . filter (not . T.null) . T.lines . UTF8.toText <$>
+  case mbfilepath of
+    Nothing -> readDataFile "abbreviations"
+    Just f  -> readFileStrict f
+
+createPngFallbacks :: (PandocMonad m, MonadIO m) => Int -> m ()
+createPngFallbacks dpi = do
+  -- create fallback pngs for svgs
+  items <- mediaItems <$> getMediaBag
+  forM_ items $ \(fp, mt, bs) ->
+    case T.takeWhile (/=';') mt of
+      "image/svg+xml" -> do
+        res <- svgToPng dpi bs
+        case res of
+          Right bs' -> do
+            let fp' = fp <> ".png"
+            insertMedia fp' (Just "image/png") bs'
+          Left e -> report $ CouldNotConvertImage (T.pack fp) (tshow e)
+      _ -> return ()
+
+getMetadataFromFiles :: PandocMonad m
+                     => Text -> ReaderOptions -> [FilePath] -> m Meta
+getMetadataFromFiles readerFormat readerOpts = \case
+  []    -> return mempty
+  paths -> mconcat <$> do
+    -- If format is markdown or commonmark, use the enabled extensions,
+    -- otherwise treat metadata as pandoc markdown (see #7926, #6832)
+    let readerOptsMeta =
+          if readerFormat `elem` ["markdown", "commonmark"]
+          then readerOpts
+          else readerOpts{ readerExtensions = pandocExtensions }
+    forM paths $ \path -> do
+      raw <- readMetadataFile path
+      yamlToMeta readerOptsMeta (Just path) raw
+
 htmlFormat :: Text -> Bool
 htmlFormat = (`elem` ["html","html4","html5","s5","slidy",
                       "slideous","dzslides","revealjs"])