{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Readers.Metadata
   Copyright   : Copyright (C) 2006-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Parse YAML/JSON metadata to 'Pandoc' 'Meta'.
-}
module Text.Pandoc.Readers.Metadata (
  yamlBsToMeta,
  yamlBsToRefs,
  yamlMetaBlock,
  yamlMap ) where


import Control.Monad.Except (throwError)
import qualified Data.ByteString as B
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import Data.Aeson (Value(..), Object, Result(..), fromJSON, (.:?), withObject)
import Data.Aeson.Types (parse)
import Text.Pandoc.Shared (tshow, blocksToInlines)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Parsing hiding (tableWith, parse)

import qualified Text.Pandoc.UTF8 as UTF8

yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st)
             => ParsecT Sources st m (Future st MetaValue)
             -> B.ByteString
             -> ParsecT Sources st m (Future st Meta)
yamlBsToMeta :: forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> ByteString -> ParsecT Sources st m (Future st Meta)
yamlBsToMeta ParsecT Sources st m (Future st MetaValue)
pMetaValue ByteString
bstr = do
  case ByteString -> Either ParseException [Value]
forall a. FromJSON a => ByteString -> Either ParseException [a]
Yaml.decodeAllEither' ByteString
bstr of
       Right (Object Object
o:[Value]
_) -> (Map Text MetaValue -> Meta)
-> Future st (Map Text MetaValue) -> Future st Meta
forall a b. (a -> b) -> Future st a -> Future st b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Text MetaValue -> Meta
Meta (Future st (Map Text MetaValue) -> Future st Meta)
-> ParsecT Sources st m (Future st (Map Text MetaValue))
-> ParsecT Sources st m (Future st Meta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources st m (Future st MetaValue)
-> Object -> ParsecT Sources st m (Future st (Map Text MetaValue))
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Object -> ParsecT Sources st m (Future st (Map Text MetaValue))
yamlMap ParsecT Sources st m (Future st MetaValue)
pMetaValue Object
o
       Right [] -> Future st Meta -> ParsecT Sources st m (Future st Meta)
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st Meta -> ParsecT Sources st m (Future st Meta))
-> (Meta -> Future st Meta)
-> Meta
-> ParsecT Sources st m (Future st Meta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> Future st Meta
forall a. a -> Future st a
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> ParsecT Sources st m (Future st Meta))
-> Meta -> ParsecT Sources st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ Meta
forall a. Monoid a => a
mempty
       Right [Value
Null] -> Future st Meta -> ParsecT Sources st m (Future st Meta)
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st Meta -> ParsecT Sources st m (Future st Meta))
-> (Meta -> Future st Meta)
-> Meta
-> ParsecT Sources st m (Future st Meta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> Future st Meta
forall a. a -> Future st a
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> ParsecT Sources st m (Future st Meta))
-> Meta -> ParsecT Sources st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ Meta
forall a. Monoid a => a
mempty
       Right [Value]
_  -> String -> ParsecT Sources st m (Future st Meta)
forall a. String -> ParsecT Sources st m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expected YAML object"
       Left ParseException
err' -> do
         PandocError -> ParsecT Sources st m (Future st Meta)
