{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{- |
   Module      : Text.Pandoc.Readers.Vimwiki
   Copyright   : Copyright (C) 2017-2020 Yuchen Pei
   License     : GNU GPL, version 2 or above

   Maintainer  : Yuchen Pei <me@ypei.me>
   Stability   : alpha
   Portability : portable

Conversion of vimwiki text to 'Pandoc' document.
-}
{--
[X]: implemented
[O]: not implemented
* block parsers:
    * [X] header
    * [X] hrule
    * [X] comment
    * [X] blockquote
    * [X] preformatted -- using codeblock
    * [X] displaymath
    * [X] bulletlist / orderedlist
        * [X] todo lists -- using span.
    * [X] table
        * [X] centered table -- using div
        * [O] colspan and rowspan -- see issue #1024
    * [X] paragraph
    * [X] definition list
* inline parsers:
    * [X] bareURL
    * [X] strong
    * [X] emph
    * [X] strikeout
    * [X] code
    * [X] link
    * [X] image
    * [X] inline math
    * [X] tag
    * [X] sub- and super-scripts
* misc:
    * [X] `TODO:` mark
    * [X] metadata placeholders: %title and %date
    * [O] control placeholders: %template and %nohtml -- ignored
--}

module Text.Pandoc.Readers.Vimwiki ( readVimwiki
                                 ) where
import Control.Monad (guard)
import Control.Monad.Except (throwError)
import Data.Default
import Data.List (isInfixOf)
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Builder (Blocks, Inlines, fromList, toList, trimInlines)
import qualified Text.Pandoc.Builder as B (blockQuote, bulletList, code,
                                           codeBlockWith, definitionList,
                                           displayMath, divWith, emph,
                                           headerWith, horizontalRule, image,
                                           imageWith, link, math, orderedList,
                                           para, plain, setMeta, simpleTable,
                                           softbreak, space, spanWith, str,
                                           strikeout, strong, subscript,
                                           superscript)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.Definition (Attr, Block (BulletList, OrderedList),
                               Inline (Space), ListNumberDelim (..),
                               ListNumberStyle (..), Pandoc (..),
                               nullMeta)
import Text.Pandoc.Options (ReaderOptions)
import Text.Pandoc.Parsing (ParserState, ParserT, blanklines, emailAddress,
                            many1Till, orderedListMarker, readWithM,
                            registerHeader, spaceChar, stateMeta,
                            stateOptions, uri, manyTillChar, manyChar, textStr,
                            many1Char, countChar, many1TillChar)
import Text.Pandoc.Shared (crFilter, splitTextBy, stringify, stripFirstAndLast,
                           isURI, tshow)
import Text.Parsec.Char (alphaNum, anyChar, char, newline, noneOf, oneOf, space,
                         spaces, string)
import Text.Parsec.Combinator (between, choice, eof, lookAhead, many1,
                               manyTill, notFollowedBy, option, skipMany1)
import Text.Parsec.Prim (getState, many, try, updateState, (<|>))

readVimwiki :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readVimwiki :: ReaderOptions -> Text -> m Pandoc
readVimwiki ReaderOptions
opts Text
s = do
  Either PandocError Pandoc
res <- ParserT Text ParserState m Pandoc
-> ParserState -> 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 ParserState m Pandoc
forall (m :: * -> *). PandocMonad m => VwParser m Pandoc
parseVimwiki ParserState
forall a. Default a => a
def{ stateOptions :: ReaderOptions
stateOptions = ReaderOptions
opts } (Text -> m (Either PandocError Pandoc))
-> Text -> m (Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ Text -> Text
crFilter Text
s
  case Either PandocError Pandoc
res of
       Left PandocError
e       -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
       Right Pandoc
result -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result

type VwParser = ParserT Text ParserState


-- constants

specialChars :: [Char]
specialChars :: [Char]
specialChars = [Char]
"=*-#[]_~{}`$|:%^,"

spaceChars :: [Char]
spaceChars :: [Char]
spaceChars = [Char]
" \t\n"

-- main parser

parseVimwiki :: PandocMonad m => VwParser m Pandoc
parseVimwiki :: VwParser m Pandoc
parseVimwiki = do
  Blocks
bs <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Text ParserState m [Blocks]
-> ParsecT Text ParserState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Blocks
-> ParsecT Text ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
block
  ParsecT Text ParserState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ParsecT Text ParserState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  ParserState
st <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let meta :: Meta
meta = ParserState -> Meta
stateMeta ParserState
st
  Pandoc -> VwParser m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> VwParser m Pandoc) -> Pandoc -> VwParser m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta (Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs)

-- block parser

block :: PandocMonad m => VwParser m Blocks
block :: VwParser m Blocks
block = do
  Blocks
res <- [VwParser m Blocks] -> VwParser m Blocks
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Text ParserState m Text -> VwParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
header
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
hrule
                , Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Text ParserState m () -> VwParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
comment
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
mixedList
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
preformatted
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
displayMath
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
table
                , Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Text ParserState m () -> VwParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
placeholder
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockQuote
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionList
                , VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
para
                ]
  Text -> ParsecT Text ParserState m ()
forall (m :: * -> *). PandocMonad m => Text -> m ()
trace (Int -> Text -> Text
T.take Int
60 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Show a => a -> Text
tshow ([Block] -> Text) -> [Block] -> Text
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
res)
  Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
res

blockML :: PandocMonad m => VwParser m Blocks
blockML :: VwParser m Blocks
blockML = [VwParser m Blocks] -> VwParser m Blocks
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
preformatted, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
displayMath, VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
table]

header :: PandocMonad m => VwParser m Blocks
header :: VwParser m Blocks
header = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  [Char]
sp <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
  [Char]
eqs <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
  ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
  let lev :: Int
lev = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
eqs
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Int
lev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6
  Inlines
contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines]
-> ParsecT Text ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m Char
 -> ParsecT Text ParserState m Char)
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
    ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
eqs ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline)
  Attr
attr <- Attr -> Inlines -> ParserT Text ParserState 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 (Inlines -> Text
makeId Inlines
contents,
    [Text
"justcenter" | Bool -> Bool
not ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
sp)], []) Inlines
contents
  Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
