diff options
| -rw-r--r-- | MANUAL.txt | 4 | ||||
| -rw-r--r-- | pandoc.cabal | 9 | ||||
| -rw-r--r-- | src/Text/Pandoc/App.hs | 11 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 102 | ||||
| -rw-r--r-- | src/Text/Pandoc/Translations.hs | 39 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 2 | ||||
| -rw-r--r-- | stack.lts9.yaml | 2 | ||||
| -rw-r--r-- | stack.yaml | 2 |
8 files changed, 94 insertions, 77 deletions
diff --git a/MANUAL.txt b/MANUAL.txt index 93b82f81c..8421ef674 100644 --- a/MANUAL.txt +++ b/MANUAL.txt @@ -3059,7 +3059,9 @@ Metadata will be taken from the fields of the YAML object and added to any existing document metadata. Metadata can contain lists and objects (nested arbitrarily), but all string scalars will be interpreted as Markdown. Fields with names ending in an underscore will be ignored by pandoc. (They may be -given a role by external processors.) +given a role by external processors.) Field names must not be +interpretable as YAML numbers or boolean values (so, for +example, `yes`, `True`, and `15` cannot be used as field names). A document may contain multiple metadata blocks. The metadata fields will be combined through a *left-biased union*: if two metadata blocks attempt diff --git a/pandoc.cabal b/pandoc.cabal index af76a9c3c..636f77482 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -370,7 +370,6 @@ library temporary >= 1.1 && < 1.4, blaze-html >= 0.9 && < 0.10, blaze-markup >= 0.8 && < 0.9, - scientific >= 0.2 && < 0.4, vector >= 0.10 && < 0.13, hslua >= 0.9.5 && < 0.9.6, hslua-module-text >= 0.1.2 && < 0.2, @@ -387,12 +386,10 @@ library http-client >= 0.4.30 && < 0.6, http-client-tls >= 0.2.4 && < 0.4, http-types >= 0.8 && < 0.13, - case-insensitive >= 1.2 && < 1.3 + case-insensitive >= 1.2 && < 1.3, + HsYAML >= 0.1.1.1 && < 0.2 if impl(ghc < 8.0) - build-depends: semigroups == 0.18.*, - yaml >= 0.8.11 && < 0.8.31 - else - build-depends: yaml >= 0.8.11 && < 0.9 + build-depends: semigroups == 0.18.* if impl(ghc < 8.4) hs-source-dirs: prelude other-modules: Prelude diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 5cbbe13e7..b79273092 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -62,8 +62,7 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TE import qualified Data.Text.Encoding.Error as TE -import Data.Yaml (decodeEither') -import qualified Data.Yaml as Yaml +import qualified Data.YAML as YAML import GHC.Generics import Network.URI (URI (..), parseURI) #ifdef EMBED_DATA_FILES @@ -702,9 +701,11 @@ removeMetaKeys :: [(String,String)] -> Pandoc -> Pandoc removeMetaKeys kvs pdc = foldr (deleteMeta . fst) pdc kvs readMetaValue :: String -> MetaValue -readMetaValue s = case decodeEither' (UTF8.fromString s) of - Right (Yaml.String t) -> MetaString $ T.unpack t - Right (Yaml.Bool b) -> MetaBool b +readMetaValue s = case YAML.decodeStrict (UTF8.fromString s) of + Right [YAML.Scalar (YAML.SStr t)] + -> MetaString $ T.unpack t + Right [YAML.Scalar (YAML.SBool b)] + -> MetaBool b _ -> MetaString s -- Determine default reader based on source file extensions diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 0cd9ce63f..9fe84013f 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -37,18 +37,14 @@ import Prelude import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isAlphaNum, isPunctuation, isSpace, toLower) -import qualified Data.HashMap.Strict as H import Data.List (intercalate, sortBy, transpose, elemIndex) import qualified Data.Map as M import Data.Maybe import Data.Ord (comparing) -import Data.Scientific (base10Exponent, coefficient) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Vector as V -import Data.Yaml (ParseException (..), YamlException (..), YamlMark (..)) -import qualified Data.Yaml as Yaml +import qualified Data.YAML as YAML import System.FilePath (addExtension, takeExtension) import Text.HTML.TagSoup import Text.Pandoc.Builder (Blocks, Inlines) @@ -246,47 +242,38 @@ yamlMetaBlock = try $ do -- by including --- and ..., we allow yaml blocks with just comments: let rawYaml = unlines ("---" : (rawYamlLines ++ ["..."])) optional blanklines - case Yaml.decodeEither' $ UTF8.fromString rawYaml of - Right (Yaml.Object hashmap) -> do - let alist = H.toList hashmap - mapM_ (\(k, v) -> - 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} + case YAML.decodeStrict (UTF8.fromString rawYaml) of + Right (YAML.Mapping _ hashmap : _) -> do + let alist = M.toList hashmap + mapM_ (\(k', v) -> + case YAML.parseEither (YAML.parseYAML k') of + Left e -> fail e + Right k -> do + 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} ) alist - Right Yaml.Null -> return () + Right [] -> return () + Right (YAML.Scalar YAML.SNull:_) -> return () Right _ -> do - logMessage $ - CouldNotParseYamlMetadata "not an object" - pos - return () + logMessage $ + CouldNotParseYamlMetadata "not an object" + pos + return () Left err' -> do - case err' of - InvalidYaml (Just YamlParseException{ - yamlProblem = problem - , yamlContext = _ctxt - , yamlProblemMark = Yaml.YamlMark { - yamlLine = yline - , yamlColumn = ycol - }}) -> - logMessage $ CouldNotParseYamlMetadata - problem (setSourceLine - (setSourceColumn pos - (sourceColumn pos + ycol)) - (sourceLine pos + 1 + yline)) - _ -> logMessage $ CouldNotParseYamlMetadata - (show err') pos - return () + logMessage $ CouldNotParseYamlMetadata + err' pos + return () return mempty -- ignore fields ending with _ @@ -313,22 +300,25 @@ toMetaValue x = -- `|` or `>` will. yamlToMeta :: PandocMonad m - => Yaml.Value -> MarkdownParser m (F MetaValue) -yamlToMeta (Yaml.String t) = toMetaValue t -yamlToMeta (Yaml.Number n) - -- avoid decimal points for numbers that don't need them: - | base10Exponent n >= 0 = return $ return $ MetaString $ show - $ coefficient n * (10 ^ base10Exponent n) - | otherwise = return $ return $ MetaString $ show n -yamlToMeta (Yaml.Bool b) = return $ return $ MetaBool b -yamlToMeta (Yaml.Array xs) = do - xs' <- mapM yamlToMeta (V.toList xs) + => YAML.Node -> MarkdownParser m (F MetaValue) +yamlToMeta (YAML.Scalar x) = + case x of + YAML.SStr t -> toMetaValue t + YAML.SBool b -> return $ return $ MetaBool b + YAML.SFloat d -> return $ return $ MetaString (show d) + YAML.SInt i -> return $ return $ MetaString (show i) + _ -> return $ return $ MetaString "" +yamlToMeta (YAML.Sequence _ xs) = do + xs' <- mapM yamlToMeta xs return $ do xs'' <- sequence xs' return $ B.toMetaValue xs'' -yamlToMeta (Yaml.Object o) = do - let alist = H.toList o - foldM (\m (k,v) -> +yamlToMeta (YAML.Mapping _ o) = do + let alist = M.toList o + foldM (\m (k',v) -> + case YAML.parseEither (YAML.parseYAML k') of + Left e -> fail e + Right k -> do if ignorable k then return m else do diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs index 4a216af92..13dcb3b61 100644 --- a/src/Text/Pandoc/Translations.hs +++ b/src/Text/Pandoc/Translations.hs @@ -48,11 +48,12 @@ module Text.Pandoc.Translations ( ) where import Prelude -import Data.Aeson.Types (typeMismatch) +import Data.Aeson.Types (Value(..), FromJSON(..)) +import qualified Data.Aeson.Types as Aeson import qualified Data.HashMap.Strict as HM import qualified Data.Map as M import Data.Text as T -import Data.Yaml as Yaml +import qualified Data.YAML as YAML import GHC.Generics (Generic) import Text.Pandoc.Shared (safeRead) import qualified Text.Pandoc.UTF8 as UTF8 @@ -90,7 +91,15 @@ instance FromJSON Term where Just t' -> pure t' Nothing -> fail $ "Invalid Term name " ++ show t - parseJSON invalid = typeMismatch "Term" invalid + parseJSON invalid = Aeson.typeMismatch "Term" invalid + +instance YAML.FromYAML Term where + parseYAML (YAML.Scalar (YAML.SStr t)) = + case safeRead (T.unpack t) of + Just t' -> pure t' + Nothing -> fail $ "Invalid Term name " ++ + show t + parseYAML invalid = YAML.typeMismatch "Term" invalid instance FromJSON Translations where parseJSON (Object hm) = do @@ -102,14 +111,28 @@ instance FromJSON Translations where Just t -> case v of (String s) -> return (t, T.unpack $ T.strip s) - inv -> typeMismatch "String" inv - parseJSON invalid = typeMismatch "Translations" invalid + inv -> Aeson.typeMismatch "String" inv + parseJSON invalid = Aeson.typeMismatch "Translations" invalid + +instance YAML.FromYAML Translations where + parseYAML = YAML.withMap "Translations" $ + \tr -> Translations .M.fromList <$> mapM addItem (M.toList tr) + where addItem (n@(YAML.Scalar (YAML.SStr k)), v) = + case safeRead (T.unpack k) of + Nothing -> YAML.typeMismatch "Term" n + Just t -> + case v of + (YAML.Scalar (YAML.SStr s)) -> + return (t, T.unpack (T.strip s)) + n' -> YAML.typeMismatch "String" n' + addItem (n, _) = YAML.typeMismatch "String" n lookupTerm :: Term -> Translations -> Maybe String lookupTerm t (Translations tm) = M.lookup t tm readTranslations :: String -> Either String Translations readTranslations s = - case Yaml.decodeEither' $ UTF8.fromString s of - Left err' -> Left $ prettyPrintParseException err' - Right t -> Right t + case YAML.decodeStrict $ UTF8.fromString s of + Left err' -> Left err' + Right (t:_) -> Right t + Right [] -> Left "empty YAML document" diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index fe8f452d3..dc0b154bf 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -50,7 +50,7 @@ import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import qualified Data.Vector as V -import Data.Yaml (Value (Array, Bool, Number, Object, String)) +import Data.Aeson (Value (Array, Bool, Number, Object, String)) import Network.HTTP (urlEncode) import Text.HTML.TagSoup (Tag (..), isTagText, parseTags) import Text.Pandoc.Class (PandocMonad, report) diff --git a/stack.lts9.yaml b/stack.lts9.yaml index 355254618..75b6763b2 100644 --- a/stack.lts9.yaml +++ b/stack.lts9.yaml @@ -27,4 +27,6 @@ extra-deps: - pandoc-types-1.17.5 - haddock-library-1.6.0 - texmath-0.11 +- HsYAML-0.1.1.1 +- text-1.2.3.0 resolver: lts-9.14 diff --git a/stack.yaml b/stack.yaml index e0d7045c8..f9b573931 100644 --- a/stack.yaml +++ b/stack.yaml @@ -22,6 +22,8 @@ extra-deps: - hslua-module-text-0.1.2.1 - texmath-0.11 - haddock-library-1.6.0 +- HsYAML-0.1.1.1 +- text-1.2.3.0 ghc-options: "$locals": -fhide-source-paths -XNoImplicitPrelude resolver: lts-10.10 |