forall a. PandocError -> ParsecT Sources st m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT Sources st m (Future st Meta))
-> PandocError -> ParsecT Sources st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError
                    (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseException -> String
Yaml.prettyPrintParseException ParseException
err'

-- Returns filtered list of references.
yamlBsToRefs :: (PandocMonad m, HasLastStrPosition st)
             => ParsecT Sources st m (Future st MetaValue)
             -> (Text -> Bool) -- ^ Filter for id
             -> B.ByteString
             -> ParsecT Sources st m (Future st [MetaValue])
yamlBsToRefs :: forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> (Text -> Bool)
-> ByteString
-> ParsecT Sources st m (Future st [MetaValue])
yamlBsToRefs ParsecT Sources st m (Future st MetaValue)
pMetaValue Text -> Bool
idpred ByteString
bstr =
  case ByteString -> Either ParseException [Value]
forall a. FromJSON a => ByteString -> Either ParseException [a]
Yaml.decodeAllEither' ByteString
bstr of
       Right (Object Object
m : [Value]
_) -> do
         let isSelected :: Value -> Bool
isSelected (String Text
t) = Text -> Bool
idpred Text
t
             isSelected Value
_ = Bool
False
         let hasSelectedId :: Value -> Bool
hasSelectedId (Object Object
o) =
               case (Value -> Parser (Maybe Value)) -> Value -> Result (Maybe Value)
forall a b. (a -> Parser b) -> a -> Result b
parse (String
-> (Object -> Parser (Maybe Value))
-> Value
-> Parser (Maybe Value)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ref" (Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")) (Object -> Value
Object Object
o) of
                 Success (Just Value
id') -> Value -> Bool
isSelected Value
id'
                 Result (Maybe Value)
_ -> Bool
False
             hasSelectedId Value
_ = Bool
False
         case (Value -> Parser (Maybe [Value]))
-> Value -> Result (Maybe [Value])
forall a b. (a -> Parser b) -> a -> Result b
parse (String
-> (Object -> Parser (Maybe [Value]))
-> Value
-> Parser (Maybe [Value])
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"metadata" (Object -> Key -> Parser (Maybe [Value])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"references")) (Object -> Value
Object Object
m) of
           Success (Just [Value]
refs) -> [Future st MetaValue] -> Future st [MetaValue]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Future st MetaValue] -> Future st [MetaValue])
-> ParsecT Sources st m [Future st MetaValue]
-> ParsecT Sources st m (Future st [MetaValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 (Value -> ParsecT Sources st m (Future st MetaValue))
-> [Value] -> ParsecT Sources st m [Future st MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ParsecT Sources st m (Future st MetaValue)
-> Value -> ParsecT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Value -> ParsecT Sources st m (Future st MetaValue)
yamlToMetaValue ParsecT Sources st m (Future st MetaValue)
pMetaValue) ((Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter Value -> Bool
hasSelectedId [Value]
refs)
           Result (Maybe [Value])
_ -> Future st [MetaValue]
-> ParsecT Sources st m (Future st [MetaValue])
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st [MetaValue]
 -> ParsecT Sources st m (Future st [MetaValue]))
-> Future st [MetaValue]
-> ParsecT Sources st m (Future st [MetaValue])
forall a b. (a -> b) -> a -> b
$ [MetaValue] -> Future st [MetaValue]
forall a. a -> Future st a
forall (m :: * -> *) a. Monad m => a -> m a
return []
       Right [Value]
_ -> Future st [MetaValue]
-> ParsecT Sources st m (Future st [MetaValue])
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st [MetaValue]
 -> ParsecT Sources st m (Future st [MetaValue]))
-> ([MetaValue] -> Future st [MetaValue])
-> [MetaValue]
-> ParsecT Sources st m (Future st [MetaValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetaValue] -> Future st [MetaValue]
forall a. a -> Future st a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaValue] -> ParsecT Sources st m (Future st [MetaValue]))
-> [MetaValue] -> ParsecT Sources st m (Future st [MetaValue])
forall a b. (a -> b) -> a -> b
$ []
       Left ParseException
err' -> do
         PandocError -> ParsecT Sources st m (Future st [MetaValue])
