{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Readers.Metadata
   Copyright   : Copyright (C) 2006-2021 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
import Control.Monad.Except (throwError)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.YAML as YAML
import qualified Data.YAML.Event as YE
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Parsing hiding (tableWith)
import Text.Pandoc.Shared
import qualified Data.Text.Lazy as TL
import qualified Text.Pandoc.UTF8 as UTF8

yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st)
             => ParserT Sources st m (Future st MetaValue)
             -> BL.ByteString
             -> ParserT Sources st m (Future st Meta)
yamlBsToMeta :: ParserT Sources st m (Future st MetaValue)
-> ByteString -> ParserT Sources st m (Future st Meta)
yamlBsToMeta ParserT Sources st m (Future st MetaValue)
pMetaValue ByteString
bstr = do
  case SchemaResolver
-> Bool
-> Bool
-> ByteString
-> Either (Pos, String) [Doc (Node Pos)]
YAML.decodeNode' SchemaResolver
YAML.failsafeSchemaResolver Bool
False Bool
False ByteString
bstr of
       Right (YAML.Doc (YAML.Mapping Pos
_ Tag
_ Mapping Pos
o):[Doc (Node Pos)]
_)
                -> (Map Text MetaValue -> Meta)
-> Future st (Map Text MetaValue) -> Future st Meta
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))
-> ParserT Sources st m (Future st Meta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Sources st m (Future st MetaValue)
-> Mapping Pos
-> ParsecT Sources st m (Future st (Map Text MetaValue))
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Sources st m (Future st MetaValue)
-> Mapping Pos
-> ParserT Sources st m (Future st (Map Text MetaValue))
yamlMap ParserT Sources st m (Future st MetaValue)
pMetaValue Mapping Pos
o
       Right [] -> Future st Meta -> ParserT Sources st m (Future st Meta)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st Meta -> ParserT Sources st m (Future st Meta))
-> (Meta -> Future st Meta)
-> Meta
-> ParserT Sources st m (Future st Meta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> Future st Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> ParserT Sources st m (Future st Meta))
-> Meta -> ParserT Sources st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ Meta
forall a. Monoid a => a
mempty
       Right [YAML.Doc (YAML.Scalar Pos
_ Scalar
YAML.SNull)]
                -> Future st Meta -> ParserT Sources st m (Future st Meta)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st Meta -> ParserT Sources st m (Future st Meta))
-> (Meta -> Future st Meta)
-> Meta
-> ParserT Sources st m (Future st Meta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> Future st Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> ParserT Sources st m (Future st Meta))
-> Meta -> ParserT Sources st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ Meta
forall a. Monoid a => a
mempty
       Right [Doc (Node Pos)]
_  -> String -> ParserT Sources st m (Future st Meta)
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expected YAML object"
       Left (Pos
yamlpos, String
err')
                -> do SourcePos
pos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                      SourcePos -> ParsecT Sources st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Sources st m ())
-> SourcePos -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> Line -> SourcePos
incSourceLine
                            (SourcePos -> Line -> SourcePos
setSourceColumn SourcePos
pos (Pos -> Line
YE.posColumn Pos
yamlpos))
                            (Pos -> Line
YE.posLine Pos
yamlpos Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1)
                      String -> ParserT Sources st m (Future st Meta)
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
err'

fakePos :: YAML.Pos
fakePos :: Pos
fakePos = Line -> Line -> Line -> Line -> Pos
YAML.Pos (-Line
1) (-Line
1) Line
1 Line
0

lookupYAML :: Text
           -> YAML.Node YE.Pos
           -> Maybe (YAML.Node YE.Pos)
lookupYAML :: Text -> Node Pos -> Maybe (Node Pos)
lookupYAML Text
t (YAML.Mapping Pos
_ Tag
_ Mapping Pos
m) =
  Node Pos -> Mapping Pos -> Maybe (Node Pos)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Pos -> Scalar -> Node Pos
forall loc. loc -> Scalar -> Node loc
YAML.Scalar Pos
fakePos (Tag -> Text -> Scalar
YAML.SUnknown Tag
YE.untagged Text
t)) Mapping Pos
m
    Maybe (Node Pos) -> Maybe (Node Pos) -> Maybe (Node Pos)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    Node Pos -> Mapping Pos -> Maybe (Node Pos)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Pos -> Scalar -> Node Pos
