{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.MediaWiki ( readMediaWiki ) where
import Control.Monad
import Control.Monad.Except (throwError)
import Data.Char (isDigit, isSpace)
import qualified Data.Foldable as F
import Data.List (intersperse)
import Data.Maybe (fromMaybe, maybeToList)
import Data.Sequence (ViewL (..), viewl, (<|))
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup
import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (nested)
import Text.Pandoc.Readers.HTML (htmlTag, isBlockTag, isCommentTag)
import Text.Pandoc.Shared (crFilter, safeRead, stringify, stripTrailingNewlines,
trim, splitTextBy, tshow)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.XML (fromEntities)
readMediaWiki :: PandocMonad m
=> ReaderOptions
-> Text
-> m Pandoc
readMediaWiki :: ReaderOptions -> Text -> m Pandoc
readMediaWiki ReaderOptions
opts Text
s = do
Either PandocError Pandoc
parsed <- ParserT Text MWState m Pandoc
-> MWState -> Text -> m (Either PandocError Pandoc)
forall s (m :: * -> *) st a.
(Stream s m Char, ToText s) =>
ParserT s st m a -> st -> s -> m (Either PandocError a)
readWithM ParserT Text MWState m Pandoc
forall (m :: * -> *). PandocMonad m => MWParser m Pandoc
parseMediaWiki MWState :: ReaderOptions
-> Int
-> Int
-> [Inlines]
-> Set Text
-> [LogMessage]
-> Bool
-> MWState
MWState{ mwOptions :: ReaderOptions
mwOptions = ReaderOptions
opts
, mwMaxNestingLevel :: Int
mwMaxNestingLevel = Int
4
, mwNextLinkNumber :: Int
mwNextLinkNumber = Int
1
, mwCategoryLinks :: [Inlines]
mwCategoryLinks = []
, mwIdentifierList :: Set Text
mwIdentifierList = Set Text
forall a. Set a
Set.empty
, mwLogMessages :: [LogMessage]
mwLogMessages = []
, mwInTT :: Bool
mwInTT = Bool
False
}
(Text -> Text
crFilter Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
case Either PandocError Pandoc
parsed of
Right Pandoc
result -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result
Left PandocError
e -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
data MWState = MWState { MWState -> ReaderOptions
mwOptions :: ReaderOptions
, MWState -> Int
mwMaxNestingLevel :: Int
, MWState -> Int
mwNextLinkNumber :: Int
, MWState -> [Inlines]
mwCategoryLinks :: [Inlines]
, MWState -> Set Text
mwIdentifierList :: Set.Set Text
, MWState -> [LogMessage]
mwLogMessages :: [LogMessage]
, MWState -> Bool
mwInTT :: Bool
}
type MWParser m = ParserT Text MWState m
instance HasReaderOptions MWState where
extractReaderOptions :: MWState -> ReaderOptions
extractReaderOptions = MWState -> ReaderOptions
mwOptions
instance HasIdentifierList MWState where
extractIdentifierList :: MWState -> Set Text
extractIdentifierList = MWState -> Set Text
mwIdentifierList
updateIdentifierList :: (Set Text -> Set Text) -> MWState -> MWState
updateIdentifierList Set Text -> Set Text
f MWState
st = MWState
st{ mwIdentifierList :: Set Text
mwIdentifierList = Set Text -> Set Text
f (Set Text -> Set Text) -> Set Text -> Set Text
forall a b. (a -> b) -> a -> b
$ MWState -> Set Text
mwIdentifierList MWState
st }
instance HasLogMessages MWState where
addLogMessage :: LogMessage -> MWState -> MWState
addLogMessage LogMessage
m MWState
s = MWState
s{ mwLogMessages :: [LogMessage]
mwLogMessages = LogMessage
m LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
: MWState -> [LogMessage]
mwLogMessages MWState
s }
getLogMessages :: MWState -> [LogMessage]
getLogMessages = [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage])
-> (MWState -> [LogMessage]) -> MWState -> [LogMessage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MWState -> [LogMessage]
mwLogMessages
nested :: PandocMonad m => MWParser m a -> MWParser m a
nested :: MWParser m a -> MWParser m a
nested MWParser m a
p = do
Int
nestlevel <- MWState -> Int
mwMaxNestingLevel (MWState -> Int)
-> ParsecT Text MWState m MWState -> ParsecT Text MWState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT Text MWState m MWState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Bool -> ParsecT Text MWState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text MWState m ())
-> Bool -> ParsecT Text MWState m ()
forall a b. (a -> b) -> a -> b
$ Int
nestlevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
(MWState -> MWState) -> ParsecT Text MWState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((MWState -> MWState) -> ParsecT Text MWState m ())
-> (MWState -> MWState) -> ParsecT Text MWState m ()
forall a b. (a -> b) -> a -> b
$ \MWState
st -> MWState
st{ mwMaxNestingLevel :: Int
mwMaxNestingLevel = MWState -> Int
mwMaxNestingLevel MWState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
a
res <- MWParser m a
p
(MWState -> MWState) -> ParsecT Text MWState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((MWState -> MWState) -> ParsecT Text MWState m ())
-> (MWState -> MWState) -> ParsecT Text MWState m ()
forall a b. (a -> b) -> a -> b
$ \MWState
st -> MWState
st{ mwMaxNestingLevel :: Int
mwMaxNestingLevel = Int
nestlevel }
a -> MWParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
specialChars :: [Char]
specialChars :: [Char]
specialChars = [Char]
"'[]<=&*{}|\":\\"
spaceChars :: [Char]
spaceChars :: [Char]
spaceChars = [Char]
" \n\t"
sym :: PandocMonad m => Text -> MWParser m ()
sym :: Text -> MWParser m ()
sym Text
s = () () -> ParsecT Text MWState m [Char] -> MWParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string ([Char] -> ParsecT Text MWState m [Char])
-> [Char] -> ParsecT Text MWState m [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s)
newBlockTags :: [Text]
newBlockTags :: [Text]
newBlockTags = [Text
"haskell",Text
"syntaxhighlight",Text
"source",Text
"gallery",Text
"references"]
isBlockTag' :: Tag Text -> Bool
isBlockTag' :: Tag Text -> Bool
isBlockTag' tag :: Tag Text
tag@(TagOpen Text
t [Attribute Text]
_) = (Tag Text -> Bool
forall a. NamedTag (Tag a) => Tag a -> Bool
isBlockTag Tag Text
tag Bool -> Bool -> Bool
|| Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
newBlockTags) Bool -> Bool -> Bool
&&
Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
eitherBlockOrInline
isBlockTag' tag :: Tag Text
tag@(TagClose Text
t) = (Tag Text -> Bool
forall a. NamedTag (Tag a) => Tag a -> Bool
isBlockTag Tag Text
tag Bool -> Bool -> Bool
|| Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
newBlockTags) Bool -> Bool -> Bool
&&
Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
eitherBlockOrInline
isBlockTag' Tag Text
tag = Tag Text -> Bool
forall a. NamedTag (Tag a) => Tag a -> Bool
isBlockTag Tag Text
tag
isInlineTag' :: Tag Text -> Bool
isInlineTag' :: Tag Text -> Bool
isInlineTag' (TagComment Text
_) = Bool
True
isInlineTag' Tag Text
t = Bool -> Bool
not (Tag Text -> Bool
isBlockTag' Tag Text
t)
eitherBlockOrInline :: [Text]
eitherBlockOrInline :: [Text]
eitherBlockOrInline = [Text
"applet", Text
"button", Text
"del", Text
"iframe", Text
"ins",
Text
"map", Text
"area", Text
"object"]
htmlComment :: PandocMonad m => MWParser m ()
= () () -> ParsecT Text MWState m (Tag Text, Text) -> MWParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag Tag Text -> Bool
forall a. Tag a -> Bool
isCommentTag
inlinesInTags :: PandocMonad m => Text -> MWParser m Inlines
inlinesInTags :: Text -> MWParser m Inlines
inlinesInTags Text
tag = MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Inlines -> MWParser m Inlines)
-> MWParser m Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
(Tag Text
_,Text
raw) <- (Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
tag [])
if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
raw
then Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
else 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 Text MWState m [Inlines] -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
MWParser m Inlines
-> ParserT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState 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 MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline ((Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose Text
tag))
blocksInTags :: PandocMonad m => Text -> MWParser m Blocks
blocksInTags :: Text -> MWParser m Blocks
blocksInTags Text
tag = MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Blocks -> MWParser m Blocks)
-> MWParser m Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
(Tag Text
_,Text
raw) <- (Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
tag [])
let closer :: ParserT Text MWState m (Tag Text, Text)
closer = if Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"li"
then (Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose (Text
"li" :: Text))
ParserT Text MWState m (Tag Text, Text)
-> ParserT Text MWState m (Tag Text, Text)
-> ParserT Text MWState m (Tag Text, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParserT Text MWState m (Tag Text, Text)
-> ParserT Text MWState m (Tag Text, Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (
(Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen (Text
"li" :: Text) [])
ParserT Text MWState m (Tag Text, Text)
-> ParserT Text MWState m (Tag Text, Text)
-> ParserT Text MWState m (Tag Text, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose (Text
"ol" :: Text))
ParserT Text MWState m (Tag Text, Text)
-> ParserT Text MWState m (Tag Text, Text)
-> ParserT Text MWState m (Tag Text, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose (Text
"ul" :: Text)))
else (Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose Text
tag)
if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
raw
then Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Text MWState m [Blocks] -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Blocks
-> ParserT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m [Blocks]
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 MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
block ParserT Text MWState m (Tag Text, Text)
closer
textInTags :: PandocMonad m => Text -> MWParser m Text
textInTags :: Text -> MWParser m Text
textInTags Text
tag = MWParser m Text -> MWParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Text -> MWParser m Text)
-> MWParser m Text -> MWParser m Text
forall a b. (a -> b) -> a -> b
$ do
(Tag Text
_,Text
raw) <- (Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
tag [])
if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
raw
then Text -> MWParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
else [Char] -> Text
T.pack ([Char] -> Text)
-> ParsecT Text MWState m [Char] -> MWParser m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Char
-> ParserT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState 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 Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ((Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose Text
tag))
parseMediaWiki :: PandocMonad m => MWParser m Pandoc
parseMediaWiki :: MWParser m Pandoc
parseMediaWiki = do
Blocks
bs <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Text MWState m [Blocks] -> ParsecT Text MWState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Blocks -> ParsecT Text MWState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text MWState m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
block
ParsecT Text MWState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
ParsecT Text MWState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
[Inlines]
categoryLinks <- [Inlines] -> [Inlines]
forall a. [a] -> [a]
reverse ([Inlines] -> [Inlines])
-> (MWState -> [Inlines]) -> MWState -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MWState -> [Inlines]
mwCategoryLinks (MWState -> [Inlines])
-> ParsecT Text MWState m MWState
-> ParsecT Text MWState m [Inlines]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m MWState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let categories :: Blocks
categories = if [Inlines] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inlines]
categoryLinks
then Blocks
forall a. Monoid a => a
mempty
else Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
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 -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space [Inlines]
categoryLinks
ParsecT Text MWState m ()
forall (m :: * -> *) st s.
(PandocMonad m, HasLogMessages st) =>
ParserT s st m ()
reportLogMessages
Pandoc -> MWParser m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> MWParser m Pandoc) -> Pandoc -> MWParser m Pandoc
forall a b. (a -> b) -> a -> b
$ Blocks -> Pandoc
B.doc (Blocks -> Pandoc) -> Blocks -> Pandoc
forall a b. (a -> b) -> a -> b
$ Blocks
bs Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
categories
block :: PandocMonad m => MWParser m Blocks
block :: MWParser m Blocks
block = do
Blocks
res <- Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Text MWState m () -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text MWState m Char -> ParsecT Text MWState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
table
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
header
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
hrule
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
orderedList
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
bulletList
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
definitionList
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Text MWState m () -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text MWState m () -> ParsecT Text MWState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text MWState m ()
-> ParsecT Text MWState m () -> ParsecT Text MWState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
htmlComment)
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
preformatted
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
blockTag
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Text -> Blocks
B.rawBlock Text
"mediawiki" (Text -> Blocks)
-> ParsecT Text MWState m Text -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
template)
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
para
Text -> ParsecT Text MWState 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]
B.toList Blocks
res)
Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
res
para :: PandocMonad m => MWParser m Blocks
para :: MWParser m Blocks
para = 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 Text MWState m [Inlines]
-> ParsecT Text MWState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Inlines -> ParsecT Text MWState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text MWState m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline
if (Inline -> Bool) -> Inlines -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) Inlines
contents
then Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para Inlines
contents
table :: PandocMonad m => MWParser m Blocks
table :: MWParser m Blocks
table = do
MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
tableStart
[Attribute Text]
styles <- [Attribute Text]
-> ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text])
-> ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text]
forall a b. (a -> b) -> a -> b
$
ParsecT Text MWState m [Attribute Text]
forall (m :: * -> *). PandocMonad m => MWParser m [Attribute Text]
parseAttrs ParsecT Text MWState m [Attribute Text]
-> MWParser m () -> ParsecT Text MWState m [Attribute Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text MWState m Char -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text MWState m [Attribute Text]
-> MWParser m () -> ParsecT Text MWState m [Attribute Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text MWState m Char -> MWParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
ParsecT Text MWState m Char -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
MWParser m () -> MWParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (MWParser m () -> MWParser m ()) -> MWParser m () -> MWParser m ()
forall a b. (a -> b) -> a -> b
$ MWParser m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
template MWParser m Text -> MWParser m () -> MWParser m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text MWState m Char -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
MWParser m Text -> MWParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional MWParser m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
let tableWidth :: Double
tableWidth = case Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [Attribute Text]
styles of
Just Text
w -> Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
parseWidth Text
w
Maybe Text
Nothing -> Double
1.0
Inlines
caption <- Inlines
-> ParsecT Text MWState m Inlines -> ParsecT Text MWState 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 Text MWState m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
tableCaption
MWParser m () -> MWParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
rowsep
Bool
hasheader <- Bool -> ParsecT Text MWState m Bool -> ParsecT Text MWState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (ParsecT Text MWState m Bool -> ParsecT Text MWState m Bool)
-> ParsecT Text MWState m Bool -> ParsecT Text MWState m Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> ParsecT Text MWState m Char -> ParsecT Text MWState m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (MWParser m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces MWParser m ()
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!')
([(Alignment, Double)]
cellspecs',[Blocks]
hdr) <- [((Alignment, Double), Blocks)]
-> ([(Alignment, Double)], [Blocks])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Alignment, Double), Blocks)]
-> ([(Alignment, Double)], [Blocks]))
-> ParsecT Text MWState m [((Alignment, Double), Blocks)]
-> ParsecT Text MWState m ([(Alignment, Double)], [Blocks])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m [((Alignment, Double), Blocks)]
forall (m :: * -> *).
PandocMonad m =>
MWParser m [((Alignment, Double), Blocks)]
tableRow
let widths :: [Double]
widths = ((Alignment, Double) -> Double)
-> [(Alignment, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Double
tableWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double)
-> ((Alignment, Double) -> Double) -> (Alignment, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alignment, Double) -> Double
forall a b. (a, b) -> b
snd) [(Alignment, Double)]
cellspecs'
let restwidth :: Double
restwidth = Double
tableWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
let zerocols :: Int
zerocols = [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [Double] -> Int
forall a b. (a -> b) -> a -> b
$ (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0.0) [Double]
widths
let defaultwidth :: ColWidth
defaultwidth = if Int
zerocols Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
zerocols Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths
then ColWidth
ColWidthDefault
else Double -> ColWidth
ColWidth (Double -> ColWidth) -> Double -> ColWidth
forall a b. (a -> b) -> a -> b
$ Double
restwidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
zerocols
let widths' :: [ColWidth]
widths' = (Double -> ColWidth) -> [Double] -> [ColWidth]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
w -> if Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then Double -> ColWidth
ColWidth Double
w else ColWidth
defaultwidth) [Double]
widths
let cellspecs :: [(Alignment, ColWidth)]
cellspecs = [Alignment] -> [ColWidth] -> [(Alignment, ColWidth)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Alignment, Double) -> Alignment)
-> [(Alignment, Double)] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment, Double) -> Alignment
forall a b. (a, b) -> a
fst [(Alignment, Double)]
cellspecs') [ColWidth]
widths'
[[Blocks]]
rows' <- ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [[Blocks]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [[Blocks]])
-> ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [[Blocks]]
forall a b. (a -> b) -> a -> b
$ ParsecT Text MWState m [Blocks] -> ParsecT Text MWState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [Blocks])
-> ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [Blocks]
forall a b. (a -> b) -> a -> b
$ MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
rowsep MWParser m ()
-> ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [Blocks]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((((Alignment, Double), Blocks) -> Blocks)
-> [((Alignment, Double), Blocks)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map ((Alignment, Double), Blocks) -> Blocks
forall a b. (a, b) -> b
snd ([((Alignment, Double), Blocks)] -> [Blocks])
-> ParsecT Text MWState m [((Alignment, Double), Blocks)]
-> ParsecT Text MWState m [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m [((Alignment, Double), Blocks)]
forall (m :: * -> *).
PandocMonad m =>
MWParser m [((Alignment, Double), Blocks)]
tableRow)
MWParser m Text -> MWParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional MWParser m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
tableEnd
let cols :: Int
cols = [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Blocks]
hdr
let ([Blocks]
headers,[[Blocks]]
rows) = if Bool
hasheader
then ([Blocks]
hdr, [[Blocks]]
rows')
else (Int -> Blocks -> [Blocks]
forall a. Int -> a -> [a]
replicate Int
cols Blocks
forall a. Monoid a => a
mempty, [Blocks]
hdr[Blocks] -> [[Blocks]] -> [[Blocks]]
forall a. a -> [a] -> [a]
:[[Blocks]]
rows')
let toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
B.simpleCell
toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ Caption
-> [(Alignment, ColWidth)]
-> TableHead
-> [TableBody]
-> TableFoot
-> Blocks
B.table (Blocks -> Caption
B.simpleCaption (Blocks -> Caption) -> Blocks -> Caption
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain Inlines
caption)
[(Alignment, ColWidth)]
cellspecs
(Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ [Blocks] -> [Row]
toHeaderRow [Blocks]
headers)
[Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
rows]
(Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])
parseAttrs :: PandocMonad m => MWParser m [(Text,Text)]
parseAttrs :: MWParser m [Attribute Text]
parseAttrs = ParsecT Text MWState m (Attribute Text)
-> MWParser m [Attribute Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text MWState m (Attribute Text)
forall (m :: * -> *). PandocMonad m => MWParser m (Attribute Text)
parseAttr
parseAttr :: PandocMonad m => MWParser m (Text, Text)
parseAttr :: MWParser m (Attribute Text)
parseAttr = MWParser m (Attribute Text) -> MWParser m (Attribute Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m (Attribute Text) -> MWParser m (Attribute Text))
-> MWParser m (Attribute Text) -> MWParser m (Attribute Text)
forall a b. (a -> b) -> a -> b
$ do
ParsecT Text MWState m Char -> ParsecT Text MWState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
Text
k <- ParsecT Text MWState m Char -> ParserT Text MWState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
Text
v <- (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"' ParsecT Text MWState m Char
-> ParserT Text MWState m Text -> ParserT Text MWState m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text MWState m Char
-> ParsecT Text MWState m Char -> ParserT Text MWState m Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParserT s st m Char -> ParserT s st m end -> ParserT s st m Text
many1TillChar ((Char -> Bool) -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n')) (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'))
ParserT Text MWState m Text
-> ParserT Text MWState m Text -> ParserT Text MWState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text MWState m Char -> ParserT Text MWState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ((Char -> Bool) -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT Text MWState m Char)
-> (Char -> Bool) -> ParsecT Text MWState m Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|')
Attribute Text -> MWParser m (Attribute Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k,Text
v)
tableStart :: PandocMonad m => MWParser m ()
tableStart :: MWParser m ()
tableStart = MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m () -> MWParser m ()) -> MWParser m () -> MWParser m ()
forall a b. (a -> b) -> a -> b
$ MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne MWParser m () -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces MWParser m () -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"{|"
tableEnd :: PandocMonad m => MWParser m ()
tableEnd :: MWParser m ()
tableEnd = MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m () -> MWParser m ()) -> MWParser m () -> MWParser m ()
forall a b. (a -> b) -> a -> b
$ MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne MWParser m () -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces MWParser m () -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"|}"
rowsep :: PandocMonad m => MWParser m ()
rowsep :: MWParser m ()
rowsep = MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m () -> MWParser m ()) -> MWParser m () -> MWParser m ()
forall a b. (a -> b) -> a -> b
$ MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne MWParser m () -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces MWParser m () -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"|-" MWParser m () -> ParsecT Text MWState m [Char] -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Text MWState m Char -> ParsecT Text MWState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') MWParser m () -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text MWState m [Attribute Text] -> MWParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text MWState m [Attribute Text]
forall (m :: * -> *). PandocMonad m => MWParser m [Attribute Text]
parseAttrs MWParser m () -> ParsecT Text MWState m Text -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text MWState m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
cellsep :: PandocMonad m => MWParser m ()
cellsep :: MWParser m ()
cellsep = MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m () -> MWParser m ()) -> MWParser m () -> MWParser m ()
forall a b. (a -> b) -> a -> b
$ do
Int
col <- SourcePos -> Int
sourceColumn (SourcePos -> Int)
-> ParsecT Text MWState m SourcePos -> ParsecT Text MWState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
MWParser m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces
let pipeSep :: ParsecT Text u m ()
pipeSep = do
Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
ParsecT Text u m Char -> ParsecT Text u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ([Char] -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"-}+")
if Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then ParsecT Text u m Char -> ParsecT Text u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
else ParsecT Text u m Char -> ParsecT Text u m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
let exclSep :: ParsecT Text u m ()
exclSep = do
Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!'
if Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then ParsecT Text u m Char -> ParsecT Text u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!')
else ParsecT Text u m Char -> ParsecT Text u m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!')
MWParser m ()
forall u. ParsecT Text u m ()
pipeSep MWParser m () -> MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m ()
forall u. ParsecT Text u m ()
exclSep
tableCaption :: PandocMonad m => MWParser m Inlines
tableCaption :: MWParser m Inlines
tableCaption = MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Inlines -> MWParser m Inlines)
-> MWParser m Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne
MWParser m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces
Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"|+"
ParsecT Text MWState m Text -> MWParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m Text -> ParsecT Text MWState m Text)
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall a b. (a -> b) -> a -> b
$ MWParser m [Attribute Text]
forall (m :: * -> *). PandocMonad m => MWParser m [Attribute Text]
parseAttrs MWParser m [Attribute Text] -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces MWParser m ()
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Text MWState m Char
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines)
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 Text MWState m [Inlines] -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
MWParser m Inlines -> ParsecT Text MWState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (MWParser m () -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
cellsep MWParser m () -> MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
rowsep) MWParser m () -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline)
tableRow :: PandocMonad m => MWParser m [((Alignment, Double), Blocks)]
tableRow :: MWParser m [((Alignment, Double), Blocks)]
tableRow = MWParser m [((Alignment, Double), Blocks)]
-> MWParser m [((Alignment, Double), Blocks)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m [((Alignment, Double), Blocks)]
-> MWParser m [((Alignment, Double), Blocks)])
-> MWParser m [((Alignment, Double), Blocks)]
-> MWParser m [((Alignment, Double), Blocks)]
forall a b. (a -> b) -> a -> b
$ ParsecT Text MWState m () -> ParsecT Text MWState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
htmlComment ParsecT Text MWState m ()
-> MWParser m [((Alignment, Double), Blocks)]
-> MWParser m [((Alignment, Double), Blocks)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m ((Alignment, Double), Blocks)
-> MWParser m [((Alignment, Double), Blocks)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text MWState m ((Alignment, Double), Blocks)
forall (m :: * -> *).
PandocMonad m =>
MWParser m ((Alignment, Double), Blocks)
tableCell
tableCell :: PandocMonad m => MWParser m ((Alignment, Double), Blocks)
tableCell :: MWParser m ((Alignment, Double), Blocks)
tableCell = MWParser m ((Alignment, Double), Blocks)
-> MWParser m ((Alignment, Double), Blocks)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m ((Alignment, Double), Blocks)
-> MWParser m ((Alignment, Double), Blocks))
-> MWParser m ((Alignment, Double), Blocks)
-> MWParser m ((Alignment, Double), Blocks)
forall a b. (a -> b) -> a -> b
$ do
MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
cellsep
ParsecT Text MWState m Char -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
[Attribute Text]
attrs <- [Attribute Text]
-> ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text])
-> ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text]
forall a b. (a -> b) -> a -> b
$ ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text])
-> ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m [Attribute Text]
forall a b. (a -> b) -> a -> b
$ ParsecT Text MWState m [Attribute Text]
forall (m :: * -> *). PandocMonad m => MWParser m [Attribute Text]
parseAttrs ParsecT Text MWState m [Attribute Text]
-> MWParser m () -> ParsecT Text MWState m [Attribute Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MWParser m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces ParsecT Text MWState m [Attribute Text]
-> ParsecT Text MWState m Char
-> ParsecT Text MWState m [Attribute Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Text MWState m [Attribute Text]
-> MWParser m () -> ParsecT Text MWState m [Attribute Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Text MWState m Char -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
ParsecT Text MWState m Char -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
SourcePos
pos' <- ParsecT Text MWState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Text
ls <- [Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Text MWState m [Text] -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text -> ParsecT Text MWState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (MWParser m () -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
cellsep MWParser m () -> MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
rowsep MWParser m () -> MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
tableEnd) MWParser m ()
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(((Blocks, Text) -> Text
forall a b. (a, b) -> b
snd ((Blocks, Text) -> Text)
-> ParsecT Text MWState m (Blocks, Text)
-> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Blocks
-> ParsecT Text MWState m (Blocks, Text)
forall (m :: * -> *) st a.
Monad m =>
ParsecT Text st m a -> ParsecT Text st m (a, Text)
withRaw ParsecT Text MWState m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
table) ParsecT Text MWState m Text
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT Text MWState m Char -> ParsecT Text MWState m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar))
Blocks
bs <- ParsecT Text MWState m Blocks
-> Text -> ParsecT Text MWState m Blocks
forall s (m :: * -> *) st r.
(Stream s m Char, IsString s) =>
ParserT s st m r -> Text -> ParserT s st m r
parseFromString (do SourcePos -> MWParser m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos'
[Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Text MWState m [Blocks] -> ParsecT Text MWState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Blocks -> ParsecT Text MWState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text MWState m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
block) Text
ls
let align :: Alignment
align = case Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"align" [Attribute Text]
attrs of
Just Text
"left" -> Alignment
AlignLeft
Just Text
"right" -> Alignment
AlignRight
Just Text
"center" -> Alignment
AlignCenter
Maybe Text
_ -> Alignment
AlignDefault
let width :: Double
width = case Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [Attribute Text]
attrs of
Just Text
xs -> Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
parseWidth Text
xs
Maybe Text
Nothing -> Double
0.0
((Alignment, Double), Blocks)
-> MWParser m ((Alignment, Double), Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Alignment
align, Double
width), Blocks
bs)
parseWidth :: Text -> Maybe Double
parseWidth :: Text -> Maybe Double
parseWidth Text
s =
case Text -> Maybe (Text, Char)
T.unsnoc Text
s of
Just (Text
ds, Char
'%') | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
ds -> Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Double) -> Text -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Text
"0." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ds
Maybe (Text, Char)
_ -> Maybe Double
forall a. Maybe a
Nothing
template :: PandocMonad m => MWParser m Text
template :: MWParser m Text
template = MWParser m Text -> MWParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Text -> MWParser m Text)
-> MWParser m Text -> MWParser m Text
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{"
ParsecT Text MWState m Char -> ParsecT Text MWState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{')
ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text MWState m Char -> ParsecT Text MWState m Char)
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall a b. (a -> b) -> a -> b
$ ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT Text MWState m Char
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT Text MWState m Char
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
let chunk :: MWParser m Text
chunk = MWParser m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
template MWParser m Text -> MWParser m Text -> MWParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
variable MWParser m Text -> MWParser m Text -> MWParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text MWState m Char -> MWParser m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ([Char] -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"{}") MWParser m Text -> MWParser m Text -> MWParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT Text MWState m Char -> MWParser m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[Text]
contents <- MWParser m Text
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill MWParser m Text
chunk (ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char])
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
Text -> MWParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MWParser m Text) -> Text -> MWParser m Text
forall a b. (a -> b) -> a -> b
$ Text
"{{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}"
blockTag :: PandocMonad m => MWParser m Blocks
blockTag :: MWParser m Blocks
blockTag = do
(Tag Text
tag, Text
_) <- ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m (Tag Text, Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m (Tag Text, Text))
-> ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m (Tag Text, Text)
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag Tag Text -> Bool
isBlockTag'
case Tag Text
tag of
TagOpen Text
"blockquote" [Attribute Text]
_ -> Blocks -> Blocks
B.blockQuote (Blocks -> Blocks) -> MWParser m Blocks -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Blocks
blocksInTags Text
"blockquote"
TagOpen Text
"pre" [Attribute Text]
_ -> Text -> Blocks
B.codeBlock (Text -> Blocks) -> (Text -> Text) -> Text -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimCode (Text -> Blocks)
-> ParsecT Text MWState m Text -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Text
textInTags Text
"pre"
TagOpen Text
"syntaxhighlight" [Attribute Text]
attrs -> Text -> [Attribute Text] -> MWParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Text -> [Attribute Text] -> MWParser m Blocks
syntaxhighlight Text
"syntaxhighlight" [Attribute Text]
attrs
TagOpen Text
"source" [Attribute Text]
attrs -> Text -> [Attribute Text] -> MWParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Text -> [Attribute Text] -> MWParser m Blocks
syntaxhighlight Text
"source" [Attribute Text]
attrs
TagOpen Text
"haskell" [Attribute Text]
_ -> Attr -> Text -> Blocks
B.codeBlockWith (Text
"",[Text
"haskell"],[]) (Text -> Blocks) -> (Text -> Text) -> Text -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimCode (Text -> Blocks)
-> ParsecT Text MWState m Text -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Text -> ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Text
textInTags Text
"haskell"
TagOpen Text
"gallery" [Attribute Text]
_ -> Text -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Blocks
blocksInTags Text
"gallery"
TagOpen Text
"p" [Attribute Text]
_ -> Blocks
forall a. Monoid a => a
mempty Blocks
-> ParsecT Text MWState m (Tag Text, Text) -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Tag Text
tag)
TagClose Text
"p" -> Blocks
forall a. Monoid a => a
mempty Blocks
-> ParsecT Text MWState m (Tag Text, Text) -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Tag Text
tag)
Tag Text
_ -> Text -> Text -> Blocks
B.rawBlock Text
"html" (Text -> Blocks)
-> ((Tag Text, Text) -> Text) -> (Tag Text, Text) -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Tag Text, Text) -> Blocks)
-> ParsecT Text MWState m (Tag Text, Text) -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Tag Text
tag)
trimCode :: Text -> Text
trimCode :: Text -> Text
trimCode Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
'\n', Text
xs) -> Text -> Text
stripTrailingNewlines Text
xs
Maybe (Char, Text)
_ -> Text -> Text
stripTrailingNewlines Text
t
syntaxhighlight :: PandocMonad m => Text -> [Attribute Text] -> MWParser m Blocks
syntaxhighlight :: Text -> [Attribute Text] -> MWParser m Blocks
syntaxhighlight Text
tag [Attribute Text]
attrs = MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Blocks -> MWParser m Blocks)
-> MWParser m Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
let mblang :: Maybe Text
mblang = Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [Attribute Text]
attrs
let mbstart :: Maybe Text
mbstart = Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start" [Attribute Text]
attrs
let mbline :: Maybe Text
mbline = Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"line" [Attribute Text]
attrs
let classes :: [Text]
classes = Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
mblang [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Text] -> Text -> [Text]
forall a b. a -> b -> a
const [Text
"numberLines"]) Maybe Text
mbline
let kvs :: [Attribute Text]
kvs = [Attribute Text]
-> (Text -> [Attribute Text]) -> Maybe Text -> [Attribute Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text
"startFrom",Text
x)]) Maybe Text
mbstart
Text
contents <- Text -> MWParser m Text
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Text
textInTags Text
tag
Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith (Text
"",[Text]
classes,[Attribute Text]
kvs) (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimCode Text
contents
hrule :: PandocMonad m => MWParser m Blocks
hrule :: MWParser m Blocks
hrule = Blocks
B.horizontalRule Blocks -> ParsecT Text MWState m Char -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"----" ParsecT Text MWState m [Char]
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Char -> ParsecT Text MWState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Text MWState m [Char]
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline)
guardColumnOne :: PandocMonad m => MWParser m ()
guardColumnOne :: MWParser m ()
guardColumnOne = ParsecT Text MWState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT Text MWState m SourcePos
-> (SourcePos -> MWParser m ()) -> MWParser m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourcePos
pos -> Bool -> MWParser m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
preformatted :: PandocMonad m => MWParser m Blocks
preformatted :: MWParser m Blocks
preformatted = MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Blocks -> MWParser m Blocks)
-> MWParser m Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne
Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
let endline' :: ParsecT Text u m Inlines
endline' = Inlines
B.linebreak Inlines -> ParsecT Text u m Char -> ParsecT Text u m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text u m Char -> ParsecT Text u m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT Text u m Char
-> ParsecT Text u m Char -> ParsecT Text u m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')
let whitespace' :: ParsecT Text st m Inlines
whitespace' = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Text st m Text -> ParsecT Text st m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text st m Char -> ParsecT Text st m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char (Char
'\160' Char -> ParserT Text st m Char -> ParserT Text st m Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParserT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar)
let spToNbsp :: Char -> Char
spToNbsp Char
' ' = Char
'\160'
spToNbsp Char
x = Char
x
let nowiki' :: ParsecT Text MWState m Inlines
nowiki' = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> (Text -> [Inlines]) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak ([Inlines] -> [Inlines])
-> (Text -> [Inlines]) -> Text -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
B.str ([Text] -> [Inlines]) -> (Text -> [Text]) -> Text -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> [Text]
T.lines (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fromEntities (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
spToNbsp (Text -> Inlines)
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
((Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen (Text
"nowiki" :: Text) []) ParserT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
ParsecT Text MWState m Char
-> ParserT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ((Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose (Text
"nowiki" :: Text))))
let inline' :: ParsecT Text MWState m Inlines
inline' = ParsecT Text MWState m Inlines
forall st. ParsecT Text st m Inlines
whitespace' ParsecT Text MWState m Inlines
-> ParsecT Text MWState m Inlines -> ParsecT Text MWState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text MWState m Inlines
forall st. ParsecT Text st m Inlines
endline' ParsecT Text MWState m Inlines
-> ParsecT Text MWState m Inlines -> ParsecT Text MWState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text MWState m Inlines
nowiki'
ParsecT Text MWState m Inlines
-> ParsecT Text MWState m Inlines -> ParsecT Text MWState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text MWState m Inlines -> ParsecT Text MWState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m Char -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline MWParser m ()
-> ParsecT Text MWState m Inlines -> ParsecT Text MWState m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline)
Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text MWState m [Inlines]
-> ParsecT Text MWState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Inlines -> ParsecT Text MWState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text MWState m Inlines
inline'
let spacesStr :: Inline -> Bool
spacesStr (Str Text
xs) = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
xs
spacesStr Inline
_ = Bool
False
if (Inline -> Bool) -> Inlines -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all Inline -> Bool
spacesStr Inlines
contents
then Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
encode Inlines
contents
encode :: Inlines -> Inlines
encode :: Inlines -> Inlines
encode = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([Inline] -> Inlines)
-> (Inlines -> [Inline]) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
normalizeCode ([Inline] -> [Inline])
-> (Inlines -> [Inline]) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline])
-> (Inlines -> Inlines) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
strToCode
where strToCode :: Inline -> Inline
strToCode (Str Text
s) = Attr -> Text -> Inline
Code (Text
"",[],[]) Text
s
strToCode Inline
Space = Attr -> Text -> Inline
Code (Text
"",[],[]) Text
" "
strToCode Inline
x = Inline
x
normalizeCode :: [Inline] -> [Inline]
normalizeCode [] = []
normalizeCode (Code Attr
a1 Text
x : Code Attr
a2 Text
y : [Inline]
zs) | Attr
a1 Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
a2 =
[Inline] -> [Inline]
normalizeCode ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inline
Code Attr
a1 (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs
normalizeCode (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
normalizeCode [Inline]
xs
header :: PandocMonad m => MWParser m Blocks
= MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Blocks -> MWParser m Blocks)
-> MWParser m Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne
Int
lev <- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int)
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Char -> ParsecT Text MWState 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 Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
Bool -> MWParser m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MWParser m ()) -> Bool -> MWParser 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 Text MWState m [Inlines]
-> ParsecT Text MWState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Inlines
-> ParsecT Text MWState m [Char]
-> ParsecT Text MWState 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 Text MWState m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline (Int -> ParsecT Text MWState m Char -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
lev (ParsecT Text MWState m Char -> ParsecT Text MWState m [Char])
-> ParsecT Text MWState m Char -> ParsecT Text MWState m [Char]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
ReaderOptions
opts <- MWState -> ReaderOptions
mwOptions (MWState -> ReaderOptions)
-> ParsecT Text MWState m MWState
-> ParsecT Text MWState m ReaderOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m MWState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Attr
attr <- (if Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_gfm_auto_identifiers ReaderOptions
opts
then Attr -> Attr
forall a. a -> a
id
else Attr -> Attr
modifyIdentifier) (Attr -> Attr)
-> ParsecT Text MWState m Attr -> ParsecT Text MWState m Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Attr -> Inlines -> ParsecT Text MWState m Attr
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
HasIdentifierList st) =>
Attr -> Inlines -> ParserT s st m Attr
registerHeader Attr
nullAttr Inlines
contents
Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
B.headerWith Attr
attr Int
lev Inlines
contents
modifyIdentifier :: Attr -> Attr
modifyIdentifier :: Attr -> Attr
modifyIdentifier (Text
ident,[Text]
cl,[Attribute Text]
kv) = (Text
ident',[Text]
cl,[Attribute Text]
kv)
where ident' :: Text
ident' = (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
'_' else Char
c) Text
ident
bulletList :: PandocMonad m => MWParser m Blocks
bulletList :: MWParser m Blocks
bulletList = [Blocks] -> Blocks
B.bulletList ([Blocks] -> Blocks)
-> ParsecT Text MWState m [Blocks] -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
( MWParser m Blocks -> ParsecT Text MWState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Char -> MWParser m Blocks
listItem Char
'*')
ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [Blocks]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen (Text
"ul" :: Text) []) ParserT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m () -> ParsecT Text MWState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text MWState m ()
-> ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [Blocks]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m Blocks -> ParsecT Text MWState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Char -> MWParser m Blocks
listItem Char
'*' MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
li) ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m () -> ParsecT Text MWState m [Blocks]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParserT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ((Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose (Text
"ul" :: Text)))) )
orderedList :: PandocMonad m => MWParser m Blocks
orderedList :: MWParser m Blocks
orderedList =
([Blocks] -> Blocks
B.orderedList ([Blocks] -> Blocks)
-> ParsecT Text MWState m [Blocks] -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Blocks -> ParsecT Text MWState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Char -> MWParser m Blocks
listItem Char
'#'))
MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
(do (Tag Text
tag,Text
_) <- (Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen (Text
"ol" :: Text) [])
ParsecT Text MWState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
[Blocks]
items <- MWParser m Blocks -> ParsecT Text MWState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Char -> MWParser m Blocks
listItem Char
'#' MWParser m Blocks -> MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
li)
ParserT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ((Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose (Text
"ol" :: Text)))
let start :: Int
start = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"start" Tag Text
tag
Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Blocks] -> Blocks
B.orderedListWith (Int
start, ListNumberStyle
DefaultStyle, ListNumberDelim
DefaultDelim) [Blocks]
items)
definitionList :: PandocMonad m => MWParser m Blocks
definitionList :: MWParser m Blocks
definitionList = [(Inlines, [Blocks])] -> Blocks
B.definitionList ([(Inlines, [Blocks])] -> Blocks)
-> ParsecT Text MWState m [(Inlines, [Blocks])]
-> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m (Inlines, [Blocks])
-> ParsecT Text MWState 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 Text MWState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
MWParser m (Inlines, [Blocks])
defListItem
defListItem :: PandocMonad m => MWParser m (Inlines, [Blocks])
defListItem :: MWParser m (Inlines, [Blocks])
defListItem = MWParser m (Inlines, [Blocks]) -> MWParser m (Inlines, [Blocks])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m (Inlines, [Blocks]) -> MWParser m (Inlines, [Blocks]))
-> MWParser m (Inlines, [Blocks]) -> MWParser m (Inlines, [Blocks])
forall a b. (a -> b) -> a -> b
$ do
Inlines
terms <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak ([Inlines] -> Inlines)
-> ParsecT Text MWState m [Inlines]
-> ParsecT Text MWState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Inlines -> ParsecT Text MWState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text MWState m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
defListTerm
[Blocks]
defs <- if Inlines -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
terms
then ParsecT Text MWState m [Char] -> ParsecT Text MWState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy
(ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char])
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Text MWState m Char -> ParsecT Text MWState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':') ParsecT Text MWState m ()
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<math>") ParsecT Text MWState m ()
-> ParsecT Text MWState m [Blocks]
-> ParsecT Text MWState m [Blocks]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
ParsecT Text MWState m Blocks -> ParsecT Text MWState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Text MWState m Blocks
forall (m :: * -> *). PandocMonad m => Char -> MWParser m Blocks
listItem Char
':')
else ParsecT Text MWState m Blocks -> ParsecT Text MWState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT Text MWState m Blocks
forall (m :: * -> *). PandocMonad m => Char -> MWParser m Blocks
listItem Char
':')
(Inlines, [Blocks]) -> MWParser m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
terms, [Blocks]
defs)
defListTerm :: PandocMonad m => MWParser m Inlines
defListTerm :: MWParser m Inlines
defListTerm = do
MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne
Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
ParsecT Text MWState m Char -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
SourcePos
pos' <- ParsecT Text MWState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
ParserT Text MWState m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine ParserT Text MWState m Text
-> (Text -> MWParser m Inlines) -> MWParser m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MWParser m Inlines -> Text -> MWParser m Inlines
forall s (m :: * -> *) st r.
(Stream s m Char, IsString s) =>
ParserT s st m r -> Text -> ParserT s st m r
parseFromString (do SourcePos -> MWParser m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos'
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 Text MWState m [Inlines] -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Inlines -> ParsecT Text MWState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline)
listStart :: PandocMonad m => Char -> MWParser m ()
listStart :: Char -> MWParser m ()
listStart Char
c = Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c ParsecT Text MWState m Char -> MWParser m () -> MWParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Char -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text MWState m Char
forall (m :: * -> *). PandocMonad m => MWParser m Char
listStartChar
listStartChar :: PandocMonad m => MWParser m Char
listStartChar :: MWParser m Char
listStartChar = [Char] -> MWParser m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"*#;:"
anyListStart :: PandocMonad m => MWParser m Char
anyListStart :: MWParser m Char
anyListStart = MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne MWParser m () -> MWParser m Char -> MWParser m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> MWParser m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"*#:;"
li :: PandocMonad m => MWParser m Blocks
li :: MWParser m Blocks
li = ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m (Tag Text, Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen (Text
"li" :: Text) [])) ParsecT Text MWState m (Tag Text, Text)
-> MWParser m Blocks -> MWParser m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(Blocks -> Blocks
firstParaToPlain (Blocks -> Blocks) -> MWParser m Blocks -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Blocks
blocksInTags Text
"li") MWParser m Blocks -> ParsecT Text MWState m () -> MWParser m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text MWState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
listItem :: PandocMonad m => Char -> MWParser m Blocks
listItem :: Char -> MWParser m Blocks
listItem Char
c = MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Blocks -> MWParser m Blocks)
-> MWParser m Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
guardColumnOne
[Char]
extras <- ParsecT Text MWState m Char -> ParsecT Text MWState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m Char -> ParsecT Text MWState m Char)
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c ParsecT Text MWState m Char
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text MWState m Char
forall (m :: * -> *). PandocMonad m => MWParser m Char
listStartChar)
if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
extras
then Char -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Char -> MWParser m Blocks
listItem' Char
c
else do
ParsecT Text MWState m Char -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
SourcePos
pos' <- ParsecT Text MWState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Text
first <- [Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Text MWState m [Text] -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text
-> ParsecT Text MWState m Char -> ParsecT Text MWState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
listChunk ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
[Text]
rest <- ParsecT Text MWState m Text -> ParsecT Text MWState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many
(ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m Text -> ParsecT Text MWState m Text)
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
extras ParsecT Text MWState m [Char]
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text MWState m Char
forall (m :: * -> *). PandocMonad m => MWParser m Char
listStartChar ParsecT Text MWState m Char
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
([Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Text MWState m [Text] -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text
-> ParsecT Text MWState m Char -> ParsecT Text MWState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
listChunk ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline))
[Blocks]
contents <- ParserT Text MWState m [Blocks]
-> Text -> ParserT Text MWState m [Blocks]
forall s (m :: * -> *) st r.
(Stream s m Char, IsString s) =>
ParserT s st m r -> Text -> ParserT s st m r
parseFromString (do SourcePos -> MWParser m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos'
MWParser m Blocks -> ParserT Text MWState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (MWParser m Blocks -> ParserT Text MWState m [Blocks])
-> MWParser m Blocks -> ParserT Text MWState m [Blocks]
forall a b. (a -> b) -> a -> b
$ Char -> MWParser m Blocks
forall (m :: * -> *). PandocMonad m => Char -> MWParser m Blocks
listItem' Char
c)
([Text] -> Text
T.unlines (Text
first Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rest))
case Char
c of
Char
'*' -> Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
B.bulletList [Blocks]
contents
Char
'#' -> Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
B.orderedList [Blocks]
contents
Char
':' -> Blocks -> MWParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> MWParser m Blocks) -> Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ [(Inlines, [Blocks])] -> Blocks
B.definitionList [(Inlines
forall a. Monoid a => a
mempty, [Blocks]
contents)]
Char
_ -> MWParser m Blocks
forall (m :: * -> *) a. MonadPlus m => m a
mzero
listChunk :: PandocMonad m => MWParser m Text
listChunk :: MWParser m Text
listChunk = MWParser m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
template MWParser m Text -> MWParser m Text -> MWParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT Text MWState m Char -> MWParser m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
listItem' :: PandocMonad m => Char -> MWParser m Blocks
listItem' :: Char -> MWParser m Blocks
listItem' Char
c = MWParser m Blocks -> MWParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Blocks -> MWParser m Blocks)
-> MWParser m Blocks -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
Char -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Char -> MWParser m ()
listStart Char
c
ParsecT Text MWState m Char -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
SourcePos
pos' <- ParsecT Text MWState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Text
first <- [Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Text MWState m [Text] -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text
-> ParsecT Text MWState m Char -> ParsecT Text MWState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
listChunk ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
[Text]
rest <- ParsecT Text MWState m Text -> ParsecT Text MWState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m Text -> ParsecT Text MWState m Text)
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c ParsecT Text MWState m Char
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text MWState m Char
forall (m :: * -> *). PandocMonad m => MWParser m Char
listStartChar ParsecT Text MWState m Char
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
([Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Text MWState m [Text] -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text
-> ParsecT Text MWState m Char -> ParsecT Text MWState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
listChunk ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline))
MWParser m Blocks -> Text -> MWParser m Blocks
forall s (m :: * -> *) st r.
(Stream s m Char, IsString s) =>
ParserT s st m r -> Text -> ParserT s st m r
parseFromString (do SourcePos -> MWParser m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos'
Blocks -> Blocks
firstParaToPlain (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Text MWState m [Blocks] -> MWParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Blocks -> ParsecT Text MWState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 MWParser m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
block)
(Text -> MWParser m Blocks) -> Text -> MWParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
first Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rest
firstParaToPlain :: Blocks -> Blocks
firstParaToPlain :: Blocks -> Blocks
firstParaToPlain Blocks
contents =
case Seq Block -> ViewL Block
forall a. Seq a -> ViewL a
viewl (Blocks -> Seq Block
forall a. Many a -> Seq a
B.unMany Blocks
contents) of
Para [Inline]
xs :< Seq Block
ys -> Seq Block -> Blocks
forall a. Seq a -> Many a
B.Many (Seq Block -> Blocks) -> Seq Block -> Blocks
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Plain [Inline]
xs Block -> Seq Block -> Seq Block
forall a. a -> Seq a -> Seq a
<| Seq Block
ys
ViewL Block
_ -> Blocks
contents
inline :: PandocMonad m => MWParser m Inlines
inline :: MWParser m Inlines
inline = MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
whitespace
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
url
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
str
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
doubleQuotes
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
strong
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
emph
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
image
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
internalLink
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
externalLink
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
math
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inlineTag
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Inline -> Inlines
forall a. a -> Many a
B.singleton (Inline -> Inlines)
-> ParsecT Text MWState m Inline -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Inline
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Inline
charRef
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inlineHtml
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Text -> Inlines
B.rawInline Text
"mediawiki" (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
variable)
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Text -> Inlines
B.rawInline Text
"mediawiki" (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
template)
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
special
str :: PandocMonad m => MWParser m Inlines
str :: MWParser m Inlines
str = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text MWState m Char -> ParsecT Text MWState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ([Char] -> ParserT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf ([Char] -> ParserT Text MWState m Char)
-> [Char] -> ParserT Text MWState m Char
forall a b. (a -> b) -> a -> b
$ [Char]
specialChars [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
spaceChars)
math :: PandocMonad m => MWParser m Inlines
math :: MWParser m Inlines
math = (Text -> Inlines
B.displayMath (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m Char -> ParsecT Text MWState 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 Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':') ParsecT Text MWState m [Char]
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Text
textInTags Text
"math"))
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Inlines
B.math (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Text
textInTags Text
"math")
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Inlines
B.displayMath (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m [Char]
forall u. ParsecT Text u m [Char]
dmStart ParsecT Text MWState m [Char]
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Char
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Text MWState m [Char]
forall u. ParsecT Text u m [Char]
dmEnd))
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Inlines
B.math (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m [Char]
forall u. ParsecT Text u m [Char]
mStart ParsecT Text MWState m [Char]
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Char
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ((Char -> Bool) -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n')) ParsecT Text MWState m [Char]
forall u. ParsecT Text u m [Char]
mEnd))
where dmStart :: ParsecT Text u m [Char]
dmStart = [Char] -> ParsecT Text u m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\["
dmEnd :: ParsecT Text u m [Char]
dmEnd = ParsecT Text u m [Char] -> ParsecT Text u m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text u m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\]")
mStart :: ParsecT Text u m [Char]
mStart = [Char] -> ParsecT Text u m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\("
mEnd :: ParsecT Text u m [Char]
mEnd = ParsecT Text u m [Char] -> ParsecT Text u m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text u m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\)")
variable :: PandocMonad m => MWParser m Text
variable :: MWParser m Text
variable = MWParser m Text -> MWParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Text -> MWParser m Text)
-> MWParser m Text -> MWParser m Text
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{{"
Text
contents <- ParserT Text MWState m Char
-> ParsecT Text MWState m [Char] -> MWParser m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ParserT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char])
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}}")
Text -> MWParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MWParser m Text) -> Text -> MWParser m Text
forall a b. (a -> b) -> a -> b
$ Text
"{{{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}}"
inlineTag :: PandocMonad m => MWParser m Inlines
inlineTag :: MWParser m Inlines
inlineTag = do
(Tag Text
tag, Text
_) <- ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m (Tag Text, Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m (Tag Text, Text))
-> ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m (Tag Text, Text)
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag Tag Text -> Bool
isInlineTag'
case Tag Text
tag of
TagOpen Text
"ref" [Attribute Text]
_ -> Blocks -> Inlines
B.note (Blocks -> Inlines) -> (Inlines -> Blocks) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
B.plain (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Inlines
inlinesInTags Text
"ref"
TagOpen Text
"nowiki" [Attribute Text]
_ -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Inlines -> MWParser m Inlines)
-> MWParser m Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
(Tag Text
_,Text
raw) <- (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Tag Text
tag)
if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
raw
then Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
else Text -> Inlines
B.text (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fromEntities (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParserT Text MWState m Char
-> ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ParserT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ((Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose (Text
"nowiki" :: Text)))
TagOpen Text
"br" [Attribute Text]
_ -> Inlines
B.linebreak Inlines -> ParsecT Text MWState m () -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ((Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen (Text
"br" :: Text) [])
ParsecT Text MWState m (Tag Text, Text)
-> ParsecT Text MWState m () -> ParsecT Text MWState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT Text MWState m Char -> ParsecT Text MWState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParserT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline)
TagOpen Text
"strike" [Attribute Text]
_ -> Inlines -> Inlines
B.strikeout (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Inlines
inlinesInTags Text
"strike"
TagOpen Text
"del" [Attribute Text]
_ -> Inlines -> Inlines
B.strikeout (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Inlines
inlinesInTags Text
"del"
TagOpen Text
"sub" [Attribute Text]
_ -> Inlines -> Inlines
B.subscript (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Inlines
inlinesInTags Text
"sub"
TagOpen Text
"sup" [Attribute Text]
_ -> Inlines -> Inlines
B.superscript (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Inlines
inlinesInTags Text
"sup"
TagOpen Text
"code" [Attribute Text]
_ -> Inlines -> Inlines
encode (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Inlines
inlinesInTags Text
"code"
TagOpen Text
"tt" [Attribute Text]
_ -> do
Bool
inTT <- MWState -> Bool
mwInTT (MWState -> Bool)
-> ParsecT Text MWState m MWState -> ParsecT Text MWState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m MWState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(MWState -> MWState) -> ParsecT Text MWState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((MWState -> MWState) -> ParsecT Text MWState m ())
-> (MWState -> MWState) -> ParsecT Text MWState m ()
forall a b. (a -> b) -> a -> b
$ \MWState
st -> MWState
st{ mwInTT :: Bool
mwInTT = Bool
True }
Inlines
result <- Inlines -> Inlines
encode (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Inlines
inlinesInTags Text
"tt"
(MWState -> MWState) -> ParsecT Text MWState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((MWState -> MWState) -> ParsecT Text MWState m ())
-> (MWState -> MWState) -> ParsecT Text MWState m ()
forall a b. (a -> b) -> a -> b
$ \MWState
st -> MWState
st{ mwInTT :: Bool
mwInTT = Bool
inTT }
Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
result
TagOpen Text
"hask" [Attribute Text]
_ -> Attr -> Text -> Inlines
B.codeWith (Text
"",[Text
"haskell"],[]) (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => Text -> MWParser m Text
textInTags Text
"hask"
Tag Text
_ -> Text -> Text -> Inlines
B.rawInline Text
"html" (Text -> Inlines)
-> ((Tag Text, Text) -> Text) -> (Tag Text, Text) -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Tag Text, Text) -> Inlines)
-> ParsecT Text MWState m (Tag Text, Text) -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Tag Text
tag)
special :: PandocMonad m => MWParser m Inlines
special :: MWParser m Inlines
special = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Text MWState m Char -> ParsecT Text MWState m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 (ParserT Text MWState m (Tag Text, Text)
-> ParserT Text MWState m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ((Tag Text -> Bool) -> ParserT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag Tag Text -> Bool
isBlockTag') ParserT Text MWState m ()
-> ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
[Char] -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
specialChars)
inlineHtml :: PandocMonad m => MWParser m Inlines
inlineHtml :: MWParser m Inlines
inlineHtml = Text -> Text -> Inlines
B.rawInline Text
"html" (Text -> Inlines)
-> ((Tag Text, Text) -> Text) -> (Tag Text, Text) -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Tag Text, Text) -> Inlines)
-> ParsecT Text MWState m (Tag Text, Text) -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tag Text -> Bool) -> ParsecT Text MWState m (Tag Text, Text)
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag Tag Text -> Bool
isInlineTag'
whitespace :: PandocMonad m => MWParser m Inlines
whitespace :: MWParser m Inlines
whitespace = Inlines
B.space Inlines -> ParsecT Text MWState m () -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Text MWState m Char -> ParsecT Text MWState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text MWState m ()
-> ParsecT Text MWState m () -> ParsecT Text MWState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text MWState m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
htmlComment)
MWParser m Inlines -> MWParser m Inlines -> MWParser 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 -> ParsecT Text MWState m () -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text MWState m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
endline
endline :: PandocMonad m => MWParser m ()
endline :: MWParser m ()
endline = () () -> ParsecT Text MWState m Char -> MWParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text MWState m Char -> ParsecT Text MWState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT Text MWState m Char
-> MWParser m () -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Text MWState m Char -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text MWState m Char
-> MWParser m () -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Text MWState m Char -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT Text MWState m Char
-> MWParser m () -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParserT Text MWState m Blocks -> MWParser m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParserT Text MWState m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
hrule ParsecT Text MWState m Char
-> MWParser m () -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
MWParser m () -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy MWParser m ()
forall (m :: * -> *). PandocMonad m => MWParser m ()
tableStart ParsecT Text MWState m Char
-> MWParser m () -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParserT Text MWState m Blocks -> MWParser m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParserT Text MWState m Blocks
forall (m :: * -> *). PandocMonad m => MWParser m Blocks
header ParsecT Text MWState m Char
-> MWParser m () -> ParsecT Text MWState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Text MWState m Char -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text MWState m Char
forall (m :: * -> *). PandocMonad m => MWParser m Char
anyListStart)
imageIdentifiers :: PandocMonad m => [MWParser m ()]
imageIdentifiers :: [MWParser m ()]
imageIdentifiers = [Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym (Text
identifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") | Text
identifier <- [Text]
identifiers]
where identifiers :: [Text]
identifiers = [Text
"File", Text
"Image", Text
"Archivo", Text
"Datei", Text
"Fichier",
Text
"Bild"]
image :: PandocMonad m => MWParser m Inlines
image :: MWParser m Inlines
image = MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Inlines -> MWParser m Inlines)
-> MWParser m Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"[["
[MWParser m ()] -> MWParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [MWParser m ()]
forall (m :: * -> *). PandocMonad m => [MWParser m ()]
imageIdentifiers
Text
fname <- Text -> Text
addUnderscores (Text -> Text)
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text MWState m Char -> ParsecT Text MWState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ([Char] -> ParserT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"|]")
[Text]
_ <- ParsecT Text MWState m Text -> ParsecT Text MWState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
imageOption
[Text]
dims <- ParsecT Text MWState m [Text] -> ParsecT Text MWState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParserT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParserT Text MWState m Char
-> ParsecT Text MWState m [Text] -> ParsecT Text MWState m [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text MWState m Text
-> ParserT Text MWState m Char -> ParsecT Text MWState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepBy (ParserT Text MWState m Char -> ParsecT Text MWState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
manyChar ParserT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) (Char -> ParserT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'x') ParsecT Text MWState m [Text]
-> ParsecT Text MWState m [Char] -> ParsecT Text MWState m [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> ParsecT Text MWState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"px")
ParsecT Text MWState m [Text]
-> ParsecT Text MWState m [Text] -> ParsecT Text MWState m [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Text] -> ParsecT Text MWState m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Text]
_ <- ParsecT Text MWState m Text -> ParsecT Text MWState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text MWState m Text
forall (m :: * -> *). PandocMonad m => MWParser m Text
imageOption
let kvs :: [Attribute Text]
kvs = case [Text]
dims of
[Text
w] -> [(Text
"width", Text
w)]
[Text
w, Text
h] -> [(Text
"width", Text
w), (Text
"height", Text
h)]
[Text]
_ -> []
let attr :: (Text, [a], [Attribute Text])
attr = (Text
"", [], [Attribute Text]
kvs)
Inlines
caption <- (Text -> Inlines
B.str Text
fname Inlines -> MWParser m () -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"]]")
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParserT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParserT Text MWState m Char
-> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text MWState m [Inlines] -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Inlines
-> MWParser m () -> ParsecT Text MWState 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 MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline (Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"]]")))
Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> MWParser m Inlines) -> Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith Attr
forall a. (Text, [a], [Attribute Text])
attr Text
fname (Text
"fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify Inlines
caption) Inlines
caption
imageOption :: PandocMonad m => MWParser m Text
imageOption :: MWParser m Text
imageOption = MWParser m Text -> MWParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Text -> MWParser m Text)
-> MWParser m Text -> MWParser m Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Text MWState m Char -> MWParser m Text -> MWParser m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m Text
forall u. ParsecT Text u m Text
opt
where
opt :: ParsecT Text u m Text
opt = ParsecT Text u m Text -> ParsecT Text u m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Text] -> ParsecT Text u m Text
forall s (m :: * -> *) st.
Stream s m Char =>
[Text] -> ParserT s st m Text
oneOfStrings [ Text
"border", Text
"thumbnail", Text
"frameless"
, Text
"thumb", Text
"upright", Text
"left", Text
"right"
, Text
"center", Text
"none", Text
"baseline", Text
"sub"
, Text
"super", Text
"top", Text
"text-top", Text
"middle"
, Text
"bottom", Text
"text-bottom" ])
ParsecT Text u m Text
-> ParsecT Text u m Text -> ParsecT Text u m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u m Text -> ParsecT Text u m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> ParsecT Text u m Text
forall s (m :: * -> *) u.
Stream s m Char =>
Text -> ParsecT s u m Text
textStr Text
"frame")
ParsecT Text u m Text
-> ParsecT Text u m Text -> ParsecT Text u m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u m Text -> ParsecT Text u m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Text] -> ParsecT Text u m Text
forall s (m :: * -> *) st.
Stream s m Char =>
[Text] -> ParserT s st m Text
oneOfStrings [Text
"link=",Text
"alt=",Text
"page=",Text
"class="] ParsecT Text u m Text
-> ParsecT Text u m [Char] -> ParsecT Text u m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text u m Char -> ParsecT Text u m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"|]"))
addUnderscores :: Text -> Text
addUnderscores :: Text -> Text
addUnderscores = Text -> [Text] -> Text
T.intercalate Text
"_" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
splitTextBy Char -> Bool
sep
where
sep :: Char -> Bool
sep Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
internalLink :: PandocMonad m => MWParser m Inlines
internalLink :: MWParser m Inlines
internalLink = MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Inlines -> MWParser m Inlines)
-> MWParser m Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"[["
Text
pagename <- [Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> Text)
-> ParsecT Text MWState m Text -> ParsecT Text MWState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text MWState m Char -> ParsecT Text MWState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
manyChar ([Char] -> ParserT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"|]")
Inlines
label <- Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> Inlines
B.text Text
pagename) (MWParser m Inlines -> MWParser m Inlines)
-> MWParser m Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ Char -> ParserT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParserT Text MWState m Char
-> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
( ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text MWState m [Inlines] -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Inlines -> ParsecT Text MWState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParserT Text MWState m Char -> MWParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParserT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') MWParser m () -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline))
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':') Text
pagename) )
Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"]]"
Inlines
linktrail <- Text -> Inlines
B.text (Text -> Inlines)
-> ParsecT Text MWState m Text -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text MWState m Char -> ParsecT Text MWState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
manyChar ParserT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
let link :: Inlines
link = Text -> Text -> Inlines -> Inlines
B.link (Text -> Text
addUnderscores Text
pagename) Text
"wikilink" (Inlines
label Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
linktrail)
if Text
"Category:" Text -> Text -> Bool
`T.isPrefixOf` Text
pagename
then do
(MWState -> MWState) -> MWParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((MWState -> MWState) -> MWParser m ())
-> (MWState -> MWState) -> MWParser m ()
forall a b. (a -> b) -> a -> b
$ \MWState
st -> MWState
st{ mwCategoryLinks :: [Inlines]
mwCategoryLinks = Inlines
link Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
: MWState -> [Inlines]
mwCategoryLinks MWState
st }
Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
else Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
link
externalLink :: PandocMonad m => MWParser m Inlines
externalLink :: MWParser m Inlines
externalLink = MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Inlines -> MWParser m Inlines)
-> MWParser m Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
(Text
_, Text
src) <- ParserT Text MWState m (Attribute Text)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (Attribute Text)
uri
Inlines
lab <- MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (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 Text MWState m [Inlines] -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(ParsecT Text MWState m Char -> ParsecT Text MWState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text MWState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text MWState m ()
-> ParsecT Text MWState m [Inlines]
-> ParsecT Text MWState m [Inlines]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MWParser m Inlines
-> ParsecT Text MWState m Char -> ParsecT Text MWState 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 MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline (Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')))
MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do Char -> ParsecT Text MWState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
Int
num <- MWState -> Int
mwNextLinkNumber (MWState -> Int)
-> ParsecT Text MWState m MWState -> ParsecT Text MWState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m MWState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(MWState -> MWState) -> ParsecT Text MWState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((MWState -> MWState) -> ParsecT Text MWState m ())
-> (MWState -> MWState) -> ParsecT Text MWState m ()
forall a b. (a -> b) -> a -> b
$ \MWState
st -> MWState
st{ mwNextLinkNumber :: Int
mwNextLinkNumber = Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> MWParser m Inlines) -> Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
num
Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> MWParser m Inlines) -> Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link Text
src Text
"" Inlines
lab
url :: PandocMonad m => MWParser m Inlines
url :: MWParser m Inlines
url = do
(Text
orig, Text
src) <- ParserT Text MWState m (Attribute Text)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (Attribute Text)
uri
Inlines -> MWParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> MWParser m Inlines) -> Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link Text
src Text
"" (Text -> Inlines
B.str Text
orig)
inlinesBetween :: (PandocMonad m, Show b) => MWParser m a -> MWParser m b -> MWParser m Inlines
inlinesBetween :: MWParser m a -> MWParser m b -> MWParser m Inlines
inlinesBetween MWParser m a
start MWParser m b
end =
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 Text MWState m [Inlines] -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m [Inlines]
-> ParsecT Text MWState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m a
start MWParser m a
-> ParsecT Text MWState m [Inlines]
-> ParsecT Text MWState m [Inlines]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MWParser m Inlines
-> MWParser m b -> ParsecT Text MWState m [Inlines]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till MWParser m Inlines
inner MWParser m b
end)
where inner :: MWParser m Inlines
inner = MWParser m Inlines
innerSpace MWParser m Inlines -> MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParserT Text MWState m () -> ParserT Text MWState m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' (() () -> MWParser m Inlines -> ParserT Text MWState m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
whitespace) ParserT Text MWState m ()
-> MWParser m Inlines -> MWParser m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
inline)
innerSpace :: MWParser m Inlines
innerSpace = MWParser m Inlines -> MWParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m Inlines -> MWParser m Inlines)
-> MWParser m Inlines -> MWParser m Inlines
forall a b. (a -> b) -> a -> b
$ MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
whitespace MWParser m Inlines
-> ParserT Text MWState m () -> MWParser m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MWParser m b -> ParserT Text MWState m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' MWParser m b
end
emph :: PandocMonad m => MWParser m Inlines
emph :: MWParser m Inlines
emph = Inlines -> Inlines
B.emph (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Inlines -> MWParser m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
MWParser m a -> MWParser m a
nested (MWParser m Char -> MWParser m () -> MWParser m Inlines
forall (m :: * -> *) b a.
(PandocMonad m, Show b) =>
MWParser m a -> MWParser m b -> MWParser m Inlines
inlinesBetween MWParser m Char
start MWParser m ()
end)
where start :: MWParser m Char
start = Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"''" MWParser m () -> MWParser m Char -> MWParser m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MWParser m Char -> MWParser m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead MWParser m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
nonspaceChar
end :: MWParser m ()
end = MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m () -> MWParser m ()) -> MWParser m () -> MWParser m ()
forall a b. (a -> b) -> a -> b
$ MWParser m () -> MWParser m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' (() () -> MWParser m Inlines -> MWParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MWParser m Inlines
forall (m :: * -> *). PandocMonad m => MWParser m Inlines
strong) MWParser m () -> MWParser m () -> MWParser m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"''"
strong :: PandocMonad m => MWParser m Inlines
strong :: MWParser m Inlines
strong = Inlines -> Inlines
B.strong (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Inlines -> MWParser m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
MWParser m a -> MWParser m a
nested (MWParser m Char -> MWParser m () -> MWParser m Inlines
forall (m :: * -> *) b a.
(PandocMonad m, Show b) =>
MWParser m a -> MWParser m b -> MWParser m Inlines
inlinesBetween MWParser m Char
start MWParser m ()
end)
where start :: MWParser m Char
start = Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"'''" MWParser m () -> MWParser m Char -> MWParser m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MWParser m Char -> MWParser m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead MWParser m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
nonspaceChar
end :: MWParser m ()
end = MWParser m () -> MWParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MWParser m () -> MWParser m ()) -> MWParser m () -> MWParser m ()
forall a b. (a -> b) -> a -> b
$ Text -> MWParser m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"'''"
doubleQuotes :: PandocMonad m => MWParser m Inlines
doubleQuotes :: MWParser m Inlines
doubleQuotes = do
Extension -> ParserT Text MWState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_smart
Bool
inTT <- MWState -> Bool
mwInTT (MWState -> Bool)
-> ParsecT Text MWState m MWState -> ParsecT Text MWState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text MWState m MWState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Bool -> ParserT Text MWState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
inTT)
Inlines -> Inlines
B.doubleQuoted (Inlines -> Inlines) -> MWParser m Inlines -> MWParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MWParser m Inlines -> MWParser m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
MWParser m a -> MWParser m a
nested (MWParser m Char -> ParserT Text MWState m () -> MWParser m Inlines
forall (m :: * -> *) b a.
(PandocMonad m, Show b) =>
MWParser m a -> MWParser m b -> MWParser m Inlines
inlinesBetween MWParser m Char
openDoubleQuote ParserT Text MWState m ()
closeDoubleQuote)
where openDoubleQuote :: MWParser m Char
openDoubleQuote = Text -> ParserT Text MWState m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"\"" ParserT Text MWState m () -> MWParser m Char -> MWParser m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MWParser m Char -> MWParser m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead MWParser m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
nonspaceChar
closeDoubleQuote :: ParserT Text MWState m ()
closeDoubleQuote = ParserT Text MWState m () -> ParserT Text MWState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text MWState m () -> ParserT Text MWState m ())
-> ParserT Text MWState m () -> ParserT Text MWState m ()
forall a b. (a -> b) -> a -> b
$ Text -> ParserT Text MWState m ()
forall (m :: * -> *). PandocMonad m => Text -> MWParser m ()
sym Text
"\""