1 files changed, 40 insertions, 30 deletions
diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs
index 244f77940..b099a9b50 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -30,45 +30,55 @@ import Text.Pandoc.Readers.Metadata (yamlMetaBlock)
 import Control.Monad.Except
 import Data.Functor.Identity (runIdentity)
 import Data.Typeable
-import Text.Pandoc.Parsing (runParserT, getPosition, sourceLine,
-                            runF, defaultParserState, take1WhileP, option)
+import Text.Pandoc.Parsing (runParserT, getPosition,
+                            runF, defaultParserState, option, many1, anyChar,
+                            Sources(..), ToSources(..), ParserT, Future,
+                            sourceName)
 import qualified Data.Text as T
 
 -- | Parse a CommonMark formatted string into a 'Pandoc' structure.
-readCommonMark :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
+readCommonMark :: (PandocMonad m, ToSources a)
+               => ReaderOptions -> a -> m Pandoc
 readCommonMark opts s
-  | isEnabled Ext_yaml_metadata_block opts
-  , "---" `T.isPrefixOf` s = do
-       let metaValueParser = do
-             inp <- option "" $ take1WhileP (const True)
-             case runIdentity
-                    (commonmarkWith (specFor opts) "metadata value" inp) of
-                    Left _ -> mzero
-                    Right (Cm bls :: Cm () Blocks)
-                             -> return $ return $ B.toMetaValue bls
-       res <- runParserT (do meta <- yamlMetaBlock metaValueParser
-                             pos <- getPosition
-                             return (meta, pos))
-                         defaultParserState "YAML metadata" s
-       case res of
-         Left _ -> readCommonMarkBody opts s
-         Right (meta, pos) -> do
-           let dropLines 0 = id
-               dropLines n = dropLines (n - 1) . T.drop 1 . T.dropWhile (/='\n')
-           let metaLines = sourceLine pos - 1
-           let body = T.replicate metaLines "\n" <> dropLines metaLines s
-           Pandoc _ bs <- readCommonMarkBody opts body
-           return $ Pandoc (runF meta defaultParserState) bs
-  | otherwise = readCommonMarkBody opts s
+  | isEnabled Ext_yaml_metadata_block opts = do
+    let sources = toSources s
+    let toks = concatMap sourceToToks (unSources sources)
+    res <- runParserT (do meta <- yamlMetaBlock (metaValueParser opts)
+                          pos <- getPosition
+                          return (meta, pos))
+                      defaultParserState "YAML metadata" (toSources s)
+    case res of
+      Left _ -> readCommonMarkBody opts sources toks
+      Right (meta, pos) -> do
+        -- strip off metadata section and parse body
+        let body = dropWhile (\t -> tokPos t < pos) toks
+        Pandoc _ bs <- readCommonMarkBody opts sources body
+        return $ Pandoc (runF meta defaultParserState) bs
+  | otherwise = do
+    let sources = toSources s
+    let toks = concatMap sourceToToks (unSources sources)
+    readCommonMarkBody opts sources toks
 
-readCommonMarkBody :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
-readCommonMarkBody opts s
+sourceToToks :: (SourcePos, Text) -> [Tok]
+sourceToToks (pos, s) = tokenize (sourceName pos) s
+
+metaValueParser :: Monad m
+                => ReaderOptions -> ParserT Sources st m (Future st MetaValue)
+metaValueParser opts = do
+  inp <- option "" $ T.pack <$> many1 anyChar
+  let toks = concatMap sourceToToks (unSources (toSources inp))
+  case runIdentity (parseCommonmarkWith (specFor opts) toks) of
+     Left _ -> mzero
+     Right (Cm bls :: Cm () Blocks) -> return $ return $ B.toMetaValue bls
+
+readCommonMarkBody :: PandocMonad m => ReaderOptions -> Sources -> [Tok] -> m Pandoc
+readCommonMarkBody opts s toks
   | isEnabled Ext_sourcepos opts =
-    case runIdentity (commonmarkWith (specFor opts) "" s) of
+    case runIdentity (parseCommonmarkWith (specFor opts) toks) of
       Left err -> throwError $ PandocParsecError s err
       Right (Cm bls :: Cm SourceRange Blocks) -> return $ B.doc bls
   | otherwise =
-    case runIdentity (commonmarkWith (specFor opts) "" s) of
+    case runIdentity (parseCommonmarkWith (specFor opts) toks) of
       Left err -> throwError $ PandocParsecError s err
       Right (Cm bls :: Cm () Blocks) -> return $ B.doc bls