B.headerWith Attr
attr Int
lev Inlines
contents

para :: PandocMonad m => VwParser m Blocks
para :: VwParser m Blocks
para = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  Inlines
contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines]
-> ParsecT Text ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline
  if (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
contents)
     then Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
     else Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para Inlines
contents

hrule :: PandocMonad m => VwParser m Blocks
hrule :: VwParser m Blocks
hrule = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
B.horizontalRule Blocks -> ParsecT Text ParserState m Char -> VwParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ([Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"----" ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline)

comment :: PandocMonad m => VwParser m ()
comment :: VwParser m ()
comment = VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m () -> VwParser m ()) -> VwParser m () -> VwParser m ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"%%" ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
  () -> VwParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

blockQuote :: PandocMonad m => VwParser m Blocks
blockQuote :: VwParser m Blocks
blockQuote = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"    "
  Inlines
contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines]
-> ParsecT Text ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineBQ
  if (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
contents)
     then Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
     else Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
B.blockQuote (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain Inlines
contents

definitionList :: PandocMonad m => VwParser m Blocks
definitionList :: VwParser m Blocks
definitionList = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$
  [(Inlines, [Blocks])] -> Blocks
B.definitionList ([(Inlines, [Blocks])] -> Blocks)
-> ParsecT Text ParserState m [(Inlines, [Blocks])]
-> VwParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m (Inlines, [Blocks])
-> ParsecT Text ParserState m [(Inlines, [Blocks])]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text ParserState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
VwParser m (Inlines, [Blocks])
dlItemWithDT ParsecT Text ParserState m (Inlines, [Blocks])
-> ParsecT Text ParserState m (Inlines, [Blocks])
-> ParsecT Text ParserState m (Inlines, [Blocks])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text ParserState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
VwParser m (Inlines, [Blocks])
dlItemWithoutDT)

dlItemWithDT :: PandocMonad m => VwParser m (Inlines, [Blocks])
dlItemWithDT :: VwParser m (Inlines, [Blocks])
dlItemWithDT = do
  Inlines
dt <- VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm
  [Blocks]
dds <- ParsecT Text ParserState m Blocks
-> ParsecT Text ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef
  (Inlines, [Blocks]) -> VwParser m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
dt, [Blocks]
dds)

dlItemWithoutDT :: PandocMonad m => VwParser m (Inlines, [Blocks])
dlItemWithoutDT :: VwParser m (Inlines, [Blocks])
dlItemWithoutDT = do
  [Blocks]
dds <- ParsecT Text ParserState m Blocks
-> ParsecT Text ParserState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef
  (Inlines, [Blocks]) -> VwParser m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
forall a. Monoid a => a
mempty, [Blocks]
dds)

definitionDef :: PandocMonad m => VwParser m Blocks
definitionDef :: VwParser m Blocks
definitionDef = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$
  ParsecT Text ParserState m Inlines -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm ParsecT Text ParserState m ()
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
    ParsecT Text ParserState m [Char]
-> VwParser m Blocks -> VwParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef1 VwParser m Blocks -> VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
definitionDef2)

definitionDef1 :: PandocMonad m => VwParser m Blocks
definitionDef1 :: VwParser m Blocks
definitionDef1 = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Text ParserState m Char -> VwParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerE

definitionDef2 :: PandocMonad m => VwParser m Blocks
definitionDef2 :: VwParser m Blocks
definitionDef2 = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain (Inlines -> Blocks)
-> ParsecT Text ParserState m Inlines -> VwParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (VwParser m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerM VwParser m Char
-> ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines]
-> ParsecT Text ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline') ParsecT Text ParserState m Inlines
-> VwParser m Char -> ParsecT Text ParserState m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* VwParser m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline)


definitionTerm :: PandocMonad m => VwParser m Inlines
definitionTerm :: VwParser m Inlines
definitionTerm = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  Inlines
x <- VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm1 VwParser m Inlines -> VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
definitionTerm2
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify Inlines
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"")
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
x

definitionTerm1 :: PandocMonad m => VwParser m Inlines
definitionTerm1 :: VwParser m Inlines
definitionTerm1 = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$
  Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text ParserState m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerE)

definitionTerm2 :: PandocMonad m => VwParser m Inlines
definitionTerm2 :: VwParser m Inlines
definitionTerm2 = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParsecT Text ParserState m ()
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline'
  (ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m () -> ParsecT Text ParserState m ())
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (VwParser m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerM VwParser m Char
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Text -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text ParserState m Text
forall (m :: * -> *). PandocMonad m => VwParser m Text
hasDefMarkerM))

