{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{- |
   Module      : Text.Pandoc.Readers.Metadata
   Copyright   : Copyright (C) 2006-2024 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.List as L
import qualified Data.Map as M
import qualified Data.Vector as V
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.List.NonEmpty as NE
import qualified Yamlet as Y
import Yamlet.Aeson ()
import Data.Aeson (Value(..), Object, Result(..), fromJSON, (.:?), withObject)
import Data.Aeson.Types (parse)
import Text.Pandoc.Shared (tshow, blocksToInlines)
import Text.Pandoc.Class (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
  pos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  case Y.decodeAll @Value bstr of
       Right [Value]
xs ->
         case [Value]
xs of
           (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
           [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
           [] -> 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
           [Value]
_  -> [Char] -> ParsecT Sources st m (Future st Meta)
forall a. [Char] -> ParsecT Sources st m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Prelude.fail [Char]
"expected YAML object"
       Left NonEmpty Error
errs -> 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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$
         [Char]
"Error parsing YAML metadata at " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SourcePos -> [Char]
forall a. Show a => a -> [Char]
show SourcePos
pos [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
":\n" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
         SourcePos -> NonEmpty Error -> [Char]
renderYamlErrors SourcePos
pos NonEmpty Error
errs

-- | Render the errors with their lines in the source, given the position of
-- the first line of the YAML input.
renderYamlErrors :: SourcePos -> NE.NonEmpty Y.Error -> String
renderYamlErrors :: SourcePos -> NonEmpty Error -> [Char]
renderYamlErrors SourcePos
pos =
  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char]
"\n" ([[Char]] -> [Char])
-> (NonEmpty Error -> [[Char]]) -> NonEmpty Error -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error -> [Char]) -> [Error] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Error -> [Char]
Y.prettyError (SourcePos -> [Char]
sourceName SourcePos
pos) (Error -> [Char]) -> (Error -> Error) -> Error -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Error
shift) ([Error] -> [[Char]])
-> (NonEmpty Error -> [Error]) -> NonEmpty Error -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Error -> [Error]
forall a. NonEmpty a -> [a]
NE.toList
  where
    shift :: Y.Error -> Y.Error
    shift :: Error -> Error
shift err :: Error
err@Y.Error{location :: Error -> Location
Y.location = loc :: Location
loc@Y.Location{line :: Location -> Int
Y.line = Int
l}}
      -- Line 0 means that the error has no position.
      | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Error
err
      | Bool
otherwise = Error
err{Y.location = loc{Y.line = l + sourceLine pos - 1}}

-- 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 = do
  pos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  case Y.decodeAll @Value bstr of
       Right (Object Object
m : [Value]
_) -> do
         case (Value -> Parser (Maybe [Value]))
-> Value -> Result (Maybe [Value])
forall a b. (a -> Parser b) -> a -> Result b
parse ([Char]
-> (Object -> Parser (Maybe [Value]))
-> Value
-> Parser (Maybe [Value])
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"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 (Array Array
v : [Value]
_) -> do
         let refs :: [Value]
refs = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter Value -> Bool
hasSelectedId ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
v
         [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)
       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 NonEmpty Error
errs -> 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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ SourcePos -> NonEmpty Error -> [Char]
renderYamlErrors SourcePos
pos NonEmpty Error
errs
 where
   isSelected :: Value -> Bool
isSelected (String Text
t) = Text -> Bool
idpred Text
t
   isSelected Value
_ = Bool
False
   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 ([Char]
-> (Object -> Parser (Maybe Value))
-> Value
-> Parser (Maybe Value)
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"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

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 [Char]
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
$ [Char] -> Text
T.pack [Char]
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 [Char]
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
$ [Char] -> Text
T.pack [Char]
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
      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
      return $ do
        v' <- fv
        return (k, 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
  pos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  string "---"
  blankline
  notFollowedBy blankline  -- if --- is followed by a blank it's an HRULE
  rawYamlLines <- manyTill anyLine stopLine
  -- by including --- and ..., we allow yaml blocks with just comments:
  let 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
"..."]))
  optional blanklines
  oldPos <- getPosition
  setPosition pos
  res <- yamlBsToMeta parser $ UTF8.fromText rawYaml
  setPosition oldPos
  pure res

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
$ ([Char] -> ParsecT Sources st m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"---" ParsecT Sources st m [Char]
-> ParsecT Sources st m [Char] -> ParsecT Sources st m [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> ParsecT Sources st m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"...") ParsecT Sources st m [Char]
-> 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 ()