forall loc. loc -> Scalar -> Node loc
YAML.Scalar Pos
fakePos (Text -> Scalar
YAML.SStr Text
t)) Mapping Pos
m
lookupYAML Text
_ Node Pos
_ = Maybe (Node Pos)
forall a. Maybe a
Nothing

-- Returns filtered list of references.
yamlBsToRefs :: (PandocMonad m, HasLastStrPosition st)
             => ParserT Sources st m (Future st MetaValue)
             -> (Text -> Bool) -- ^ Filter for id
             -> BL.ByteString
             -> ParserT Sources st m (Future st [MetaValue])
yamlBsToRefs :: ParserT Sources st m (Future st MetaValue)
-> (Text -> Bool)
-> ByteString
-> ParserT Sources st m (Future st [MetaValue])
yamlBsToRefs ParserT Sources st m (Future st MetaValue)
pMetaValue Text -> Bool
idpred ByteString
bstr =
  case SchemaResolver
-> Bool
-> Bool
-> ByteString
-> Either (Pos, String) [Doc (Node Pos)]
YAML.decodeNode' SchemaResolver
YAML.failsafeSchemaResolver Bool
False Bool
False ByteString
bstr of
       Right (YAML.Doc o :: Node Pos
o@YAML.Mapping{}:[Doc (Node Pos)]
_)
                -> case Text -> Node Pos -> Maybe (Node Pos)
lookupYAML Text
"references" Node Pos
o of
                     Just (YAML.Sequence Pos
_ Tag
_ [Node Pos]
ns) -> do
                       let g :: Node Pos -> Bool
g Node Pos
n = case Text -> Node Pos -> Maybe (Node Pos)
lookupYAML Text
"id" Node Pos
n of
                                    Just Node Pos
n' ->
                                      case Node Pos -> Maybe Text
nodeToKey Node Pos
n' of
                                        Maybe Text
Nothing -> Bool
False
                                        Just Text
t -> Text -> Bool
idpred Text
t Bool -> Bool -> Bool
||
                                          case Text -> Node Pos -> Maybe (Node Pos)
lookupYAML Text
"other-ids" Node Pos
n of
                                            Just (YAML.Sequence Pos
_ Tag
_ [Node Pos]
ns') ->
                                              let ts' :: [Text]
ts' = (Node Pos -> Maybe Text) -> [Node Pos] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node Pos -> Maybe Text
nodeToKey [Node Pos]
ns'
                                               in (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
idpred [Text]
ts'
                                            Maybe (Node Pos)
_ -> Bool
False
                                    Maybe (Node Pos)
Nothing   -> Bool
False
                       [Future st MetaValue] -> Future st [MetaValue]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Future st MetaValue] -> Future st [MetaValue])