defMarkerM :: PandocMonad m => VwParser m Char
defMarkerM :: VwParser m Char
defMarkerM = [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::" ParsecT Text ParserState m [Char]
-> VwParser m Char -> VwParser m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VwParser m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar

defMarkerE :: PandocMonad m => VwParser m Char
defMarkerE :: VwParser m Char
defMarkerE = [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::" ParsecT Text ParserState m [Char]
-> VwParser m Char -> VwParser m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VwParser m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline

hasDefMarkerM :: PandocMonad m => VwParser m Text
hasDefMarkerM :: VwParser m Text
hasDefMarkerM = ParserT Text ParserState m Char
-> ParserT Text ParserState m Char -> VwParser 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] -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (ParserT Text ParserState m Char -> ParserT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParserT Text ParserState m Char
forall (m :: * -> *). PandocMonad m => VwParser m Char
defMarkerM)

preformatted :: PandocMonad m => VwParser m Blocks
preformatted :: VwParser m Blocks
preformatted = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{{"
  Text
attrText <- ParsecT Text ParserState m Char -> ParserT Text ParserState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
manyChar ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
  ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline
  Text
contents <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParserT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}}"
    ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline))
  if (Text
contents Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") Bool -> Bool -> Bool
&& (Text -> Char
T.head Text
contents Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
     then Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith (Text -> Attr
makeAttr Text
attrText) (Text -> Text
T.tail Text
contents)
     else Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith (Text -> Attr
makeAttr Text
attrText) Text
contents

makeAttr :: Text -> Attr
makeAttr :: Text -> Attr
makeAttr Text
s =
  let xs :: [Text]
xs = (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" \t" :: String)) Text
s in
    (Text
"", [Text] -> [Text]
syntax [Text]
xs, (Text -> Maybe (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe (Text, Text)
nameValue [Text]
xs)

syntax :: [Text] -> [Text]
syntax :: [Text] -> [Text]
syntax (Text
s:[Text]
_) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
T.isInfixOf Text
"=" Text
s = [Text
s]
syntax [Text]
_ = []

nameValue :: Text -> Maybe (Text, Text)
nameValue :: Text -> Maybe (Text, Text)
nameValue Text
s =
  let t :: [Text]
t = (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
s in
    if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2
      then Maybe (Text, Text)
forall a. Maybe a
Nothing
      else let (Text
a, Text
b) = ([Text] -> Text
forall a. [a] -> a
head [Text]
t, [Text] -> Text
forall a. [a] -> a
last [Text]
t) in
             if (Text -> Int
T.length Text
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2) Bool -> Bool -> Bool
|| ((Text -> Char
T.head Text
b, Text -> Char
T.last Text
b) (Char, Char) -> (Char, Char) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Char
'"', Char
'"'))
               then Maybe (Text, Text)
forall a. Maybe a
Nothing
               else (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
a, Text -> Text
stripFirstAndLast Text
b)


displayMath :: PandocMonad m => VwParser m Blocks
displayMath :: VwParser m Blocks
displayMath = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{$"
  Text
mathTag <- Text
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" ParsecT Text ParserState m Text
forall (m :: * -> *). PandocMonad m => VwParser m Text
mathTagParser
  ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
space
  Text
contents <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}$"
    ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline))
  let contentsWithTags :: Text
contentsWithTags
        | Text
mathTag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = Text
contents
        | Bool
otherwise     = Text
"\\begin{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mathTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\\end{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mathTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
  Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.displayMath Text
contentsWithTags


mathTagLaTeX :: Text -> Text
mathTagLaTeX :: Text -> Text
mathTagLaTeX Text
s = case Text
s of
   Text
"equation"  -> Text
""
   Text
"equation*" -> Text
""
   Text
"gather"    -> Text
"gathered"
   Text
"gather*"   -> Text
"gathered"
   Text
"multline"  -> Text
"gathered"
   Text
"multline*" -> Text
"gathered"
   Text
"eqnarray"  -> Text
"aligned"
   Text
"eqnarray*" -> Text
"aligned"
   Text
"align"     -> Text
"aligned"
   Text
"align*"    -> Text
"aligned"
   Text
"alignat"   -> Text
"aligned"
   Text
"alignat*"  -> Text
"aligned"
   Text
_           -> Text
s


mixedList :: PandocMonad m => VwParser m Blocks
mixedList :: VwParser m Blocks
mixedList = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  ([Blocks]
bl, Int
_) <- Int -> VwParser m ([Blocks], Int)
forall (m :: * -> *).
PandocMonad m =>
Int -> VwParser m ([Blocks], Int)
mixedList' (-Int
1)
  Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. [a] -> a
head [Blocks]
bl

mixedList' :: PandocMonad m => Int -> VwParser m ([Blocks], Int)
mixedList' :: Int -> VwParser m ([Blocks], Int)
mixedList' Int
prevInd = do
  (Int
curInd, Text
builder) <- (Int, Text)
-> ParsecT Text ParserState m (Int, Text)
-> ParsecT Text ParserState m (Int, Text)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (-Int
1, Text
"na") (ParsecT Text ParserState m (Int, Text)
-> ParsecT Text ParserState m (Int, Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text ParserState m (Int, Text)
forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart)
  if Int
curInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
prevInd
     then ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Int
curInd)
     else do
          ParsecT Text ParserState m (Int, Text)
forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart
          Blocks
curLine <- VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
listItemContent
          let listBuilder :: [Blocks] -> Blocks
listBuilder =
                if Text
builder Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"ul" then [Blocks] -> Blocks
B.bulletList else [Blocks] -> Blocks
B.orderedList
          ([Blocks]
subList, Int
lowInd) <- Int -> VwParser m ([Blocks], Int)
forall (m :: * -> *).
PandocMonad m =>
Int -> VwParser m ([Blocks], Int)
mixedList' Int
curInd
          if Int
lowInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
curInd
             then do
                  ([Blocks]
sameIndList, Int
endInd) <- Int -> VwParser m ([Blocks], Int)
forall (m :: * -> *).
PandocMonad m =>
Int -> VwParser m ([Blocks], Int)
mixedList' Int
lowInd
                  let curList :: [Blocks]
curList = Blocks -> [Blocks] -> [Blocks]
combineList Blocks
curLine [Blocks]
subList [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ [Blocks]
sameIndList
                  if Int
curInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
prevInd
                     then ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Blocks] -> Blocks
listBuilder [Blocks]
curList], Int
endInd)
                     else ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks]
curList, Int
endInd)
             else do
                  let ([Blocks]
curList, Int
endInd) = (Blocks -> [Blocks] -> [Blocks]
combineList Blocks
curLine [Blocks]
subList,
                                           Int
lowInd)
                  if Int
curInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
prevInd
                     then ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Blocks] -> Blocks
listBuilder [Blocks]
curList], Int
endInd)
                     else ([Blocks], Int) -> VwParser m ([Blocks], Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks]
curList, Int
endInd)

plainInlineML' :: PandocMonad m => Inlines -> VwParser m Blocks
plainInlineML' :: Inlines -> VwParser m Blocks
plainInlineML' Inlines
w = do
  [Inlines]
xs <- ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineML
  ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline
  Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
wInlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:[Inlines]
xs

plainInlineML :: PandocMonad m => VwParser m Blocks
plainInlineML :: VwParser m Blocks
plainInlineML = ParsecT Text ParserState m (Int, Text)
-> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text ParserState m (Int, Text)
forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart ParsecT Text ParserState m ()
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m Char
-> VwParser m Blocks -> VwParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> VwParser m Blocks
forall (m :: * -> *). PandocMonad m => Inlines -> VwParser m Blocks
plainInlineML' Inlines
forall a. Monoid a => a
mempty


