{-# 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 Text st m (Future st MetaValue)
             -> BL.ByteString
             -> ParserT Text st m (Future st Meta)
yamlBsToMeta :: ParserT Text st m (Future st MetaValue)
-> ByteString -> ParserT Text st m (Future st Meta)
yamlBsToMeta ParserT Text 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 Text st m (Future st (Map Text MetaValue))
-> ParserT Text st m (Future st Meta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text st m (Future st MetaValue)
-> Mapping Pos
-> ParsecT Text st m (Future st (Map Text MetaValue))
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Text st m (Future st MetaValue)
-> Mapping Pos
-> ParserT Text st m (Future st (Map Text MetaValue))
yamlMap ParserT Text st m (Future st MetaValue)
pMetaValue Mapping Pos
o
       Right [] -> Future st Meta -> ParserT Text st m (Future st Meta)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st Meta -> ParserT Text st m (Future st Meta))
-> (Meta -> Future st Meta)
-> Meta
-> ParserT Text 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 Text st m (Future st Meta))
-> Meta -> ParserT Text 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 Text st m (Future st Meta)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st Meta -> ParserT Text st m (Future st Meta))
-> (Meta -> Future st Meta)
-> Meta
-> ParserT Text 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 Text st m (Future st Meta))
-> Meta -> ParserT Text 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 Text 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 Text st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                      SourcePos -> ParsecT Text st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Text st m ())
-> SourcePos -> ParsecT Text 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 Text 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 Text st m (Future st MetaValue)
             -> (Text -> Bool) -- ^ Filter for id
             -> BL.ByteString
             -> ParserT Text st m (Future st [MetaValue])
