diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/App.hs | 17 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 101 |
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 () |