forall a. PandocError -> ParsecT Sources st m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT Sources st m (Future st [MetaValue]))
-> PandocError -> ParsecT Sources st m (Future st [MetaValue])
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError
                    (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseException -> String
Yaml.prettyPrintParseException ParseException
err'

normalizeMetaValue :: (PandocMonad m, HasLastStrPosition st)
                   => ParsecT Sources st m (Future st MetaValue)
                   -> Text
                   -> ParsecT Sources st m (Future st MetaValue)
normalizeMetaValue :: forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Text -> ParsecT Sources st m (Future st MetaValue)
normalizeMetaValue ParsecT Sources st m (Future st MetaValue)
pMetaValue Text
x =
   -- Note: a standard quoted or unquoted YAML value will
   -- not end in a newline, but a "block" set off with
   -- `|` or `>` will.
   if Text
"\n" Text -> Text -> Bool
`T.isSuffixOf` ((Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpaceChar Text
x) -- see #6823
      then ParsecT Sources st m (Future st MetaValue)
-> Text -> ParsecT Sources st m (Future st MetaValue)
forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParsecT Sources u m a -> Text -> ParsecT Sources u m a
parseFromString' ParsecT Sources st m (Future st MetaValue)
pMetaValue (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
      else ParsecT Sources st m (Future st MetaValue)
-> ParsecT Sources st m (Future st MetaValue)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m (Future st MetaValue)
-> Text -> ParsecT Sources st m (Future st MetaValue)
forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParsecT Sources u m a -> Text -> ParsecT Sources u m a
parseFromString' ParsecT Sources st m (Future st MetaValue)
asInlines Text
x') -- see #8358
           ParsecT Sources st m (Future st MetaValue)
-> ParsecT Sources st m (Future st MetaValue)
-> ParsecT Sources st m (Future st MetaValue)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> -- see #8465
           ParsecT Sources st m (Future st MetaValue)
-> Text -> ParsecT Sources st m (Future st MetaValue)
forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParsecT Sources u m a -> Text -> ParsecT Sources u m a
parseFromString' ParsecT Sources st m (Future st MetaValue)
asInlines (Text
x' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
  where x' :: Text
x' = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpaceOrNlChar Text
x
        asInlines :: ParsecT Sources st m (Future st MetaValue)
asInlines = (MetaValue -> MetaValue)
-> Future st MetaValue -> Future st MetaValue
forall a b. (a -> b) -> Future st a -> Future st b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaValue -> MetaValue
b2i (Future st MetaValue -> Future st MetaValue)
-> ParsecT Sources st m (Future st MetaValue)
-> ParsecT Sources st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources st m (Future st MetaValue)
pMetaValue
        b2i :: MetaValue -> MetaValue
b2i (MetaBlocks [Block]
bs) = [Inline] -> MetaValue
MetaInlines ([Block] -> [Inline]
blocksToInlines [Block]
bs)
        b2i MetaValue
y = MetaValue
y
        isSpaceChar :: Char -> Bool
isSpaceChar Char
' '  = Bool
True
        isSpaceChar Char
'\t' = Bool
True
        isSpaceChar Char
_    = Bool
False
        isSpaceOrNlChar :: Char -> Bool
isSpaceOrNlChar Char
'\r' = Bool
True
        isSpaceOrNlChar Char
'\n' = Bool
True
        isSpaceOrNlChar Char
c = Char -> Bool
isSpaceChar Char
c

yamlToMetaValue :: (PandocMonad m, HasLastStrPosition st)
                => ParsecT Sources st m (Future st MetaValue)
                -> Value
                -> ParsecT Sources st m (Future st MetaValue)
yamlToMetaValue :: forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Value -> ParsecT Sources st m (Future st MetaValue)
yamlToMetaValue ParsecT Sources st m (Future st MetaValue)
pMetaValue Value
v =
  case Value
v of
       String Text
t -> ParsecT Sources st m (Future st MetaValue)
-> Text -> ParsecT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Text -> ParsecT Sources st m (Future st MetaValue)
normalizeMetaValue ParsecT Sources st m (Future st MetaValue)
pMetaValue Text
t
       Bool Bool
b -> Future st MetaValue -> ParsecT Sources st m (Future st MetaValue)
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParsecT Sources st m (Future st MetaValue))
-> Future st MetaValue
-> ParsecT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Future st MetaValue
forall a. a -> Future st a
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> Future st MetaValue)
-> MetaValue -> Future st MetaValue
forall a b. (a -> b) -> a -> b
$ Bool -> MetaValue
MetaBool Bool
b
       Number Scientific
d -> ParsecT Sources st m (Future st MetaValue)
-> Text -> ParsecT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Text -> ParsecT Sources st m (Future st MetaValue)
normalizeMetaValue ParsecT Sources st m (Future st MetaValue)
pMetaValue (Text -> ParsecT Sources st m (Future st MetaValue))
-> Text -> ParsecT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$
         case Value -> Result Int
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
           Success (Int
x :: Int) -> Int -> Text
forall a. Show a => a -> Text
tshow Int
x
           Result Int
_ -> Scientific -> Text
forall a. Show a => a -> Text
tshow Scientific
d
       Value
Null -> Future st MetaValue -> ParsecT Sources st m (Future st MetaValue)
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParsecT Sources st m (Future st MetaValue))
-> Future st MetaValue
-> ParsecT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Future st MetaValue
forall a. a -> Future st a
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> Future st MetaValue)
-> MetaValue -> Future st MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> MetaValue
MetaString Text
""
       Array{} -> do
         case Value -> Result [Value]
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
           Error String
