{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
yamlBsToRefs :: (PandocMonad m, HasLastStrPosition st)
=> ParserT Text st m (Future st MetaValue)
-> (Text -> Bool)
-> 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 =
if Text
"\n" Text -> Text -> Bool
`T.isSuffixOf` (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpaceChar Text
x
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')
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
[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
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 ()