{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   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.Map as M
import qualified Data.Vector as V
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import qualified Data.Yaml.Internal as Yaml
import qualified Text.Libyaml as Y
import Data.Aeson (Value(..), Object, Result(..), fromJSON, (.:?), withObject,
                   FromJSON)
import Data.Aeson.Types (formatRelativePath, parse)
import Text.Pandoc.Shared (tshow, blocksToInlines)
import Text.Pandoc.Class (PandocMonad (..), report)
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Logging (LogMessage(YamlWarning))
import Text.Pandoc.Parsing hiding (tableWith, parse)
import qualified Text.Pandoc.UTF8 as UTF8
import System.IO.Unsafe (unsafePerformIO)

yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st)
             => ParsecT Sources st m (Future st MetaValue)
             -> B.ByteString
             -> ParsecT Sources st m (Future st Meta)
yamlBsToMeta :: forall (m :: * -> *) st.
(PandocMonad m, HasLastStrPosition st) =>
ParsecT Sources st m (Future st MetaValue)
-> ByteString -> ParsecT Sources st m (Future st Meta)
yamlBsToMeta ParsecT Sources st m (Future st MetaValue)
pMetaValue ByteString
bstr = do
  case ByteString -> Either ParseException ([Warning], [Value])
forall a.
FromJSON a =>
ByteString -> Either ParseException ([Warning], [a])
decodeAllWithWarnings ByteString
bstr of
       Right ([Warning]
warnings, [Value]
xs) -> do
         SourcePos
pos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         (Warning -> ParsecT Sources st m ())
-> [Warning] -> ParsecT Sources st m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Yaml.DuplicateKey JSONPath
jpath) ->
                          LogMessage -> ParsecT Sources st m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (SourcePos -> Text -> LogMessage
YamlWarning SourcePos
pos (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ Text
"Duplicate key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                  String -> Text
T.pack (JSONPath -> String
formatRelativePath JSONPath
jpath)))
           [Warning]
warnings
         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]
_  -> String -> ParsecT Sources st m (Future st Meta)
forall a. String -> ParsecT Sources st m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"expected YAML object"
       Left ParseException
err' -> do
         let msg :: Text
msg = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseException -> String
Yaml.prettyPrintParseException ParseException
err'
         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
$
           if Text
"did not find expected key" Text -> Text -> Bool
`T.isInfixOf` Text
msg
              then Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                   Text
"\nConsider enclosing the entire field in 'single quotes'"
              else Text
msg

decodeAllWithWarnings :: FromJSON a
                      => B.ByteString
                      -> (Either Yaml.ParseException ([Yaml.Warning], [a]))
decodeAllWithWarnings :: forall a.
FromJSON a =>
ByteString -> Either ParseException ([Warning], [a])
decodeAllWithWarnings = (ParseException -> Either ParseException ([Warning], [a]))
-> (([Warning], Either String [a])
    -> Either ParseException ([Warning], [a]))
-> Either ParseException ([Warning], Either String [a])
-> Either ParseException ([Warning], [a])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseException -> Either ParseException ([Warning], [a])
forall a b. a -> Either a b
Left (\([Warning]
ws,Either String [a]
res)
                       -> case Either String [a]
res of
                            Left String
s  -> ParseException -> Either ParseException ([Warning], [a])
forall a b. a -> Either a b
Left (String -> ParseException
Yaml.AesonException String
s)
                            Right [a]
v -> ([Warning], [a]) -> Either ParseException ([Warning], [a])
forall a b. b -> Either a b
Right ([Warning]
ws, [a]
v))
                   (Either ParseException ([Warning], Either String [a])
 -> Either ParseException ([Warning], [a]))
-> (ByteString
    -> Either ParseException ([Warning], Either String [a]))
-> ByteString
-> Either ParseException ([Warning], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either ParseException ([Warning], Either String [a]))
-> Either ParseException ([Warning], Either String [a])
forall a. IO a -> a
unsafePerformIO
                   (IO (Either ParseException ([Warning], Either String [a]))
 -> Either ParseException ([Warning], Either String [a]))
-> (ByteString
    -> IO (Either ParseException ([Warning], Either String [a])))
-> ByteString
-> Either ParseException ([Warning], Either String [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitM () Event Parse ()
-> IO (Either ParseException ([Warning], Either String [a]))
forall a.
FromJSON a =>
ConduitM () Event Parse ()
-> IO (Either ParseException ([Warning], Either String [a]))
Yaml.decodeAllHelper
                   (ConduitM () Event Parse ()
 -> IO (Either ParseException ([Warning], Either String [a])))
-> (ByteString -> ConduitM () Event Parse ())
-> ByteString
-> IO (Either ParseException ([Warning], Either String [a]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ConduitM () Event Parse ()
forall (m :: * -> *) i.
MonadResource m =>
ByteString -> ConduitM i Event m ()
Y.decode

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

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

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

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

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