From 9cb0581de6b485ddfbd37e66414990339cd44b72 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 19 Nov 2010 22:13:30 -0800 Subject: Shared: Added findFirstFile, findDataFile, refactored readDataFile. --- src/Text/Pandoc/Shared.hs | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 0fdaf42f3..67c5153c7 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -71,6 +71,8 @@ module Text.Pandoc.Shared ( defaultWriterOptions, -- * File handling inDirectory, + findFirstFile, + findDataFile, readDataFile ) where @@ -538,11 +540,28 @@ inDirectory path action = do setCurrentDirectory oldDir return result +-- | Get full file path for the first of a list of files found in the +-- specified directory. +findFirstFile :: (Maybe FilePath) -> [FilePath] -> IO (Maybe FilePath) +findFirstFile Nothing _ = return Nothing +findFirstFile (Just _) [] = return Nothing +findFirstFile (Just dir) (f:fs) = do + ex <- doesFileExist (dir f) + if ex + then return $ Just (dir f) + else findFirstFile (Just dir) fs + +-- | Get file path for data file, either from specified user data directory, +-- or, if not found there, from Cabal data directory. +findDataFile :: Maybe FilePath -> FilePath -> IO FilePath +findDataFile Nothing f = getDataFileName f +findDataFile (Just u) f = do + ex <- doesFileExist (u f) + if ex + then return (u f) + else getDataFileName f + -- | Read file from specified user data directory or, if not found there, from -- Cabal data directory. readDataFile :: Maybe FilePath -> FilePath -> IO String -readDataFile userDir fname = - case userDir of - Nothing -> getDataFileName fname >>= UTF8.readFile - Just u -> catch (UTF8.readFile $ u fname) - (\_ -> getDataFileName fname >>= UTF8.readFile) +readDataFile userDir fname = findDataFile userDir fname >>= UTF8.readFile -- cgit v1.2.3 From 3eef887dfa4e47095c4be9b2bdbf67c002e29f90 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 20 Nov 2010 08:11:30 -0800 Subject: Citation related changes. * Don't look for bibliography in ~/.pandoc. Reason: doing this requires a read + parse of the bibliography even when the document doesn't use citations. This is a big performance drag on regular pandoc invocations. * Only look for default.csl if the document contains references. Reason: avoids the need to read and parse csl file when the document contains no references anyway. * Removed findFirstFile from Shared. --- src/Text/Pandoc/Biblio.hs | 5 +++-- src/Text/Pandoc/Shared.hs | 12 ------------ src/pandoc.hs | 31 +++++++++---------------------- 3 files changed, 12 insertions(+), 36 deletions(-) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs index 12911e1ee..a60909e19 100644 --- a/src/Text/Pandoc/Biblio.hs +++ b/src/Text/Pandoc/Biblio.hs @@ -38,10 +38,11 @@ import Text.Pandoc.Definition -- | Process a 'Pandoc' document by adding citations formatted -- according to a CSL style, using 'citeproc' from citeproc-hs. -processBiblio :: Style -> [Reference] -> Pandoc -> IO Pandoc -processBiblio csl r p +processBiblio :: FilePath -> [Reference] -> Pandoc -> IO Pandoc +processBiblio cslfile r p = if null r then return p else do + csl <- readCSLFile cslfile p' <- processWithM setHash p let (nts,grps) = if styleClass csl /= "note" then (,) [] $ queryWith getCitation p' diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 67c5153c7..6cc48b88c 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -71,7 +71,6 @@ module Text.Pandoc.Shared ( defaultWriterOptions, -- * File handling inDirectory, - findFirstFile, findDataFile, readDataFile ) where @@ -540,17 +539,6 @@ inDirectory path action = do setCurrentDirectory oldDir return result --- | Get full file path for the first of a list of files found in the --- specified directory. -findFirstFile :: (Maybe FilePath) -> [FilePath] -> IO (Maybe FilePath) -findFirstFile Nothing _ = return Nothing -findFirstFile (Just _) [] = return Nothing -findFirstFile (Just dir) (f:fs) = do - ex <- doesFileExist (dir f) - if ex - then return $ Just (dir f) - else findFirstFile (Just dir) fs - -- | Get file path for data file, either from specified user data directory, -- or, if not found there, from Cabal data directory. findDataFile :: Maybe FilePath -> FilePath -> IO FilePath diff --git a/src/pandoc.hs b/src/pandoc.hs index ab4110b42..66a09b309 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -32,7 +32,7 @@ module Main where import Text.Pandoc import Text.Pandoc.S5 (s5HeaderIncludes) import Text.Pandoc.Shared ( tabFilter, ObfuscationMethod (..), readDataFile, - headerShift, findDataFile, findFirstFile ) + headerShift, findDataFile ) #ifdef _HIGHLIGHTING import Text.Pandoc.Highlighting ( languages ) #endif @@ -767,25 +767,6 @@ main = do return $ ("mathml-script", s) : variables' _ -> return variables' -#ifdef _CITEPROC - cslfile' <- if null cslfile - then findDataFile datadir "default.csl" - else return cslfile - csl <- readCSLFile cslfile' - refs' <- if null refs - then do - f <- findFirstFile datadir - ["biblio.xml","biblio.json","biblio.bib"] - case f of - Just x -> catch (readBiblioFile x) $ \e -> do - UTF8.hPutStrLn stderr $ - "Error reading bibliography `" ++ x ++ "'" - UTF8.hPutStrLn stderr $ show e - exitWith (ExitFailure 23) >> return [] - Nothing -> return [] - else return refs -#endif - let sourceDir = if null sources then "." else takeDirectory (head sources) @@ -803,7 +784,7 @@ main = do lhsExtension sources, stateStandalone = standalone', #ifdef _CITEPROC - stateCitations = map refId refs', + stateCitations = map refId refs, #endif stateSmart = smart || writerName' `elem` ["latex", "context", "latex+lhs", "man"], @@ -863,7 +844,13 @@ main = do doc'' <- do #ifdef _CITEPROC - processBiblio csl refs' doc' + if null refs + then return doc' + else do + cslfile' <- if null cslfile + then findDataFile datadir "default.csl" + else return cslfile + processBiblio cslfile' refs doc' #else return doc' #endif -- cgit v1.2.3 From 044a9a61574ff1414b44e2f92307996cba00a2e1 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 27 Nov 2010 07:08:06 -0800 Subject: Added 'stringify' to Text.Pandoc.Shared. --- src/Text/Pandoc/Shared.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 6cc48b88c..f2f38519b 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -57,6 +57,7 @@ module Text.Pandoc.Shared ( -- * Pandoc block and inline list processing orderedListMarkers, normalizeSpaces, + stringify, compactify, Element (..), hierarchicalize, @@ -340,6 +341,15 @@ normalizeSpaces list = else lst in removeLeading $ removeTrailing $ removeDoubles list +-- | Convert list of inlines to a string with formatting removed. +stringify :: [Inline] -> String +stringify = queryWith go + where go :: Inline -> [Char] + go Space = " " + go (Str x) = x + go (Code x) = x + go _ = "" + -- | Change final list item from @Para@ to @Plain@ if the list contains -- no other @Para@ blocks. compactify :: [[Block]] -- ^ List of list items (each a list of blocks) -- cgit v1.2.3