err' -> PandocError -> ParsecT Sources st m (Future st MetaValue)
forall a. PandocError -> ParsecT Sources st m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT Sources st m (Future st MetaValue))
-> PandocError -> ParsecT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err'
           Success [Value]
xs -> ([MetaValue] -> MetaValue)
-> Future st [MetaValue] -> Future st MetaValue
forall a b. (a -> b) -> Future st a -> Future st b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MetaValue] -> MetaValue
MetaList (Future st [MetaValue] -> Future st MetaValue)
-> ([Future st MetaValue] -> Future st [MetaValue])
-> [Future st MetaValue]
-> Future st MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Future st MetaValue] -> Future st [MetaValue]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Future st MetaValue] -> Future st MetaValue)
-> ParsecT Sources st m [Future st MetaValue]
-> ParsecT Sources st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          (Value -> ParsecT Sources st m (Future st MetaValue))
-> [Value] -> ParsecT Sources st m [Future st MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ParsecT Sources st m (Future st MetaValue)
-> Value -> ParsecT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Value -> ParsecT Sources st m (Future st MetaValue)
yamlToMetaValue ParsecT Sources st m (Future st MetaValue)
pMetaValue) [Value]
xs
       Object Object
o -> (Map Text MetaValue -> MetaValue)
-> Future st (Map Text MetaValue) -> Future st MetaValue
forall a b. (a -> b) -> Future st a -> Future st b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Text MetaValue -> MetaValue
MetaMap (Future st (Map Text MetaValue) -> Future st MetaValue)
-> ParsecT Sources st m (Future st (Map Text MetaValue))
-> ParsecT Sources st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources st m (Future st MetaValue)
-> Object -> ParsecT Sources st m (Future st (Map Text MetaValue))
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Object -> ParsecT Sources st m (Future st (Map Text MetaValue))
yamlMap ParsecT Sources st m (Future st MetaValue)
pMetaValue Object
o

yamlMap :: (PandocMonad m, HasLastStrPosition st)
        => ParsecT Sources st m (Future st MetaValue)
        -> Object
        -> ParsecT Sources st m (Future st (M.Map Text MetaValue))
yamlMap :: forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Object -> ParsecT Sources st m (Future st (Map Text MetaValue))
yamlMap ParsecT Sources st m (Future st MetaValue)
pMetaValue Object
o = do
    case Value -> Result (Map Text Value)
forall a. FromJSON a => Value -> Result a
fromJSON (Object -> Value
Object Object
o) of
      Error String
err' -> PandocError
-> ParsecT Sources st m (Future st (Map Text MetaValue))
forall a. PandocError -> ParsecT Sources st m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError
 -> ParsecT Sources st m (Future st (Map Text MetaValue)))
-> PandocError
-> ParsecT Sources st m (Future st (Map Text MetaValue))
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err'
      Success (Map Text Value
m' :: M.Map Text Value) -> do
        let kvs :: [(Text, Value)]
kvs = ((Text, Value) -> Bool) -> [(Text, Value)] -> [(Text, Value)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Text, Value) -> Bool) -> (Text, Value) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
ignorable (Text -> Bool) -> ((Text, Value) -> Text) -> (Text, Value) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Value) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Value)] -> [(Text, Value)])
-> [(Text, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Value
m'
        ([(Text, MetaValue)] -> Map Text MetaValue)
-> Future st [(Text, MetaValue)] -> Future st (Map Text MetaValue)
forall a b. (a -> b) -> Future st a -> Future st b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, MetaValue)] -> Map Text MetaValue
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (Future st [(Text, MetaValue)] -> Future st (Map Text MetaValue))
-> ([Future st (Text, MetaValue)] -> Future st [(Text, MetaValue)])
-> [Future st (Text, MetaValue)]
-> Future st (Map Text MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Future st (Text, MetaValue)] -> Future st [(Text, MetaValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Future st (Text, MetaValue)] -> Future st (Map Text MetaValue))
-> ParsecT Sources st m [Future st (Text, MetaValue)]
-> ParsecT Sources st m (Future st (Map Text MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Value)
 -> ParsecT Sources st m (Future st (Text, MetaValue)))
