f26923b · typeable/pandoc

git.iko.soy/typeable/pandoc

Unify defaults and markdown metadata parsers

commitf26923b9e493ecd2c4515d821da58e88fd2d946b authorNikolay Yakimov <root@livid.pp.ru> dateFri 1 May 2020, 03:11 (6 years ago) parent11dc9f8

3 files changed+35−29

compare with master

unifiedsplit

src/Text/Pandoc/App/Opt.hs+15−14 src/Text/Pandoc/Readers/Markdown.hs+5−2 src/Text/Pandoc/Readers/Metadata.hs+15−13

src/Text/Pandoc/App/Opt.hs+15−14

@@ -34,9 +34,13 @@ import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault),

3434 ObfuscationMethod (NoObfuscation),

3535 CiteMethod (Citeproc))

3636import Text.Pandoc.Shared (camelCaseStrToHyphenated)

37−import Text.DocLayout (render)

38−import Text.DocTemplates (Context(..), Val(..))

37+import qualified Text.Pandoc.Parsing as P

38+import Text.Pandoc.Readers.Metadata (yamlMap)

39+import Text.Pandoc.Class.PandocPure

40+import Text.DocTemplates (Context(..))

3941import Data.Text (Text, unpack)

42+import Data.Default (def)

43+import Control.Monad (join)

4044import qualified Data.Text as T

4145import qualified Data.Map as M

4246import Text.Pandoc.Definition (Meta(..), MetaValue(..), lookupMeta)

@@ -185,8 +189,7 @@ doOpt (k',v) = do

185189 -- Note: x comes first because <> for Context is left-biased union

186190 -- and we want to favor later default files. See #5988.

187191 "metadata" ->

188− parseYAML v >>= \x -> return (\o -> o{ optMetadata = optMetadata o <>

189− contextToMeta x })

192+ return (\o -> o{ optMetadata = optMetadata o <> yamlToMeta v })

190193 "metadata-files" ->

191194 parseYAML v >>= \x ->

192195 return (\o -> o{ optMetadataFiles =

@@ -475,16 +478,14 @@ defaultOpts = Opt

475478 , optStripComments = False

476479 }

477480

478−contextToMeta :: Context Text -> Meta

479−contextToMeta (Context m) =

480− Meta . M.map valToMetaVal $ m

481−

482−valToMetaVal :: Val Text -> MetaValue

483−valToMetaVal (MapVal (Context m)) =

484− MetaMap . M.map valToMetaVal $ m

485−valToMetaVal (ListVal xs) = MetaList $ map valToMetaVal xs

486−valToMetaVal (SimpleVal d) = MetaString $ render Nothing d

487−valToMetaVal NullVal = MetaString ""

481+yamlToMeta :: Node Pos -> Meta

482+yamlToMeta (Mapping _ _ m) = runEverything (yamlMap pMetaString m)

483+ where

484+ pMetaString = pure . MetaString <$> P.manyChar P.anyChar

485+ runEverything :: P.ParserT Text P.ParserState PandocPure (P.F (M.Map Text MetaValue)) -> Meta

486+ runEverything p =

487+ either (const mempty) (Meta . flip P.runF def) . join . runPure $ P.readWithM p def ""

488+yamlToMeta _ = mempty

488489

489490addMeta :: String -> String -> Meta -> Meta

490491addMeta k v meta =

src/Text/Pandoc/Readers/Markdown.hs+5−2

@@ -67,14 +67,17 @@ yamlToMeta :: PandocMonad m

6767 -> m Meta

6868yamlToMeta opts bstr = do

6969 let parser = do

70− meta <- yamlBsToMeta parseBlocks bstr

70+ meta <- yamlBsToMeta (fmap asBlocks parseBlocks) bstr

7171 return $ runF meta defaultParserState

7272 parsed <- readWithM parser def{ stateOptions = opts } ""

7373 case parsed of

7474 Right result -> return result

7575 Left e -> throwError e

76+ where

7677

7778

79+asBlocks :: Functor f => f (B.Many Block) -> f MetaValue

80+asBlocks p = MetaBlocks . B.toList <$> p

7881

7982--

8083-- Constants and data structure definitions

@@ -240,7 +243,7 @@ yamlMetaBlock = try $ do

240243 -- by including --- and ..., we allow yaml blocks with just comments:

241244 let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."]))

242245 optional blanklines

243− newMetaF <- yamlBsToMeta parseBlocks

246+ newMetaF <- yamlBsToMeta (asBlocks <$> parseBlocks)

244247 $ UTF8.fromTextLazy $ TL.fromStrict rawYaml

245248 -- Since `<>` is left-biased, existing values are not touched:

246249 updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }

src/Text/Pandoc/Readers/Metadata.hs+15−13

@@ -11,7 +11,7 @@

1111

1212Parse YAML/JSON metadata to 'Pandoc' 'Meta'.

1313-}