-> ParsecT Sources st m [Future st MetaValue]
-> ParserT Sources st m (Future st [MetaValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (Node Pos -> ParserT Sources st m (Future st MetaValue))
-> [Node Pos] -> ParsecT Sources st m [Future st MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Sources st m (Future st MetaValue)
-> Node Pos -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Sources st m (Future st MetaValue)
-> Node Pos -> ParserT Sources st m (Future st MetaValue)
yamlToMetaValue ParserT Sources st m (Future st MetaValue)
pMetaValue) ((Node Pos -> Bool) -> [Node Pos] -> [Node Pos]
forall a. (a -> Bool) -> [a] -> [a]
filter Node Pos -> Bool
g [Node Pos]
ns)
                     Just Node Pos
_ ->
                       String -> ParserT Sources st m (Future st [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expecting sequence in 'references' field"
                     Maybe (Node Pos)
Nothing ->
                       String -> ParserT Sources st m (Future st [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expecting 'references' field"

       Right [] -> Future st [MetaValue]
-> ParserT Sources st m (Future st [MetaValue])
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st [MetaValue]
 -> ParserT Sources st m (Future st [MetaValue]))
-> ([MetaValue] -> Future st [MetaValue])
-> [MetaValue]
-> ParserT Sources st m (Future st [MetaValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetaValue] -> Future st [MetaValue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaValue] -> ParserT Sources st m (Future st [MetaValue]))
-> [MetaValue] -> ParserT Sources st m (Future st [MetaValue])
forall a b. (a -> b) -> a -> b
$ [MetaValue]
forall a. Monoid a => a
mempty
       Right [YAML.Doc (YAML.Scalar Pos
_ Scalar
YAML.SNull)]
                -> Future st [MetaValue]
-> ParserT Sources st m (Future st [MetaValue])
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st [MetaValue]
 -> ParserT Sources st m (Future st [MetaValue]))
-> ([MetaValue] -> Future st [MetaValue])
-> [MetaValue]
-> ParserT Sources st m (Future st [MetaValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetaValue] -> Future st [MetaValue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaValue] -> ParserT Sources st m (Future st [MetaValue]))
-> [MetaValue] -> ParserT Sources st m (Future st [MetaValue])
forall a b. (a -> b) -> a -> b
$ [MetaValue]
forall a. Monoid a => a
mempty
       Right [Doc (Node Pos)]
_  -> String -> ParserT Sources st m (Future st [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expecting YAML object"
       Left (Pos
yamlpos, String
err')
                -> do SourcePos
pos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                      SourcePos -> ParsecT Sources st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Sources st m ())
-> SourcePos -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> Line -> SourcePos
incSourceLine
                            (SourcePos -> Line -> SourcePos
setSourceColumn SourcePos
pos (Pos -> Line
YE.posColumn Pos
yamlpos))
                            (Pos -> Line
YE.posLine Pos
yamlpos Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1)
                      String -> ParserT Sources st m (Future st [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
err'


nodeToKey :: YAML.Node YE.Pos -> Maybe Text
nodeToKey :: Node Pos -> Maybe Text
nodeToKey (YAML.Scalar Pos
_ (YAML.SStr Text
t))       = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
nodeToKey (YAML.Scalar Pos
_ (YAML.SUnknown Tag
_ Text
t)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
nodeToKey Node Pos
_                                   = Maybe Text
forall a. Maybe a
Nothing

normalizeMetaValue :: (PandocMonad m, HasLastStrPosition st)
                   => ParserT Sources st m (Future st MetaValue)
                   -> Text
                   -> ParserT Sources st m (Future st MetaValue)
normalizeMetaValue :: ParserT Sources st m (Future st MetaValue)
-> Text -> ParserT Sources st m (Future st MetaValue)
normalizeMetaValue ParserT 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 ParserT Sources st m (Future st MetaValue)
-> Text -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' ParserT Sources st m (Future st MetaValue)
pMetaValue (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
      else ParserT Sources st m (Future st MetaValue)
-> Text -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' ParserT Sources st m (Future st MetaValue)
asInlines Text
x
  where asInlines :: ParserT Sources st m (Future st MetaValue)
asInlines = (MetaValue -> MetaValue)
-> Future st MetaValue -> Future st MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaValue -> MetaValue
b2i (Future st MetaValue -> Future st MetaValue)
-> ParserT Sources st m (Future st MetaValue)
-> ParserT Sources st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Sources st m (Future st MetaValue)
pMetaValue
        b2i :: MetaValue -> MetaValue
b2i (MetaBlocks [Plain [Inline]
ils]) = [Inline] -> MetaValue
MetaInlines [Inline]
ils
        b2i (MetaBlocks [Para [Inline]
ils]) = [Inline] -> MetaValue
MetaInlines [Inline]
ils
        b2i MetaValue
bs = MetaValue
bs
        isSpaceChar :: Char -> Bool
isSpaceChar Char
' '  = Bool
True
        isSpaceChar Char
'\t' = Bool
True
        isSpaceChar Char
_    = Bool
False

checkBoolean :: Text -> Maybe Bool
checkBoolean :: Text -> Maybe Bool
checkBoolean Text
t
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"true" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"True" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"TRUE" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"false" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"False" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"FALSE" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  | Bool
otherwise = Maybe Bool
forall a. Maybe a
Nothing

yamlToMetaValue :: (PandocMonad m, HasLastStrPosition st)
                => ParserT Sources st m (Future st MetaValue)
                -> YAML.Node YE.Pos
                -> ParserT Sources st m (Future st MetaValue)
yamlToMetaValue :: ParserT Sources st m (Future st MetaValue)
-> Node Pos -> ParserT Sources st m (Future st MetaValue)
yamlToMetaValue ParserT Sources st m (Future st MetaValue)
pMetaValue (YAML.Scalar Pos
_ Scalar
x) =
  case Scalar
x of
       YAML.SStr Text
t       -> ParserT Sources st m (Future st MetaValue)
-> Text -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Sources st m (Future st MetaValue)
-> Text -> ParserT Sources st m (Future st MetaValue)
normalizeMetaValue ParserT Sources st m (Future st MetaValue)
pMetaValue Text
t
       YAML.SBool Bool
b      -> Future st MetaValue -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Sources st m (Future st MetaValue))
-> Future st MetaValue
-> ParserT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Future st MetaValue
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
       YAML.SFloat Double
d     -> Future st MetaValue -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Sources st m (Future st MetaValue))
-> Future st MetaValue
-> ParserT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Future st MetaValue
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 -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Double -> Text
forall a. Show a => a -> Text
tshow Double
d
       YAML.SInt Integer
i       -> Future st MetaValue -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Sources st m (Future st MetaValue))
-> Future st MetaValue
-> ParserT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Future st MetaValue
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 -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Integer -> Text
forall a. Show a => a -> Text
tshow Integer
i
       YAML.SUnknown Tag
_ Text
t ->
         case Text -> Maybe Bool
checkBoolean Text
t of
           Just Bool
b        -> Future st MetaValue -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Sources st m (Future st MetaValue))
-> Future st MetaValue
-> ParserT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Future st MetaValue
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
           Maybe Bool
Nothing       -> ParserT Sources st m (Future st MetaValue)
-> Text -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Sources st m (Future st MetaValue)
-> Text -> ParserT Sources st m (Future st MetaValue)
normalizeMetaValue ParserT Sources st m (Future st MetaValue)
pMetaValue Text
t
       Scalar
YAML.SNull        -> Future st MetaValue -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Sources st m (Future st MetaValue))
-> Future st MetaValue
-> ParserT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Future st MetaValue
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
""

yamlToMetaValue ParserT Sources st m (Future st MetaValue)
pMetaValue (YAML.Sequence Pos
_ Tag
_ [Node Pos]
xs) =
  ([MetaValue] -> MetaValue)
-> Future st [MetaValue] -> Future st MetaValue
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)
sequence
  ([Future st MetaValue] -> Future st MetaValue)
-> ParsecT Sources st m [Future st MetaValue]
-> ParserT Sources st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node Pos -> ParserT Sources st m (Future st MetaValue))
-> [Node Pos] -> ParsecT Sources st m [Future st MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Sources st m (Future st MetaValue)
-> Node Pos -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Sources st m (Future st MetaValue)
-> Node Pos -> ParserT Sources st m (Future st MetaValue)
yamlToMetaValue ParserT Sources st m (Future st MetaValue)
pMetaValue) [Node Pos]
xs
yamlToMetaValue ParserT Sources st m (Future st MetaValue)
pMetaValue (YAML.Mapping Pos
_ Tag
_ Mapping Pos
o) =
  (Map Text MetaValue -> MetaValue)
-> Future st (Map Text MetaValue) -> Future st MetaValue
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))
-> ParserT Sources st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Sources st m (Future st MetaValue)
-> Mapping Pos
-> ParsecT Sources st m (Future st (Map Text MetaValue))
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Sources st m (Future st MetaValue)
-> Mapping Pos
-> ParserT Sources st m (Future st (Map Text MetaValue))
yamlMap ParserT Sources st m (Future st MetaValue)
pMetaValue Mapping Pos
o
yamlToMetaValue ParserT Sources st m (Future st MetaValue)
_ Node Pos
_ = Future st MetaValue -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Sources st m (Future st MetaValue))
-> Future st MetaValue
-> ParserT Sources st m (Future st MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Future st MetaValue
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
""

yamlMap :: (PandocMonad m, HasLastStrPosition st)
        => ParserT Sources st m (Future st MetaValue)
        -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)
        -> ParserT Sources st m (Future st (M.Map Text MetaValue))