yamlBsToRefs :: ParserT Text st m (Future st MetaValue)
-> (Text -> Bool)
-> ByteString
-> ParserT Text st m (Future st [MetaValue])
yamlBsToRefs ParserT Text 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 Text st m [Future st MetaValue]
-> ParserT Text st m (Future st [MetaValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (Node Pos -> ParserT Text st m (Future st MetaValue))
-> [Node Pos] -> ParsecT Text st m [Future st MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Text st m (Future st MetaValue)
-> Node Pos -> ParserT Text st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Text st m (Future st MetaValue)
-> Node Pos -> ParserT Text st m (Future st MetaValue)
yamlToMetaValue ParserT Text 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 Text 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 Text st m (Future st [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expecting 'references' field"

       Right [] -> Future st [MetaValue] -> ParserT Text st m (Future st [MetaValue])
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st [MetaValue]
 -> ParserT Text st m (Future st [MetaValue]))
-> ([MetaValue] -> Future st [MetaValue])
-> [MetaValue]
-> ParserT Text 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 Text st m (Future st [MetaValue]))
-> [MetaValue] -> ParserT Text 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 Text st m (Future st [MetaValue])
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st [MetaValue]
 -> ParserT Text st m (Future st [MetaValue]))
-> ([MetaValue] -> Future st [MetaValue])
-> [MetaValue]
-> ParserT Text 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 Text st m (Future st [MetaValue]))
-> [MetaValue] -> ParserT Text 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 Text st m (Future st [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expecting YAML object"
       Left (Pos
_pos, String
err')
                -> String -> ParserT Text 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 Text st m (Future st MetaValue)
                   -> Text
                   -> ParserT Text st m (Future st MetaValue)
normalizeMetaValue :: ParserT Text st m (Future st MetaValue)
-> Text -> ParserT Text st m (Future st MetaValue)
normalizeMetaValue ParserT Text 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 Text st m (Future st MetaValue)
-> Text -> ParserT Text st m (Future st MetaValue)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParserT Text st m (Future st MetaValue)
pMetaValue (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
      else ParserT Text st m (Future st MetaValue)
-> Text -> ParserT Text st m (Future st MetaValue)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParserT Text st m (Future st MetaValue)
asInlines Text
x
  where asInlines :: ParserT Text 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 Text st m (Future st MetaValue)
-> ParserT Text st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text 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 Text st m (Future st MetaValue)
                -> YAML.Node YE.Pos
                -> ParserT Text st m (Future st MetaValue)
yamlToMetaValue :: ParserT Text st m (Future st MetaValue)
-> Node Pos -> ParserT Text st m (Future st MetaValue)
yamlToMetaValue ParserT Text st m (Future st MetaValue)
pMetaValue (YAML.Scalar Pos
_ Scalar
x) =
  case Scalar
x of
       YAML.SStr Text
t       -> ParserT Text st m (Future st MetaValue)
-> Text -> ParserT Text st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Text st m (Future st MetaValue)
-> Text -> ParserT Text st m (Future st MetaValue)
normalizeMetaValue ParserT Text st m (Future st MetaValue)
pMetaValue Text
t
       YAML.SBool Bool
b      -> Future st MetaValue -> ParserT Text st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Text st m (Future st MetaValue))
-> Future st MetaValue -> ParserT Text 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 Text st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Text st m (Future st MetaValue))
-> Future st MetaValue -> ParserT Text 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 Text st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Text st m (Future st MetaValue))
-> Future st MetaValue -> ParserT Text 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 Text st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Text st m (Future st MetaValue))
-> Future st MetaValue -> ParserT Text 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 Text st m (Future st MetaValue)
-> Text -> ParserT Text st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Text st m (Future st MetaValue)
-> Text -> ParserT Text st m (Future st MetaValue)
normalizeMetaValue ParserT Text st m (Future st MetaValue)
pMetaValue Text
t
       Scalar
YAML.SNull        -> Future st MetaValue -> ParserT Text st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Text st m (Future st MetaValue))
-> Future st MetaValue -> ParserT Text 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 Text 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 Text st m [Future st MetaValue]
-> ParserT Text st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node Pos -> ParserT Text st m (Future st MetaValue))
-> [Node Pos] -> ParsecT Text st m [Future st MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Text st m (Future st MetaValue)
-> Node Pos -> ParserT Text st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Text st m (Future st MetaValue)
-> Node Pos -> ParserT Text st m (Future st MetaValue)
yamlToMetaValue ParserT Text st m (Future st MetaValue)
pMetaValue) [Node Pos]
xs
yamlToMetaValue ParserT Text 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 Text st m (Future st (Map Text MetaValue))
-> ParserT Text st m (Future st MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text st m (Future st MetaValue)
-> Mapping Pos
-> ParsecT Text st m (Future st (Map Text MetaValue))
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Text st m (Future st MetaValue)
-> Mapping Pos
-> ParserT Text st m (Future st (Map Text MetaValue))
yamlMap ParserT Text st m (Future st MetaValue)
pMetaValue Mapping Pos
o
yamlToMetaValue ParserT Text st m (Future st MetaValue)
_ Node Pos
_ = Future st MetaValue -> ParserT Text st m (Future st MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st MetaValue -> ParserT Text st m (Future st MetaValue))
-> Future st MetaValue -> ParserT Text 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 Text st m (Future st MetaValue)
        -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)
        -> ParserT Text st m (Future st (M.Map Text MetaValue))
yamlMap :: ParserT Text st m (Future st MetaValue)
-> Mapping Pos
-> ParserT Text st m (Future st (Map Text MetaValue))
yamlMap ParserT Text st m (Future st MetaValue)
pMetaValue Mapping Pos
o = do
    [(Text, Node Pos)]
kvs <- [(Node Pos, Node Pos)]
-> ((Node Pos, Node Pos) -> ParsecT Text st m (Text, Node Pos))
-> ParsecT Text 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 Text st m (Text, Node Pos))
 -> ParsecT Text st m [(Text, Node Pos)])
-> ((Node Pos, Node Pos) -> ParsecT Text st m (Text, Node Pos))
-> ParsecT Text st m [(Text, Node Pos)]
forall a b. (a -> b) -> a -> b
$ \(Node Pos
key, Node Pos
v) -> do
             Text
