aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2018-09-15 14:32:06 -0700
committerGitHub <noreply@github.com>2018-09-15 14:32:06 -0700
commit6bd8037b8dc3a6e9d820d412d23fff99ec0c21a6 (patch)
treea58c10319121ad847f1c39e0c22cee9863fbfb70 /src/Text
parentf736dea4ba71f81b37ff28a218115871249b35ec (diff)
parent5347e9454fae70cd2b534ad8e3c02d1cea8c2d93 (diff)
downloadpandoc-6bd8037b8dc3a6e9d820d412d23fff99ec0c21a6.tar.gz
Merge pull request #4604 from mb21/yaml-file
Introduce --metadata-file option
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/App.hs17
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs101
2 files changed, 69 insertions, 49 deletions
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 44bb30223..cb1db4f89 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -89,6 +89,7 @@ import Text.Pandoc.Builder (setMeta, deleteMeta)
import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters)
import Text.Pandoc.Highlighting (highlightingStyles)
import Text.Pandoc.PDF (makePDF)
+import Text.Pandoc.Readers.Markdown (yamlToMeta)
import Text.Pandoc.SelfContained (makeDataURI, makeSelfContained)
import Text.Pandoc.Shared (eastAsianLineBreakFilter, stripEmptyParagraphs,
headerShift, isURI, ordNub, safeRead, tabFilter, uriPathToPath)
@@ -399,6 +400,10 @@ convertWithOpts opts = do
("application/xml", jatsCSL)
return $ ("csl", jatsEncoded) : optMetadata opts
else return $ optMetadata opts
+ metadataFromFile <-
+ case optMetadataFile opts of
+ Nothing -> return mempty
+ Just file -> readFileLazy file >>= yamlToMeta
case lookup "lang" (optMetadata opts) of
Just l -> case parseBCP47 l of
@@ -491,6 +496,7 @@ convertWithOpts opts = do
( (if isJust (optExtractMedia opts)
then fillMediaBag
else return)
+ >=> return . addNonPresentMetadata metadataFromFile
>=> return . addMetadata metadata
>=> applyTransforms transforms
>=> applyFilters readerOpts filters' [format]
@@ -556,6 +562,7 @@ data Opt = Opt
, optTemplate :: Maybe FilePath -- ^ Custom template
, optVariables :: [(String,String)] -- ^ Template variables to set
, optMetadata :: [(String, String)] -- ^ Metadata fields to set
+ , optMetadataFile :: Maybe FilePath -- ^ Name of YAML metadata file
, optOutputFile :: Maybe FilePath -- ^ Name of output file
, optInputFiles :: [FilePath] -- ^ Names of input files
, optNumberSections :: Bool -- ^ Number sections in LaTeX
@@ -628,6 +635,7 @@ defaultOpts = Opt
, optTemplate = Nothing
, optVariables = []
, optMetadata = []
+ , optMetadataFile = Nothing
, optOutputFile = Nothing
, optInputFiles = []
, optNumberSections = False
@@ -687,6 +695,9 @@ defaultOpts = Opt
, optStripComments = False
}
+addNonPresentMetadata :: Text.Pandoc.Meta -> Pandoc -> Pandoc
+addNonPresentMetadata newmeta (Pandoc meta bs) = Pandoc (meta <> newmeta) bs
+
addMetadata :: [(String, String)] -> Pandoc -> Pandoc
addMetadata kvs pdc = foldr addMeta (removeMetaKeys kvs pdc) kvs
@@ -963,6 +974,12 @@ options =
"KEY[:VALUE]")
""
+ , Option "" ["metadata-file"]
+ (ReqArg
+ (\arg opt -> return opt{ optMetadataFile = Just arg })
+ "FILE")
+ ""
+
, Option "V" ["variable"]
(ReqArg
(\arg opt -> do
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index a81942a9e..502abae9a 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -31,11 +31,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of markdown-formatted plain text to 'Pandoc' document.
-}
-module Text.Pandoc.Readers.Markdown ( readMarkdown ) where
+module Text.Pandoc.Readers.Markdown ( readMarkdown, yamlToMeta ) where
import Prelude
import Control.Monad
import Control.Monad.Except (throwError)
+import qualified Data.ByteString.Lazy as BS
import Data.Char (isAlphaNum, isPunctuation, isSpace, toLower)
import Data.List (intercalate, sortBy, transpose, elemIndex)
import qualified Data.Map as M
@@ -233,7 +234,6 @@ pandocTitleBlock = try $ do
yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)
yamlMetaBlock = try $ do
guardEnabled Ext_yaml_metadata_block
- pos <- getPosition
string "---"
blankline
notFollowedBy blankline -- if --- is followed by a blank it's an HRULE
@@ -241,47 +241,45 @@ yamlMetaBlock = try $ do
-- by including --- and ..., we allow yaml blocks with just comments:
let rawYaml = unlines ("---" : (rawYamlLines ++ ["..."]))
optional blanklines
- case YAML.decodeNode' YAML.failsafeSchemaResolver False False
- (UTF8.fromStringLazy rawYaml) of
- Right [YAML.Doc (YAML.Mapping _ hashmap)] ->
- mapM_ (\(key, v) -> do
- k <- nodeToKey key
- if ignorable k
- then return ()
- else do
- v' <- yamlToMeta v
- let k' = T.unpack k
- updateState $ \st -> st{ stateMeta' =
- do m <- stateMeta' st
- -- if there's already a value, leave it unchanged
- case lookupMeta k' m of
- Just _ -> return m
- Nothing -> do
- v'' <- v'
- return $ B.setMeta (T.unpack k) v'' m})
- (M.toList hashmap)
- Right [] -> return ()
- Right [YAML.Doc (YAML.Scalar YAML.SNull)] -> return ()
+ newMetaF <- yamlBsToMeta $ UTF8.fromStringLazy rawYaml
+ -- Since `<>` is left-biased, existing values are not touched:
+ updateState $ \st -> st{ stateMeta' = (stateMeta' st) <> newMetaF }
+ return mempty
+
+-- | Read a YAML string and convert it to pandoc metadata.
+-- String scalars in the YAML are parsed as Markdown.
+yamlToMeta :: PandocMonad m => BS.ByteString -> m Meta
+yamlToMeta bstr = do
+ let parser = do
+ meta <- yamlBsToMeta bstr
+ return $ runF meta defaultParserState
+ parsed <- readWithM parser def ""
+ case parsed of
+ Right result -> return result
+ Left e -> throwError e
+
+yamlBsToMeta :: PandocMonad m => BS.ByteString -> MarkdownParser m (F Meta)
+yamlBsToMeta bstr = do
+ pos <- getPosition
+ case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
+ Right ((YAML.Doc (YAML.Mapping _ o)):_) -> (fmap Meta) <$> yamlMap o
+ Right [] -> return . return $ mempty
+ Right [YAML.Doc (YAML.Scalar YAML.SNull)] -> return . return $ mempty
Right _ -> do
logMessage $
CouldNotParseYamlMetadata "not an object"
pos
- return ()
+ return . return $ mempty
Left err' -> do
logMessage $ CouldNotParseYamlMetadata
err' pos
- return ()
- return mempty
+ return . return $ mempty
nodeToKey :: Monad m => YAML.Node -> m Text
nodeToKey (YAML.Scalar (YAML.SStr t)) = return t
nodeToKey (YAML.Scalar (YAML.SUnknown _ t)) = return t
nodeToKey _ = fail "Non-string key in YAML mapping"
--- ignore fields ending with _
-ignorable :: Text -> Bool
-ignorable t = (T.pack "_") `T.isSuffixOf` t
-
toMetaValue :: PandocMonad m
=> Text -> MarkdownParser m (F MetaValue)
toMetaValue x =
@@ -309,9 +307,9 @@ checkBoolean t =
then Just False
else Nothing
-yamlToMeta :: PandocMonad m
- => YAML.Node -> MarkdownParser m (F MetaValue)
-yamlToMeta (YAML.Scalar x) =
+yamlToMetaValue :: PandocMonad m
+ => YAML.Node -> MarkdownParser m (F MetaValue)
+yamlToMetaValue (YAML.Scalar x) =
case x of
YAML.SStr t -> toMetaValue t
YAML.SBool b -> return $ return $ MetaBool b
@@ -322,25 +320,30 @@ yamlToMeta (YAML.Scalar x) =
Just b -> return $ return $ MetaBool b
Nothing -> toMetaValue t
YAML.SNull -> return $ return $ MetaString ""
-yamlToMeta (YAML.Sequence _ xs) = do
- xs' <- mapM yamlToMeta xs
+yamlToMetaValue (YAML.Sequence _ xs) = do
+ xs' <- mapM yamlToMetaValue xs
return $ do
xs'' <- sequence xs'
return $ B.toMetaValue xs''
-yamlToMeta (YAML.Mapping _ o) =
- foldM (\m (key, v) -> do
- k <- nodeToKey key
- if ignorable k
- then return m
- else do
- v' <- yamlToMeta v
- return $ do
- MetaMap m' <- m
- v'' <- v'
- return (MetaMap $ M.insert (T.unpack k) v'' m'))
- (return $ MetaMap M.empty)
- (M.toList o)
-yamlToMeta _ = return $ return $ MetaString ""
+yamlToMetaValue (YAML.Mapping _ o) = fmap B.toMetaValue <$> yamlMap o
+yamlToMetaValue _ = return $ return $ MetaString ""
+
+yamlMap :: PandocMonad m
+ => M.Map YAML.Node YAML.Node
+ -> MarkdownParser m (F (M.Map String MetaValue))
+yamlMap o = do
+ kvs <- forM (M.toList o) $ \(key, v) -> do
+ k <- nodeToKey key
+ return (k, v)
+ let kvs' = filter (not . ignorable . fst) kvs
+ (fmap M.fromList . sequence) <$> mapM toMeta kvs'
+ where
+ ignorable t = (T.pack "_") `T.isSuffixOf` t
+ toMeta (k, v) = do
+ fv <- yamlToMetaValue v
+ return $ do
+ v' <- fv
+ return (T.unpack k, v')
stopLine :: PandocMonad m => MarkdownParser m ()
stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()