yamlMap :: ParserT Sources st m (Future st MetaValue)
-> Mapping Pos
-> ParserT Sources st m (Future st (Map Text MetaValue))
yamlMap ParserT Sources st m (Future st MetaValue)
pMetaValue Mapping Pos
o = do
    [(Text, Node Pos)]
kvs <- [(Node Pos, Node Pos)]
-> ((Node Pos, Node Pos) -> ParsecT Sources st m (Text, Node Pos))
-> ParsecT Sources st m [(Text, Node Pos)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Mapping Pos -> [(Node Pos, Node Pos)]
forall k a. Map k a -> [(k, a)]
M.toList Mapping Pos
o) (((Node Pos, Node Pos) -> ParsecT Sources st m (Text, Node Pos))
 -> ParsecT Sources st m [(Text, Node Pos)])
-> ((Node Pos, Node Pos) -> ParsecT Sources st m (Text, Node Pos))
-> ParsecT Sources st m [(Text, Node Pos)]
forall a b. (a -> b) -> a -> b
$ \(Node Pos
key, Node Pos
v) -> do
             Text
k <- ParsecT Sources st m Text
-> (Text -> ParsecT Sources st m Text)
-> Maybe Text
-> ParsecT Sources st m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PandocError -> ParsecT Sources st m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT Sources st m Text)
-> PandocError -> ParsecT Sources st m Text
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError
                            Text