14−module Text.Pandoc.Readers.Metadata ( yamlBsToMeta ) where

14+module Text.Pandoc.Readers.Metadata ( yamlBsToMeta, yamlMap ) where

1515

1616import Control.Monad

1717import Control.Monad.Except (throwError)

@@ -22,7 +22,6 @@ import qualified Data.Text as T

2222import qualified Data.YAML as YAML

2323import qualified Data.YAML.Event as YE

2424import qualified Text.Pandoc.Builder as B

25−import Text.Pandoc.Builder (Blocks)

2625import Text.Pandoc.Class.PandocMonad (PandocMonad (..))

2726import Text.Pandoc.Definition

2827import Text.Pandoc.Error

@@ -31,7 +30,7 @@ import Text.Pandoc.Parsing hiding (tableWith)

3130import Text.Pandoc.Shared

3231

3332yamlBsToMeta :: PandocMonad m

34− => ParserT Text ParserState m (F Blocks)

33+ => ParserT Text ParserState m (F MetaValue)

3534 -> BL.ByteString

3635 -> ParserT Text ParserState m (F Meta)

3736yamlBsToMeta pBlocks bstr = do

@@ -59,7 +58,7 @@ nodeToKey _ = throwError $ PandocParseError

5958 "Non-string key in YAML mapping"

6059

6160toMetaValue :: PandocMonad m

62− => ParserT Text ParserState m (F Blocks)

61+ => ParserT Text ParserState m (F MetaValue)

6362 -> Text

6463 -> ParserT Text ParserState m (F MetaValue)

6564toMetaValue pBlocks x =

@@ -67,18 +66,21 @@ toMetaValue pBlocks x =

6766 -- not end in a newline, but a "block" set off with

6867 -- `|` or `>` will.

6968 if "\n" `T.isSuffixOf` x

70− then parseFromString' (asBlocks <$> pBlocks) (x <> "\n")

69+ then parseFromString' pBlocks (x <> "\n")

7170 else parseFromString' pInlines x

7271 where pInlines = do

7372 bs <- pBlocks

7473 return $ do

7574 bs' <- bs

7675 return $

77− case B.toList bs' of

78− [Plain ils] -> MetaInlines ils

79− [Para ils] -> MetaInlines ils

80− xs -> MetaBlocks xs

81− asBlocks p = MetaBlocks . B.toList <$> p

76+ case bs' of

77+ MetaBlocks bs'' ->

78+ case bs'' of

79+ [Plain ils] -> MetaInlines ils

80+ [Para ils] -> MetaInlines ils

81+ xs -> MetaBlocks xs

82+ _ -> bs'

83+

8284

8385checkBoolean :: Text -> Maybe Bool

8486checkBoolean t

@@ -87,7 +89,7 @@ checkBoolean t

8789 | otherwise = Nothing

8890

8991yamlToMetaValue :: PandocMonad m

90− => ParserT Text ParserState m (F Blocks)

92+ => ParserT Text ParserState m (F MetaValue)

9193 -> YAML.Node YE.Pos

9294 -> ParserT Text ParserState m (F MetaValue)

9395yamlToMetaValue pBlocks (YAML.Scalar _ x) =

@@ -112,7 +114,7 @@ yamlToMetaValue pBlocks (YAML.Mapping _ _ o) =

112114yamlToMetaValue _ _ = return $ return $ MetaString ""

113115

114116yamlMap :: PandocMonad m

115− => ParserT Text ParserState m (F Blocks)

117+ => ParserT Text ParserState m (F MetaValue)

116118 -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)

117119 -> ParserT Text ParserState m (F (M.Map Text MetaValue))

118120yamlMap pBlocks o = do

@@ -120,7 +122,7 @@ yamlMap pBlocks o = do

120122 k <- nodeToKey key

121123 return (k, v)

122124 let kvs' = filter (not . ignorable . fst) kvs

123− (fmap M.fromList . sequence) <$> mapM toMeta kvs'

125+ fmap M.fromList . sequence <$> mapM toMeta kvs'

124126 where

125127 ignorable t = "_" `T.isSuffixOf` t

126128 toMeta (k, v) = do