-> [(Text, Value)]
-> ParsecT Sources st m [Future st (Text, MetaValue)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, Value) -> ParsecT Sources st m (Future st (Text, MetaValue))
forall {a}.
(a, Value) -> ParsecT Sources st m (Future st (a, MetaValue))
toMeta [(Text, Value)]
kvs
  where
    ignorable :: Text -> Bool
ignorable Text
t = Text
"_" Text -> Text -> Bool
`T.isSuffixOf` Text
t
    toMeta :: (a, Value) -> ParsecT Sources st m (Future st (a, MetaValue))
toMeta (a
k, Value
v) = do
      Future st MetaValue
fv <- ParsecT Sources st m (Future st MetaValue)
-> Value -> ParsecT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> Value -> ParsecT Sources st m (Future st MetaValue)
yamlToMetaValue ParsecT Sources st m (Future st MetaValue)
pMetaValue Value
v
      Future st (a, MetaValue)
-> ParsecT Sources st m (Future st (a, MetaValue))
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st (a, MetaValue)
 -> ParsecT Sources st m (Future st (a, MetaValue)))
-> Future st (a, MetaValue)
-> ParsecT Sources st m (Future st (a, MetaValue))
forall a b. (a -> b) -> a -> b
$ do
        MetaValue
v' <- Future st MetaValue
fv
        (a, MetaValue) -> Future st (a, MetaValue)
forall a. a -> Future st a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
k, MetaValue
v')

-- | Parse a YAML metadata block using the supplied 'MetaValue' parser.
yamlMetaBlock :: (HasLastStrPosition st, PandocMonad m)
              => ParsecT Sources st m (Future st MetaValue)
              -> ParsecT Sources st m (Future st Meta)
yamlMetaBlock :: forall st (m :: * -> *).
(HasLastStrPosition st, PandocMonad m) =>
ParsecT Sources st m (Future st MetaValue)
-> ParsecT Sources st m (Future st Meta)
yamlMetaBlock ParsecT Sources st m (Future st MetaValue)
parser = ParsecT Sources st m (Future st Meta)
-> ParsecT Sources st m (Future st Meta)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m (Future st Meta)
 -> ParsecT Sources st m (Future st Meta))
-> ParsecT Sources st m (Future st Meta)
-> ParsecT Sources st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT Sources st m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"---"
  ParsecT Sources st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline
  ParsecT Sources st m Char -> ParsecT Sources st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Sources st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline  -- if --- is followed by a blank it's an HRULE
  [Text]
rawYamlLines <- ParsecT Sources st m Text
-> ParsecT Sources st m () -> ParsecT Sources st m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Sources st m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine ParsecT Sources st m ()
forall (m :: * -> *) st. Monad m => ParsecT Sources st m ()
stopLine
  -- by including --- and ..., we allow yaml blocks with just comments:
  let rawYaml :: Text
rawYaml = [Text] -> Text
T.unlines (Text
"---" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ([Text]
rawYamlLines [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"..."]))
  ParsecT Sources st m Text -> ParsecT Sources st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  ParsecT Sources st m (Future st MetaValue)
-> ByteString -> ParsecT Sources st m (Future st Meta)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> ByteString -> ParsecT Sources st m (Future st Meta)
yamlBsToMeta ParsecT Sources st m (Future st MetaValue)
parser (ByteString -> ParsecT Sources st m (Future st Meta))
-> ByteString -> ParsecT Sources st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText Text
rawYaml

stopLine :: Monad m => ParsecT Sources st m ()
stopLine :: forall (m :: * -> *) st. Monad m => ParsecT Sources st m ()
stopLine = ParsecT Sources st m () -> ParsecT Sources st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m () -> ParsecT Sources st m ())
-> ParsecT Sources st m () -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ (String -> ParsecT Sources st m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"---" ParsecT Sources st m String
-> ParsecT Sources st m String -> ParsecT Sources st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Sources st m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"...") ParsecT Sources st m String
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall a b.
ParsecT Sources st m a
-> ParsecT Sources st m b -> ParsecT Sources st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline ParsecT Sources st m Char
-> ParsecT Sources st m () -> ParsecT Sources st m ()
forall a b.
ParsecT Sources st m a
-> ParsecT Sources st m b -> ParsecT Sources st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT Sources st m ()
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()