"Non-string key in YAML mapping")
                        Text -> ParsecT Sources st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT Sources st m Text)
-> Maybe Text -> ParsecT Sources st m Text
forall a b. (a -> b) -> a -> b
$ Node Pos -> Maybe Text
nodeToKey Node Pos
key
             (Text, Node Pos) -> ParsecT Sources st m (Text, Node Pos)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k, Node Pos
v)
    let kvs' :: [(Text, Node Pos)]
kvs' = ((Text, Node Pos) -> Bool)
-> [(Text, Node Pos)] -> [(Text, Node Pos)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Text, Node Pos) -> Bool) -> (Text, Node Pos) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
ignorable (Text -> Bool)
-> ((Text, Node Pos) -> Text) -> (Text, Node Pos) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Node Pos) -> Text
forall a b. (a, b) -> a
fst) [(Text, Node Pos)]
kvs
    ([(Text, MetaValue)] -> Map Text MetaValue)
-> Future st [(Text, MetaValue)] -> Future st (Map Text MetaValue)
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)
sequence ([Future st (Text, MetaValue)] -> Future st (Map Text MetaValue))
-> ParsecT Sources st m [Future st (Text, MetaValue)]
-> ParserT Sources st m (Future st (Map Text MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Node Pos)
 -> ParsecT Sources st m (Future st (Text, MetaValue)))
-> [(Text, Node Pos)]
-> 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)
mapM (Text, Node Pos)
-> ParsecT Sources st m (Future st (Text, MetaValue))
forall a.
(a, Node Pos) -> ParsecT Sources st m (Future st (a, MetaValue))
toMeta [(Text, Node Pos)]
kvs'
  where
    ignorable :: Text -> Bool
ignorable Text
t = Text
"_" Text -> Text -> Bool
`T.isSuffixOf` Text
t
    toMeta :: (a, Node Pos) -> ParsecT Sources st m (Future st (a, MetaValue))
toMeta (a
k, Node Pos
v) = do
      Future st MetaValue
fv <- ParserT Sources st m (Future st MetaValue)
-> Node Pos -> ParserT Sources st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Sources st m (Future st MetaValue)
-> Node Pos -> ParserT Sources st m (Future st MetaValue)
yamlToMetaValue ParserT Sources st m (Future st MetaValue)
pMetaValue Node Pos
v
      Future st (a, MetaValue)
-> ParsecT Sources st m (Future st (a, MetaValue))
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 (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)
              => ParserT Sources st m (Future st MetaValue)
              -> ParserT Sources st m (Future st Meta)
yamlMetaBlock :: ParserT Sources st m (Future st MetaValue)
-> ParserT Sources st m (Future st Meta)
yamlMetaBlock ParserT Sources st m (Future st MetaValue)
parser = ParserT Sources st m (Future st Meta)
-> ParserT Sources st m (Future st Meta)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Sources st m (Future st Meta)
 -> ParserT Sources st m (Future st Meta))
-> ParserT Sources st m (Future st Meta)
-> ParserT 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
"---"
  ParserT Sources st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline
  ParserT 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 ParserT Sources st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT 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 => ParserT Sources st m Text
anyLine ParsecT Sources st m ()
forall (m :: * -> *) st. Monad m => ParserT 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) =>
ParserT s st m Text
blanklines
  ParserT Sources st m (Future st MetaValue)
-> ByteString -> ParserT Sources st m (Future st Meta)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Sources st m (Future st MetaValue)
-> ByteString -> ParserT Sources st m (Future st Meta)
yamlBsToMeta ParserT Sources st m (Future st MetaValue)
parser (ByteString -> ParserT Sources st m (Future st Meta))
-> ByteString -> ParserT Sources st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromTextLazy (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
rawYaml

stopLine :: Monad m => ParserT Sources st m ()
stopLine :: ParserT Sources st m ()
stopLine = ParserT Sources st m () -> ParserT Sources st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Sources st m () -> ParserT Sources st m ())
-> ParserT Sources st m () -> ParserT 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 (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) =>
ParserT s st m Char
blankline ParsecT Sources st m Char
-> ParserT Sources st m () -> ParserT Sources st m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParserT Sources st m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()