aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/App/Opt.hs
diff options
context:
space:
mode:
authorNikolay Yakimov <root@livid.pp.ru>2020-05-25 15:11:36 +0300
committerNikolay Yakimov <root@livid.pp.ru>2020-06-29 17:06:29 +0300
commit34e54d30202e492fa6a4b1541fd8d094af8bc2a1 (patch)
treebd9889df2e06a65fdbc559e395b4896298c618a3 /src/Text/Pandoc/App/Opt.hs
parentf26923b9e493ecd2c4515d821da58e88fd2d946b (diff)
downloadpandoc-34e54d30202e492fa6a4b1541fd8d094af8bc2a1.tar.gz
Handle errors in yamlToMeta
Diffstat (limited to 'src/Text/Pandoc/App/Opt.hs')
-rw-r--r--src/Text/Pandoc/App/Opt.hs16
1 files changed, 8 insertions, 8 deletions
diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs
index c550bed2c..5c39f4ab6 100644
--- a/src/Text/Pandoc/App/Opt.hs
+++ b/src/Text/Pandoc/App/Opt.hs
@@ -4,6 +4,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
{- |
Module : Text.Pandoc.App.Opt
Copyright : Copyright (C) 2006-2020 John MacFarlane
@@ -40,7 +41,6 @@ import Text.Pandoc.Class.PandocPure
import Text.DocTemplates (Context(..))
import Data.Text (Text, unpack)
import Data.Default (def)
-import Control.Monad (join)
import qualified Data.Text as T
import qualified Data.Map as M
import Text.Pandoc.Definition (Meta(..), MetaValue(..), lookupMeta)
@@ -189,7 +189,7 @@ doOpt (k',v) = do
-- Note: x comes first because <> for Context is left-biased union
-- and we want to favor later default files. See #5988.
"metadata" ->
- return (\o -> o{ optMetadata = optMetadata o <> yamlToMeta v })
+ yamlToMeta v >>= \x -> return (\o -> o{ optMetadata = optMetadata o <> x })
"metadata-files" ->
parseYAML v >>= \x ->
return (\o -> o{ optMetadataFiles =
@@ -478,14 +478,14 @@ defaultOpts = Opt
, optStripComments = False
}
-yamlToMeta :: Node Pos -> Meta
-yamlToMeta (Mapping _ _ m) = runEverything (yamlMap pMetaString m)
+yamlToMeta :: Node Pos -> Parser Meta
+yamlToMeta (Mapping _ _ m) =
+ either (fail . show) return $ runEverything (yamlMap pMetaString m)
where
pMetaString = pure . MetaString <$> P.manyChar P.anyChar
- runEverything :: P.ParserT Text P.ParserState PandocPure (P.F (M.Map Text MetaValue)) -> Meta
- runEverything p =
- either (const mempty) (Meta . flip P.runF def) . join . runPure $ P.readWithM p def ""
-yamlToMeta _ = mempty
+ runEverything p = runPure (P.readWithM p def "")
+ >>= fmap (Meta . flip P.runF def)
+yamlToMeta _ = return mempty
addMeta :: String -> String -> Meta -> Meta
addMeta k v meta =