listItemContent :: PandocMonad m => VwParser m Blocks
listItemContent :: VwParser m Blocks
listItemContent = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  Inlines
w <- Inlines
-> ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
listTodoMarker
  Blocks
x <- Inlines -> VwParser m Blocks
forall (m :: * -> *). PandocMonad m => Inlines -> VwParser m Blocks
plainInlineML' Inlines
w
  [Blocks]
y <- VwParser m Blocks -> ParsecT Text ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blocksThenInline
  [Blocks]
z <- VwParser m Blocks -> ParsecT Text ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockML
  Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
xBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks]
y [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ [Blocks]
z

blocksThenInline :: PandocMonad m => VwParser m Blocks
blocksThenInline :: VwParser m Blocks
blocksThenInline = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  [Blocks]
y <- VwParser m Blocks -> ParsecT Text ParserState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockML
  Blocks
x <- VwParser m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
plainInlineML
  Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks]
y [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ [Blocks
x]

listTodoMarker :: PandocMonad m => VwParser m Inlines
listTodoMarker :: VwParser m Inlines
listTodoMarker = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  Char
x <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar)
    ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" .oOX")
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Char -> Inlines
makeListMarkerSpan Char
x

makeListMarkerSpan :: Char -> Inlines
makeListMarkerSpan :: Char -> Inlines
makeListMarkerSpan Char
x =
  let cl :: Text
cl = case Char
x of
            Char
' ' -> Text
"done0"
            Char
'.' -> Text
"done1"
            Char
'o' -> Text
"done2"
            Char
'O' -> Text
"done3"
            Char
'X' -> Text
"done4"
            Char
_   -> Text
""
    in
      Attr -> Inlines -> Inlines
B.spanWith (Text
"", [Text
cl], []) Inlines
forall a. Monoid a => a
mempty

combineList :: Blocks -> [Blocks] -> [Blocks]
combineList :: Blocks -> [Blocks] -> [Blocks]
combineList Blocks
x [Blocks
y] = case Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
y of
                            [BulletList [[Block]]
z] -> [[Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
x
                                              [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[[Block]] -> Block
BulletList [[Block]]
z]]
                            [OrderedList ListAttributes
attr [[Block]]
z] -> [[Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
x
                                                    [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attr [[Block]]
z]]
                            [Block]
_ -> Blocks
xBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks
y]
combineList Blocks
x [Blocks]
xs = Blocks
xBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks]
xs

listStart :: PandocMonad m => VwParser m (Int, Text)
listStart :: VwParser m (Int, Text)
listStart = VwParser m (Int, Text) -> VwParser m (Int, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m (Int, Text) -> VwParser m (Int, Text))
-> VwParser m (Int, Text) -> VwParser m (Int, Text)
forall a b. (a -> b) -> a -> b
$ do
  [Char]
s <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
  Text
listType <- VwParser m Text
forall (m :: * -> *). PandocMonad m => VwParser m Text
bulletListMarkers VwParser m Text -> VwParser m Text -> VwParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m Text
forall (m :: * -> *). PandocMonad m => VwParser m Text
orderedListMarkers
  ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
  (Int, Text) -> VwParser m (Int, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s, Text
listType)

bulletListMarkers :: PandocMonad m => VwParser m Text
bulletListMarkers :: VwParser m Text
bulletListMarkers = Text
"ul" Text -> ParsecT Text ParserState m Char -> VwParser m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')

orderedListMarkers :: PandocMonad m => VwParser m Text
orderedListMarkers :: VwParser m Text
orderedListMarkers =
  (Text
"ol" Text -> ParsecT Text ParserState m Int -> VwParser m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$[ParsecT Text ParserState m Int] -> ParsecT Text ParserState m Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (ListNumberStyle
-> ListNumberDelim -> ParsecT Text ParserState m Int
forall s (m :: * -> *).
Stream s m Char =>
ListNumberStyle -> ListNumberDelim -> ParserT s ParserState m Int
orderedListMarker ListNumberStyle
Decimal ListNumberDelim
PeriodParsecT Text ParserState m Int
-> [ParsecT Text ParserState m Int]
-> [ParsecT Text ParserState m Int]
forall a. a -> [a] -> [a]
:(((ListNumberDelim -> ParsecT Text ParserState m Int)
-> ListNumberDelim -> ParsecT Text ParserState m Int
forall a b. (a -> b) -> a -> b
$ListNumberDelim
OneParen) ((ListNumberDelim -> ParsecT Text ParserState m Int)
 -> ParsecT Text ParserState m Int)
-> (ListNumberStyle
    -> ListNumberDelim -> ParsecT Text ParserState m Int)
-> ListNumberStyle
-> ParsecT Text ParserState m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberStyle
-> ListNumberDelim -> ParsecT Text ParserState m Int
forall s (m :: * -> *).
Stream s m Char =>
ListNumberStyle -> ListNumberDelim -> ParserT s ParserState m Int
orderedListMarker (ListNumberStyle -> ParsecT Text ParserState m Int)
-> [ListNumberStyle] -> [ParsecT Text ParserState m Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ListNumberStyle
Decimal, ListNumberStyle
LowerRoman, ListNumberStyle
UpperRoman, ListNumberStyle
LowerAlpha, ListNumberStyle
UpperAlpha])))
    VwParser m Text -> VwParser m Text -> VwParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"ol" Text -> ParsecT Text ParserState m Char -> VwParser m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#')

--many need trimInlines
table :: PandocMonad m => VwParser m Blocks
table :: VwParser m Blocks
table = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  [Char]
indent <- ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar)
  ([Blocks]
th, [[Blocks]]
trs) <- VwParser m ([Blocks], [[Blocks]])
forall (m :: * -> *).
PandocMonad m =>
VwParser m ([Blocks], [[Blocks]])
table1 VwParser m ([Blocks], [[Blocks]])
-> VwParser m ([Blocks], [[Blocks]])
-> VwParser m ([Blocks], [[Blocks]])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m ([Blocks], [[Blocks]])
forall (m :: * -> *).
PandocMonad m =>
VwParser m ([Blocks], [[Blocks]])
table2
  let tab :: Blocks
