{-# 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,
  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

yamlBsToMeta :: PandocMonad m
             => ParserT Text ParserState m (F MetaValue)
             -> BL.ByteString
             -> ParserT Text ParserState m (F Meta)
yamlBsToMeta :: ParserT Text ParserState m (F MetaValue)
-> ByteString -> ParserT Text ParserState m (F Meta)
yamlBsToMeta ParserT Text ParserState m (F 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 ParserState (Map Text MetaValue) -> F Meta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Text MetaValue -> Meta
Meta (Future ParserState (Map Text MetaValue) -> F Meta)
-> ParsecT
     Text ParserState m (Future ParserState (Map Text MetaValue))
-> ParserT Text ParserState m (F Meta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text ParserState m (F MetaValue)
-> Mapping Pos
-> ParsecT
     Text ParserState m (Future ParserState (Map Text MetaValue))
forall (m :: * -> *).
PandocMonad m =>
ParserT Text ParserState m (F MetaValue)
-> Mapping Pos
-> ParserT
     Text ParserState m (Future ParserState (Map Text MetaValue))
yamlMap ParserT Text ParserState m (F MetaValue)
pMetaValue Mapping Pos
o
       Right [] -> F Meta -> ParserT Text ParserState m (F Meta)
forall (m :: * -> *) a. Monad m => a -> m a
return (F Meta -> ParserT Text ParserState m (F Meta))
-> (Meta -> F Meta) -> Meta -> ParserT Text ParserState m (F Meta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> F Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> ParserT Text ParserState m (F Meta))
-> Meta -> ParserT Text ParserState m (F Meta)
forall a b. (a -> b) -> a -> b
$ Meta
forall a. Monoid a => a
mempty
       Right [YAML.Doc (YAML.Scalar Pos
_ Scalar
YAML.SNull)]
                -> F Meta -> ParserT Text ParserState m (F Meta)
forall (m :: * -> *) a. Monad m => a -> m a
return (F Meta -> ParserT Text ParserState m (F Meta))
-> (Meta -> F Meta) -> Meta -> ParserT Text ParserState m (F Meta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> F Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> ParserT Text ParserState m (F Meta))
-> Meta -> ParserT Text ParserState m (F Meta)
forall a b. (a -> b) -> a -> b
$ Meta
forall a. Monoid a => a
mempty
       Right [Doc (Node Pos)]
_  -> String -> ParserT Text ParserState m (F 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 ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                      SourcePos -> ParsecT Text ParserState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Text ParserState m ())
-> SourcePos -> ParsecT Text ParserState 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 ParserState m (F 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
             => ParserT Text ParserState m (F MetaValue)
             -> (Text -> Bool) -- ^ Filter for id
             -> BL.ByteString
             -> ParserT Text ParserState m (F [MetaValue])
yamlBsToRefs :: ParserT Text ParserState m (F MetaValue)
-> (Text -> Bool)
-> ByteString
-> ParserT Text ParserState m (F [MetaValue])
yamlBsToRefs ParserT Text ParserState m (F 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
                       [F MetaValue] -> F [MetaValue]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([F MetaValue] -> F [MetaValue])
-> ParsecT Text ParserState m [F MetaValue]
-> ParserT Text ParserState m (F [MetaValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (Node Pos -> ParserT Text ParserState m (F MetaValue))
-> [Node Pos] -> ParsecT Text ParserState m [F MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Text ParserState m (F MetaValue)
-> Node Pos -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *).
PandocMonad m =>
ParserT Text ParserState m (F MetaValue)
-> Node Pos -> ParserT Text ParserState m (F MetaValue)
yamlToMetaValue ParserT Text ParserState m (F 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 ParserState m (F [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expecting sequence in 'references' field"
                     Maybe (Node Pos)
Nothing ->
                       String -> ParserT Text ParserState m (F [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expecting 'references' field"

       Right [] -> F [MetaValue] -> ParserT Text ParserState m (F [MetaValue])
forall (m :: * -> *) a. Monad m => a -> m a
return (F [MetaValue] -> ParserT Text ParserState m (F [MetaValue]))
-> ([MetaValue] -> F [MetaValue])
-> [MetaValue]
-> ParserT Text ParserState m (F [MetaValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetaValue] -> F [MetaValue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaValue] -> ParserT Text ParserState m (F [MetaValue]))
-> [MetaValue] -> ParserT Text ParserState m (F [MetaValue])
forall a b. (a -> b) -> a -> b
$ [MetaValue]
forall a. Monoid a => a
mempty
       Right [YAML.Doc (YAML.Scalar Pos
_ Scalar
YAML.SNull)]
                -> F [MetaValue] -> ParserT Text ParserState m (F [MetaValue])
forall (m :: * -> *) a. Monad m => a -> m a
return (F [MetaValue] -> ParserT Text ParserState m (F [MetaValue]))
-> ([MetaValue] -> F [MetaValue])
-> [MetaValue]
-> ParserT Text ParserState m (F [MetaValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetaValue] -> F [MetaValue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaValue] -> ParserT Text ParserState m (F [MetaValue]))
-> [MetaValue] -> ParserT Text ParserState m (F [MetaValue])
forall a b. (a -> b) -> a -> b
$ [MetaValue]
forall a. Monoid a => a
mempty
       Right [Doc (Node Pos)]
_  -> String -> ParserT Text ParserState m (F [MetaValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expecting YAML object"
       Left (Pos
_pos, String
err')
                -> String -> ParserT Text ParserState m (F [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
                   => ParserT Text ParserState m (F MetaValue)
                   -> Text
                   -> ParserT Text ParserState m (F MetaValue)
normalizeMetaValue :: ParserT Text ParserState m (F MetaValue)
-> Text -> ParserT Text ParserState m (F MetaValue)
normalizeMetaValue ParserT Text ParserState m (F 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 ParserState m (F MetaValue)
-> Text -> ParserT Text ParserState m (F 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 ParserState m (F MetaValue)
pMetaValue (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
      else ParserT Text ParserState m (F MetaValue)
-> Text -> ParserT Text ParserState m (F 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 ParserState m (F MetaValue)
asInlines Text
x
  where asInlines :: ParserT Text ParserState m (F MetaValue)
asInlines = (MetaValue -> MetaValue) -> F MetaValue -> F MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaValue -> MetaValue
b2i (F MetaValue -> F MetaValue)
-> ParserT Text ParserState m (F MetaValue)
-> ParserT Text ParserState m (F MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text ParserState m (F 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
                => ParserT Text ParserState m (F MetaValue)
                -> YAML.Node YE.Pos
                -> ParserT Text ParserState m (F MetaValue)
yamlToMetaValue :: ParserT Text ParserState m (F MetaValue)
-> Node Pos -> ParserT Text ParserState m (F MetaValue)
yamlToMetaValue ParserT Text ParserState m (F MetaValue)
pMetaValue (YAML.Scalar Pos
_ Scalar
x) =
  case Scalar
x of
       YAML.SStr Text
t       -> ParserT Text ParserState m (F MetaValue)
-> Text -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *).
PandocMonad m =>
ParserT Text ParserState m (F MetaValue)
-> Text -> ParserT Text ParserState m (F MetaValue)
normalizeMetaValue ParserT Text ParserState m (F MetaValue)
pMetaValue Text
t
       YAML.SBool Bool
b      -> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (F MetaValue -> ParserT Text ParserState m (F MetaValue))
-> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> F MetaValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> F MetaValue) -> MetaValue -> F MetaValue
forall a b. (a -> b) -> a -> b
$ Bool -> MetaValue
MetaBool Bool
b
       YAML.SFloat Double
d     -> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (F MetaValue -> ParserT Text ParserState m (F MetaValue))
-> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> F MetaValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> F MetaValue) -> MetaValue -> F 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       -> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (F MetaValue -> ParserT Text ParserState m (F MetaValue))
-> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> F MetaValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> F MetaValue) -> MetaValue -> F 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        -> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (F MetaValue -> ParserT Text ParserState m (F MetaValue))
-> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> F MetaValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> F MetaValue) -> MetaValue -> F MetaValue
forall a b. (a -> b) -> a -> b
$ Bool -> MetaValue
MetaBool Bool
b
           Maybe Bool
Nothing       -> ParserT Text ParserState m (F MetaValue)
-> Text -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *).
PandocMonad m =>
ParserT Text ParserState m (F MetaValue)
-> Text -> ParserT Text ParserState m (F MetaValue)
normalizeMetaValue ParserT Text ParserState m (F MetaValue)
pMetaValue Text
t
       Scalar
YAML.SNull        -> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (F MetaValue -> ParserT Text ParserState m (F MetaValue))
-> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> F MetaValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> F MetaValue) -> MetaValue -> F MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> MetaValue
MetaString Text
""

yamlToMetaValue ParserT Text ParserState m (F MetaValue)
pMetaValue (YAML.Sequence Pos
_ Tag
_ [Node Pos]
xs) =
  ([MetaValue] -> MetaValue) -> F [MetaValue] -> F MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MetaValue] -> MetaValue
MetaList (F [MetaValue] -> F MetaValue)
-> ([F MetaValue] -> F [MetaValue]) -> [F MetaValue] -> F MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [F MetaValue] -> F [MetaValue]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
  ([F MetaValue] -> F MetaValue)
-> ParsecT Text ParserState m [F MetaValue]
-> ParserT Text ParserState m (F MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node Pos -> ParserT Text ParserState m (F MetaValue))
-> [Node Pos] -> ParsecT Text ParserState m [F MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Text ParserState m (F MetaValue)
-> Node Pos -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *).
PandocMonad m =>
ParserT Text ParserState m (F MetaValue)
-> Node Pos -> ParserT Text ParserState m (F MetaValue)
yamlToMetaValue ParserT Text ParserState m (F MetaValue)
pMetaValue) [Node Pos]
xs
yamlToMetaValue ParserT Text ParserState m (F MetaValue)
pMetaValue (YAML.Mapping Pos
_ Tag
_ Mapping Pos
o) =
  (Map Text MetaValue -> MetaValue)
-> Future ParserState (Map Text MetaValue) -> F MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Text MetaValue -> MetaValue
MetaMap (Future ParserState (Map Text MetaValue) -> F MetaValue)
-> ParsecT
     Text ParserState m (Future ParserState (Map Text MetaValue))
-> ParserT Text ParserState m (F MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text ParserState m (F MetaValue)
-> Mapping Pos
-> ParsecT
     Text ParserState m (Future ParserState (Map Text MetaValue))
forall (m :: * -> *).
PandocMonad m =>
ParserT Text ParserState m (F MetaValue)
-> Mapping Pos
-> ParserT
     Text ParserState m (Future ParserState (Map Text MetaValue))
yamlMap ParserT Text ParserState m (F MetaValue)
pMetaValue Mapping Pos
o
yamlToMetaValue ParserT Text ParserState m (F MetaValue)
_ Node Pos
_ = F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (F MetaValue -> ParserT Text ParserState m (F MetaValue))
-> F MetaValue -> ParserT Text ParserState m (F MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> F MetaValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> F MetaValue) -> MetaValue -> F MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> MetaValue
MetaString Text
""

yamlMap :: PandocMonad m
        => ParserT Text ParserState m (F MetaValue)
        -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)
        -> ParserT Text ParserState m (F (M.Map Text MetaValue))
yamlMap :: ParserT Text ParserState m (F MetaValue)
-> Mapping Pos
-> ParserT
     Text ParserState m (Future ParserState (Map Text MetaValue))
yamlMap ParserT Text ParserState m (F MetaValue)
pMetaValue Mapping Pos
o = do
    [(Text, Node Pos)]
kvs <- [(Node Pos, Node Pos)]
-> ((Node Pos, Node Pos)
    -> ParsecT Text ParserState m (Text, Node Pos))
-> ParsecT Text ParserState 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 ParserState m (Text, Node Pos))
 -> ParsecT Text ParserState m [(Text, Node Pos)])
-> ((Node Pos, Node Pos)
    -> ParsecT Text ParserState m (Text, Node Pos))
-> ParsecT Text ParserState m [(Text, Node Pos)]
forall a b. (a -> b) -> a -> b
$ \(Node Pos
key, Node Pos
v) -> do
             Text
k <- ParsecT Text ParserState m Text
-> (Text -> ParsecT Text ParserState m Text)
-> Maybe Text
-> ParsecT Text ParserState m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PandocError -> ParsecT Text ParserState m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT Text ParserState m Text)
-> PandocError -> ParsecT Text ParserState m Text
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError
                            Text
"Non-string key in YAML mapping")
                        Text -> ParsecT Text ParserState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT Text ParserState m Text)
-> Maybe Text -> ParsecT Text ParserState m Text
forall a b. (a -> b) -> a -> b
$ Node Pos -> Maybe Text
nodeToKey Node Pos
key
             (Text, Node Pos) -> ParsecT Text ParserState 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 ParserState [(Text, MetaValue)]
-> Future ParserState (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 ParserState [(Text, MetaValue)]
 -> Future ParserState (Map Text MetaValue))
-> ([Future ParserState (Text, MetaValue)]
    -> Future ParserState [(Text, MetaValue)])
-> [Future ParserState (Text, MetaValue)]
-> Future ParserState (Map Text MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Future ParserState (Text, MetaValue)]
-> Future ParserState [(Text, MetaValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Future ParserState (Text, MetaValue)]
 -> Future ParserState (Map Text MetaValue))
-> ParsecT
     Text ParserState m [Future ParserState (Text, MetaValue)]
-> ParserT
     Text ParserState m (Future ParserState (Map Text MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Node Pos)
 -> ParsecT
      Text ParserState m (Future ParserState (Text, MetaValue)))
-> [(Text, Node Pos)]
-> ParsecT
     Text ParserState m [Future ParserState (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 ParserState m (Future ParserState (Text, MetaValue))
forall a.
(a, Node Pos)
-> ParsecT Text ParserState m (Future ParserState (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 ParserState m (Future ParserState (a, MetaValue))
toMeta (a
k, Node Pos
v) = do
      F MetaValue
fv <- ParserT Text ParserState m (F MetaValue)
-> Node Pos -> ParserT Text ParserState m (F MetaValue)
forall (m :: * -> *).
PandocMonad m =>
ParserT Text ParserState m (F MetaValue)
-> Node Pos -> ParserT Text ParserState m (F MetaValue)
yamlToMetaValue ParserT Text ParserState m (F MetaValue)
pMetaValue Node Pos
v
      Future ParserState (a, MetaValue)
-> ParsecT Text ParserState m (Future ParserState (a, MetaValue))
forall (m :: * -> *) a. Monad m => a -> m a
return (Future ParserState (a, MetaValue)
 -> ParsecT Text ParserState m (Future ParserState (a, MetaValue)))
-> Future ParserState (a, MetaValue)
-> ParsecT Text ParserState m (Future ParserState (a, MetaValue))
forall a b. (a -> b) -> a -> b
$ do
        MetaValue
v' <- F MetaValue
fv
        (a, MetaValue) -> Future ParserState (a, MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
k, MetaValue
v')