k <- ParsecT Text st m Text
-> (Text -> ParsecT Text st m Text)
-> Maybe Text
-> ParsecT Text st m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PandocError -> ParsecT Text st m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT Text st m Text)
-> PandocError -> ParsecT Text st m Text
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError
                            Text
"Non-string key in YAML mapping")
                        Text -> ParsecT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT Text st m Text)
-> Maybe Text -> ParsecT Text st m Text
forall a b. (a -> b) -> a -> b
$ Node Pos -> Maybe Text
nodeToKey Node Pos
key
             (Text, Node Pos) -> ParsecT Text 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 Text st m [Future st (Text, MetaValue)]
-> ParserT Text st m (Future st (Map Text MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Node Pos)
 -> ParsecT Text st m (Future st (Text, MetaValue)))
-> [(Text, Node Pos)]
-> ParsecT Text 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 Text st m (Future st (Text, MetaValue))
forall a.
(a, Node Pos) -> ParsecT Text 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 Text st m (Future st (a, MetaValue))
toMeta (a
k, Node Pos
v) = do
      Future st MetaValue
fv <- ParserT Text st m (Future st MetaValue)
-> Node Pos -> ParserT Text st m (Future st MetaValue)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Text st m (Future st MetaValue)
-> Node Pos -> ParserT Text st m (Future st MetaValue)
yamlToMetaValue ParserT Text st m (Future st MetaValue)
pMetaValue Node Pos
v
      Future st (a, MetaValue)
-> ParsecT Text st m (Future st (a, MetaValue))
forall (m :: * -> *) a. Monad m => a -> m a
return (Future st (a, MetaValue)
 -> ParsecT Text st m (Future st (a, MetaValue)))
-> Future st (a, MetaValue)
-> ParsecT Text 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 Text st m (Future st MetaValue)
              -> ParserT Text st m (Future st Meta)
yamlMetaBlock :: ParserT Text st m (Future st MetaValue)
-> ParserT Text st m (Future st Meta)
yamlMetaBlock ParserT Text st m (Future st MetaValue)
parser = ParserT Text st m (Future st Meta)
-> ParserT Text st m (Future st Meta)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m (Future st Meta)
 -> ParserT Text st m (Future st Meta))
-> ParserT Text st m (Future st Meta)
-> ParserT Text st m (Future st Meta)
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT Text st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"---"
  ParserT Text st m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
blankline
  ParserT Text st m Char -> ParsecT Text 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 Text st m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
blankline  -- if --- is followed by a blank it's an HRULE
  [Text]
rawYamlLines <- ParsecT Text st m Text
-> ParsecT Text st m () -> ParsecT Text 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 Text st m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine ParsecT Text st m ()
forall (m :: * -> *) st. Monad m => ParserT Text 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 Text st m Text -> ParsecT Text st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
  ParserT Text st m (Future st MetaValue)
-> ByteString -> ParserT Text st m (Future st Meta)
forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParserT Text st m (Future st MetaValue)
-> ByteString -> ParserT Text st m (Future st Meta)
yamlBsToMeta ParserT Text st m (Future st MetaValue)
parser (ByteString -> ParserT Text st m (Future st Meta))
-> ByteString -> ParserT Text 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 Text st m ()
stopLine :: ParserT Text st m ()
stopLine = ParserT Text st m () -> ParserT Text st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m () -> ParserT Text st m ())
-> ParserT Text st m () -> ParserT Text st m ()
forall a b. (a -> b) -> a -> b
$ (String -> ParsecT Text st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"---" ParsecT Text st m String
-> ParsecT Text st m String -> ParsecT Text 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 Text st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"...") ParsecT Text st m String
-> ParsecT Text st m Char -> ParsecT Text st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text st m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
blankline ParsecT Text st m Char
-> ParserT Text st m () -> ParserT Text st m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParserT Text st m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()