tab = [Blocks] -> [[Blocks]] -> Blocks
B.simpleTable [Blocks]
th [[Blocks]]
trs
  if [Char]
indent [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
""
    then Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
tab
    else Blocks -> VwParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> VwParser m Blocks) -> Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"", [Text
"center"], []) Blocks
tab

-- table with header
table1 :: PandocMonad m => VwParser m ([Blocks], [[Blocks]])
table1 :: VwParser m ([Blocks], [[Blocks]])
table1 = VwParser m ([Blocks], [[Blocks]])
-> VwParser m ([Blocks], [[Blocks]])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m ([Blocks], [[Blocks]])
 -> VwParser m ([Blocks], [[Blocks]]))
-> VwParser m ([Blocks], [[Blocks]])
-> VwParser m ([Blocks], [[Blocks]])
forall a b. (a -> b) -> a -> b
$ do
  [Blocks]
th <- VwParser m [Blocks]
forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow
  ParsecT Text ParserState m () -> ParsecT Text ParserState m [()]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
tableHeaderSeparator
  [[Blocks]]
trs <- VwParser m [Blocks] -> ParsecT Text ParserState m [[Blocks]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many VwParser m [Blocks]
forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow
  ([Blocks], [[Blocks]]) -> VwParser m ([Blocks], [[Blocks]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks]
th, [[Blocks]]
trs)

-- headerless table
table2 :: PandocMonad m => VwParser m ([Blocks], [[Blocks]])
table2 :: VwParser m ([Blocks], [[Blocks]])
table2 = VwParser m ([Blocks], [[Blocks]])
-> VwParser m ([Blocks], [[Blocks]])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m ([Blocks], [[Blocks]])
 -> VwParser m ([Blocks], [[Blocks]]))
-> VwParser m ([Blocks], [[Blocks]])
-> VwParser m ([Blocks], [[Blocks]])
forall a b. (a -> b) -> a -> b
$ do
  [[Blocks]]
trs <- ParsecT Text ParserState m [Blocks]
-> ParsecT Text ParserState m [[Blocks]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState m [Blocks]
forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow
  ([Blocks], [[Blocks]]) -> VwParser m ([Blocks], [[Blocks]])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Blocks -> [Blocks]
forall a. Int -> a -> [a]
replicate ([Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Blocks] -> Int) -> [Blocks] -> Int
forall a b. (a -> b) -> a -> b
$ [[Blocks]] -> [Blocks]
forall a. [a] -> a
head [[Blocks]]
trs) Blocks
forall a. Monoid a => a
mempty, [[Blocks]]
trs)

tableHeaderSeparator :: PandocMonad m => VwParser m ()
tableHeaderSeparator :: VwParser m ()
tableHeaderSeparator = VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m () -> VwParser m ()) -> VwParser m () -> VwParser m ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
    ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline
  () -> VwParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

tableRow :: PandocMonad m => VwParser m [Blocks]
tableRow :: VwParser m [Blocks]
tableRow = VwParser m [Blocks] -> VwParser m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m [Blocks] -> VwParser m [Blocks])
-> VwParser m [Blocks] -> VwParser m [Blocks]
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
  [Char]
