From 737d09e325a65ad37f97b03371d1999c0360dea0 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 10 Aug 2017 23:29:25 -0700 Subject: Removed datadir param from readDataFile and getDefaultTemplate. In Text.Pandoc.Class and Text.Pandoc.Template, resp. We now get the datadir from CommonState. --- src/Text/Pandoc/App.hs | 13 +++++++++---- src/Text/Pandoc/Class.hs | 34 ++++++++++++++++++++-------------- src/Text/Pandoc/Templates.hs | 27 +++++++++++++-------------- src/Text/Pandoc/Writers/Docx.hs | 2 +- src/Text/Pandoc/Writers/EPUB.hs | 3 +-- src/Text/Pandoc/Writers/ODT.hs | 3 +-- 6 files changed, 45 insertions(+), 37 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 8a7947de6..3174fe738 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -76,7 +76,8 @@ import System.IO.Error (isDoesNotExistError) import Text.Pandoc import Text.Pandoc.Builder (setMeta) import Text.Pandoc.Class (PandocIO, extractMedia, fillMediaBag, getLog, - setResourcePath, getMediaBag, setTrace, report) + setResourcePath, getMediaBag, setTrace, report, + setUserDataDir) import Text.Pandoc.Highlighting (highlightingStyles) import Text.Pandoc.Lua (runLuaFilter, LuaException(..)) import Text.Pandoc.Writers.Math (defaultMathJaxURL, defaultKaTeXURL) @@ -218,8 +219,9 @@ convertWithOpts opts = do templ <- case optTemplate opts of _ | not standalone -> return Nothing Nothing -> do - deftemp <- runIO $ - getDefaultTemplate datadir format + deftemp <- runIO $ do + setUserDataDir datadir + getDefaultTemplate format case deftemp of Left e -> E.throwIO e Right t -> return (Just t) @@ -444,6 +446,7 @@ convertWithOpts opts = do Native -> nativeNewline runIO' $ do + setUserDataDir datadir when (readerName == "markdown_github" || writerName == "markdown_github") $ report $ Deprecated "markdown_github" "Use gfm instead." @@ -996,7 +999,9 @@ options = , Option "D" ["print-default-template"] (ReqArg (\arg _ -> do - templ <- runIO $ getDefaultTemplate Nothing arg + templ <- runIO $ do + setUserDataDir Nothing + getDefaultTemplate arg case templ of Right t -> UTF8.hPutStr stdout t Left e -> E.throwIO e diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 8ef7f3c66..4697177ed 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -157,9 +157,9 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m) readFileStrict :: FilePath -> m B.ByteString -- | Read file from from Cabal data directory. readDefaultDataFile :: FilePath -> m B.ByteString - -- | Read file from specified user data directory or, + -- | Read file from user data directory or, -- if not found there, from Cabal data directory. - readDataFile :: Maybe FilePath -> FilePath -> m B.ByteString + readDataFile :: FilePath -> m B.ByteString -- | Return a list of paths that match a glob, relative to -- the working directory. See 'System.FilePath.Glob' for -- the glob syntax. @@ -335,7 +335,9 @@ instance PandocMonad PandocIO where readFileLazy s = liftIOError BL.readFile s readFileStrict s = liftIOError B.readFile s readDefaultDataFile fname = liftIOError IO.readDefaultDataFile fname - readDataFile mfp fname = liftIOError (IO.readDataFile mfp) fname + readDataFile fname = do + datadir <- getUserDataDir + liftIOError (IO.readDataFile datadir) fname glob = liftIO . IO.glob getModificationTime fp = liftIOError IO.getModificationTime fp getCommonState = PandocIO $ lift get @@ -629,12 +631,16 @@ instance PandocMonad PandocPure where readDefaultDataFile fname = do let fname' = if fname == "MANUAL.txt" then fname else "data" fname readFileStrict fname' - readDataFile (Just userDir) fname = do - userDirFiles <- getsPureState stUserDataFiles - case infoFileContents <$> getFileInfo (userDir fname) userDirFiles of - Just bs -> return bs - Nothing -> readDataFile Nothing fname - readDataFile Nothing fname = readDefaultDataFile fname + readDataFile fname = do + datadir <- getUserDataDir + case datadir of + Just userDir -> do + userDirFiles <- getsPureState stUserDataFiles + case infoFileContents <$> getFileInfo (userDir fname) + userDirFiles of + Just bs -> return bs + Nothing -> readDefaultDataFile fname + Nothing -> readDefaultDataFile fname glob s = do FileTree ftmap <- getsPureState stFiles @@ -662,7 +668,7 @@ instance PandocMonad m => PandocMonad (ParsecT s st m) where readFileLazy = lift . readFileLazy readFileStrict = lift . readFileStrict readDefaultDataFile = lift . readDefaultDataFile - readDataFile mbuserdir = lift . readDataFile mbuserdir + readDataFile = lift . readDataFile glob = lift . glob getModificationTime = lift . getModificationTime getCommonState = lift getCommonState @@ -691,7 +697,7 @@ instance PandocMonad m => PandocMonad (ReaderT r m) where readFileLazy = lift . readFileLazy readFileStrict = lift . readFileStrict readDefaultDataFile = lift . readDefaultDataFile - readDataFile mbuserdir = lift . readDataFile mbuserdir + readDataFile = lift . readDataFile glob = lift . glob getModificationTime = lift . getModificationTime getCommonState = lift getCommonState @@ -708,7 +714,7 @@ instance (PandocMonad m, Monoid w) => PandocMonad (WriterT w m) where readFileLazy = lift . readFileLazy readFileStrict = lift . readFileStrict readDefaultDataFile = lift . readDefaultDataFile - readDataFile mbuserdir = lift . readDataFile mbuserdir + readDataFile = lift . readDataFile glob = lift . glob getModificationTime = lift . getModificationTime getCommonState = lift getCommonState @@ -725,7 +731,7 @@ instance (PandocMonad m, Monoid w) => PandocMonad (RWST r w st m) where readFileLazy = lift . readFileLazy readFileStrict = lift . readFileStrict readDefaultDataFile = lift . readDefaultDataFile - readDataFile mbuserdir = lift . readDataFile mbuserdir + readDataFile = lift . readDataFile glob = lift . glob getModificationTime = lift . getModificationTime getCommonState = lift getCommonState @@ -742,7 +748,7 @@ instance PandocMonad m => PandocMonad (StateT st m) where readFileLazy = lift . readFileLazy readFileStrict = lift . readFileStrict readDefaultDataFile = lift . readDefaultDataFile - readDataFile mbuserdir = lift . readDataFile mbuserdir + readDataFile = lift . readDataFile glob = lift . glob getModificationTime = lift . getModificationTime getCommonState = lift getCommonState diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index 6582e0556..43b7dc37b 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -50,28 +50,27 @@ import qualified Text.Pandoc.UTF8 as UTF8 -- | Get default template for the specified writer. getDefaultTemplate :: PandocMonad m - => (Maybe FilePath) -- ^ User data directory to search 1st - -> String -- ^ Name of writer + => String -- ^ Name of writer -> m String -getDefaultTemplate user writer = do +getDefaultTemplate writer = do let format = takeWhile (`notElem` ("+-" :: String)) writer -- strip off extensions case format of "native" -> return "" "json" -> return "" "docx" -> return "" "fb2" -> return "" - "odt" -> getDefaultTemplate user "opendocument" - "html" -> getDefaultTemplate user "html5" - "docbook" -> getDefaultTemplate user "docbook5" - "epub" -> getDefaultTemplate user "epub3" - "markdown_strict" -> getDefaultTemplate user "markdown" - "multimarkdown" -> getDefaultTemplate user "markdown" - "markdown_github" -> getDefaultTemplate user "markdown" - "markdown_mmd" -> getDefaultTemplate user "markdown" - "markdown_phpextra" -> getDefaultTemplate user "markdown" - "gfm" -> getDefaultTemplate user "commonmark" + "odt" -> getDefaultTemplate "opendocument" + "html" -> getDefaultTemplate "html5" + "docbook" -> getDefaultTemplate "docbook5" + "epub" -> getDefaultTemplate "epub3" + "markdown_strict" -> getDefaultTemplate "markdown" + "multimarkdown" -> getDefaultTemplate "markdown" + "markdown_github" -> getDefaultTemplate "markdown" + "markdown_mmd" -> getDefaultTemplate "markdown" + "markdown_phpextra" -> getDefaultTemplate "markdown" + "gfm" -> getDefaultTemplate "commonmark" _ -> let fname = "templates" "default" <.> format - in UTF8.toString <$> readDataFile user fname + in UTF8.toString <$> readDataFile fname -- | Like 'applyTemplate', but runs in PandocMonad and -- raises an error if compilation fails. diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index a60056845..f20edbfaa 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -235,7 +235,7 @@ writeDocx opts doc@(Pandoc meta _) = do refArchive <- case writerReferenceDoc opts of Just f -> toArchive <$> P.readFileLazy f Nothing -> (toArchive . BL.fromStrict) <$> - P.readDataFile datadir "reference.docx" + P.readDataFile "reference.docx" parsedDoc <- parseXml refArchive distArchive "word/document.xml" let wname f qn = qPrefix qn == Just "w" && f (qName qn) diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index b04a7de51..04126fbb7 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -393,8 +393,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do -- stylesheet stylesheets <- case epubStylesheets metadata of [] -> (\x -> [B.fromChunks [x]]) <$> - P.readDataFile (writerUserDataDir opts) - "epub.css" + P.readDataFile "epub.css" fs -> mapM P.readFileLazy fs let stylesheetEntries = zipWith (\bs n -> mkEntry ("styles/stylesheet" ++ show n ++ ".css") bs) diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 785891a9f..160141822 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -78,14 +78,13 @@ pandocToODT :: PandocMonad m -> Pandoc -- ^ Document to convert -> O m B.ByteString pandocToODT opts doc@(Pandoc meta _) = do - let datadir = writerUserDataDir opts let title = docTitle meta lang <- toLang (getLang opts meta) refArchive <- case writerReferenceDoc opts of Just f -> liftM toArchive $ lift $ P.readFileLazy f Nothing -> lift $ (toArchive . B.fromStrict) <$> - P.readDataFile datadir "reference.odt" + P.readDataFile "reference.odt" -- handle formulas and pictures -- picEntriesRef <- P.newIORef ([] :: [Entry]) doc' <- walkM (transformPicMath opts) $ walk fixDisplayMath doc -- cgit v1.2.3