{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Text.Pandoc.Readers.Vimwiki ( readVimwiki
) where
import Control.Monad (guard)
import Control.Monad.Except (throwError)
import Data.Default
import Data.List (isInfixOf)
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Builder (Blocks, Inlines, fromList, toList, trimInlines)
import qualified Text.Pandoc.Builder as B (blockQuote, bulletList, code,
codeBlockWith, definitionList,
displayMath, divWith, emph,
headerWith, horizontalRule, image,
imageWith, link, math, orderedList,
para, plain, setMeta, simpleTable,
softbreak, space, spanWith, str,
strikeout, strong, subscript,
superscript)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.Definition (Attr, Block (BulletList, OrderedList),
Inline (Space), ListNumberDelim (..),
ListNumberStyle (..), Pandoc (..),
nullMeta)
import Text.Pandoc.Options (ReaderOptions)
import Text.Pandoc.Parsing (ParserState, ParsecT, blanklines, emailAddress,
many1Till, orderedListMarker, readWithM,
registerHeader, spaceChar, stateMeta,
stateOptions, uri, manyTillChar, manyChar, textStr,
many1Char, countChar, many1TillChar,
alphaNum, anyChar, char, newline, noneOf, oneOf,
space, spaces, string, choice, eof, lookAhead,
many1, many, manyTill, notFollowedBy,
skipMany1, try, option,
updateState, getState, (<|>))
import Text.Pandoc.Sources (ToSources(..), Sources)
import Text.Pandoc.Shared (splitTextBy, stringify, stripFirstAndLast, tshow)
import Text.Pandoc.URI (isURI)
readVimwiki :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readVimwiki :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readVimwiki ReaderOptions
opts a
s = do
let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
s
Either PandocError Pandoc
res <- ParsecT Sources ParserState m Pandoc
-> ParserState -> Sources -> m (Either PandocError Pandoc)
forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParsecT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM ParsecT Sources ParserState m Pandoc
forall (m :: * -> *). PandocMonad m => VwParser m Pandoc
parseVimwiki ParserState
forall a. Default a => a
def{ stateOptions = opts } Sources
sources
case Either PandocError Pandoc
res of
Left PandocError
e -> PandocError -> m Pandoc
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
Right Pandoc
result -> Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result
type VwParser = ParsecT Sources ParserState
specialChars :: [Char]
specialChars :: [Char]
specialChars = [Char]
"=*-#[]_~{}`$|:%^,"
spaceChars :: [Char]
spaceChars :: [Char]
spaceChars = [Char]
" \t\n"
parseVimwiki :: PandocMonad m => VwParser m Pandoc
parseVimwiki :: forall (m :: * -> *). PandocMonad m => VwParser m Pandoc
parseVimwiki = do
Blocks
bs <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Sources ParserState m [Blocks]
-> ParsecT Sources ParserState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
block
ParsecT Sources ParserState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
ParsecT Sources ParserState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
ParserState
st <- ParsecT Sources ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let meta :: Meta
meta = ParserState -> Meta
stateMeta ParserState
st
Pandoc -> VwParser m Pandoc
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> VwParser m Pandoc) -> Pandoc -> VwParser m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta (Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs)
block :: PandocMonad m => VwParser m Blocks
block :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
block = do
Blocks
res <- [VwParser m Blocks] -> VwParser m Blocks
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Sources ParserState m Text -> VwParser m Blocks
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
header
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
hrule
, Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Sources ParserState m () -> VwParser m Blocks
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
comment
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
mixedList
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
preformatted
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
displayMath
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
table
, Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Sources ParserState m () -> VwParser m Blocks
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
placeholder
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockQuote
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionList
, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
para
]
Text -> ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => Text -> m ()
trace (Int -> Text -> Text
T.take Int
60 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Show a => a -> Text
tshow ([Block] -> Text) -> [Block] -> Text
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
res)
Blocks -> VwParser m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
res
blockML :: PandocMonad m => VwParser m Blocks
blockML :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockML = [ParsecT Sources ParserState m Blocks]
-> ParsecT Sources ParserState m Blocks
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
preformatted, ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
displayMath, ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
table]
header :: PandocMonad m => VwParser m Blocks
= ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
[Char]
sp <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
[Char]
eqs <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'=')
ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
let lev :: Int
lev = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
eqs
Bool -> ParsecT Sources ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources ParserState m ())
-> Bool -> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ Int
lev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6
Inlines
contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Inlines]
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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char)
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b. (a -> b) -> a -> b
$ ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
eqs ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline)
Attr
attr <- Attr -> Inlines -> ParsecT Sources ParserState m Attr
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
HasIdentifierList st) =>
Attr -> Inlines -> ParsecT s st m Attr
registerHeader (Inlines -> Text
makeId Inlines
contents,
[Text
"justcenter" | Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
sp)], []) Inlines
contents
Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
B.headerWith Attr
attr Int
lev Inlines
contents
para :: PandocMonad m => VwParser m Blocks
para :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
para = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
Inlines
contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline
if (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
contents)
then Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para Inlines
contents
hrule :: PandocMonad m => VwParser m Blocks
hrule :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
hrule = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
B.horizontalRule Blocks
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Blocks
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ([Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"----" ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline)
comment :: PandocMonad m => VwParser m ()
= ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ())
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ do
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"%%" ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
() -> ParsecT Sources ParserState m ()
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
blockQuote :: PandocMonad m => VwParser m Blocks
blockQuote :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockQuote = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
" "
Inlines
contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineBQ
if (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
contents)
then Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
B.blockQuote (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain Inlines
contents
definitionList :: PandocMonad m => VwParser m Blocks
definitionList :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionList = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$
[(Inlines, [Blocks])] -> Blocks
B.definitionList ([(Inlines, [Blocks])] -> Blocks)
-> ParsecT Sources ParserState m [(Inlines, [Blocks])]
-> ParsecT Sources ParserState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m (Inlines, [Blocks])
-> ParsecT Sources ParserState m [(Inlines, [Blocks])]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources ParserState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
VwParser m (Inlines, [Blocks])
dlItemWithDT ParsecT Sources ParserState m (Inlines, [Blocks])
-> ParsecT Sources ParserState m (Inlines, [Blocks])
-> ParsecT Sources ParserState m (Inlines, [Blocks])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources ParserState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
VwParser m (Inlines, [Blocks])
dlItemWithoutDT)
dlItemWithDT :: PandocMonad m => VwParser m (Inlines, [Blocks])
dlItemWithDT :: forall (m :: * -> *).
PandocMonad m =>
VwParser m (Inlines, [Blocks])
dlItemWithDT = do
Inlines
dt <- VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm
[Blocks]
dds <- ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef
(Inlines, [Blocks]) -> VwParser m (Inlines, [Blocks])
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
dt, [Blocks]
dds)
dlItemWithoutDT :: PandocMonad m => VwParser m (Inlines, [Blocks])
dlItemWithoutDT :: forall (m :: * -> *).
PandocMonad m =>
VwParser m (Inlines, [Blocks])
dlItemWithoutDT = do
[Blocks]
dds <- ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef
(Inlines, [Blocks]) -> VwParser m (Inlines, [Blocks])
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
forall a. Monoid a => a
mempty, [Blocks]
dds)
definitionDef :: PandocMonad m => VwParser m Blocks
definitionDef :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$
ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState 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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef1 ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef2)
definitionDef1 :: PandocMonad m => VwParser m Blocks
definitionDef1 :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef1 = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
forall a. Monoid a => a
mempty Blocks
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Blocks
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerE
definitionDef2 :: PandocMonad m => VwParser m Blocks
definitionDef2 :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef2 = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain (Inlines -> Blocks)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(VwParser m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerM VwParser m Char
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline') ParsecT Sources ParserState m Inlines
-> VwParser m Char -> ParsecT Sources ParserState m Inlines
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* VwParser m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline)
definitionTerm :: PandocMonad m => VwParser m Inlines
definitionTerm :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
Inlines
x <- ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm1 ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm2
Bool -> ParsecT Sources ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify Inlines
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"")
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
x
definitionTerm1 :: PandocMonad m => VwParser m Inlines
definitionTerm1 :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm1 = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$
Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Inlines]
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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources ParserState m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerE)
definitionTerm2 :: PandocMonad m => VwParser m Inlines
definitionTerm2 :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm2 = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [Inlines]
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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline'
(ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ())
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (VwParser m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerM VwParser m Char
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState 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 ParserState m Text
forall (m :: * -> *). PandocMonad m => VwParser m Text
hasDefMarkerM))
defMarkerM :: PandocMonad m => VwParser m Char
defMarkerM :: forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerM = [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::" ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
defMarkerE :: PandocMonad m => VwParser m Char
defMarkerE :: forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerE = [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::" ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
hasDefMarkerM :: PandocMonad m => VwParser m Text
hasDefMarkerM :: forall (m :: * -> *). PandocMonad m => VwParser m Text
hasDefMarkerM = ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources ParserState m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerM)
preformatted :: PandocMonad m => VwParser m Blocks
preformatted :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
preformatted = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{{"
Text
attrText <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
manyChar ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
Text
contents <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}}"
ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline))
if (Text
contents Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") Bool -> Bool -> Bool
&& (HasCallStack => Text -> Char
Text -> Char
T.head Text
contents Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
then Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith (Text -> Attr
makeAttr Text
attrText) (HasCallStack => Text -> Text
Text -> Text
T.tail Text
contents)
else Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith (Text -> Attr
makeAttr Text
attrText) Text
contents
makeAttr :: Text -> Attr
makeAttr :: Text -> Attr
makeAttr Text
s =
let xs :: [Text]
xs = (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" \t" :: String)) Text
s in
(Text
"", [Text] -> [Text]
syntax [Text]
xs, (Text -> Maybe (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe (Text, Text)
nameValue [Text]
xs)
syntax :: [Text] -> [Text]
syntax :: [Text] -> [Text]
syntax (Text
s:[Text]
_) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
T.isInfixOf Text
"=" Text
s = [Text
s]
syntax [Text]
_ = []
nameValue :: Text -> Maybe (Text, Text)
nameValue :: Text -> Maybe (Text, Text)
nameValue Text
s =
let t :: [Text]
t = (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
s in
if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2
then Maybe (Text, Text)
forall a. Maybe a
Nothing
else let (Text
a, Text
b) = ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
t, [Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
t) in
if (Text -> Int
T.length Text
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2) Bool -> Bool -> Bool
|| ((HasCallStack => Text -> Char
Text -> Char
T.head Text
b, HasCallStack => Text -> Char
Text -> Char
T.last Text
b) (Char, Char) -> (Char, Char) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Char
'"', Char
'"'))
then Maybe (Text, Text)
forall a. Maybe a
Nothing
else (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
a, Text -> Text
stripFirstAndLast Text
b)
displayMath :: PandocMonad m => VwParser m Blocks
displayMath :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
displayMath = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{$"
Text
mathTag <- Text
-> ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" ParsecT Sources ParserState m Text
forall (m :: * -> *). PandocMonad m => VwParser m Text
mathTagParser
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space
Text
contents <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}$"
ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline))
let contentsWithTags :: Text
contentsWithTags
| Text
mathTag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = Text
contents
| Bool
otherwise = Text
"\\begin{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mathTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\\end{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mathTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.displayMath Text
contentsWithTags
mathTagLaTeX :: Text -> Text
mathTagLaTeX :: Text -> Text
mathTagLaTeX Text
s = case Text
s of
Text
"equation" -> Text
""
Text
"equation*" -> Text
""
Text
"gather" -> Text
"gathered"
Text
"gather*" -> Text
"gathered"
Text
"multline" -> Text
"gathered"
Text
"multline*" -> Text
"gathered"
Text
"eqnarray" -> Text
"aligned"
Text
"eqnarray*" -> Text
"aligned"
Text
"align" -> Text
"aligned"
Text
"align*" -> Text
"aligned"
Text
"alignat" -> Text
"aligned"
Text
"alignat*" -> Text
"aligned"
Text
_ -> Text
s
mixedList :: PandocMonad m => VwParser m Blocks
mixedList :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
mixedList = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
([Blocks]
bl, Int
_) <- Int -> VwParser m ([Blocks], Int)
forall (m :: * -> *).
PandocMonad m =>
Int -> VwParser m ([Blocks], Int)
mixedList' (-Int
1)
Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. HasCallStack => [a] -> a
head [Blocks]
bl
mixedList' :: PandocMonad m => Int -> VwParser m ([Blocks], Int)
mixedList' :: forall (m :: * -> *).
PandocMonad m =>
Int -> VwParser m ([Blocks], Int)
mixedList' Int
prevInd = do
(Int
curInd, Text
builder) <- (Int, Text)
-> ParsecT Sources ParserState m (Int, Text)
-> ParsecT Sources ParserState m (Int, Text)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (-Int
1, Text
"na") (ParsecT Sources ParserState m (Int, Text)
-> ParsecT Sources ParserState m (Int, Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Sources ParserState m (Int, Text)
forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart)
if Int
curInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
prevInd
then ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Int
curInd)
else do
ParsecT Sources ParserState m (Int, Text)
forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart
Blocks
curLine <- VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
listItemContent
let listBuilder :: [Blocks] -> Blocks
listBuilder =
if Text
builder Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"ul" then [Blocks] -> Blocks
B.bulletList else [Blocks] -> Blocks
B.orderedList
([Blocks]
subList, Int
lowInd) <- Int -> VwParser m ([Blocks], Int)
forall (m :: * -> *).
PandocMonad m =>
Int -> VwParser m ([Blocks], Int)
mixedList' Int
curInd
if Int
lowInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
curInd
then do
([Blocks]
sameIndList, Int
endInd) <- Int -> VwParser m ([Blocks], Int)
forall (m :: * -> *).
PandocMonad m =>
Int -> VwParser m ([Blocks], Int)
mixedList' Int
lowInd
let curList :: [Blocks]
curList = Blocks -> [Blocks] -> [Blocks]
combineList Blocks
curLine [Blocks]
subList [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ [Blocks]
sameIndList
if Int
curInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
prevInd
then ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Blocks] -> Blocks
listBuilder [Blocks]
curList], Int
endInd)
else ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks]
curList, Int
endInd)
else do
let ([Blocks]
curList, Int
endInd) = (Blocks -> [Blocks] -> [Blocks]
combineList Blocks
curLine [Blocks]
subList,
Int
lowInd)
if Int
curInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
prevInd
then ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Blocks] -> Blocks
listBuilder [Blocks]
curList], Int
endInd)
else ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks]
curList, Int
endInd)
plainInlineML' :: PandocMonad m => Inlines -> VwParser m Blocks
plainInlineML' :: forall (m :: * -> *). PandocMonad m => Inlines -> VwParser m Blocks
plainInlineML' Inlines
w = do
[Inlines]
xs <- ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineML
ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
Blocks -> VwParser m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
wInlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:[Inlines]
xs
plainInlineML :: PandocMonad m => VwParser m Blocks
plainInlineML :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
plainInlineML = ParsecT Sources ParserState m (Int, Text)
-> ParsecT Sources ParserState 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 ParserState m (Int, Text)
forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => Inlines -> VwParser m Blocks
plainInlineML' Inlines
forall a. Monoid a => a
mempty
listItemContent :: PandocMonad m => VwParser m Blocks
listItemContent :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
listItemContent = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
Inlines
w <- Inlines
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
listTodoMarker
Blocks
x <- Inlines -> ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => Inlines -> VwParser m Blocks
plainInlineML' Inlines
w
[Blocks]
y <- ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blocksThenInline
[Blocks]
z <- ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockML
Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
xBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks]
y [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ [Blocks]
z
blocksThenInline :: PandocMonad m => VwParser m Blocks
blocksThenInline :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blocksThenInline = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
[Blocks]
y <- ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockML
Blocks
x <- ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
plainInlineML
Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks]
y [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ [Blocks
x]
listTodoMarker :: PandocMonad m => VwParser m Inlines
listTodoMarker :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
listTodoMarker = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
Char
x <- (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'[')
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" .oOX"
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
']' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar)
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Char -> Inlines
makeListMarkerSpan Char
x
makeListMarkerSpan :: Char -> Inlines
makeListMarkerSpan :: Char -> Inlines
makeListMarkerSpan Char
x =
let cl :: Text
cl = case Char
x of
Char
' ' -> Text
"done0"
Char
'.' -> Text
"done1"
Char
'o' -> Text
"done2"
Char
'O' -> Text
"done3"
Char
'X' -> Text
"done4"
Char
_ -> Text
""
in
Attr -> Inlines -> Inlines
B.spanWith (Text
"", [Text
cl], []) Inlines
forall a. Monoid a => a
mempty
combineList :: Blocks -> [Blocks] -> [Blocks]
combineList :: Blocks -> [Blocks] -> [Blocks]
combineList Blocks
x [Blocks
y] = case Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
y of
[BulletList [[Block]]
z] -> [[Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
x
[Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[[Block]] -> Block
BulletList [[Block]]
z]]
[OrderedList ListAttributes
attr [[Block]]
z] -> [[Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
x
[Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attr [[Block]]
z]]
[Block]
_ -> Blocks
xBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks
y]
combineList Blocks
x [Blocks]
xs = Blocks
xBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks]
xs
listStart :: PandocMonad m => VwParser m (Int, Text)
listStart :: forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart = ParsecT Sources ParserState m (Int, Text)
-> ParsecT Sources ParserState m (Int, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m (Int, Text)
-> ParsecT Sources ParserState m (Int, Text))
-> ParsecT Sources ParserState m (Int, Text)
-> ParsecT Sources ParserState m (Int, Text)
forall a b. (a -> b) -> a -> b
$ do
[Char]
s <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
Text
listType <- VwParser m Text
forall (m :: * -> *). PandocMonad m => VwParser m Text
bulletListMarkers VwParser m Text -> VwParser m Text -> VwParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m Text
forall (m :: * -> *). PandocMonad m => VwParser m Text
orderedListMarkers
ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
(Int, Text) -> ParsecT Sources ParserState m (Int, Text)
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s, Text
listType)
bulletListMarkers :: PandocMonad m => VwParser m Text
bulletListMarkers :: forall (m :: * -> *). PandocMonad m => VwParser m Text
bulletListMarkers = Text
"ul" Text
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-')
orderedListMarkers :: PandocMonad m => VwParser m Text
orderedListMarkers :: forall (m :: * -> *). PandocMonad m => VwParser m Text
orderedListMarkers =
(Text
"ol" Text
-> ParsecT Sources ParserState m Int
-> ParsecT Sources ParserState m Text
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [ParsecT Sources ParserState m Int]
-> ParsecT Sources ParserState m Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (ListNumberStyle
-> ListNumberDelim -> ParsecT Sources ParserState m Int
forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ListNumberStyle -> ListNumberDelim -> ParsecT s ParserState m Int
orderedListMarker ListNumberStyle
Decimal ListNumberDelim
PeriodParsecT Sources ParserState m Int
-> [ParsecT Sources ParserState m Int]
-> [ParsecT Sources ParserState m Int]
forall a. a -> [a] -> [a]
:(((ListNumberDelim -> ParsecT Sources ParserState m Int)
-> ListNumberDelim -> ParsecT Sources ParserState m Int
forall a b. (a -> b) -> a -> b
$ ListNumberDelim
OneParen) ((ListNumberDelim -> ParsecT Sources ParserState m Int)
-> ParsecT Sources ParserState m Int)
-> (ListNumberStyle
-> ListNumberDelim -> ParsecT Sources ParserState m Int)
-> ListNumberStyle
-> ParsecT Sources ParserState m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberStyle
-> ListNumberDelim -> ParsecT Sources ParserState m Int
forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ListNumberStyle -> ListNumberDelim -> ParsecT s ParserState m Int
orderedListMarker (ListNumberStyle -> ParsecT Sources ParserState m Int)
-> [ListNumberStyle] -> [ParsecT Sources ParserState m Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ListNumberStyle
Decimal, ListNumberStyle
LowerRoman, ListNumberStyle
UpperRoman, ListNumberStyle
LowerAlpha, ListNumberStyle
UpperAlpha])))
ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"ol" Text
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'#')
table :: PandocMonad m => VwParser m Blocks
table :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
table = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ do
[Char]
indent <- ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar)
([Blocks]
th, [[Blocks]]
trs) <- VwParser m ([Blocks], [[Blocks]])
forall (m :: * -> *).
PandocMonad m =>
VwParser m ([Blocks], [[Blocks]])
table1 VwParser m ([Blocks], [[Blocks]])
-> VwParser m ([Blocks], [[Blocks]])
-> VwParser m ([Blocks], [[Blocks]])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m ([Blocks], [[Blocks]])
forall (m :: * -> *).
PandocMonad m =>
VwParser m ([Blocks], [[Blocks]])
table2
let tab :: Blocks
tab = [Blocks] -> [[Blocks]] -> Blocks
B.simpleTable [Blocks]
th [[Blocks]]
trs
if [Char]
indent [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
""
then Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
tab
else Blocks -> ParsecT Sources ParserState m Blocks
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ParsecT Sources ParserState m Blocks)
-> Blocks -> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"", [Text
"center"], []) Blocks
tab
table1 :: PandocMonad m => VwParser m ([Blocks], [[Blocks]])
table1 :: forall (m :: * -> *).
PandocMonad m =>
VwParser m ([Blocks], [[Blocks]])
table1 = ParsecT Sources ParserState m ([Blocks], [[Blocks]])
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ([Blocks], [[Blocks]])
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]]))
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]])
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]])
forall a b. (a -> b) -> a -> b
$ do
[Blocks]
th <- VwParser m [Blocks]
forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow
ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [()]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
tableHeaderSeparator
[[Blocks]]
trs <- VwParser m [Blocks] -> ParsecT Sources ParserState m [[Blocks]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many VwParser m [Blocks]
forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow
([Blocks], [[Blocks]])
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]])
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks]
th, [[Blocks]]
trs)
table2 :: PandocMonad m => VwParser m ([Blocks], [[Blocks]])
table2 :: forall (m :: * -> *).
PandocMonad m =>
VwParser m ([Blocks], [[Blocks]])
table2 = ParsecT Sources ParserState m ([Blocks], [[Blocks]])
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ([Blocks], [[Blocks]])
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]]))
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]])
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]])
forall a b. (a -> b) -> a -> b
$ do
[[Blocks]]
trs <- ParsecT Sources ParserState m [Blocks]
-> ParsecT Sources ParserState m [[Blocks]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources ParserState m [Blocks]
forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow
([Blocks], [[Blocks]])
-> ParsecT Sources ParserState m ([Blocks], [[Blocks]])
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Blocks -> [Blocks]
forall a. Int -> a -> [a]
replicate ([Blocks] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Blocks] -> Int) -> [Blocks] -> Int
forall a b. (a -> b) -> a -> b
$ [[Blocks]] -> [Blocks]
forall a. HasCallStack => [a] -> a
head [[Blocks]]
trs) Blocks
forall a. Monoid a => a
mempty, [[Blocks]]
trs)
tableHeaderSeparator :: PandocMonad m => VwParser m ()
= ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ())
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ do
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|')
ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
() -> ParsecT Sources ParserState m ()
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tableRow :: PandocMonad m => VwParser m [Blocks]
tableRow :: forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow = ParsecT Sources ParserState m [Blocks]
-> ParsecT Sources ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m [Blocks]
-> ParsecT Sources ParserState m [Blocks])
-> ParsecT Sources ParserState m [Blocks]
-> ParsecT Sources ParserState m [Blocks]
forall a b. (a -> b) -> a -> b
$ do
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|'
[Char]
s <- ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
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 ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline))
Bool -> ParsecT Sources ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources ParserState m ())
-> Bool -> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"||" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` ([Char]
"|" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"|")
ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
tableCell ParsecT Sources ParserState m [Blocks]
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Blocks]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Blocks]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Blocks]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n'
tableCell :: PandocMonad m => VwParser m Blocks
tableCell :: forall (m :: * -> *). PandocMonad m => VwParser m Blocks
tableCell = ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks)
-> ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState m Blocks
forall a b. (a -> b) -> a -> b
$
Inlines -> Blocks
B.plain (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Blocks)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Inlines]
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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|')
placeholder :: PandocMonad m => VwParser m ()
placeholder :: forall (m :: * -> *). PandocMonad m => VwParser m ()
placeholder = ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ())
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$
[ParsecT Sources ParserState m ()]
-> ParsecT Sources ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (Text -> ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => Text -> VwParser m ()
ph (Text -> ParsecT Sources ParserState m ())
-> [Text] -> [ParsecT Sources ParserState m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text
"title", Text
"date"]) ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
noHtmlPh ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
templatePh
ph :: PandocMonad m => Text -> VwParser m ()
ph :: forall (m :: * -> *). PandocMonad m => Text -> VwParser m ()
ph Text
s = ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ())
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ do
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Text
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParsecT Sources ParserState m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr (Char -> Text -> Text
T.cons Char
'%' Text
s) ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
Inlines
contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Inlines]
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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline)
let meta' :: Meta
meta' = Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
s Inlines
contents Meta
nullMeta
(ParserState -> ParserState) -> ParsecT Sources ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Sources ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st { stateMeta = meta' <> stateMeta st }
noHtmlPh :: PandocMonad m => VwParser m ()
noHtmlPh :: forall (m :: * -> *). PandocMonad m => VwParser m ()
noHtmlPh = ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ())
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$
() ()
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m ()
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"%nohtml" ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
templatePh :: PandocMonad m => VwParser m ()
templatePh :: forall (m :: * -> *). PandocMonad m => VwParser m ()
templatePh = ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ())
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$
() ()
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m ()
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"%template" ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
inline :: PandocMonad m => VwParser m Inlines
inline :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline = [ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines)
-> [ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ VwParser m () -> ParsecT Sources ParserState m Inlines
forall (m :: * -> *).
PandocMonad m =>
VwParser m () -> VwParser m Inlines
whitespace VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
endlinePParsecT Sources ParserState m Inlines
-> [ParsecT Sources ParserState m Inlines]
-> [ParsecT Sources ParserState m Inlines]
forall a. a -> [a] -> [a]
:[ParsecT Sources ParserState m Inlines]
forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList
inlineList :: PandocMonad m => [VwParser m Inlines]
inlineList :: forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList = [ VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
bareURL
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
todoMark
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
str
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
strong
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
emph
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
strikeout
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
code
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
link
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
image
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineMath
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
tag
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
superscript
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
subscript
, VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
special
]
inline' :: PandocMonad m => VwParser m Inlines
inline' :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' = [ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines)
-> [ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
whitespace'ParsecT Sources ParserState m Inlines
-> [ParsecT Sources ParserState m Inlines]
-> [ParsecT Sources ParserState m Inlines]
forall a. a -> [a] -> [a]
:[ParsecT Sources ParserState m Inlines]
forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList
inlineBQ :: PandocMonad m => VwParser m Inlines
inlineBQ :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineBQ = [ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines)
-> [ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ VwParser m () -> ParsecT Sources ParserState m Inlines
forall (m :: * -> *).
PandocMonad m =>
VwParser m () -> VwParser m Inlines
whitespace VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
endlineBQParsecT Sources ParserState m Inlines
-> [ParsecT Sources ParserState m Inlines]
-> [ParsecT Sources ParserState m Inlines]
forall a. a -> [a] -> [a]
:[ParsecT Sources ParserState m Inlines]
forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList
inlineML :: PandocMonad m => VwParser m Inlines
inlineML :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineML = [ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines)
-> [ParsecT Sources ParserState m Inlines]
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ VwParser m () -> ParsecT Sources ParserState m Inlines
forall (m :: * -> *).
PandocMonad m =>
VwParser m () -> VwParser m Inlines
whitespace VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
endlineMLParsecT Sources ParserState m Inlines
-> [ParsecT Sources ParserState m Inlines]
-> [ParsecT Sources ParserState m Inlines]
forall a. a -> [a] -> [a]
:[ParsecT Sources ParserState m Inlines]
forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList
str :: PandocMonad m => VwParser m Inlines
str :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
str = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf ([Char] -> ParsecT Sources ParserState m Char)
-> [Char] -> ParsecT Sources ParserState m Char
forall a b. (a -> b) -> a -> b
$ [Char]
spaceChars [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
specialChars)
whitespace :: PandocMonad m => VwParser m () -> VwParser m Inlines
whitespace :: forall (m :: * -> *).
PandocMonad m =>
VwParser m () -> VwParser m Inlines
whitespace VwParser m ()
endline = Inlines
B.space Inlines -> VwParser m () -> ParsecT Sources ParserState m Inlines
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Sources ParserState m Char -> VwParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar VwParser m () -> VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT Sources ParserState m Char
-> VwParser m () -> VwParser m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
comment VwParser m () -> VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
placeholder)))
ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Inlines
B.softbreak Inlines -> VwParser m () -> ParsecT Sources ParserState m Inlines
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ VwParser m ()
endline
whitespace' :: PandocMonad m => VwParser m Inlines
whitespace' :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
whitespace' = Inlines
B.space Inlines
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m Inlines
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
special :: PandocMonad m => VwParser m Inlines
special :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
special = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
specialChars)
bareURL :: PandocMonad m => VwParser m Inlines
bareURL :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
bareURL = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
(Text
orig, Text
src) <- ParsecT Sources ParserState m (Text, Text)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (Text, Text)
uri ParsecT Sources ParserState m (Text, Text)
-> ParsecT Sources ParserState m (Text, Text)
-> ParsecT Sources ParserState m (Text, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources ParserState m (Text, Text)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (Text, Text)
emailAddress
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link Text
src Text
"" (Text -> Inlines
B.str Text
orig)
strong :: PandocMonad m => VwParser m Inlines
strong :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
strong = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
[Char]
s <- ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"*") ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*'
Bool -> ParsecT Sources ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources ParserState m ())
-> Bool -> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
spaceChars)
Bool -> Bool -> Bool
&& ([Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
spaceChars)
Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*'
Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [Inlines]
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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*'
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState 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 ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum)
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Inlines -> Text
makeId Inlines
contents, [], []) Inlines
forall a. Monoid a => a
mempty
Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
B.strong Inlines
contents
makeId :: Inlines -> Text
makeId :: Inlines -> Text
makeId Inlines
i = [Text] -> Text
T.concat (Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text) -> [Inline] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
i)
emph :: PandocMonad m => VwParser m Inlines
emph :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
emph = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
[Char]
s <- ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"_") ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_'
Bool -> ParsecT Sources ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources ParserState m ())
-> Bool -> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
spaceChars)
Bool -> Bool -> Bool
&& ([Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
spaceChars)
Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_'
Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m [Inlines]
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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_'
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState 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 ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum)
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
B.emph Inlines
contents
strikeout :: PandocMonad m => VwParser m Inlines
strikeout :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
strikeout = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"~~"
Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Inlines]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' ([Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"~~")
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
B.strikeout Inlines
contents
code :: PandocMonad m => VwParser m Inlines
code :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
code = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`'
Text
contents <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParsecT s st m Char -> ParsecT s st m end -> ParsecT s st m Text
many1TillChar ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`')
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.code Text
contents
superscript :: PandocMonad m => VwParser m Inlines
superscript :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
superscript = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$
Inlines -> Inlines
B.superscript (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'^' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m [Inlines]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Inlines]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'^'))
subscript :: PandocMonad m => VwParser m Inlines
subscript :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
subscript = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$
Inlines -> Inlines
B.subscript (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
",,"
ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m [Inlines]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Inlines]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
",,"))
link :: PandocMonad m => VwParser m Inlines
link :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
link = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[["
Text
contents <- ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Text)
-> ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Text
forall a b. (a -> b) -> a -> b
$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar ([Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"]]")
if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|') Text
contents
then do
Text
url <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text)
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|'
Inlines
lab <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines]
-> ParsecT Sources ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Inlines]
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 ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline ([Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"]]")
let tit :: Text
tit = if Text -> Bool
isURI Text
url
then Text
""
else Text
"wikilink"
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link (Text -> Text
procLink Text
url) Text
tit Inlines
lab
else do
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
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 ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar ([Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"]]")
let tit :: Text
tit = if Text -> Bool
isURI Text
contents
then Text
""
else Text
"wikilink"
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link (Text -> Text
procLink Text
contents) Text
tit (Text -> Inlines
B.str Text
contents)
image :: PandocMonad m => VwParser m Inlines
image :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
image = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{"
[Char]
contentText <- ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
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 ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
Int -> ParsecT Sources ParserState m Inlines
forall (m :: * -> *). PandocMonad m => Int -> VwParser m Inlines
images (Int -> ParsecT Sources ParserState m Inlines)
-> Int -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|') [Char]
contentText
images :: PandocMonad m => Int -> VwParser m Inlines
images :: forall (m :: * -> *). PandocMonad m => Int -> VwParser m Inlines
images Int
k
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = do
Text
imgurl <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
Inlines -> VwParser m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image (Text -> Text
procImgurl Text
imgurl) Text
"" (Text -> Inlines
B.str Text
"")
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = do
Text
imgurl <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|')
Inlines
alt <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Inlines]
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 VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
Inlines -> VwParser m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image (Text -> Text
procImgurl Text
imgurl) Text
"" Inlines
alt
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = do
Text
imgurl <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|')
Inlines
alt <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Inlines]
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 VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|')
Text
attrText <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
Inlines -> VwParser m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text -> Attr
makeAttr Text
attrText) (Text -> Text
procImgurl Text
imgurl) Text
"" Inlines
alt
| Bool
otherwise = do
Text
imgurl <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|')
Inlines
alt <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Inlines]
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 VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|')
Text
attrText <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|')
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
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 ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char])
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
Inlines -> VwParser m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text -> Attr
makeAttr Text
attrText) (Text -> Text
procImgurl Text
imgurl) Text
"" Inlines
alt
procLink' :: Text -> Text
procLink' :: Text -> Text
procLink' Text
s
| Int -> Text -> Text
T.take Int
6 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"local:" = Text
"file" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
5 Text
s
| Int -> Text -> Text
T.take Int
6 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"diary:" = Text
"diary/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
6 Text
s
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((Text -> Text -> Bool
`T.isPrefixOf` Text
s) (Text -> Bool) -> [Text] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Text
"http:", Text
"https:", Text
"ftp:", Text
"file:", Text
"mailto:",
Text
"news:", Text
"telnet:" ])
= Text
s
| Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = Text
""
| HasCallStack => Text -> Char
Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = Text
s
| Bool
otherwise = Text
s
procLink :: Text -> Text
procLink :: Text -> Text
procLink Text
s = Text -> Text
procLink' Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y
where (Text
x, Text
y) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'#') Text
s
procImgurl :: Text -> Text
procImgurl :: Text -> Text
procImgurl Text
s = if Int -> Text -> Text
T.take Int
6 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"local:" then Text
"file" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
5 Text
s else Text
s
inlineMath :: PandocMonad m => VwParser m Inlines
inlineMath :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineMath = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$
Text -> Inlines
B.math (Text -> Inlines)
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m (Text -> Inlines)
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'$' ParsecT Sources ParserState m (Text -> Inlines)
-> ParsecT Sources ParserState m Text
-> ParsecT Sources ParserState m Inlines
forall a b.
ParsecT Sources ParserState m (a -> b)
-> ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParsecT s st m Char -> ParsecT s st m end -> ParsecT s st m Text
many1TillChar ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'$')
tag :: PandocMonad m => VwParser m Inlines
tag :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
tag = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':'
Text
s <- ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
spaceChars) (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space))
Bool -> ParsecT Sources ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources ParserState m ())
-> Bool -> ParsecT Sources ParserState m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"::" Text -> Text -> Bool
`T.isInfixOf` (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")
let ss :: [Text]
ss = (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') Text
s
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
makeTagSpan' ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
ss)Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:(Text -> Inlines
makeTagSpan (Text -> Inlines) -> [Text] -> [Inlines]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail [Text]
ss)
todoMark :: PandocMonad m => VwParser m Inlines
todoMark :: forall (m :: * -> *). PandocMonad m => VwParser m Inlines
todoMark = ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines)
-> ParsecT Sources ParserState m Inlines
-> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"TODO:"
Inlines -> ParsecT Sources ParserState m Inlines
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources ParserState m Inlines)
-> Inlines -> ParsecT Sources ParserState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"", [Text
"todo"], []) (Text -> Inlines
B.str Text
"TODO:")
endlineP :: PandocMonad m => VwParser m ()
endlineP :: forall (m :: * -> *). PandocMonad m => VwParser m ()
endlineP = () ()
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
nFBTTBSB ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockQuote)
endlineBQ :: PandocMonad m => VwParser m ()
endlineBQ :: forall (m :: * -> *). PandocMonad m => VwParser m ()
endlineBQ = () ()
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
nFBTTBSB ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
" ")
endlineML :: PandocMonad m => VwParser m ()
endlineML :: forall (m :: * -> *). PandocMonad m => VwParser m ()
endlineML = () ()
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
nFBTTBSB ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources ParserState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar)
nFBTTBSB :: PandocMonad m => VwParser m ()
nFBTTBSB :: forall (m :: * -> *). PandocMonad m => VwParser m ()
nFBTTBSB =
ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState 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 ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
hrule ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Sources ParserState m [Blocks]
-> ParsecT Sources ParserState 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 ParserState m [Blocks]
forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
header ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Sources ParserState m (Int, Text)
-> ParsecT Sources ParserState 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 ParserState m (Int, Text)
forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
preformatted ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Sources ParserState m Blocks
-> ParsecT Sources ParserState 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
displayMath ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState m ()
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Sources ParserState m ()
-> ParsecT Sources ParserState 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 ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
hasDefMarker
hasDefMarker :: PandocMonad m => VwParser m ()
hasDefMarker :: forall (m :: * -> *). PandocMonad m => VwParser m ()
hasDefMarker = () ()
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m ()
forall a b.
a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
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 ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") ([Char] -> ParsecT Sources ParserState m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::" ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
spaceChars)
makeTagSpan' :: Text -> Inlines
makeTagSpan' :: Text -> Inlines
makeTagSpan' Text
s = Attr -> Inlines -> Inlines
B.spanWith (Char -> Text -> Text
T.cons Char
'-' Text
s, [], []) (Text -> Inlines
B.str Text
"") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
Attr -> Inlines -> Inlines
B.spanWith (Text
s, [Text
"tag"], []) (Text -> Inlines
B.str Text
s)
makeTagSpan :: Text -> Inlines
makeTagSpan :: Text -> Inlines
makeTagSpan Text
s = Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
makeTagSpan' Text
s
mathTagParser :: PandocMonad m => VwParser m Text
mathTagParser :: forall (m :: * -> *). PandocMonad m => VwParser m Text
mathTagParser = do
Text
s <- VwParser m Text -> VwParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Text -> VwParser m Text)
-> VwParser m Text -> VwParser m Text
forall a b. (a -> b) -> a -> b
$ VwParser m Text -> VwParser m Text
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT Sources ParserState m Char
-> VwParser m Text -> VwParser m Text
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char -> VwParser m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m a -> ParsecT s st m Text
manyTillChar ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
spaceChars)
(ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char)
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m [Char]
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf ([Char] -> ParsecT Sources ParserState m Char)
-> [Char] -> ParsecT Sources ParserState m Char
forall a b. (a -> b) -> a -> b
$ Char
'%'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
spaceChars) ParsecT Sources ParserState m [Char]
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space))
Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT Sources ParserState m Char
-> VwParser m Text -> VwParser m Text
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> VwParser m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
s VwParser m Text
-> ParsecT Sources ParserState m Char
-> ParsecT Sources ParserState m Char
forall a b.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m b
-> ParsecT Sources ParserState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'%'
Text -> VwParser m Text
forall a. a -> ParsecT Sources ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> VwParser m Text) -> Text -> VwParser m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
mathTagLaTeX Text
s