s <- ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text ParserState m [Char]
 -> ParsecT Text ParserState m [Char])
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
    ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline))
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"||" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` ([Char]
"|" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"|")
  ParsecT Text ParserState m Blocks -> VwParser m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
tableCell VwParser m [Blocks]
-> ParsecT Text ParserState m [Char] -> VwParser m [Blocks]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar VwParser m [Blocks]
-> ParsecT Text ParserState m Char -> VwParser m [Blocks]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'

tableCell :: PandocMonad m => VwParser m Blocks
tableCell :: VwParser m Blocks
tableCell = VwParser m Blocks -> VwParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Blocks -> VwParser m Blocks)
-> VwParser m Blocks -> VwParser m Blocks
forall a b. (a -> b) -> a -> b
$
  Inlines -> Blocks
B.plain (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Blocks)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')

placeholder :: PandocMonad m => VwParser m ()
placeholder :: VwParser m ()
placeholder = VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m () -> VwParser m ()) -> VwParser m () -> VwParser m ()
forall a b. (a -> b) -> a -> b
$
  [VwParser m ()] -> VwParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (Text -> VwParser m ()
forall (m :: * -> *). PandocMonad m => Text -> VwParser m ()
ph (Text -> VwParser m ()) -> [Text] -> [VwParser m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text
"title", Text
"date"]) VwParser m () -> VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
noHtmlPh VwParser m () -> VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
templatePh

ph :: PandocMonad m => Text -> VwParser m ()
ph :: Text -> VwParser m ()
ph Text
s = VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m () -> VwParser m ()) -> VwParser m () -> VwParser m ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParsecT Text ParserState m Text
forall s (m :: * -> *) u.
Stream s m Char =>
Text -> ParsecT s u m Text
textStr (Char -> Text -> Text
T.cons Char
'%' Text
s) ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
  Inlines
contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines]
-> ParsecT Text ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Inlines
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text ParserState m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline)
    --use lookAhead because of placeholder in the whitespace parser
  let meta' :: Meta
meta' = Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
s Inlines
contents Meta
nullMeta
  -- this order ensures that later values will be ignored in favor
  -- of earlier ones:
  (ParserState -> ParserState) -> VwParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> VwParser m ())
-> (ParserState -> ParserState) -> VwParser m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st { stateMeta :: Meta
stateMeta = Meta
meta' Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> ParserState -> Meta
stateMeta ParserState
st }

noHtmlPh :: PandocMonad m => VwParser m ()
noHtmlPh :: VwParser m ()
noHtmlPh = VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m () -> VwParser m ()) -> VwParser m () -> VwParser m ()
forall a b. (a -> b) -> a -> b
$
  () () -> ParsecT Text ParserState m [Char] -> VwParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar VwParser m () -> ParsecT Text ParserState m [Char] -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"%nohtml" VwParser m () -> ParsecT Text ParserState m [Char] -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar
    VwParser m () -> ParsecT Text ParserState m Char -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline

templatePh :: PandocMonad m => VwParser m ()
templatePh :: VwParser m ()
templatePh = VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m () -> VwParser m ()) -> VwParser m () -> VwParser m ()
forall a b. (a -> b) -> a -> b
$
  () () -> ParsecT Text ParserState m [Char] -> VwParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar VwParser m () -> ParsecT Text ParserState m [Char] -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"%template" VwParser m () -> ParsecT Text ParserState m [Char] -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
    VwParser m () -> ParsecT Text ParserState m Char -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline

-- inline parser

inline :: PandocMonad m => VwParser m Inlines
inline :: VwParser m Inlines
inline = [VwParser m Inlines] -> VwParser m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([VwParser m Inlines] -> VwParser m Inlines)
-> [VwParser m Inlines] -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ VwParser m () -> VwParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
VwParser m () -> VwParser m Inlines
whitespace VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
endlinePVwParser m Inlines -> [VwParser m Inlines] -> [VwParser m Inlines]
forall a. a -> [a] -> [a]
:[VwParser m Inlines]
forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList

inlineList :: PandocMonad m => [VwParser m Inlines]
inlineList :: [VwParser m Inlines]
inlineList = [  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
bareURL
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
todoMark
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
str
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
strong
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
emph
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
strikeout
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
code
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
link
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
image
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inlineMath
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
tag
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
superscript
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
subscript
             ,  VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
special
             ]

-- inline parser without softbreaks or comment breaks
inline' :: PandocMonad m => VwParser m Inlines
inline' :: VwParser m Inlines
inline' = [VwParser m Inlines] -> VwParser m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([VwParser m Inlines] -> VwParser m Inlines)
-> [VwParser m Inlines] -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
whitespace'VwParser m Inlines -> [VwParser m Inlines] -> [VwParser m Inlines]
forall a. a -> [a] -> [a]
:[VwParser m Inlines]
forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList

-- inline parser for blockquotes
inlineBQ :: PandocMonad m => VwParser m Inlines
inlineBQ :: VwParser m Inlines
inlineBQ = [VwParser m Inlines] -> VwParser m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([VwParser m Inlines] -> VwParser m Inlines)
-> [VwParser m Inlines] -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ VwParser m () -> VwParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
VwParser m () -> VwParser m Inlines
whitespace VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
endlineBQVwParser m Inlines -> [VwParser m Inlines] -> [VwParser m Inlines]
forall a. a -> [a] -> [a]
:[VwParser m Inlines]
forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList

-- inline parser for mixedlists
inlineML :: PandocMonad m => VwParser m Inlines
inlineML :: VwParser m Inlines
inlineML = [VwParser m Inlines] -> VwParser m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([VwParser m Inlines] -> VwParser m Inlines)
-> [VwParser m Inlines] -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ VwParser m () -> VwParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
VwParser m () -> VwParser m Inlines
whitespace VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
endlineMLVwParser m Inlines -> [VwParser m Inlines] -> [VwParser m Inlines]
forall a. a -> [a] -> [a]
:[VwParser m Inlines]
forall (m :: * -> *). PandocMonad m => [VwParser m Inlines]
inlineList

str :: PandocMonad m => VwParser m Inlines
str :: VwParser m Inlines
str = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Text ParserState m Text -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text ParserState m Char -> ParsecT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf ([Char] -> ParserT Text ParserState m Char)
-> [Char] -> ParserT Text ParserState m Char
forall a b. (a -> b) -> a -> b
$ [Char]
spaceChars [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
specialChars)

whitespace :: PandocMonad m => VwParser m () -> VwParser m Inlines
whitespace :: VwParser m () -> VwParser m Inlines
whitespace VwParser m ()
endline = Inlines
B.space Inlines -> VwParser m () -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Text ParserState m Char -> VwParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar VwParser m () -> VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                 VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline ParsecT Text ParserState m Char -> VwParser m () -> VwParser m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
comment VwParser m () -> VwParser m () -> VwParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
placeholder)))
         VwParser m Inlines -> VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Inlines
B.softbreak Inlines -> VwParser m () -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ VwParser m ()
endline

whitespace' :: PandocMonad m => VwParser m Inlines
whitespace' :: VwParser m Inlines
whitespace' = Inlines
B.space Inlines -> ParsecT Text ParserState m () -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar

special :: PandocMonad m => VwParser m Inlines
special :: VwParser m Inlines
special = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Text ParserState m Text -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState 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 ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
specialChars)

bareURL :: PandocMonad m => VwParser m Inlines
bareURL :: VwParser m Inlines
bareURL = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  (Text
orig, Text
src) <- ParserT Text ParserState m (Text, Text)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (Text, Text)
uri ParserT Text ParserState m (Text, Text)
-> ParserT Text ParserState m (Text, Text)
-> ParserT Text ParserState m (Text, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParserT Text ParserState m (Text, Text)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (Text, Text)
emailAddress
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link Text
src Text
"" (Text -> Inlines
B.str Text
orig)

strong :: PandocMonad m => VwParser m Inlines
strong :: VwParser m Inlines
strong = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  [Char]
s <- ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text ParserState m [Char]
 -> ParsecT Text ParserState m [Char])
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*') (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*') (ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text ParserState m Char
 -> ParsecT Text ParserState m [Char])
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"*")
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> Char
forall a. [a] -> a
head [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
spaceChars)
             Bool -> Bool -> Bool
&& ([Char] -> Char
forall a. [a] -> a
last [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
spaceChars)
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
  Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>VwParser m Inlines
-> ParsecT Text ParserState m ()
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
    ParsecT Text ParserState m Char
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
alphaNum)
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Inlines -> Text
makeId Inlines
contents, [], []) Inlines
forall a. Monoid a => a
mempty
    Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
B.strong Inlines
contents

makeId :: Inlines -> Text
makeId :: Inlines -> Text
makeId Inlines
i = [Text] -> Text
T.concat (Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text) -> [Inline] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
i)

emph :: PandocMonad m => VwParser m Inlines
emph :: VwParser m Inlines
emph = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  [Char]
s <- ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text ParserState m [Char]
 -> ParsecT Text ParserState m [Char])
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_') (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_') (ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text ParserState m Char
 -> ParsecT Text ParserState m [Char])
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"_")
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> Char
forall a. [a] -> a
head [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
spaceChars)
          Bool -> Bool -> Bool
&& ([Char] -> Char
forall a. [a] -> a
last [Char]
s Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
spaceChars)
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
  Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>VwParser m Inlines
-> ParsecT Text ParserState m ()
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
    ParsecT Text ParserState m Char
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
alphaNum)
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
B.emph Inlines
contents

strikeout :: PandocMonad m => VwParser m Inlines
strikeout :: VwParser m Inlines
strikeout = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"~~"
  Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>VwParser m Inlines
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState 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 VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' ([Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"~~")
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
B.strikeout Inlines
contents

code :: PandocMonad m => VwParser m Inlines
code :: VwParser m Inlines
code = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`'
  Text
