f26923b · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Unify defaults and markdown metadata parsers

f26923bNikolay Yakimov6 years ago

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

compare with master

unifiedsplit

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

34 ObfuscationMethod (NoObfuscation),

35 CiteMethod (Citeproc))

36import Text.Pandoc.Shared (camelCaseStrToHyphenated)

37−import Text.DocLayout (render)

37+import qualified Text.Pandoc.Parsing as P

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

39+import Text.Pandoc.Class.PandocPure

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

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

39import Data.Text (Text, unpack)

41import Data.Text (Text, unpack)

42+import Data.Default (def)

43+import Control.Monad (join)

40import qualified Data.Text as T

44import qualified Data.Text as T

41import qualified Data.Map as M

45import qualified Data.Map as M

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

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

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

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

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

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

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

187 "metadata" ->

191 "metadata" ->

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

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

189− contextToMeta x })

190 "metadata-files" ->

193 "metadata-files" ->

191 parseYAML v >>= \x ->

194 parseYAML v >>= \x ->

192 return (\o -> o{ optMetadataFiles =

195 return (\o -> o{ optMetadataFiles =

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

475 , optStripComments = False

478 , optStripComments = False

476 }

479 }

477

480

478−contextToMeta :: Context Text -> Meta

481+yamlToMeta :: Node Pos -> Meta

479−contextToMeta (Context m) =

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

480− Meta . M.map valToMetaVal $ m

483+ where

481−

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

482−valToMetaVal :: Val Text -> MetaValue

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

483−valToMetaVal (MapVal (Context m)) =

486+ runEverything p =

484− MetaMap . M.map valToMetaVal $ m

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

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

488+yamlToMeta _ = mempty

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

487−valToMetaVal NullVal = MetaString ""

488

489

489addMeta :: String -> String -> Meta -> Meta

490addMeta :: String -> String -> Meta -> Meta

490addMeta k v meta =

491addMeta k v meta =

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

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

67 -> m Meta

68yamlToMeta opts bstr = do

69 let parser = do

70− meta <- yamlBsToMeta parseBlocks bstr

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

71 return $ runF meta defaultParserState

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

73 case parsed of

74 Right result -> return result

75 Left e -> throwError e

76+ where

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

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

79--

82--

80-- Constants and data structure definitions

83-- Constants and data structure definitions

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

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

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

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

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

242 optional blanklines

245 optional blanklines

243− newMetaF <- yamlBsToMeta parseBlocks

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

244 $ UTF8.fromTextLazy $ TL.fromStrict rawYaml

247 $ UTF8.fromTextLazy $ TL.fromStrict rawYaml

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

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

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

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

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

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

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

13-}

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

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

16import Control.Monad

17import Control.Monad.Except (throwError)

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

22import qualified Data.YAML as YAML

23import qualified Data.YAML.Event as YE

24import qualified Text.Pandoc.Builder as B

25−import Text.Pandoc.Builder (Blocks)

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

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

27import Text.Pandoc.Definition

26import Text.Pandoc.Definition

28import Text.Pandoc.Error

27import Text.Pandoc.Error

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

31import Text.Pandoc.Shared

30import Text.Pandoc.Shared

33yamlBsToMeta :: PandocMonad m

32yamlBsToMeta :: PandocMonad m

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

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

35 -> BL.ByteString

34 -> BL.ByteString

36 -> ParserT Text ParserState m (F Meta)

35 -> ParserT Text ParserState m (F Meta)

37yamlBsToMeta pBlocks bstr = do

36yamlBsToMeta pBlocks bstr = do

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

59 "Non-string key in YAML mapping"

58 "Non-string key in YAML mapping"

61toMetaValue :: PandocMonad m

60toMetaValue :: PandocMonad m

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

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

63 -> Text

62 -> Text

64 -> ParserT Text ParserState m (F MetaValue)

63 -> ParserT Text ParserState m (F MetaValue)

65toMetaValue pBlocks x =

64toMetaValue pBlocks x =

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

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

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

68 -- `|` or `>` will.

67 -- `|` or `>` will.

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

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

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

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

71 else parseFromString' pInlines x

70 else parseFromString' pInlines x

72 where pInlines = do

71 where pInlines = do

73 bs <- pBlocks

72 bs <- pBlocks

74 return $ do

73 return $ do

75 bs' <- bs

74 bs' <- bs

76 return $

75 return $

77− case B.toList bs' of

76+ case bs' of

77+ MetaBlocks bs'' ->

78+ case bs'' of

78− [Plain ils] -> MetaInlines ils

79+ [Plain ils] -> MetaInlines ils

79− [Para ils] -> MetaInlines ils

80+ [Para ils] -> MetaInlines ils

80− xs -> MetaBlocks xs

81+ xs -> MetaBlocks xs

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

82+ _ -> bs'

83+

83checkBoolean :: Text -> Maybe Bool

85checkBoolean :: Text -> Maybe Bool

84checkBoolean t

86checkBoolean t

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

87 | otherwise = Nothing

89 | otherwise = Nothing

89yamlToMetaValue :: PandocMonad m

91yamlToMetaValue :: PandocMonad m

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

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

91 -> YAML.Node YE.Pos

93 -> YAML.Node YE.Pos

92 -> ParserT Text ParserState m (F MetaValue)

94 -> ParserT Text ParserState m (F MetaValue)

93yamlToMetaValue pBlocks (YAML.Scalar _ x) =

95yamlToMetaValue pBlocks (YAML.Scalar _ x) =

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

112yamlToMetaValue _ _ = return $ return $ MetaString ""

114yamlToMetaValue _ _ = return $ return $ MetaString ""

113

115

114yamlMap :: PandocMonad m

116yamlMap :: PandocMonad m

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

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

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

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

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

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

118yamlMap pBlocks o = do

120yamlMap pBlocks o = do

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

120 k <- nodeToKey key

122 k <- nodeToKey key

121 return (k, v)

123 return (k, v)

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

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

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

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

124 where

126 where

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

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

126 toMeta (k, v) = do

128 toMeta (k, v) = do