contents <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParserT Text ParserState 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] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`')
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.code Text
contents

superscript :: PandocMonad m => VwParser m Inlines
superscript :: VwParser m Inlines
superscript = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$
  Inlines -> Inlines
B.superscript (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Inlines]
-> ParsecT Text ParserState m [Inlines]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VwParser m Inlines
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState 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 VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^'))

subscript :: PandocMonad m => VwParser m Inlines
subscript :: VwParser m Inlines
subscript = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$
  Inlines -> Inlines
B.subscript (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
",,"
    ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Inlines]
-> ParsecT Text ParserState m [Inlines]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VwParser m Inlines
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState 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 VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline' (ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m [Char]
 -> ParsecT Text ParserState m [Char])
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
",,"))

link :: PandocMonad m => VwParser m Inlines
link :: VwParser m Inlines
link = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[["
  Text
contents <- ParsecT Text ParserState m Text -> ParsecT Text ParserState m Text
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text ParserState m Text
 -> ParsecT Text ParserState m Text)
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall a b. (a -> b) -> a -> b
$ ParserT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar ([Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"]]")
  if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|') Text
contents
                  then do
                    Text
url <- ParserT Text ParserState m Char
-> ParserT Text ParserState m Char
-> ParsecT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (ParserT Text ParserState m Char
 -> ParsecT Text ParserState m Text)
-> ParserT Text ParserState m Char
-> ParsecT Text ParserState m Text
forall a b. (a -> b) -> a -> b
$ Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
                    Inlines
lab <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline ([Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"]]")
                    let tit :: Text
tit = if Text -> Bool
isURI Text
url
                                 then Text
""
                                 else Text
"wikilink"
                    Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link (Text -> Text
procLink Text
url) Text
tit Inlines
lab
                  else do
                    ParserT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParserT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar ([Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"]]")
-- not using try here because [[hell]o]] is not rendered as a link in vimwiki
                    let tit :: Text
tit = if Text -> Bool
isURI Text
contents
                                 then Text
""
                                 else Text
"wikilink"
                    Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link (Text -> Text
procLink Text
contents) Text
tit (Text -> Inlines
B.str Text
contents)

image :: PandocMonad m => VwParser m Inlines
image :: VwParser m Inlines
image = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{"
  [Char]
contentText <- ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text ParserState m [Char]
 -> ParsecT Text ParserState m [Char])
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m [Char]
 -> ParsecT Text ParserState m [Char])
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
  Int -> VwParser m Inlines
forall (m :: * -> *). PandocMonad m => Int -> VwParser m Inlines
images (Int -> VwParser m Inlines) -> Int -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|') [Char]
contentText

images :: PandocMonad m => Int -> VwParser m Inlines
images :: Int -> VwParser m Inlines
images Int
k
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = do
           Text
imgurl <- ParserT Text ParserState m Char
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text ParserState m [Char]
 -> ParserT Text ParserState m [Char])
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
           Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image (Text -> Text
procImgurl Text
imgurl) Text
"" (Text -> Inlines
B.str Text
"")
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = do
           Text
imgurl <- ParserT Text ParserState m Char
-> ParserT Text ParserState m Char
-> ParserT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
           Inlines
alt <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParserT Text ParserState m [Char]
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text ParserState m [Char]
 -> ParserT Text ParserState m [Char])
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
           Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image (Text -> Text
procImgurl Text
imgurl) Text
"" Inlines
alt
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = do
           Text
imgurl <- ParserT Text ParserState m Char
-> ParserT Text ParserState m Char
-> ParserT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
           Inlines
alt <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParserT Text ParserState m Char
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
           Text
attrText <- ParserT Text ParserState m Char
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text ParserState m [Char]
 -> ParserT Text ParserState m [Char])
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
           Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text -> Attr
makeAttr Text
attrText) (Text -> Text
procImgurl Text
imgurl) Text
"" Inlines
alt
  | Bool
otherwise = do
           Text
imgurl <- ParserT Text ParserState m Char
-> ParserT Text ParserState m Char
-> ParserT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
           Inlines
alt <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text ParserState m [Inlines] -> VwParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VwParser m Inlines
-> ParserT Text ParserState m Char
-> ParsecT Text ParserState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill VwParser m Inlines
forall (m :: * -> *). PandocMonad m => VwParser m Inlines
inline (Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
           Text
attrText <- ParserT Text ParserState m Char
-> ParserT Text ParserState m Char
-> ParserT Text ParserState 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
           ParserT Text ParserState m Char
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParserT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
anyChar (ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text ParserState m [Char]
 -> ParserT Text ParserState m [Char])
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}")
           Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text -> Attr
makeAttr Text
attrText) (Text -> Text
procImgurl Text
imgurl) Text
"" Inlines
alt

procLink' :: Text -> Text
procLink' :: Text -> Text
procLink' Text
s
  | Int -> Text -> Text
T.take Int
6 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"local:" = Text
"file" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
5 Text
s
  | Int -> Text -> Text
T.take Int
6 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"diary:" = Text
"diary/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
6 Text
s
  | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((Text -> Text -> Bool
`T.isPrefixOf` Text
s) (Text -> Bool) -> [Text] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Text
"http:", Text
"https:", Text
"ftp:", Text
"file:", Text
"mailto:",
                              Text
"news:", Text
"telnet:" ])
                             = Text
s
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""                  = Text
""
  | Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'          = Text
s
  | Bool
otherwise                = Text
s

procLink :: Text -> Text
procLink :: Text -> Text
procLink Text
s = Text -> Text
procLink' Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y
  where (Text
x, Text
y) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'#') Text
s

procImgurl :: Text -> Text
procImgurl :: Text -> Text
procImgurl Text
s = if Int -> Text -> Text
T.take Int
6 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"local:" then Text
"file" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
5 Text
s else Text
s

inlineMath :: PandocMonad m => VwParser m Inlines
inlineMath :: VwParser m Inlines
inlineMath = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$
  Text -> Inlines
B.math (Text -> Inlines)
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m (Text -> Inlines)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$' ParsecT Text ParserState m (Text -> Inlines)
-> ParsecT Text ParserState m Text -> VwParser m Inlines
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState 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] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$')

tag :: PandocMonad m => VwParser m Inlines
tag :: VwParser m Inlines
tag = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  Text
s <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParserT Text ParserState 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] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
spaceChars) (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
space))
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"::" Text -> Text -> Bool
`T.isInfixOf` (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")
  let ss :: [Text]
ss = (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') Text
s
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
makeTagSpan' ([Text] -> Text
forall a. [a] -> a
head [Text]
ss)Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:(Text -> Inlines
makeTagSpan (Text -> Inlines) -> [Text] -> [Inlines]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
ss)

todoMark :: PandocMonad m => VwParser m Inlines
todoMark :: VwParser m Inlines
todoMark = VwParser m Inlines -> VwParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Inlines -> VwParser m Inlines)
-> VwParser m Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"TODO:"
  Inlines -> VwParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> VwParser m Inlines) -> Inlines -> VwParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"", [Text
"todo"], []) (Text -> Inlines
B.str Text
"TODO:")

-- helper functions and parsers
endlineP :: PandocMonad m => VwParser m ()
endlineP :: VwParser m ()
endlineP = () () -> ParsecT Text ParserState m Char -> VwParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline ParsecT Text ParserState m Char
-> VwParser m () -> ParsecT Text ParserState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
nFBTTBSB ParsecT Text ParserState m Char
-> VwParser m () -> ParsecT Text ParserState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState m Blocks -> VwParser 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
blockQuote)

endlineBQ :: PandocMonad m => VwParser m ()
endlineBQ :: VwParser m ()
endlineBQ = () () -> ParsecT Text ParserState m Char -> VwParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline ParsecT Text ParserState m Char
-> VwParser m () -> ParsecT Text ParserState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
nFBTTBSB ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"    ")

endlineML :: PandocMonad m => VwParser m ()
endlineML :: VwParser m ()
endlineML = () () -> ParsecT Text ParserState m Char -> VwParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline ParsecT Text ParserState m Char
-> VwParser m () -> ParsecT Text ParserState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
nFBTTBSB ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar)

--- nFBTTBSB is short for notFollowedByThingsThatBreakSoftBreaks
nFBTTBSB :: PandocMonad m => VwParser m ()
nFBTTBSB :: VwParser m ()
nFBTTBSB =
    ParsecT Text ParserState m Char -> VwParser 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 ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
newline VwParser m () -> VwParser m () -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    ParsecT Text ParserState m Blocks -> VwParser 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
hrule VwParser m () -> VwParser m () -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    ParsecT Text ParserState m [Blocks] -> VwParser 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 ParserState m [Blocks]
forall (m :: * -> *). PandocMonad m => VwParser m [Blocks]
tableRow VwParser m () -> VwParser m () -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    ParsecT Text ParserState m Blocks -> VwParser 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
header VwParser m () -> VwParser m () -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    ParsecT Text ParserState m (Int, Text) -> VwParser 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 ParserState m (Int, Text)
forall (m :: * -> *). PandocMonad m => VwParser m (Int, Text)
listStart VwParser m () -> VwParser m () -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    ParsecT Text ParserState m Blocks -> VwParser 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
preformatted VwParser m () -> VwParser m () -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    ParsecT Text ParserState m Blocks -> VwParser 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 ParserState m Blocks
forall (m :: * -> *). PandocMonad m => VwParser m Blocks
displayMath VwParser m () -> VwParser m () -> VwParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    VwParser m () -> VwParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy VwParser m ()
forall (m :: * -> *). PandocMonad m => VwParser m ()
hasDefMarker

hasDefMarker :: PandocMonad m => VwParser m ()
hasDefMarker :: VwParser m ()
hasDefMarker = () () -> ParsecT Text ParserState m [Char] -> VwParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") ([Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::" ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
spaceChars)

makeTagSpan' :: Text -> Inlines
makeTagSpan' :: Text -> Inlines
makeTagSpan' Text
s = Attr -> Inlines -> Inlines
B.spanWith (Char -> Text -> Text
T.cons Char
'-' Text
s, [], []) (Text -> Inlines
B.str Text
"") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                  Attr -> Inlines -> Inlines
B.spanWith (Text
s, [Text
"tag"], []) (Text -> Inlines
B.str Text
s)

makeTagSpan :: Text -> Inlines
makeTagSpan :: Text -> Inlines
makeTagSpan Text
s = Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
makeTagSpan' Text
s

mathTagParser :: PandocMonad m => VwParser m Text
mathTagParser :: VwParser m Text
mathTagParser = do
  Text
s <- VwParser m Text -> VwParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (VwParser m Text -> VwParser m Text)
-> VwParser m Text -> VwParser m Text
forall a b. (a -> b) -> a -> b
$ VwParser m Text -> VwParser m Text
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT Text ParserState m Char
-> VwParser m Text -> VwParser m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char -> VwParser 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] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
spaceChars)
    (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m Char
 -> ParsecT Text ParserState m Char)
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf ([Char] -> ParsecT Text ParserState m Char)
-> [Char] -> ParsecT Text ParserState m Char
forall a b. (a -> b) -> a -> b
$ Char
'%'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
spaceChars) ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
space))
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT Text ParserState m Char
-> VwParser m Text -> VwParser m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> VwParser m Text
forall s (m :: * -> *) u.
Stream s m Char =>
Text -> ParsecT s u m Text
textStr Text
s VwParser m Text
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
  Text -> VwParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> VwParser m Text) -> Text -> VwParser m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
mathTagLaTeX Text
s