{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Readers.RST
   Copyright   : Copyright (C) 2006-2022 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion from reStructuredText to 'Pandoc' document.
-}
module Text.Pandoc.Readers.RST ( readRST ) where
import Control.Arrow (second)
import Control.Monad (forM_, guard, liftM, mplus, mzero, when)
import Control.Monad.Except (throwError)
import Control.Monad.Identity (Identity (..))
import Data.Char (isHexDigit, isSpace, toUpper, isAlphaNum)
import Data.List (deleteFirstsBy, elemIndex, nub, sort, transpose)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, maybeToList, isJust)
import Data.Sequence (ViewR (..), viewr)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Builder (Blocks, Inlines, fromList, setMeta, trimInlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem, getTimestamp)
import Text.Pandoc.CSV (CSVOptions (..), defaultCSVOptions, parseCSV)
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.ImageSize (lengthToDim, scaleDimension)
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Shared
import qualified Text.Pandoc.UTF8 as UTF8
import Data.Time.Format
import System.FilePath (takeDirectory)

-- TODO:
-- [ ] .. parsed-literal

-- | Parse reStructuredText string and return Pandoc document.
readRST :: (PandocMonad m, ToSources a)
        => ReaderOptions -- ^ Reader options
        -> a
        -> m Pandoc
readRST :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readRST ReaderOptions
opts a
s = do
  Either PandocError Pandoc
parsed <- forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParserT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM forall (m :: * -> *). PandocMonad m => RSTParser m Pandoc
parseRST forall a. Default a => a
def{ stateOptions :: ReaderOptions
stateOptions = ReaderOptions
opts }
               (Int -> Sources -> Sources
ensureFinalNewlines Int
2 (forall a. ToSources a => a -> Sources
toSources a
s))
  case Either PandocError Pandoc
parsed of
    Right Pandoc
result -> forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result
    Left PandocError
e       -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e

type RSTParser m = ParserT Sources ParserState m

--
-- Constants and data structure definitions
---

bulletListMarkers :: [Char]
bulletListMarkers :: [Char]
bulletListMarkers = [Char]
"*+-•‣⁃"

underlineChars :: [Char]
underlineChars :: [Char]
underlineChars = [Char]
"!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"

-- treat these as potentially non-text when parsing inline:
specialChars :: [Char]
specialChars :: [Char]
specialChars = [Char]
"\\`|*_<>$:/[]{}()-.\"'\8216\8217\8220\8221"

--
-- parsing documents
--

isHeader :: Int -> Block -> Bool
isHeader :: Int -> Block -> Bool
isHeader Int
n (Header Int
x Attr
_ [Inline]
_) = Int
x forall a. Eq a => a -> a -> Bool
== Int
n
isHeader Int
_ Block
_              = Bool
False

-- | Promote all headers in a list of blocks.  (Part of
-- title transformation for RST.)
promoteHeaders :: Int -> [Block] -> [Block]
promoteHeaders :: Int -> [Block] -> [Block]
promoteHeaders Int
num (Header Int
level Attr
attr [Inline]
text:[Block]
rest) =
    Int -> Attr -> [Inline] -> Block
Header (Int
level forall a. Num a => a -> a -> a
- Int
num) Attr
attr [Inline]
textforall a. a -> [a] -> [a]
:Int -> [Block] -> [Block]
promoteHeaders Int
num [Block]
rest
promoteHeaders Int
num (Block
other:[Block]
rest) = Block
otherforall a. a -> [a] -> [a]
:Int -> [Block] -> [Block]
promoteHeaders Int
num [Block]
rest
promoteHeaders Int
_   [] = []

-- | If list of blocks starts with a header (or a header and subheader)
-- of level that are not found elsewhere, return it as a title and
-- promote all the other headers.  Also process a definition list right
-- after the title block as metadata.
titleTransform :: ([Block], Meta)  -- ^ list of blocks, metadata
               -> ([Block], Meta)  -- ^ modified list of blocks, metadata
titleTransform :: ([Block], Meta) -> ([Block], Meta)
titleTransform ([Block]
bs, Meta
meta) =
  let ([Block]
bs', Meta
meta') =
       case [Block]
bs of
          (Header Int
1 Attr
_ [Inline]
head1:Header Int
2 Attr
_ [Inline]
head2:[Block]
rest)
           | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Block -> Bool
isHeader Int
1) [Block]
rest Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Block -> Bool
isHeader Int
2) [Block]
rest) -> -- tit/sub
            (Int -> [Block] -> [Block]
promoteHeaders Int
2 [Block]
rest, forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" (forall a. [a] -> Many a
fromList [Inline]
head1) forall a b. (a -> b) -> a -> b
$
              forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"subtitle" (forall a. [a] -> Many a
fromList [Inline]
head2) Meta
meta)
          (Header Int
1 Attr
_ [Inline]
head1:[Block]
rest)
           | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Block -> Bool
isHeader Int
1) [Block]
rest) -> -- title only
            (Int -> [Block] -> [Block]
promoteHeaders Int
1 [Block]
rest,
                forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" (forall a. [a] -> Many a
fromList [Inline]
head1) Meta
meta)
          [Block]
_ -> ([Block]
bs, Meta
meta)
  in   case [Block]
bs' of
          (DefinitionList [([Inline], [[Block]])]
ds : [Block]
rest) ->
            ([Block]
rest, [([Inline], [[Block]])] -> Meta -> Meta
metaFromDefList [([Inline], [[Block]])]
ds Meta
meta')
          [Block]
_ -> ([Block]
bs', Meta
meta')

metaFromDefList :: [([Inline], [[Block]])] -> Meta -> Meta
metaFromDefList :: [([Inline], [[Block]])] -> Meta -> Meta
metaFromDefList [([Inline], [[Block]])]
ds Meta
meta = Meta -> Meta
adjustAuthors forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a} {a}.
(HasMeta a, ToMetaValue (Many a), Walkable Inline a,
 Monoid (Many a)) =>
(a, [[a]]) -> a -> a
f Meta
meta [([Inline], [[Block]])]
ds
 where f :: (a, [[a]]) -> a -> a
f (a
k,[[a]]
v) = forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta (Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify a
k) (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> Many a
fromList [[a]]
v)
       adjustAuthors :: Meta -> Meta
adjustAuthors (Meta Map Text MetaValue
metamap) = Map Text MetaValue -> Meta
Meta forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
splitAuthors Text
"author"
                                           forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
toPlain Text
"date"
                                           forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
toPlain Text
"title"
                                           forall a b. (a -> b) -> a -> b
$ forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (\Text
k ->
                                                 if Text
k forall a. Eq a => a -> a -> Bool
== Text
"authors"
                                                    then Text
"author"
                                                    else Text
k) Map Text MetaValue
metamap
       toPlain :: MetaValue -> MetaValue
toPlain (MetaBlocks [Para [Inline]
xs]) = [Inline] -> MetaValue
MetaInlines [Inline]
xs
       toPlain MetaValue
x                      = MetaValue
x
       splitAuthors :: MetaValue -> MetaValue
splitAuthors (MetaBlocks [Para [Inline]
xs])
                                      = [MetaValue] -> MetaValue
MetaList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> MetaValue
MetaInlines
                                                 forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]]
splitAuthors' [Inline]
xs
       splitAuthors MetaValue
x                 = MetaValue
x
       splitAuthors' :: [Inline] -> [[Inline]]
splitAuthors'                  = forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> [Inline]
normalizeSpaces forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                         [Inline] -> [[Inline]]
splitOnSemi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
factorSemi
       normalizeSpaces :: [Inline] -> [Inline]
normalizeSpaces                = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Inline -> Bool
isSp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                         forall a. (a -> Bool) -> [a] -> [a]
dropWhile Inline -> Bool
isSp
       isSp :: Inline -> Bool
isSp Inline
Space     = Bool
True
       isSp Inline
SoftBreak = Bool
True
       isSp Inline
LineBreak = Bool
True
       isSp Inline
_         = Bool
False
       splitOnSemi :: [Inline] -> [[Inline]]
splitOnSemi                    = forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (forall a. Eq a => a -> a -> Bool
==Text -> Inline
Str Text
";")
       factorSemi :: Inline -> [Inline]
factorSemi (Str Text
"")            = []
       factorSemi (Str Text
s)             = case (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
==Char
';') Text
s of
                                          (Text
xs,Text
"") -> [Text -> Inline
Str Text
xs]
                                          (Text
xs,Text -> Maybe (Char, Text)
T.uncons -> Just (Char
';',Text
ys)) -> Text -> Inline
Str Text
xs forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
";" forall a. a -> [a] -> [a]
:
                                            Inline -> [Inline]
factorSemi (Text -> Inline
Str Text
ys)
                                          (Text
xs,Text
ys) -> Text -> Inline
Str Text
xs forall a. a -> [a] -> [a]
:
                                            Inline -> [Inline]
factorSemi (Text -> Inline
Str Text
ys)
       factorSemi Inline
x                   = [Inline
x]

parseRST :: PandocMonad m => RSTParser m Pandoc
parseRST :: forall (m :: * -> *). PandocMonad m => RSTParser m Pandoc
parseRST = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines -- skip blank lines at beginning of file
  SourcePos
startPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  -- go through once just to get list of reference keys and notes
  -- docMinusKeys is the raw document with blanks where the keys were...
  let chunk :: ParsecT Sources ParserState m Text
chunk = forall (m :: * -> *). PandocMonad m => RSTParser m Text
referenceKey
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). PandocMonad m => RSTParser m Text
anchorDef
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). Monad m => RSTParser m Text
noteBlock
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). Monad m => RSTParser m Text
citationBlock
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) st a.
Monad m =>
ParsecT Sources st m a -> ParsecT Sources st m (a, Text)
withRaw forall (m :: * -> *). Monad m => RSTParser m (Many Block)
comment)
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). PandocMonad m => RSTParser m Text
headerBlock
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
lineClump
  Sources
docMinusKeys <- [(SourcePos, Text)] -> Sources
Sources forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  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 (do SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                               Text
t <- ParsecT Sources ParserState m Text
chunk
                               forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, Text
t)) forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  -- UGLY: we collapse source position information.
  -- TODO: fix the parser to use the F monad instead of two passes
  forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Sources
docMinusKeys
  forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
startPos
  ParserState
st' <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let reversedNotes :: NoteTable
reversedNotes = ParserState -> NoteTable
stateNotes ParserState
st'
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateNotes :: NoteTable
stateNotes = forall a. [a] -> [a]
reverse NoteTable
reversedNotes
                        , stateIdentifiers :: Set Text
stateIdentifiers = forall a. Monoid a => a
mempty }
  -- now parse it for real...
  [Block]
blocks <- forall a. Many a -> [a]
B.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks
  NoteTable
citations <- forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserState -> Map Text Text
stateCitations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  [(Many Inline, [Many Block])]
citationItems <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
(Text, Text) -> RSTParser m (Many Inline, [Many Block])
parseCitation NoteTable
citations
  let refBlock :: [Block]
refBlock = [Attr -> [Block] -> Block
Div (Text
"citations",[],[]) forall a b. (a -> b) -> a -> b
$
                 forall a. Many a -> [a]
B.toList forall a b. (a -> b) -> a -> b
$ [(Many Inline, [Many Block])] -> Many Block
B.definitionList [(Many Inline, [Many Block])]
citationItems | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Many Inline, [Many Block])]
citationItems)]
  Bool
standalone <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Bool
readerStandalone
  ParserState
state <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let meta :: Meta
meta = ParserState -> Meta
stateMeta ParserState
state
  let ([Block]
blocks', Meta
meta') = if Bool
standalone
                            then ([Block], Meta) -> ([Block], Meta)
titleTransform ([Block]
blocks, Meta
meta)
                            else ([Block]
blocks, Meta
meta)
  forall (m :: * -> *) st s.
(PandocMonad m, HasLogMessages st) =>
ParserT s st m ()
reportLogMessages
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta' ([Block]
blocks' forall a. [a] -> [a] -> [a]
++ [Block]
refBlock)

parseCitation :: PandocMonad m
              => (Text, Text) -> RSTParser m (Inlines, [Blocks])
parseCitation :: forall (m :: * -> *).
PandocMonad m =>
(Text, Text) -> RSTParser m (Many Inline, [Many Block])
parseCitation (Text
ref, Text
raw) = do
  Many Block
contents <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
raw
  forall (m :: * -> *) a. Monad m => a -> m a
return (Attr -> Many Inline -> Many Inline
B.spanWith (Text
ref, [Text
"citation-label"], []) (Text -> Many Inline
B.str Text
ref),
           [Many Block
contents])


--
-- parsing blocks
--

parseBlocks :: PandocMonad m => RSTParser m Blocks
parseBlocks :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
block forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

block :: PandocMonad m => RSTParser m Blocks
block :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
block = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall (m :: * -> *). Monad m => RSTParser m (Many Block)
codeBlock
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
blockQuote
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
fieldList
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
directive
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
anchor
               , forall (m :: * -> *). Monad m => RSTParser m (Many Block)
comment
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
header
               , forall (m :: * -> *) st.
Monad m =>
ParserT Sources st m (Many Block)
hrule
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
lineBlock     -- must go before definitionList
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
table
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
list
               , forall (m :: * -> *). Monad m => RSTParser m (Many Block)
lhsCodeBlock
               , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
para
               , forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
               ] forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"block"

--
-- field list
--

rawFieldListItem :: Monad m => Int -> RSTParser m (Text, Text)
rawFieldListItem :: forall (m :: * -> *). Monad m => Int -> RSTParser m (Text, Text)
rawFieldListItem Int
minIndent = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Int
indent <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
' ')
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
indent forall a. Ord a => a -> a -> Bool
>= Int
minIndent
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':'
  Text
name <- 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 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':')
  (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar
  Text
first <- forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine
  Text
rest <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
indent (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
' ') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar)
                               forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Sources st m Text
indentedBlock
  let raw :: Text
raw = (if Text -> Bool
T.null Text
first then Text
"" else Text
first forall a. Semigroup a => a -> a -> a
<> Text
"\n") forall a. Semigroup a => a -> a -> a
<> Text
rest forall a. Semigroup a => a -> a -> a
<>
            (if Text -> Bool
T.null Text
first Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
rest then Text
"" else Text
"\n")
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Text
raw)

fieldListItem :: PandocMonad m => Int -> RSTParser m (Inlines, [Blocks])
fieldListItem :: forall (m :: * -> *).
PandocMonad m =>
Int -> RSTParser m (Many Inline, [Many Block])
fieldListItem Int
minIndent = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (Text
name, Text
raw) <- forall (m :: * -> *). Monad m => Int -> RSTParser m (Text, Text)
rawFieldListItem Int
minIndent
  Many Inline
term <- forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText Text
name
  Many Block
contents <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
raw
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline
term, [Many Block
contents])

fieldList :: PandocMonad m => RSTParser m Blocks
fieldList :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
fieldList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Int
indent <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar)
  [(Many Inline, [Many Block])]
items <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
Int -> RSTParser m (Many Inline, [Many Block])
fieldListItem Int
indent
  case [(Many Inline, [Many Block])]
items of
     []     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     [(Many Inline, [Many Block])]
items' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(Many Inline, [Many Block])] -> Many Block
B.definitionList [(Many Inline, [Many Block])]
items'

--
-- line block
--

lineBlock :: PandocMonad m => RSTParser m Blocks
lineBlock :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
lineBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  [Text]
lines' <- forall (m :: * -> *) st. Monad m => ParserT Sources st m [Text]
lineBlockLines
  [Many Inline]
lines'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText [Text]
lines'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Many Inline] -> Many Block
B.lineBlock [Many Inline]
lines''

lineBlockDirective :: PandocMonad m => Text -> RSTParser m Blocks
lineBlockDirective :: forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Block)
lineBlockDirective Text
body = do
  [Many Inline]
lines' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text -> Text
stripTrailingNewlines Text
body
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Many Inline] -> Many Block
B.lineBlock [Many Inline]
lines'

--
-- paragraph block
--

-- note: paragraph can end in a :: starting a code block
para :: PandocMonad m => RSTParser m Blocks
para :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
para = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Many Inline
result <- Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline
  forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Many Inline -> Many Block
B.plain Many Inline
result) forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
    forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
    case forall a. Seq a -> ViewR a
viewr (forall a. Many a -> Seq a
B.unMany Many Inline
result) of
         Seq Inline
ys :> Str Text
xs | Text
"::" Text -> Text -> Bool
`T.isSuffixOf` Text
xs -> do
              Many Block
raw <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Monoid a => a
mempty forall (m :: * -> *). Monad m => RSTParser m (Many Block)
codeBlockBody
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.para (forall a. Seq a -> Many a
B.Many Seq Inline
ys forall a. Semigroup a => a -> a -> a
<> Text -> Many Inline
B.str (Int -> Text -> Text
T.take (Text -> Int
T.length Text
xs forall a. Num a => a -> a -> a
- Int
1) Text
xs))
                         forall a. Semigroup a => a -> a -> a
<> Many Block
raw
         ViewR Inline
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> Many Block
B.para Many Inline
result)

plain :: PandocMonad m => RSTParser m Blocks
plain :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
plain = Many Inline -> Many Block
B.plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline

--
-- header blocks
--

header :: PandocMonad m => RSTParser m Blocks
header :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
header = forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
doubleHeader forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
singleHeader forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"header"

-- a header with lines on top and bottom
doubleHeader :: PandocMonad m => RSTParser m Blocks
doubleHeader :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
doubleHeader = do
  (Many Inline
txt, Char
c) <- forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Char)
doubleHeader'
  -- check to see if we've had this kind of header before.
  -- if so, get appropriate level.  if not, add to list.
  ParserState
state <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let headerTable :: [HeaderType]
headerTable = ParserState -> [HeaderType]
stateHeaderTable ParserState
state
  let ([HeaderType]
headerTable',Int
level) = case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Char -> HeaderType
DoubleHeader Char
c) [HeaderType]
headerTable of
        Just Int
ind -> ([HeaderType]
headerTable, Int
ind forall a. Num a => a -> a -> a
+ Int
1)
        Maybe Int
Nothing  -> ([HeaderType]
headerTable forall a. [a] -> [a] -> [a]
++ [Char -> HeaderType
DoubleHeader Char
c], forall (t :: * -> *) a. Foldable t => t a -> Int
length [HeaderType]
headerTable forall a. Num a => a -> a -> a
+ Int
1)
  forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (ParserState
state { stateHeaderTable :: [HeaderType]
stateHeaderTable = [HeaderType]
headerTable' })
  Attr
attr <- forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
 HasIdentifierList st) =>
Attr -> Many Inline -> ParserT s st m Attr
registerHeader Attr
nullAttr Many Inline
txt
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Many Inline -> Many Block
B.headerWith Attr
attr Int
level Many Inline
txt

doubleHeader' :: PandocMonad m => RSTParser m (Inlines, Char)
doubleHeader' :: forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Char)
doubleHeader' = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Char
c <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
underlineChars
  [Char]
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
c)  -- the top line
  let lenTop :: Int
lenTop = forall (t :: * -> *) a. Foldable t => t a -> Int
length (Char
cforall a. a -> [a] -> [a]
:[Char]
rest)
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m ()
skipSpaces
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
  Many Inline
txt <- Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline)
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let len :: Int
len = SourcePos -> Int
sourceColumn SourcePos
pos forall a. Num a => a -> a -> a
- Int
1
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
> Int
lenTop) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Prelude.fail [Char]
"title longer than border"
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline              -- spaces and newline
  forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
lenTop (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
c)  -- the bottom line
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline
txt, Char
c)

-- a header with line on the bottom only
singleHeader :: PandocMonad m => RSTParser m Blocks
singleHeader :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
singleHeader = do
  (Many Inline
txt, Char
c) <- forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Char)
singleHeader'
  ParserState
state <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let headerTable :: [HeaderType]
headerTable = ParserState -> [HeaderType]
stateHeaderTable ParserState
state
  let ([HeaderType]
headerTable',Int
level) = case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Char -> HeaderType
SingleHeader Char
c) [HeaderType]
headerTable of
        Just Int
ind -> ([HeaderType]
headerTable, Int
ind forall a. Num a => a -> a -> a
+ Int
1)
        Maybe Int
Nothing  -> ([HeaderType]
headerTable forall a. [a] -> [a] -> [a]
++ [Char -> HeaderType
SingleHeader Char
c], forall (t :: * -> *) a. Foldable t => t a -> Int
length [HeaderType]
headerTable forall a. Num a => a -> a -> a
+ Int
1)
  forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (ParserState
state { stateHeaderTable :: [HeaderType]
stateHeaderTable = [HeaderType]
headerTable' })
  Attr
attr <- forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
 HasIdentifierList st) =>
Attr -> Many Inline -> ParserT s st m Attr
registerHeader Attr
nullAttr Many Inline
txt
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Many Inline -> Many Block
B.headerWith Attr
attr Int
level Many Inline
txt

singleHeader' :: PandocMonad m => RSTParser m (Inlines, Char)
singleHeader' :: forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Char)
singleHeader' = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
whitespace
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
underlineChars
  Many Inline
txt <- Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline)
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let len :: Int
len = SourcePos -> Int
sourceColumn SourcePos
pos forall a. Num a => a -> a -> a
- Int
1
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline
  Char
c <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
underlineChars
  forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count (Int
len forall a. Num a => a -> a -> a
- Int
1) (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
c)
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
c)
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline
txt, Char
c)

--
-- hrule block
--

hrule :: Monad m => ParserT Sources st m Blocks
hrule :: forall (m :: * -> *) st.
Monad m =>
ParserT Sources st m (Many Block)
hrule = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Char
chr <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
underlineChars
  forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
3 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
chr)
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
chr)
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
B.horizontalRule

--
-- code blocks
--

-- read a line indented by a given string
indentedLine :: (HasReaderOptions st, Monad m)
             => Int -> ParserT Sources st m Text
indentedLine :: forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParserT Sources st m Text
indentedLine Int
indents = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar
  forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParserT Sources st m Int
gobbleAtMostSpaces Int
indents
  forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine

-- one or more indented lines, possibly separated by blank lines.
-- any amount of indentation will work.
indentedBlock :: (HasReaderOptions st, Monad m)
              => ParserT Sources st m Text
indentedBlock :: forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Sources st m Text
indentedBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Int
indents <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar)
  [Text]
lns <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do Text
b <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
                          Text
l <- forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParserT Sources st m Text
indentedLine Int
indents
                          forall (m :: * -> *) a. Monad m => a -> m a
return (Text
b forall a. Semigroup a => a -> a -> a
<> Text
l)
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
lns

quotedBlock :: Monad m => ParserT Sources st m Text
quotedBlock :: forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
quotedBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    Char
quote <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"
    [Text]
lns <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
quote) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine
    forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
lns

codeBlockStart :: Monad m => ParserT Sources st m Char
codeBlockStart :: forall (m :: * -> *) st. Monad m => ParserT Sources st m Char
codeBlockStart = forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline

codeBlock :: Monad m => ParserT Sources ParserState m Blocks
codeBlock :: forall (m :: * -> *). Monad m => RSTParser m (Many Block)
codeBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) st. Monad m => ParserT Sources st m Char
codeBlockStart forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). Monad m => RSTParser m (Many Block)
codeBlockBody

codeBlockBody :: Monad m => ParserT Sources ParserState m Blocks
codeBlockBody :: forall (m :: * -> *). Monad m => RSTParser m (Many Block)
codeBlockBody = do
  Maybe Text
lang <- ParserState -> Maybe Text
stateRstHighlight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Block
B.codeBlockWith (Text
"", forall a. Maybe a -> [a]
maybeToList Maybe Text
lang, []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripTrailingNewlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Sources st m Text
indentedBlock forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
quotedBlock)

lhsCodeBlock :: Monad m => RSTParser m Blocks
lhsCodeBlock :: forall (m :: * -> *). Monad m => RSTParser m (Many Block)
lhsCodeBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
==Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Int
sourceColumn
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_literate_haskell
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *) st. Monad m => ParserT Sources st m Char
codeBlockStart
  [Text]
lns <- forall (m :: * -> *) st. Monad m => ParserT Sources st m [Text]
latexCodeBlock forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) st. Monad m => ParserT Sources st m [Text]
birdCodeBlock
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Block
B.codeBlockWith (Text
"", [Text
"haskell",Text
"literate"], [])
         forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
lns

latexCodeBlock :: Monad m => ParserT Sources st m [Text]
latexCodeBlock :: forall (m :: * -> *) st. Monad m => ParserT Sources st m [Text]
latexCodeBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall {s} {m :: * -> *} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
latexBlockLine [Char]
"\\begin{code}")
  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 forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall {s} {m :: * -> *} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
latexBlockLine [Char]
"\\end{code}")
 where
  latexBlockLine :: [Char] -> ParsecT s u m Char
latexBlockLine [Char]
s = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline

birdCodeBlock :: Monad m => ParserT Sources st m [Text]
birdCodeBlock :: forall (m :: * -> *) st. Monad m => ParserT Sources st m [Text]
birdCodeBlock = [Text] -> [Text]
filterSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
birdTrackLine
  where filterSpace :: [Text] -> [Text]
filterSpace [Text]
lns =
            -- if (as is normal) there is always a space after >, drop it
            if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Text
ln -> Text -> Bool
T.null Text
ln Bool -> Bool -> Bool
|| Int -> Text -> Text
T.take Int
1 Text
ln forall a. Eq a => a -> a -> Bool
== Text
" ") [Text]
lns
               then forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.drop Int
1) [Text]
lns
               else [Text]
lns

birdTrackLine :: Monad m => ParserT Sources st m Text
birdTrackLine :: forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
birdTrackLine = forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine

--
-- block quotes
--

blockQuote :: PandocMonad m => RSTParser m Blocks
blockQuote :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
blockQuote = do
  Text
raw <- forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Sources st m Text
indentedBlock
  -- parse the extracted block, which may contain various block elements:
  Many Block
contents <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks forall a b. (a -> b) -> a -> b
$ Text
raw forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Block -> Many Block
B.blockQuote Many Block
contents

{-
Unsupported options for include:
tab-width
encoding
-}

includeDirective :: PandocMonad m
                 => Text
                 -> [(Text, Text)]
                 -> Text
                 -> RSTParser m Blocks
includeDirective :: forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> Text -> RSTParser m (Many Block)
includeDirective Text
top NoteTable
fields Text
body = do
  let f :: [Char]
f = Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text
trim Text
top
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
f
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null (Text -> Text
trim Text
body)
  let startLine :: Maybe Int
startLine = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start-line" NoteTable
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  let endLine :: Maybe Int
endLine = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"end-line" NoteTable
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  let classes :: [Text]
classes =  forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" NoteTable
fields)
  let ident :: Text
ident = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
trimr forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"name" NoteTable
fields
  let parser :: RSTParser m (Many Block)
parser =
       case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"code" NoteTable
fields forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"literal" NoteTable
fields of
         Just Text
lang ->
           (Text -> [Text] -> NoteTable -> Text -> Bool -> Text -> Many Block
codeblock Text
ident [Text]
classes NoteTable
fields (Text -> Text
trimr Text
lang) Bool
False
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> Text
sourcesToText) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
         Maybe Text
Nothing   -> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks
  let isLiteral :: Bool
isLiteral = forall a. Maybe a -> Bool
isJust (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"code" NoteTable
fields forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"literal" NoteTable
fields)
  let selectLines :: [Text] -> [Text]
selectLines =
        (case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"end-before" NoteTable
fields of
                         Just Text
patt -> forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
patt Text -> Text -> Bool
`T.isInfixOf`))
                         Maybe Text
Nothing   -> forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start-after" NoteTable
fields of
                         Just Text
patt -> forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
patt Text -> Text -> Bool
`T.isInfixOf`))
                         Maybe Text
Nothing   -> forall a. a -> a
id)

  let toStream :: Text -> Sources
toStream Text
t =
        [(SourcePos, Text)] -> Sources
Sources [([Char] -> SourcePos
initialPos [Char]
f,
                   ([Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
selectLines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text
t) forall a. Semigroup a => a -> a -> a
<>
                    if Bool
isLiteral then forall a. Monoid a => a
mempty else Text
"\n")]  -- see #7436
  [Char]
currentDir <- [Char] -> [Char]
takeDirectory forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> [Char]
sourceName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (m :: * -> *) st a b.
(PandocMonad m, HasIncludeFiles st) =>
ParserT a st m b
-> (Text -> a)
-> [[Char]]
-> [Char]
-> Maybe Int
-> Maybe Int
-> ParserT a st m b
insertIncludedFile RSTParser m (Many Block)
parser Text -> Sources
toStream [[Char]
currentDir] [Char]
f Maybe Int
startLine Maybe Int
endLine

--
-- list blocks
--

list :: PandocMonad m => RSTParser m Blocks
list :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
list = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
bulletList, forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
orderedList, forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
definitionList ] forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"list"

definitionListItem :: PandocMonad m => RSTParser m (Inlines, [Blocks])
definitionListItem :: forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, [Many Block])
definitionListItem = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  -- avoid capturing a directive or comment
  forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'.')
  Many Inline
term <- Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
endline
  Text
raw <- forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Sources st m Text
indentedBlock
  -- parse the extracted block, which may contain various block elements:
  Many Block
contents <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks forall a b. (a -> b) -> a -> b
$ Text
raw forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline
term, [Many Block
contents])

definitionList :: PandocMonad m => RSTParser m Blocks
definitionList :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
definitionList = [(Many Inline, [Many Block])] -> Many Block
B.definitionList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, [Many Block])
definitionListItem

-- parses bullet list start and returns its length (inc. following whitespace)
bulletListStart :: Monad m => ParserT Sources st m Int
bulletListStart :: forall (m :: * -> *) st. Monad m => ParserT Sources st m Int
bulletListStart = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' forall (m :: * -> *) st.
Monad m =>
ParserT Sources st m (Many Block)
hrule  -- because hrules start out just like lists
  Char
marker <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
bulletListMarkers
  [Char]
white <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char]
"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (Char
markerforall a. a -> [a] -> [a]
:[Char]
white)

-- parses ordered list start and returns its length (inc following whitespace)
orderedListStart :: Monad m => ListNumberStyle
                 -> ListNumberDelim
                 -> RSTParser m Int
orderedListStart :: forall (m :: * -> *).
Monad m =>
ListNumberStyle -> ListNumberDelim -> RSTParser m Int
orderedListStart ListNumberStyle
style ListNumberDelim
delim = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (Int
_, Int
markerLen) <- forall s (m :: * -> *) st a.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m a -> ParserT s st m (a, Int)
withHorizDisplacement (forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ListNumberStyle -> ListNumberDelim -> ParserT s ParserState m Int
orderedListMarker ListNumberStyle
style ListNumberDelim
delim)
  [Char]
white <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char]
"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
markerLen forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
white

-- parse a line of a list item
listLine :: Monad m => Int -> RSTParser m Text
listLine :: forall (m :: * -> *). Monad m => Int -> RSTParser m Text
listLine Int
markerLength = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st) =>
Int -> ParserT s st m Text
indentWith Int
markerLength
  forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLineNewline

-- parse raw text for one list item, excluding start marker and continuations
rawListItem :: Monad m => RSTParser m Int
            -> RSTParser m (Int, Text)
rawListItem :: forall (m :: * -> *).
Monad m =>
RSTParser m Int -> RSTParser m (Int, Text)
rawListItem RSTParser m Int
start = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Int
markerLength <- RSTParser m Int
start
  Text
firstLine <- forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLineNewline
  [Text]
restLines <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *). Monad m => Int -> RSTParser m Text
listLine Int
markerLength)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
markerLength, Text
firstLine forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
restLines)

-- continuation of a list item - indented and separated by blankline or
-- (in compact lists) endline.
-- Note: nested lists are parsed as continuations.
listContinuation :: Monad m => Int -> RSTParser m Text
listContinuation :: forall (m :: * -> *). Monad m => Int -> RSTParser m Text
listContinuation Int
markerLength = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
blanks <- forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline
  [Text]
result <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *). Monad m => Int -> RSTParser m Text
listLine Int
markerLength)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
blanks forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
result

listItem :: PandocMonad m
         => RSTParser m Int
         -> RSTParser m Blocks
listItem :: forall (m :: * -> *).
PandocMonad m =>
RSTParser m Int -> RSTParser m (Many Block)
listItem RSTParser m Int
start = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (Int
markerLength, Text
first) <- forall (m :: * -> *).
Monad m =>
RSTParser m Int -> RSTParser m (Int, Text)
rawListItem RSTParser m Int
start
  [Text]
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *). Monad m => Int -> RSTParser m Text
listContinuation Int
markerLength)
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead RSTParser m Int
start
  -- parsing with ListItemState forces markers at beginning of lines to
  -- count as list item markers, even if not separated by blank space.
  -- see definition of "endline"
  ParserState
state <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let oldContext :: ParserContext
oldContext = ParserState -> ParserContext
stateParserContext ParserState
state
  forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState forall a b. (a -> b) -> a -> b
$ ParserState
state {stateParserContext :: ParserContext
stateParserContext = ParserContext
ListItemState}
  -- parse the extracted block, which may itself contain block elements
  Many Block
parsed <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat (Text
firstforall a. a -> [a] -> [a]
:[Text]
rest) forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\ParserState
st -> ParserState
st {stateParserContext :: ParserContext
stateParserContext = ParserContext
oldContext})
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a. Many a -> [a]
B.toList Many Block
parsed of
                [Para [Inline]
xs] ->
                   forall a. a -> Many a
B.singleton forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Plain [Inline]
xs
                [Para [Inline]
xs, BulletList [[Block]]
ys] ->
                   forall a. [a] -> Many a
B.fromList [[Inline] -> Block
Plain [Inline]
xs, [[Block]] -> Block
BulletList [[Block]]
ys]
                [Para [Inline]
xs, OrderedList ListAttributes
s [[Block]]
ys] ->
                   forall a. [a] -> Many a
B.fromList [[Inline] -> Block
Plain [Inline]
xs, ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
s [[Block]]
ys]
                [Para [Inline]
xs, DefinitionList [([Inline], [[Block]])]
ys] ->
                   forall a. [a] -> Many a
B.fromList [[Inline] -> Block
Plain [Inline]
xs, [([Inline], [[Block]])] -> Block
DefinitionList [([Inline], [[Block]])]
ys]
                [Block]
_         -> Many Block
parsed

orderedList :: PandocMonad m => RSTParser m Blocks
orderedList :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
orderedList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (Int
start, ListNumberStyle
style, ListNumberDelim
delim) <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s ParserState m ListAttributes
anyOrderedListMarker forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar)
  [Many Block]
items <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *).
PandocMonad m =>
RSTParser m Int -> RSTParser m (Many Block)
listItem (forall (m :: * -> *).
Monad m =>
ListNumberStyle -> ListNumberDelim -> RSTParser m Int
orderedListStart ListNumberStyle
style ListNumberDelim
delim))
  let items' :: [Many Block]
items' = [Many Block] -> [Many Block]
compactify [Many Block]
items
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Many Block] -> Many Block
B.orderedListWith (Int
start, ListNumberStyle
style, ListNumberDelim
delim) [Many Block]
items'

bulletList :: PandocMonad m => RSTParser m Blocks
bulletList :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
bulletList = [Many Block] -> Many Block
B.bulletList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Block] -> [Many Block]
compactify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *).
PandocMonad m =>
RSTParser m Int -> RSTParser m (Many Block)
listItem forall (m :: * -> *) st. Monad m => ParserT Sources st m Int
bulletListStart)

--
-- directive (e.g. comment, container, compound-paragraph)
--

comment :: Monad m => RSTParser m Blocks
comment :: forall (m :: * -> *). Monad m => RSTParser m (Many Block)
comment = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
".."
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline)
  -- notFollowedBy' directiveLabel -- comment comes after directive so unnec.
  Text
_ <- forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Sources st m Text
indentedBlock
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

directiveLabel :: Monad m => RSTParser m Text
directiveLabel :: forall (m :: * -> *). Monad m => RSTParser m Text
directiveLabel = Text -> Text
T.toLower
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-') (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::")

directive :: PandocMonad m => RSTParser m Blocks
directive :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
directive = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
".."
  forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
directive'

directive' :: PandocMonad m => RSTParser m Blocks
directive' :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
directive' = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar
  Text
label <- forall (m :: * -> *). Monad m => RSTParser m Text
directiveLabel
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar
  Text
top <- forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
manyChar forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/=Char
'\n')
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                      forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' (forall (m :: * -> *). Monad m => Int -> RSTParser m (Text, Text)
rawFieldListItem Int
1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                      forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                      forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline)
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
  NoteTable
fields <- do
    Int
fieldIndent <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
' '))
    if Int
fieldIndent forall a. Eq a => a -> a -> Bool
== Int
0
       then forall (m :: * -> *) a. Monad m => a -> m a
return []
       else forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Int -> RSTParser m (Text, Text)
rawFieldListItem Int
fieldIndent
  Text
body <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Sources st m Text
indentedBlock
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  let body' :: Text
body' = Text
body forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
      name :: Text
name = Text -> Text
trim forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"name" NoteTable
fields)
      classes :: [Text]
classes = Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
trim (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" NoteTable
fields)
      keyvals :: NoteTable
keyvals = [(Text
k, Text -> Text
trim Text
v) | (Text
k, Text
v) <- NoteTable
fields, Text
k forall a. Eq a => a -> a -> Bool
/= Text
"name", Text
k forall a. Eq a => a -> a -> Bool
/= Text
"class"]
      imgAttr :: Text -> (Text, [Text], [(a, Text)])
imgAttr Text
cl = (Text
name, [Text]
classes forall a. [a] -> [a] -> [a]
++ [Text]
alignClasses, [(a, Text)]
widthAttr forall a. [a] -> [a] -> [a]
++ [(a, Text)]
heightAttr)
        where
          alignClasses :: [Text]
alignClasses = Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
trim (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
cl NoteTable
fields) forall a. Semigroup a => a -> a -> a
<>
                          forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
x -> Text
"align-" forall a. Semigroup a => a -> a -> a
<> Text -> Text
trim Text
x)
                          (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"align" NoteTable
fields)
          scale :: Double
scale = case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"scale" NoteTable
fields of
                    Just Text
v -> case Text -> Maybe (Text, Char)
T.unsnoc Text
v of
                      Just (Text
vv, Char
'%') -> case forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
vv of
                                          Just (Double
percent :: Double)
                                            -> Double
percent forall a. Fractional a => a -> a -> a
/ Double
100.0
                                          Maybe Double
Nothing -> Double
1.0
                      Maybe (Text, Char)
_ -> case forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
v of
                             Just (Double
s :: Double) -> Double
s
                             Maybe Double
Nothing            -> Double
1.0
                    Maybe Text
Nothing -> Double
1.0
          widthAttr :: [(a, Text)]
widthAttr = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Dimension
x -> [(a
"width",
                                        forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ Double -> Dimension -> Dimension
scaleDimension Double
scale Dimension
x)])
                        forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" NoteTable
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                          (Text -> Maybe Dimension
lengthToDim forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))
          heightAttr :: [(a, Text)]
heightAttr = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Dimension
x -> [(a
"height",
                                         forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ Double -> Dimension -> Dimension
scaleDimension Double
scale Dimension
x)])
                        forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"height" NoteTable
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                          (Text -> Maybe Dimension
lengthToDim forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))
  case Text
label of
        Text
"include" -> forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> Text -> RSTParser m (Many Block)
includeDirective Text
top NoteTable
fields Text
body'
        Text
"table" -> forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> Text -> RSTParser m (Many Block)
tableDirective Text
top NoteTable
fields Text
body'
        Text
"list-table" -> forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> Text -> RSTParser m (Many Block)
listTableDirective Text
top NoteTable
fields Text
body'
        Text
"csv-table" -> forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> Text -> RSTParser m (Many Block)
csvTableDirective Text
top NoteTable
fields Text
body'
        Text
"line-block" -> forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Block)
lineBlockDirective Text
body'
        Text
"raw" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Block
B.rawBlock (Text -> Text
trim Text
top) (Text -> Text
stripTrailingNewlines Text
body)
        Text
"role" -> forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> RSTParser m (Many Block)
addNewRole Text
top forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Text
trim) NoteTable
fields
        Text
"container" -> Attr -> Many Block -> Many Block
B.divWith
                         (Text
name, Text
"container" forall a. a -> [a] -> [a]
: Text -> [Text]
T.words Text
top forall a. [a] -> [a] -> [a]
++ [Text]
classes, []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body'
        Text
"replace" -> Many Inline -> Many Block
B.para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  -- consumed by substKey
                   forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText (Text -> Text
trim Text
top)
        Text
"date" -> Many Inline -> Many Block
B.para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do  -- consumed by substKey
                     UTCTime
t <- forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp
                     let format :: [Char]
format = case Text -> [Char]
T.unpack (Text -> Text
T.strip Text
top) of
                                    [] -> [Char]
"%Y-%m-%d"
                                    [Char]
x  -> [Char]
x
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.text forall a b. (a -> b) -> a -> b
$
                              [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
format UTCTime
t
        Text
"unicode" -> Many Inline -> Many Block
B.para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  -- consumed by substKey
                   forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText (Text -> Text
trim forall a b. (a -> b) -> a -> b
$ Text -> Text
unicodeTransform Text
top)
        Text
"compound" -> forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body'
        Text
"pull-quote" -> Many Block -> Many Block
B.blockQuote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body'
        Text
"epigraph" -> Many Block -> Many Block
B.blockQuote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body'
        Text
"highlights" -> Many Block -> Many Block
B.blockQuote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body'
        Text
"rubric" -> Many Inline -> Many Block
B.para forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
B.strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText Text
top
        Text
_ | Text
label forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"attention",Text
"caution",Text
"danger",Text
"error",Text
"hint",
                          Text
"important",Text
"note",Text
"tip",Text
"warning",Text
"admonition"] ->
           do Many Block
bod <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks forall a b. (a -> b) -> a -> b
$ Text
top forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" forall a. Semigroup a => a -> a -> a
<> Text
body'
              let lab :: Many Block
lab = case Text
label of
                          Text
"admonition" -> forall a. Monoid a => a
mempty
                          (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
l, Text
ls))
                            -> Attr -> Many Block -> Many Block
B.divWith (Text
"",[Text
"title"],[])
                                          (Many Inline -> Many Block
B.para (Text -> Many Inline
B.str forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
l)  Text
ls))
                          Text
_ -> forall a. Monoid a => a
mempty
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Many Block -> Many Block
B.divWith (Text
name,Text
labelforall a. a -> [a] -> [a]
:[Text]
classes,NoteTable
keyvals) (Many Block
lab forall a. Semigroup a => a -> a -> a
<> Many Block
bod)
        Text
"sidebar" ->
           do let subtit :: Text
subtit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
trim forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"subtitle" NoteTable
fields
              Many Block
tit <- Many Inline -> Many Block
B.para forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
B.strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText
                          (Text -> Text
trim Text
top forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
subtit
                                          then Text
""
                                          else Text
":  " forall a. Semigroup a => a -> a -> a
<> Text
subtit)
              Many Block
bod <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body'
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Many Block -> Many Block
B.divWith (Text
name,Text
"sidebar"forall a. a -> [a] -> [a]
:[Text]
classes,NoteTable
keyvals) forall a b. (a -> b) -> a -> b
$ Many Block
tit forall a. Semigroup a => a -> a -> a
<> Many Block
bod
        Text
"topic" ->
           do Many Block
tit <- Many Inline -> Many Block
B.para forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
B.strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText Text
top
              Many Block
bod <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body'
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Many Block -> Many Block
B.divWith (Text
name,Text
"topic"forall a. a -> [a] -> [a]
:[Text]
classes,NoteTable
keyvals) forall a b. (a -> b) -> a -> b
$ Many Block
tit forall a. Semigroup a => a -> a -> a
<> Many Block
bod
        Text
"default-role" -> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\ParserState
s ->
                              ParserState
s { stateRstDefaultRole :: Text
stateRstDefaultRole =
                                  case Text -> Text
trim Text
top of
                                     Text
""   -> ParserState -> Text
stateRstDefaultRole forall a. Default a => a
def
                                     Text
role -> Text
role })
        Text
"highlight" -> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\ParserState
s ->
                              ParserState
s { stateRstHighlight :: Maybe Text
stateRstHighlight =
                                  case Text -> Text
trim Text
top of
                                     Text
""   -> ParserState -> Maybe Text
stateRstHighlight forall a. Default a => a
def
                                     Text
lang -> forall a. a -> Maybe a
Just Text
lang })
        Text
x | Text
x forall a. Eq a => a -> a -> Bool
== Text
"code" Bool -> Bool -> Bool
|| Text
x forall a. Eq a => a -> a -> Bool
== Text
"code-block" Bool -> Bool -> Bool
|| Text
x forall a. Eq a => a -> a -> Bool
== Text
"sourcecode" ->
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> NoteTable -> Text -> Bool -> Text -> Many Block
codeblock Text
name [Text]
classes (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Text
trimr) NoteTable
fields)
             (Text -> Text
trim Text
top) Bool
True Text
body
        Text
"aafig" -> do
          let attribs :: Attr
attribs = (Text
name, [Text
"aafig"], forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Text
trimr) NoteTable
fields)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Block
B.codeBlockWith Attr
attribs forall a b. (a -> b) -> a -> b
$ Text -> Text
stripTrailingNewlines Text
body
        Text
"math" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.para
                  forall a b. (a -> b) -> a -> b
$ (case Text -> [Text] -> NoteTable -> Attr
mkAttr Text
name [Text]
classes NoteTable
fields of
                       Attr
attr | Attr
attr forall a. Eq a => a -> a -> Bool
== Attr
nullAttr -> forall a. a -> a
id
                            | Bool
otherwise        -> Attr -> Many Inline -> Many Inline
B.spanWith Attr
attr)
                  forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Many Inline
B.displayMath
                  forall a b. (a -> b) -> a -> b
$ Text -> [Text]
toChunks forall a b. (a -> b) -> a -> b
$ Text
top forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" forall a. Semigroup a => a -> a -> a
<> Text
body
        Text
"figure" -> do
           (Many Inline
caption, Many Block
legend) <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Many Block)
extractCaption Text
body'
           let src :: Text
src = Text -> Text
escapeURI forall a b. (a -> b) -> a -> b
$ Text -> Text
trim Text
top
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Text -> Text -> Many Block
B.simpleFigureWith
               (forall {a}. IsString a => Text -> (Text, [Text], [(a, Text)])
imgAttr Text
"figclass") Many Inline
caption Text
src Text
"" forall a. Semigroup a => a -> a -> a
<> Many Block
legend
        Text
"image" -> do
           let src :: Text
src = Text -> Text
escapeURI forall a b. (a -> b) -> a -> b
$ Text -> Text
trim Text
top
           let alt :: Many Inline
alt = Text -> Many Inline
B.str forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"image" Text -> Text
trim forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"alt" NoteTable
fields
           let attr :: Attr
attr = forall {a}. IsString a => Text -> (Text, [Text], [(a, Text)])
imgAttr Text
"class"
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.para
                  forall a b. (a -> b) -> a -> b
$ case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"target" NoteTable
fields of
                          Just Text
t  -> Text -> Text -> Many Inline -> Many Inline
B.link (Text -> Text
escapeURI forall a b. (a -> b) -> a -> b
$ Text -> Text
trim Text
t) Text
""
                                     forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Many Inline -> Many Inline
B.imageWith Attr
attr Text
src Text
"" Many Inline
alt
                          Maybe Text
Nothing -> Attr -> Text -> Text -> Many Inline -> Many Inline
B.imageWith Attr
attr Text
src Text
"" Many Inline
alt
        Text
"class" -> do
            let attrs :: Attr
attrs = (Text
name, Text -> [Text]
T.words (Text -> Text
trim Text
top), forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Text
trimr) NoteTable
fields)
            --  directive content or the first immediately following element
            Many Block
children <- case Text
body of
                Text
"" -> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
block
                Text
_  -> forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks  Text
body'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
              case forall a. Many a -> [a]
B.toList Many Block
children of
                [Header Int
lev Attr
attrs' [Inline]
ils]
                  | Text -> Bool
T.null Text
body -> -- # see #6699
                     Attr -> Int -> Many Inline -> Many Block
B.headerWith (Attr
attrs' forall a. Semigroup a => a -> a -> a
<> Attr
attrs) Int
lev (forall a. [a] -> Many a
B.fromList [Inline]
ils)
                [Block]
_ -> Attr -> Many Block -> Many Block
B.divWith Attr
attrs Many Block
children
        Text
other     -> do
            SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
            forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
".. " forall a. Semigroup a => a -> a -> a
<> Text
other) SourcePos
pos
            Many Block
bod <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks forall a b. (a -> b) -> a -> b
$ Text
top forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" forall a. Semigroup a => a -> a -> a
<> Text
body'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Many Block -> Many Block
B.divWith (Text
name, Text
otherforall a. a -> [a] -> [a]
:[Text]
classes, NoteTable
keyvals) Many Block
bod

tableDirective :: PandocMonad m
               => Text -> [(Text, Text)] -> Text -> RSTParser m Blocks
tableDirective :: forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> Text -> RSTParser m (Many Block)
tableDirective Text
top NoteTable
fields Text
body = do
  Many Block
bs <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body
  case forall a. Many a -> [a]
B.toList Many Block
bs of
       [Table Attr
attr Caption
_ [ColSpec]
tspecs' thead :: TableHead
thead@(TableHead Attr
_ [Row]
thrs) [TableBody]
tbody TableFoot
tfoot] -> do
         let ([Alignment]
aligns', [ColWidth]
widths') = forall a b. [(a, b)] -> ([a], [b])
unzip [ColSpec]
tspecs'
         Many Inline
title <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' (Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline) Text
top
         Int
columns <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Int
readerColumns
         let numOfCols :: Int
numOfCols = case [Row]
thrs of
               [] -> Int
0
               (Row
r:[Row]
_) -> Row -> Int
rowLength Row
r
         let normWidths :: f Double -> f ColWidth
normWidths f Double
ws =
                Double -> ColWidth
strictPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ forall a. Ord a => a -> a -> a
max Double
1.0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
columns forall a. Num a => a -> a -> a
- Int
numOfCols))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
ws
         let widths :: [ColWidth]
widths = case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"widths" NoteTable
fields of
                           Just Text
"auto" -> forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
                           Just Text
"grid" -> [ColWidth]
widths'
                           Just Text
specs -> forall {f :: * -> *}. Functor f => f Double -> f ColWidth
normWidths
                               forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe (Double
0 :: Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead)
                               forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
splitTextBy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" ," :: String)) Text
specs
                           Maybe Text
Nothing -> [ColWidth]
widths'
         -- align is not applicable since we can't represent whole table align
         let tspecs :: [ColSpec]
tspecs = forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns' [ColWidth]
widths
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Many a
B.singleton forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr (Maybe [Inline] -> Many Block -> Caption
B.caption forall a. Maybe a
Nothing (Many Inline -> Many Block
B.plain Many Inline
title))
                                  [ColSpec]
tspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot
       [Block]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  where
    -- only valid on the very first row of a table section
    rowLength :: Row -> Int
rowLength (Row Attr
_ [Cell]
rb) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ Cell -> Int
cellLength forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cell]
rb
    cellLength :: Cell -> Int
cellLength (Cell Attr
_ Alignment
_ RowSpan
_ (ColSpan Int
w) [Block]
_) = forall a. Ord a => a -> a -> a
max Int
1 Int
w
    strictPos :: Double -> ColWidth
strictPos Double
w
      | Double
w forall a. Ord a => a -> a -> Bool
> Double
0     = Double -> ColWidth
ColWidth Double
w
      | Bool
otherwise = ColWidth
ColWidthDefault

-- TODO: :stub-columns:.
-- Only the first row becomes the header even if header-rows: > 1,
-- since Pandoc doesn't support a table with multiple header rows.
-- We don't need to parse :align: as it represents the whole table align.
listTableDirective :: PandocMonad m
                   => Text -> [(Text, Text)] -> Text
                   -> RSTParser m Blocks
listTableDirective :: forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> Text -> RSTParser m (Many Block)
listTableDirective Text
top NoteTable
fields Text
body = do
  Many Block
bs <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
body
  Many Inline
title <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' (Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline) Text
top
  let rows :: [[Many Block]]
rows = [Block] -> [[Many Block]]
takeRows forall a b. (a -> b) -> a -> b
$ forall a. Many a -> [a]
B.toList Many Block
bs
      headerRowsNum :: Int
headerRowsNum = forall a. a -> Maybe a -> a
fromMaybe (Int
0 :: Int) forall a b. (a -> b) -> a -> b
$
         forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"header-rows" NoteTable
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
      ([Many Block]
headerRow,[[Many Block]]
bodyRows,Int
numOfCols) = case [[Many Block]]
rows of
        [Many Block]
x:[[Many Block]]
xs -> if Int
headerRowsNum forall a. Ord a => a -> a -> Bool
> Int
0
                   then ([Many Block]
x, [[Many Block]]
xs, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Many Block]
x)
                   else ([], [[Many Block]]
rows, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Many Block]
x)
        [[Many Block]]
_ -> ([],[],Int
0)
      widths :: [ColWidth]
widths = case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"widths" NoteTable
fields of
        Just Text
"auto" -> forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
        Just Text
specs -> forall {f :: * -> *}.
(Functor f, Foldable f) =>
f Double -> f ColWidth
normWidths forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe (Double
0 :: Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead) forall a b. (a -> b) -> a -> b
$
                           (Char -> Bool) -> Text -> [Text]
splitTextBy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" ," :: String)) Text
specs
        Maybe Text
_ -> forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
      toRow :: [Many Block] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Many Block -> Cell
B.simpleCell
      toHeaderRow :: [Many Block] -> [Row]
toHeaderRow [Many Block]
l = [[Many Block] -> Row
toRow [Many Block]
l | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Many Block]
l)]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Many Block
B.table (Many Block -> Caption
B.simpleCaption forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.plain Many Inline
title)
             (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Int -> a -> [a]
replicate Int
numOfCols Alignment
AlignDefault) [ColWidth]
widths)
             (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr forall a b. (a -> b) -> a -> b
$ [Many Block] -> [Row]
toHeaderRow [Many Block]
headerRow)
             [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Many Block] -> Row
toRow [[Many Block]]
bodyRows]
             (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])
    where takeRows :: [Block] -> [[Many Block]]
takeRows [BulletList [[Block]]
rows] = forall a b. (a -> b) -> [a] -> [b]
map [Block] -> [Many Block]
takeCells [[Block]]
rows
          takeRows [Block]
_                 = []
          takeCells :: [Block] -> [Many Block]
takeCells [BulletList [[Block]]
cells] = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> Many a
B.fromList [[Block]]
cells
          takeCells [Block]
_                  = []
          normWidths :: f Double -> f ColWidth
normWidths f Double
ws = Double -> ColWidth
strictPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ forall a. Ord a => a -> a -> a
max Double
1 (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum f Double
ws)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
ws
          strictPos :: Double -> ColWidth
strictPos Double
w
            | Double
w forall a. Ord a => a -> a -> Bool
> Double
0     = Double -> ColWidth
ColWidth Double
w
            | Bool
otherwise = ColWidth
ColWidthDefault

csvTableDirective :: PandocMonad m
                   => Text -> [(Text, Text)] -> Text
                   -> RSTParser m Blocks
csvTableDirective :: forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> Text -> RSTParser m (Many Block)
csvTableDirective Text
top NoteTable
fields Text
rawcsv = do
  let explicitHeader :: Maybe Text
explicitHeader = Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"header" NoteTable
fields
  let opts :: CSVOptions
opts = CSVOptions
defaultCSVOptions{
                csvDelim :: Char
csvDelim = case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"delim" NoteTable
fields of
                                Just Text
"tab"   -> Char
'\t'
                                Just Text
"space" -> Char
' '
                                Just (Text -> [Char]
T.unpack -> [Char
c])
                                             -> Char
c
                                Maybe Text
_            -> Char
','
              , csvQuote :: Maybe Char
csvQuote = case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"quote" NoteTable
fields of
                                Just (Text -> [Char]
T.unpack -> [Char
c])
                                  -> forall a. a -> Maybe a
Just Char
c
                                Maybe Text
_ -> forall a. a -> Maybe a
Just Char
'"'
              , csvEscape :: Maybe Char
csvEscape = case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"escape" NoteTable
fields of
                                Just (Text -> [Char]
T.unpack -> [Char
c])
                                  -> forall a. a -> Maybe a
Just Char
c
                                Maybe Text
_ -> forall a. Maybe a
Nothing
              , csvKeepSpace :: Bool
csvKeepSpace = case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"keepspace" NoteTable
fields of
                                       Just Text
"true" -> Bool
True
                                       Maybe Text
_           -> Bool
False
              }
  let headerRowsNum :: Int
headerRowsNum = forall a. a -> Maybe a -> a
fromMaybe (case Maybe Text
explicitHeader of
                                       Just Text
_  -> Int
1 :: Int
                                       Maybe Text
Nothing -> Int
0 :: Int) forall a b. (a -> b) -> a -> b
$
           forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"header-rows" NoteTable
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  Text
rawcsv' <- case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"file" NoteTable
fields forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"url" NoteTable
fields of
                  Just Text
u  -> do
                    (ByteString
bs, Maybe Text
_) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
u
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Text
UTF8.toText ByteString
bs
                  Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
rawcsv
  let header' :: Either ParseError [[Text]]
header' = case Maybe Text
explicitHeader of
                  Just Text
h  -> CSVOptions -> Text -> Either ParseError [[Text]]
parseCSV CSVOptions
defaultCSVOptions Text
h
                  Maybe Text
Nothing -> forall a b. b -> Either a b
Right []
  let res :: Either ParseError [[Text]]
res = CSVOptions -> Text -> Either ParseError [[Text]]
parseCSV CSVOptions
opts Text
rawcsv'
  case forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ParseError [[Text]]
header' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either ParseError [[Text]]
res of
       Left ParseError
e  ->
         forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Sources -> ParseError -> PandocError
PandocParsecError Sources
"csv table" ParseError
e
       Right [[Text]]
rawrows -> do
         let singleParaToPlain :: Many Block -> Many Block
singleParaToPlain Many Block
bs =
               case forall a. Many a -> [a]
B.toList Many Block
bs of
                 [Para [Inline]
ils] -> forall a. [a] -> Many a
B.fromList [[Inline] -> Block
Plain [Inline]
ils]
                 [Block]
_          -> Many Block
bs
         let parseCell :: Text -> ParsecT Sources ParserState m (Many Block)
parseCell Text
t = Many Block -> Many Block
singleParaToPlain
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks (Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
         let parseRow :: [Text] -> ParsecT Sources ParserState m [Many Block]
parseRow = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Block)
parseCell
         [[Many Block]]
rows <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Text] -> ParsecT Sources ParserState m [Many Block]
parseRow [[Text]]
rawrows
         let ([Many Block]
headerRow,[[Many Block]]
bodyRows,Int
numOfCols) =
              case [[Many Block]]
rows of
                   [Many Block]
x:[[Many Block]]
xs -> if Int
headerRowsNum forall a. Ord a => a -> a -> Bool
> Int
0
                          then ([Many Block]
x, [[Many Block]]
xs, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Many Block]
x)
                          else ([], [[Many Block]]
rows, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Many Block]
x)
                   [[Many Block]]
_ -> ([],[],Int
0)
         Many Inline
title <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' (Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline) Text
top
         let strictPos :: Double -> ColWidth
strictPos Double
w
               | Double
w forall a. Ord a => a -> a -> Bool
> Double
0     = Double -> ColWidth
ColWidth Double
w
               | Bool
otherwise = ColWidth
ColWidthDefault
         let normWidths :: f Double -> f ColWidth
normWidths f Double
ws = Double -> ColWidth
strictPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ forall a. Ord a => a -> a -> a
max Double
1 (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum f Double
ws)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
ws
         let widths :: [ColWidth]
widths =
               case Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"widths" NoteTable
fields of
                 Just Text
"auto" -> forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
                 Just Text
specs -> forall {f :: * -> *}.
(Functor f, Foldable f) =>
f Double -> f ColWidth
normWidths
                               forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe (Double
0 :: Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead)
                               forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
splitTextBy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" ," :: String)) Text
specs
                 Maybe Text
_ -> forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
         let toRow :: [Many Block] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Many Block -> Cell
B.simpleCell
             toHeaderRow :: [Many Block] -> [Row]
toHeaderRow [Many Block]
l = [[Many Block] -> Row
toRow [Many Block]
l | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Many Block]
l)]
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Many Block
B.table (Many Block -> Caption
B.simpleCaption forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.plain Many Inline
title)
                          (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Int -> a -> [a]
replicate Int
numOfCols Alignment
AlignDefault) [ColWidth]
widths)
                          (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr forall a b. (a -> b) -> a -> b
$ [Many Block] -> [Row]
toHeaderRow [Many Block]
headerRow)
                          [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Many Block] -> Row
toRow [[Many Block]]
bodyRows]
                          (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])

-- TODO:
--  - Only supports :format: fields with a single format for :raw: roles,
--    change Text.Pandoc.Definition.Format to fix
addNewRole :: PandocMonad m
           => Text -> [(Text, Text)] -> RSTParser m Blocks
addNewRole :: forall (m :: * -> *).
PandocMonad m =>
Text -> NoteTable -> RSTParser m (Many Block)
addNewRole Text
roleText NoteTable
fields = do
    SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    (Text
role, Text
parentRole) <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' ParsecT Sources ParserState m (Text, Text)
inheritedRole Text
roleText
    Map Text (Text, Maybe Text, Attr)
customRoles <- ParserState -> Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let getBaseRole :: (a, b, c) -> Map a (a, b, c) -> (a, b, c)
getBaseRole (a
r, b
f, c
a) Map a (a, b, c)
roles =
            case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
r Map a (a, b, c)
roles of
                 Just (a
r', b
f', c
a') -> (a, b, c) -> Map a (a, b, c) -> (a, b, c)
getBaseRole (a
r', b
f', c
a') Map a (a, b, c)
roles
                 Maybe (a, b, c)
Nothing           -> (a
r, b
f, c
a)
        (Text
baseRole, Maybe Text
baseFmt, Attr
baseAttr) =
               forall {a} {b} {c}.
Ord a =>
(a, b, c) -> Map a (a, b, c) -> (a, b, c)
getBaseRole (Text
parentRole, forall a. Maybe a
Nothing, Attr
nullAttr) Map Text (Text, Maybe Text, Attr)
customRoles
        fmt :: Maybe Text
fmt = if Text
parentRole forall a. Eq a => a -> a -> Bool
== Text
"raw" then forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"format" NoteTable
fields else Maybe Text
baseFmt

        updateClasses :: [Text] -> [Text]
        updateClasses :: [Text] -> [Text]
updateClasses [Text]
oldClasses = let

          codeLanguageClass :: [Text]
codeLanguageClass = if Text
baseRole forall a. Eq a => a -> a -> Bool
== Text
"code"
            then forall a. Maybe a -> [a]
maybeToList (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"language" NoteTable
fields)
            else []

          -- if no ":class:" field is given, the default is the role name
          classFieldClasses :: [Text]
classFieldClasses = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text
role] Text -> [Text]
T.words (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" NoteTable
fields)

          -- nub in case role name & language class are the same
          in forall a. Eq a => [a] -> [a]
nub ([Text]
classFieldClasses forall a. [a] -> [a] -> [a]
++ [Text]
codeLanguageClass forall a. [a] -> [a] -> [a]
++ [Text]
oldClasses)

        attr :: Attr
attr = let (Text
ident, [Text]
baseClasses, NoteTable
keyValues) = Attr
baseAttr
               in (Text
ident, [Text] -> [Text]
updateClasses [Text]
baseClasses, NoteTable
keyValues)

    -- warn about syntax we ignore
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NoteTable
fields forall a b. (a -> b) -> a -> b
$ \(Text
key, Text
_) -> case Text
key of
                 Text
"language" -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
baseRole forall a. Eq a => a -> a -> Bool
/= Text
"code") forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$
                     Text -> SourcePos -> LogMessage
SkippedContent Text
":language: [because parent of role is not :code:]"
                        SourcePos
pos
                 Text
"format" -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
baseRole forall a. Eq a => a -> a -> Bool
/= Text
"raw") forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$
                     Text -> SourcePos -> LogMessage
SkippedContent Text
":format: [because parent of role is not :raw:]" SourcePos
pos
                 Text
_ -> forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
":" forall a. Semigroup a => a -> a -> a
<> Text
key forall a. Semigroup a => a -> a -> a
<> Text
":") SourcePos
pos
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
parentRole forall a. Eq a => a -> a -> Bool
== Text
"raw" Bool -> Bool -> Bool
&& Text -> Int
countKeys Text
"format" forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
        forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent
                  Text
":format: [after first in definition of role]"
                  SourcePos
pos
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
parentRole forall a. Eq a => a -> a -> Bool
== Text
"code" Bool -> Bool -> Bool
&& Text -> Int
countKeys Text
"language" forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
        forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent
          Text
":language: [after first in definition of role]" SourcePos
pos

    forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s {
        stateRstCustomRoles :: Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles =
          forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
role (Text
baseRole, Maybe Text
fmt, Attr
attr) Map Text (Text, Maybe Text, Attr)
customRoles
    }

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  where
    countKeys :: Text -> Int
countKeys Text
k = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== Text
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ NoteTable
fields
    inheritedRole :: ParsecT Sources ParserState m (Text, Text)
inheritedRole =
        (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
')')
                            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"span")


-- Can contain character codes as decimal numbers or
-- hexadecimal numbers, prefixed by 0x, x, \x, U+, u, or \u
-- or as XML-style hexadecimal character entities, e.g. &#x1a2b;
-- or text, which is used as-is.  Comments start with ..
unicodeTransform :: Text -> Text
unicodeTransform :: Text -> Text
unicodeTransform Text
t
  | Just Text
xs <- Text -> Text -> Maybe Text
T.stripPrefix Text
".." Text
t  = Text -> Text
unicodeTransform forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
xs -- comment
  | Just Text
xs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"0x" Text
t  = Text -> Text -> Text
go Text
"0x" Text
xs
  | Just Text
xs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"x" Text
t   = Text -> Text -> Text
go Text
"x" Text
xs
  | Just Text
xs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"\\x" Text
t = Text -> Text -> Text
go Text
"\\x" Text
xs
  | Just Text
xs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"U+" Text
t  = Text -> Text -> Text
go Text
"U+" Text
xs
  | Just Text
xs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"u" Text
t   = Text -> Text -> Text
go Text
"u" Text
xs
  | Just Text
xs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"\\u" Text
t = Text -> Text -> Text
go Text
"\\u" Text
xs
  | Just Text
xs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"&#x" Text
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
"&#x" forall a. Semigroup a => a -> a -> a
<> Text -> Text
unicodeTransform Text
xs)
                                       -- drop semicolon
                                       (\(Char
c,Text
s) -> Char -> Text -> Text
T.cons Char
c forall a b. (a -> b) -> a -> b
$ Text -> Text
unicodeTransform forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
s)
                                       forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Char, Text)
extractUnicodeChar Text
xs
  | Just (Char
x, Text
xs) <- Text -> Maybe (Char, Text)
T.uncons Text
t       = Char -> Text -> Text
T.cons Char
x forall a b. (a -> b) -> a -> b
$ Text -> Text
unicodeTransform Text
xs
  | Bool
otherwise                        = Text
""
  where go :: Text -> Text -> Text
go Text
pref Text
zs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
pref forall a. Semigroup a => a -> a -> a
<> Text -> Text
unicodeTransform Text
zs)
                     (\(Char
c,Text
s) -> Char -> Text -> Text
T.cons Char
c forall a b. (a -> b) -> a -> b
$ Text -> Text
unicodeTransform Text
s)
                     forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Char, Text)
extractUnicodeChar Text
zs

extractUnicodeChar :: Text -> Maybe (Char, Text)
extractUnicodeChar :: Text -> Maybe (Char, Text)
extractUnicodeChar Text
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
c -> (Char
c,Text
rest)) Maybe Char
mbc
  where (Text
ds,Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isHexDigit Text
s
        mbc :: Maybe Char
mbc = forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text
"'\\x" forall a. Semigroup a => a -> a -> a
<> Text
ds forall a. Semigroup a => a -> a -> a
<> Text
"'")

extractCaption :: PandocMonad m => RSTParser m (Inlines, Blocks)
extractCaption :: forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Many Block)
extractCaption = do
  Many Inline
capt <- Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline
  Many Block
legend <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
block)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline
capt,Many Block
legend)

-- divide string by blanklines, and surround with
-- \begin{aligned}...\end{aligned} if needed.
toChunks :: Text -> [Text]
toChunks :: Text -> [Text]
toChunks = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Text -> Bool
T.null
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
addAligned forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines)
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [[a]]
splitBy ((Char -> Bool) -> Text -> Bool
T.all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" \t" :: String))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
  -- we put this in an aligned environment if it contains \\, see #4254
  where addAligned :: Text -> Text
addAligned Text
s = if Text
"\\\\" Text -> Text -> Bool
`T.isInfixOf` Text
s
                          then Text
"\\begin{aligned}\n" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\n\\end{aligned}"
                          else Text
s

codeblock :: Text -> [Text] -> [(Text, Text)] -> Text -> Bool -> Text
          -> Blocks
codeblock :: Text -> [Text] -> NoteTable -> Text -> Bool -> Text -> Many Block
codeblock Text
ident [Text]
classes NoteTable
fields Text
lang Bool
rmTrailingNewlines Text
body =
  Attr -> Text -> Many Block
B.codeBlockWith Attr
attribs forall a b. (a -> b) -> a -> b
$ Text -> Text
stripTrailingNewlines' Text
body
    where stripTrailingNewlines' :: Text -> Text
stripTrailingNewlines' = if Bool
rmTrailingNewlines
                                     then Text -> Text
stripTrailingNewlines
                                     else forall a. a -> a
id
          attribs :: Attr
attribs = (Text
ident, [Text]
classes', NoteTable
kvs)
          classes' :: [Text]
classes' = Text
lang
                    forall a. a -> [a] -> [a]
: [Text
"numberLines" | forall a. Maybe a -> Bool
isJust (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number-lines" NoteTable
fields)]
                    forall a. [a] -> [a] -> [a]
++ [Text]
classes
          kvs :: NoteTable
kvs = [(Text
k,Text
v) | (Text
k,Text
v) <- NoteTable
fields, Text
k forall a. Eq a => a -> a -> Bool
/= Text
"number-lines", Text
k forall a. Eq a => a -> a -> Bool
/= Text
"class",
                                          Text
k forall a. Eq a => a -> a -> Bool
/= Text
"id", Text
k forall a. Eq a => a -> a -> Bool
/= Text
"name"]
                forall a. [a] -> [a] -> [a]
++ case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number-lines" NoteTable
fields of
                     Just Text
v | Bool -> Bool
not (Text -> Bool
T.null Text
v) -> [(Text
"startFrom", Text
v)]
                     Maybe Text
_ -> []

-- | Creates element attributes from a name, list of classes, and fields.
-- Removes fields named @name@, @id@, or @class@.
mkAttr :: Text -> [Text] -> [(Text, Text)] -> Attr
mkAttr :: Text -> [Text] -> NoteTable -> Attr
mkAttr Text
ident [Text]
classes NoteTable
fields = (Text
ident, [Text]
classes, NoteTable
fields')
  where fields' :: NoteTable
fields' = [(Text
k, Text
v') | (Text
k, Text
v) <- NoteTable
fields
                           , let v' :: Text
v' = Text -> Text
trimr Text
v
                           , Text
k forall a. Eq a => a -> a -> Bool
/= Text
"name", Text
k forall a. Eq a => a -> a -> Bool
/= Text
"id", Text
k forall a. Eq a => a -> a -> Bool
/= Text
"class"]

---
--- note block
---

noteBlock :: Monad m => RSTParser m Text
noteBlock :: forall (m :: * -> *). Monad m => RSTParser m Text
noteBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (Text
ref, Text
raw, Text
replacement) <- forall (m :: * -> *).
Monad m =>
RSTParser m Text -> RSTParser m (Text, Text, Text)
noteBlock' forall (m :: * -> *). Monad m => RSTParser m Text
noteMarker
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateNotes :: NoteTable
stateNotes = (Text
ref, Text
raw) forall a. a -> [a] -> [a]
: ParserState -> NoteTable
stateNotes ParserState
s }
  -- return blanks so line count isn't affected
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
replacement

citationBlock :: Monad m => RSTParser m Text
citationBlock :: forall (m :: * -> *). Monad m => RSTParser m Text
citationBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (Text
ref, Text
raw, Text
replacement) <- forall (m :: * -> *).
Monad m =>
RSTParser m Text -> RSTParser m (Text, Text, Text)
noteBlock' forall (m :: * -> *). Monad m => RSTParser m Text
citationMarker
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s ->
     ParserState
s { stateCitations :: Map Text Text
stateCitations = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ref Text
raw (ParserState -> Map Text Text
stateCitations ParserState
s),
         stateKeys :: KeyTable
stateKeys = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text -> Key
toKey Text
ref) ((Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
ref,Text
""), (Text
"",[Text
"citation"],[]))
                               (ParserState -> KeyTable
stateKeys ParserState
s) }
  -- return blanks so line count isn't affected
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
replacement

noteBlock' :: Monad m
           => RSTParser m Text -> RSTParser m (Text, Text, Text)
noteBlock' :: forall (m :: * -> *).
Monad m =>
RSTParser m Text -> RSTParser m (Text, Text, Text)
noteBlock' RSTParser m Text
marker = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  SourcePos
startPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
".."
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar
  Text
ref <- RSTParser m Text
marker
  Text
first <- (forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine)
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"")
  Text
blanks <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  Text
rest <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Sources st m Text
indentedBlock
  SourcePos
endPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let raw :: Text
raw = Text
first forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
blanks forall a. Semigroup a => a -> a -> a
<> Text
rest forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  let replacement :: Text
replacement = Int -> Text -> Text
T.replicate (SourcePos -> Int
sourceLine SourcePos
endPos forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceLine SourcePos
startPos) Text
"\n"
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
ref, Text
raw, Text
replacement)

citationMarker :: Monad m => RSTParser m Text
citationMarker :: forall (m :: * -> *). Monad m => RSTParser m Text
citationMarker = do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'['
  Text
res <- forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
simpleReferenceName
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
']'
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
res

noteMarker :: Monad m => RSTParser m Text
noteMarker :: forall (m :: * -> *). Monad m => RSTParser m Text
noteMarker = do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'['
  Text
res <- forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'#' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Text
"#" forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
simpleReferenceName)
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"#*")
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
']'
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
res

--
-- reference key
--

quotedReferenceName :: PandocMonad m => RSTParser m Text
quotedReferenceName :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
quotedReferenceName = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`') -- `` means inline code!
  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 forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`')

-- Simple reference names are single words consisting of alphanumerics
-- plus isolated (no two adjacent) internal hyphens, underscores,
-- periods, colons and plus signs; no whitespace or other characters
-- are allowed.
simpleReferenceName :: Monad m => ParserT Sources st m Text
simpleReferenceName :: forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
simpleReferenceName = do
  Char
x <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum
  [Char]
xs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"-_:+." forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
xforall a. a -> [a] -> [a]
:[Char]
xs)

referenceName :: PandocMonad m => RSTParser m Text
referenceName :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
referenceName = forall (m :: * -> *). PandocMonad m => RSTParser m Text
quotedReferenceName forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
simpleReferenceName

referenceKey :: PandocMonad m => RSTParser m Text
referenceKey :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
referenceKey = do
  SourcePos
startPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall (m :: * -> *). PandocMonad m => RSTParser m ()
substKey, forall (m :: * -> *). Monad m => RSTParser m ()
anonymousKey, forall (m :: * -> *). PandocMonad m => RSTParser m ()
regularKey]
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  SourcePos
endPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  -- return enough blanks to replace key
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (SourcePos -> Int
sourceLine SourcePos
endPos forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceLine SourcePos
startPos) Text
"\n"

targetURI :: Monad m => ParserT Sources st m Text
targetURI :: forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
targetURI = do
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m ()
skipSpaces
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline
  Text
contents <- Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/=Char
'\n')
     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
" \t\n"))
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
stripBackticks Text
contents
  where
    stripBackticks :: Text -> Text
stripBackticks Text
t
      | Just Text
xs <- Text -> Text -> Maybe Text
T.stripSuffix Text
"`_" Text
t = (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'`') Text
xs forall a. Semigroup a => a -> a -> a
<> Text
"_"
      | Just Text
_  <- Text -> Text -> Maybe Text
T.stripSuffix Text
"_"  Text
t = Text
t
      | Bool
otherwise                       = Text -> Text
escapeURI Text
t

substKey :: PandocMonad m => RSTParser m ()
substKey :: forall (m :: * -> *). PandocMonad m => RSTParser m ()
substKey = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
".."
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar
  (Many Inline
alt,Text
ref) <- forall (m :: * -> *) st a.
Monad m =>
ParsecT Sources st m a -> ParsecT Sources st m (a, Text)
withRaw forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall end s (m :: * -> *) st t a.
(Show end, Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m t
-> ParserT s st m end -> ParserT s st m a -> ParserT s st m [a]
enclosed (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|') (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|') forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline
  [Block]
res <- forall a. Many a -> [a]
B.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
directive'
  Many Inline
il <- case [Block]
res of
             -- use alt unless :alt: attribute on image:
             [Para [Image Attr
attr [Str Text
"image"] (Text
src,Text
tit)]] ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Many Inline -> Many Inline
B.imageWith Attr
attr Text
src Text
tit Many Inline
alt
             [Para [Link Attr
_ [Image Attr
attr [Str Text
"image"] (Text
src,Text
tit)] (Text
src',Text
tit')]] ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
B.link Text
src' Text
tit' (Attr -> Text -> Text -> Many Inline -> Many Inline
B.imageWith Attr
attr Text
src Text
tit Many Inline
alt)
             [Para [Inline]
ils] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
B.fromList [Inline]
ils
             [Block]
_          -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  let key :: Key
key = Text -> Key
toKey forall a b. (a -> b) -> a -> b
$ Text -> Text
stripFirstAndLast Text
ref
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s{ stateSubstitutions :: SubstTable
stateSubstitutions =
                          forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
key Many Inline
il forall a b. (a -> b) -> a -> b
$ ParserState -> SubstTable
stateSubstitutions ParserState
s }

anonymousKey :: Monad m => RSTParser m ()
anonymousKey :: forall (m :: * -> *). Monad m => RSTParser m ()
anonymousKey = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Text] -> ParserT s st m Text
oneOfStrings [Text
".. __:", Text
"__"]
  Text
src <- forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
targetURI
  -- we need to ensure that the keys are ordered by occurrence in
  -- the document.
  Int
numKeys <- forall k a. Map k a -> Int
M.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserState -> KeyTable
stateKeys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let key :: Key
key = Text -> Key
toKey forall a b. (a -> b) -> a -> b
$ Text
"_" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
numKeys)
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateKeys :: KeyTable
stateKeys = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
key ((Text
src,Text
""), Attr
nullAttr) forall a b. (a -> b) -> a -> b
$
                          ParserState -> KeyTable
stateKeys ParserState
s }

referenceNames :: PandocMonad m => RSTParser m [Text]
referenceNames :: forall (m :: * -> *). PandocMonad m => RSTParser m [Text]
referenceNames = do
  let rn :: ParsecT Sources ParserState m Text
rn = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
             forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
".. _"
             Text
ref <- forall (m :: * -> *). PandocMonad m => RSTParser m Text
quotedReferenceName
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
manyChar (  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\\:\n"
                              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                                       forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"   " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                                       forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline)
                              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':')
                              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum)
                               )
             forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':'
             forall (m :: * -> *) a. Monad m => a -> m a
return Text
ref
  Text
first <- ParsecT Sources ParserState m Text
rn
  [Text]
rest  <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources ParserState m Text
rn))
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
firstforall a. a -> [a] -> [a]
:[Text]
rest)

regularKey :: PandocMonad m => RSTParser m ()
regularKey :: forall (m :: * -> *). PandocMonad m => RSTParser m ()
regularKey = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  -- we allow several references to the same URL, e.g.
  -- .. _hello:
  -- .. _goodbye: url.com
  [Text]
refs <- forall (m :: * -> *). PandocMonad m => RSTParser m [Text]
referenceNames
  Text
src <- forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
targetURI
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Text -> Bool
T.null Text
src)
  let keys :: [Key]
keys = forall a b. (a -> b) -> [a] -> [b]
map Text -> Key
toKey [Text]
refs
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Key]
keys forall a b. (a -> b) -> a -> b
$ \Key
key ->
    forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateKeys :: KeyTable
stateKeys = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
key ((Text
src,Text
""), Attr
nullAttr) forall a b. (a -> b) -> a -> b
$
                            ParserState -> KeyTable
stateKeys ParserState
s }

anchorDef :: PandocMonad m => RSTParser m Text
anchorDef :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
anchorDef = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  ([Text]
refs, Text
raw) <- forall (m :: * -> *) st a.
Monad m =>
ParsecT Sources st m a -> ParsecT Sources st m (a, Text)
withRaw forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *). PandocMonad m => RSTParser m [Text]
referenceNames forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
refs forall a b. (a -> b) -> a -> b
$ \Text
rawkey ->
    forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateKeys :: KeyTable
stateKeys =
       forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text -> Key
toKey Text
rawkey) ((Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
rawkey,Text
""), Attr
nullAttr) forall a b. (a -> b) -> a -> b
$ ParserState -> KeyTable
stateKeys ParserState
s }
  -- keep this for 2nd round of parsing, where we'll add the divs (anchor)
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
raw

anchor :: PandocMonad m => RSTParser m Blocks
anchor :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
anchor = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  [Text]
refs <- forall (m :: * -> *). PandocMonad m => RSTParser m [Text]
referenceNames
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  Many Block
b <- forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
block
  let addDiv :: Text -> Many Block -> Many Block
addDiv Text
ref = Attr -> Many Block -> Many Block
B.divWith (Text
ref, [], [])
  let emptySpanWithId :: Text -> Inline
emptySpanWithId Text
id' = Attr -> [Inline] -> Inline
Span (Text
id',[],[]) []
  -- put identifier on next block:
  case forall a. Many a -> [a]
B.toList Many Block
b of
       [Header Int
lev (Text
_,[Text]
classes,NoteTable
kvs) [Inline]
txt] ->
         case forall a. [a] -> [a]
reverse [Text]
refs of
              [] -> forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
b
              (Text
r:[Text]
rs) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Many a
B.singleton forall a b. (a -> b) -> a -> b
$
                           Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
r,[Text]
classes,NoteTable
kvs)
                             ([Inline]
txt forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Text -> Inline
emptySpanWithId [Text]
rs)
                -- we avoid generating divs for headers,
                -- because it hides them from promoteHeader, see #4240
       [Block]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Many Block -> Many Block
addDiv Many Block
b [Text]
refs

headerBlock :: PandocMonad m => RSTParser m Text
headerBlock :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
headerBlock = do
  ((Many Inline
txt, Char
_), Text
raw) <- forall (m :: * -> *) st a.
Monad m =>
ParsecT Sources st m a -> ParsecT Sources st m (a, Text)
withRaw (forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Char)
doubleHeader' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Char)
singleHeader')
  (Text
ident,[Text]
_,NoteTable
_) <- forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
 HasIdentifierList st) =>
Attr -> Many Inline -> ParserT s st m Attr
registerHeader Attr
nullAttr Many Inline
txt
  let key :: Key
key = Text -> Key
toKey (forall a. Walkable Inline a => a -> Text
stringify Many Inline
txt)
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateKeys :: KeyTable
stateKeys = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
key ((Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
ident,Text
""), Attr
nullAttr)
                          forall a b. (a -> b) -> a -> b
$ ParserState -> KeyTable
stateKeys ParserState
s }
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
raw


--
-- tables
--

-- General tables TODO:
--  - figure out if leading spaces are acceptable and if so, add
--    support for them
--
-- Simple tables TODO:
--  - column spans
--  - multiline support
--  - ensure that rightmost column span does not need to reach end
--  - require at least 2 columns

dashedLine :: Monad m => Char -> ParserT Sources st m (Int, Int)
dashedLine :: forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m (Int, Int)
dashedLine Char
ch = do
  [Char]
dashes <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
ch)
  [Char]
sp     <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
' ')
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
dashes, forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [Char]
dashes forall a. [a] -> [a] -> [a]
++ [Char]
sp)

simpleDashedLines :: Monad m => Char -> ParserT Sources st m [(Int,Int)]
simpleDashedLines :: forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Int)]
simpleDashedLines Char
ch = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m (Int, Int)
dashedLine Char
ch)

-- Parse a table row separator
simpleTableSep :: Monad m => Char -> RSTParser m Char
simpleTableSep :: forall (m :: * -> *). Monad m => Char -> RSTParser m Char
simpleTableSep Char
ch = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Int)]
simpleDashedLines Char
ch forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline

-- Parse a table footer
simpleTableFooter :: Monad m => RSTParser m Text
simpleTableFooter :: forall (m :: * -> *). Monad m => RSTParser m Text
simpleTableFooter = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Char -> RSTParser m Char
simpleTableSep Char
'=' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines

-- Parse a raw line and split it into chunks by indices.
simpleTableRawLine :: Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLine :: forall (m :: * -> *). Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLine [Int]
indices = [Int] -> Text -> [Text]
simpleTableSplitLine [Int]
indices forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine

simpleTableRawLineWithEmptyCell :: Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLineWithEmptyCell :: forall (m :: * -> *). Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLineWithEmptyCell [Int]
indices = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  [Text]
cs <- forall (m :: * -> *). Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLine [Int]
indices
  let isEmptyCell :: Text -> Bool
isEmptyCell = (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t')
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
isEmptyCell [Text]
cs
  forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
cs

-- Parse a table row and return a list of blocks (columns).
simpleTableRow :: PandocMonad m => [Int] -> RSTParser m [Blocks]
simpleTableRow :: forall (m :: * -> *).
PandocMonad m =>
[Int] -> RSTParser m [Many Block]
simpleTableRow [Int]
indices = do
  forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' forall (m :: * -> *). Monad m => RSTParser m Text
simpleTableFooter
  [Text]
firstLine <- forall (m :: * -> *). Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLine [Int]
indices
  [[Text]]
conLines  <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLineWithEmptyCell [Int]
indices
  let cols :: [Text]
cols = forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ [Text]
firstLine forall a. a -> [a] -> [a]
: [[Text]]
conLines forall a. [a] -> [a] -> [a]
++
                                  [forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
indices) Text
""
                                    | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
conLines)]
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks) [Text]
cols

simpleTableSplitLine :: [Int] -> Text -> [Text]
simpleTableSplitLine :: [Int] -> Text -> [Text]
simpleTableSplitLine [Int]
indices Text
line =
  forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trimr
  forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ [Int] -> Text -> [Text]
splitTextByIndices (forall a. [a] -> [a]
init [Int]
indices) Text
line

simpleTableHeader :: PandocMonad m
                  => Bool  -- ^ Headerless table
                  -> RSTParser m ([Blocks], [Alignment], [Int])
simpleTableHeader :: forall (m :: * -> *).
PandocMonad m =>
Bool -> RSTParser m ([Many Block], [Alignment], [Int])
simpleTableHeader Bool
headless = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  Text
rawContent  <- if Bool
headless
                    then forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
                    else forall (m :: * -> *). Monad m => Char -> RSTParser m Char
simpleTableSep Char
'=' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) st. Monad m => ParserT Sources st m Text
anyLine
  [(Int, Int)]
dashes      <- if Bool
headless
                    then forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Int)]
simpleDashedLines Char
'='
                    else forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Int)]
simpleDashedLines Char
'=' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Int)]
simpleDashedLines Char
'-'
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
  let lines' :: [Int]
lines'   = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Int)]
dashes
  let indices :: [Int]
indices  = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Int
0 [Int]
lines'
  let aligns :: [Alignment]
aligns   = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lines') Alignment
AlignDefault
  let rawHeads :: [Text]
rawHeads = if Bool
headless
                    then []
                    else [Int] -> Text -> [Text]
simpleTableSplitLine [Int]
indices Text
rawContent
  [Many Block]
heads <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ( forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
plain) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim) [Text]
rawHeads
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Many Block]
heads, [Alignment]
aligns, [Int]
indices)

-- Parse a simple table.
simpleTable :: PandocMonad m
            => Bool  -- ^ Headerless table
            -> RSTParser m Blocks
simpleTable :: forall (m :: * -> *).
PandocMonad m =>
Bool -> RSTParser m (Many Block)
simpleTable Bool
headless = do
  let wrapIdFst :: (a, b, c) -> (Identity a, b, c)
wrapIdFst (a
a, b
b, c
c) = (forall a. a -> Identity a
Identity a
a, b
b, c
c)
      wrapId :: ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m (Identity a)
wrapId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity
  Many Block
tbl <- forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
 Monad mf) =>
ParserT s st m (mf [Many Block], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Many Block]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf (Many Block))
tableWith
           (forall {a} {b} {c}. (a, b, c) -> (Identity a, b, c)
wrapIdFst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Bool -> RSTParser m ([Many Block], [Alignment], [Int])
simpleTableHeader Bool
headless)
           (forall {a}.
ParsecT Sources ParserState m a
-> ParsecT Sources ParserState m (Identity a)
wrapId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
[Int] -> RSTParser m [Many Block]
simpleTableRow)
           ParsecT Sources ParserState m ()
sep forall (m :: * -> *). Monad m => RSTParser m Text
simpleTableFooter
  -- Simple tables get 0s for relative column widths (i.e., use default)
  case forall a. Many a -> [a]
B.toList Many Block
tbl of
       [Table Attr
attr Caption
cap [ColSpec]
spec TableHead
th [TableBody]
tb TableFoot
tf] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Many a
B.singleton forall a b. (a -> b) -> a -> b
$
                                         Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
cap (forall {a}. [(Alignment, a)] -> [ColSpec]
rewidth [ColSpec]
spec) TableHead
th [TableBody]
tb TableFoot
tf
       [Block]
_ ->
         forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError
            Text
"tableWith returned something unexpected"
 where
  sep :: ParsecT Sources ParserState m ()
sep = forall (m :: * -> *) a. Monad m => a -> m a
return () -- optional (simpleTableSep '-')
  rewidth :: [(Alignment, a)] -> [ColSpec]
rewidth = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ColWidth
ColWidthDefault

gridTable :: PandocMonad m
          => RSTParser m Blocks
gridTable :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
gridTable = forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st, HasReaderOptions st) =>
ParserT Sources st m (mf (Many Block))
-> ParserT Sources st m (mf (Many Block))
gridTableWith (forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks)

table :: PandocMonad m => RSTParser m Blocks
table :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
table = forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
gridTable forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *).
PandocMonad m =>
Bool -> RSTParser m (Many Block)
simpleTable Bool
False forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *).
PandocMonad m =>
Bool -> RSTParser m (Many Block)
simpleTable Bool
True forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"table"

--
-- inline
--

inline :: PandocMonad m => RSTParser m Inlines
inline :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
note          -- can start with whitespace, so try before ws
                , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
link
                , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
strong
                , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
emph
                , forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
code
                , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
subst
                , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
interpretedRole
                , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inlineContent ] forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"inline"

-- strings, spaces and other characters that can appear either by
-- themselves or within inline markup
inlineContent :: PandocMonad m => RSTParser m Inlines
inlineContent :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inlineContent = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
whitespace
                       , forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
str
                       , forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
endline
                       , forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
smart
                       , forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
hyphens
                       , forall (m :: * -> *) st.
Monad m =>
ParserT Sources st m (Many Inline)
escapedChar
                       , forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
symbol ] forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"inline content"

parseInlineFromText :: PandocMonad m => Text -> RSTParser m Inlines
parseInlineFromText :: forall (m :: * -> *).
PandocMonad m =>
Text -> RSTParser m (Many Inline)
parseInlineFromText = forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' (Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline)

hyphens :: Monad m => RSTParser m Inlines
hyphens :: forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
hyphens = do
  Text
result <- forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-')
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
endline
  -- don't want to treat endline after hyphen or dash as a space
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str Text
result

escapedChar :: Monad m => ParserT Sources st m Inlines
escapedChar :: forall (m :: * -> *) st.
Monad m =>
ParserT Sources st m (Many Inline)
escapedChar = do Char
c <- forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char -> ParserT s st m Char
escaped forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\r'
                             -- '\ ' is null in RST
                             then forall a. Monoid a => a
mempty
                             else Text -> Many Inline
B.str forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c

symbol :: Monad m => RSTParser m Inlines
symbol :: forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
symbol = do
  Char
result <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
specialChars
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
result

-- parses inline code, between codeStart and codeEnd
code :: Monad m => RSTParser m Inlines
code :: forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
code = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"``"
  Text
result <- 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 forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"``"))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.code
         forall a b. (a -> b) -> a -> b
$ Text -> Text
trim forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
result

-- succeeds only if we're not right after a str (ie. in middle of word)
atStart :: Monad m => RSTParser m a -> RSTParser m a
atStart :: forall (m :: * -> *) a. Monad m => RSTParser m a -> RSTParser m a
atStart RSTParser m a
p = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParserState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  -- single quote start can't be right after str
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ParserState -> Maybe SourcePos
stateLastStrPos ParserState
st forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just SourcePos
pos
  RSTParser m a
p

emph :: PandocMonad m => RSTParser m Inlines
emph :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
emph = Many Inline -> Many Inline
B.emph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         forall end s (m :: * -> *) st t a.
(Show end, Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m t
-> ParserT s st m end -> ParserT s st m a -> ParserT s st m [a]
enclosed (forall (m :: * -> *) a. Monad m => RSTParser m a -> RSTParser m a
atStart forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*') (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*') forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inlineContent

strong :: PandocMonad m => RSTParser m Inlines
strong :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
strong = Many Inline -> Many Inline
B.strong forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          forall end s (m :: * -> *) st t a.
(Show end, Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m t
-> ParserT s st m end -> ParserT s st m a -> ParserT s st m [a]
enclosed (forall (m :: * -> *) a. Monad m => RSTParser m a -> RSTParser m a
atStart forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"**") (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"**") forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inlineContent

-- Note, this doesn't precisely implement the complex rule in
-- http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html#inline-markup-recognition-rules
-- but it should be good enough for most purposes
--
-- TODO:
--  - Classes are silently discarded in addNewRole
--  - Allows direct use of the :raw: role, rST only allows inherited use.
interpretedRole :: PandocMonad m => RSTParser m Inlines
interpretedRole :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
interpretedRole = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (Text
role, Text
contents) <- forall (m :: * -> *). PandocMonad m => RSTParser m (Text, Text)
roleBefore forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). PandocMonad m => RSTParser m (Text, Text)
roleAfter
  forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Text -> Text -> Attr -> RSTParser m (Many Inline)
renderRole Text
contents forall a. Maybe a
Nothing Text
role Attr
nullAttr

renderRole :: PandocMonad m
           => Text -> Maybe Text -> Text -> Attr -> RSTParser m Inlines
renderRole :: forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Text -> Text -> Attr -> RSTParser m (Many Inline)
renderRole Text
contents Maybe Text
fmt Text
role Attr
attr = case Text
role of
    Text
"sup"  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.superscript forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"superscript" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.superscript forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"sub"  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.subscript forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"subscript"  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.subscript forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"emphasis" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.emph forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"strong" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.strong forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"rfc-reference" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
rfcLink Text
contents
    Text
"RFC" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
rfcLink Text
contents
    Text
"pep-reference" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
pepLink Text
contents
    Text
"PEP" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
pepLink Text
contents
    Text
"literal" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Inline
B.codeWith Attr
attr Text
contents
    Text
"math" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.math Text
contents
    Text
"title-reference" -> forall {m :: * -> *}. Monad m => Text -> m (Many Inline)
titleRef Text
contents
    Text
"title" -> forall {m :: * -> *}. Monad m => Text -> m (Many Inline)
titleRef Text
contents
    Text
"t" -> forall {m :: * -> *}. Monad m => Text -> m (Many Inline)
titleRef Text
contents
    Text
"code" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Inline
B.codeWith Attr
attr Text
contents
    Text
"span" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith Attr
attr forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"raw" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline
B.rawInline (forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
fmt) Text
contents
    Text
custom -> do
        Map Text (Text, Maybe Text, Attr)
customRoles <- ParserState -> Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
custom Map Text (Text, Maybe Text, Attr)
customRoles of
            Just (Text
newRole, Maybe Text
newFmt, Attr
newAttr) ->
                forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Text -> Text -> Attr -> RSTParser m (Many Inline)
renderRole Text
contents Maybe Text
newFmt Text
newRole Attr
newAttr
            Maybe (Text, Maybe Text, Attr)
Nothing -> -- undefined role
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Inline
B.codeWith (Text
"",[Text
"interpreted-text"],[(Text
"role",Text
role)])
                          Text
contents
 where
   titleRef :: Text -> m (Many Inline)
titleRef Text
ref = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"title-ref"],[]) forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
ref
   rfcLink :: Text -> Many Inline
rfcLink Text
rfcNo = Text -> Text -> Many Inline -> Many Inline
B.link Text
rfcUrl (Text
"RFC " forall a. Semigroup a => a -> a -> a
<> Text
rfcNo) forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str (Text
"RFC " forall a. Semigroup a => a -> a -> a
<> Text
rfcNo)
     where rfcUrl :: Text
rfcUrl = Text
"http://www.faqs.org/rfcs/rfc" forall a. Semigroup a => a -> a -> a
<> Text
rfcNo forall a. Semigroup a => a -> a -> a
<> Text
".html"
   pepLink :: Text -> Many Inline
pepLink Text
pepNo = Text -> Text -> Many Inline -> Many Inline
B.link Text
pepUrl (Text
"PEP " forall a. Semigroup a => a -> a -> a
<> Text
pepNo) forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str (Text
"PEP " forall a. Semigroup a => a -> a -> a
<> Text
pepNo)
     where padNo :: Text
padNo = Int -> Text -> Text
T.replicate (Int
4 forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pepNo) Text
"0" forall a. Semigroup a => a -> a -> a
<> Text
pepNo
           pepUrl :: Text
pepUrl = Text
"http://www.python.org/dev/peps/pep-" forall a. Semigroup a => a -> a -> a
<> Text
padNo forall a. Semigroup a => a -> a -> a
<> Text
"/"
   treatAsText :: Text -> Many Inline
treatAsText = Text -> Many Inline
B.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
handleEscapes
   handleEscapes :: Text -> Text
handleEscapes = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
removeSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"\\"
     where headSpace :: Text -> Text
headSpace Text
t = forall a. a -> Maybe a -> a
fromMaybe Text
t forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
" " Text
t
           removeSpace :: [Text] -> [Text]
removeSpace (Text
x:[Text]
xs) = Text
x forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
headSpace [Text]
xs
           removeSpace []     = []

roleName :: PandocMonad m => RSTParser m Text
roleName :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleName = forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-')

roleMarker :: PandocMonad m => RSTParser m Text
roleMarker :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleMarker = forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':'

roleBefore :: PandocMonad m => RSTParser m (Text,Text)
roleBefore :: forall (m :: * -> *). PandocMonad m => RSTParser m (Text, Text)
roleBefore = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
role <- forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleMarker
  Text
contents <- forall (m :: * -> *). PandocMonad m => RSTParser m Text
unmarkedInterpretedText
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
role,Text
contents)

roleAfter :: PandocMonad m => RSTParser m (Text,Text)
roleAfter :: forall (m :: * -> *). PandocMonad m => RSTParser m (Text, Text)
roleAfter = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
contents <- forall (m :: * -> *). PandocMonad m => RSTParser m Text
unmarkedInterpretedText
  Text
role <- forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleMarker forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParserState -> Text
stateRstDefaultRole forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
role,Text
contents)

unmarkedInterpretedText :: PandocMonad m => RSTParser m Text
unmarkedInterpretedText :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
unmarkedInterpretedText = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) a. Monad m => RSTParser m a -> RSTParser m a
atStart (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`')
  [Char]
contents <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1
       (  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"`\\\n")
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((\Char
c -> [Char
'\\',Char
c]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n"))
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline)
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"`" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleMarker) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAlphaNum))
       )
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
contents

whitespace :: PandocMonad m => RSTParser m Inlines
whitespace :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
whitespace = Many Inline
B.space forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"whitespace"

str :: Monad m => RSTParser m Inlines
str :: forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
str = do
  let strChar :: ParsecT Sources u m Char
strChar = forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf ([Char]
"\t\n " forall a. [a] -> [a] -> [a]
++ [Char]
specialChars)
  Text
result <- forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char forall {u}. ParsecT Sources u m Char
strChar
  forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParserT s st m ()
updateLastStrPos
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str Text
result

-- an endline character that can be treated as a space, not a structural break
endline :: Monad m => RSTParser m Inlines
endline :: forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
endline = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
  forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline
  -- parse potential list-starts at beginning of line differently in a list:
  ParserState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ParserState -> ParserContext
stateParserContext ParserState
st forall a. Eq a => a -> a -> Bool
== ParserContext
ListItemState) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s ParserState m ListAttributes
anyOrderedListMarker forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
spaceChar) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' forall (m :: * -> *) st. Monad m => ParserT Sources st m Int
bulletListStart
  forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
B.softbreak

--
-- links
--

link :: PandocMonad m => RSTParser m Inlines
link :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
link = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
explicitLink, forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
referenceLink, forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
autoLink]  forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"link"

explicitLink :: PandocMonad m => RSTParser m Inlines
explicitLink :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
explicitLink = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`'
  forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`') -- `` marks start of inline code
  Many Inline
label' <- Many Inline -> Many Inline
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             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 (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'`') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inlineContent) (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
  Text
src <- Text -> Text
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
">\n") (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>')
  forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m ()
skipSpaces
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"`_"
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_' -- anonymous form
  let label'' :: Many Inline
label'' = if Many Inline
label' forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty
                   then Text -> Many Inline
B.str Text
src
                   else Many Inline
label'
  -- `link <google_>` is a reference link to _google!
  ((Text
src',Text
tit),Attr
attr) <-
    if Text -> Bool
isURI Text
src
       then forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
src, Text
""), Attr
nullAttr)
       else
         case Text -> Maybe (Text, Char)
T.unsnoc Text
src of
           Just (Text
xs, Char
'_') -> forall (m :: * -> *).
PandocMonad m =>
[Key] -> Key -> RSTParser m ((Text, Text), Attr)
lookupKey [] (Text -> Key
toKey Text
xs)
           Maybe (Text, Char)
_              -> forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
src, Text
""), Attr
nullAttr)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Many Inline -> Many Inline
B.linkWith Attr
attr (Text -> Text
escapeURI Text
src') Text
tit Many Inline
label''

citationName :: PandocMonad m => RSTParser m Text
citationName :: forall (m :: * -> *). PandocMonad m => RSTParser m Text
citationName = do
  Text
raw <- forall (m :: * -> *). Monad m => RSTParser m Text
citationMarker
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"[" forall a. Semigroup a => a -> a -> a
<> Text
raw forall a. Semigroup a => a -> a -> a
<> Text
"]"

referenceLink :: PandocMonad m => RSTParser m Inlines
referenceLink :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
referenceLink = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
ref <- (forall (m :: * -> *). PandocMonad m => RSTParser m Text
referenceName forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). PandocMonad m => RSTParser m Text
citationName) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_'
  let label' :: Many Inline
label' = Text -> Many Inline
B.text Text
ref
  let isAnonKey :: Key -> Bool
isAnonKey (Key (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'_',Text
_))) = Bool
True
      isAnonKey Key
_                                = Bool
False
  ParserState
state <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let keyTable :: KeyTable
keyTable = ParserState -> KeyTable
stateKeys ParserState
state
  Key
key <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> Key
toKey Text
ref) forall a b. (a -> b) -> a -> b
$
                do forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_'
                   let anonKeys :: [Key]
anonKeys = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Key -> Bool
isAnonKey forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys KeyTable
keyTable
                   case [Key]
anonKeys of
                        []    -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
                        (Key
k:[Key]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Key
k
  ((Text
src,Text
tit), Attr
attr) <- forall (m :: * -> *).
PandocMonad m =>
[Key] -> Key -> RSTParser m ((Text, Text), Attr)
lookupKey [] Key
key
  -- if anonymous link, remove key so it won't be used again
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Bool
isAnonKey Key
key) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
s ->
                          ParserState
s{ stateKeys :: KeyTable
stateKeys = forall k a. Ord k => k -> Map k a -> Map k a
M.delete Key
key KeyTable
keyTable }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Many Inline -> Many Inline
B.linkWith Attr
attr Text
src Text
tit Many Inline
label'

-- We keep a list of oldkeys so we can detect lookup loops.
lookupKey :: PandocMonad m
          => [Key] -> Key -> RSTParser m ((Text, Text), Attr)
lookupKey :: forall (m :: * -> *).
PandocMonad m =>
[Key] -> Key -> RSTParser m ((Text, Text), Attr)
lookupKey [Key]
oldkeys Key
key = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParserState
state <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let keyTable :: KeyTable
keyTable = ParserState -> KeyTable
stateKeys ParserState
state
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Key
key KeyTable
keyTable of
       Maybe ((Text, Text), Attr)
Nothing  -> do
         let Key Text
key' = Key
key
         forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ReferenceNotFound Text
key' SourcePos
pos
         forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
"",Text
""),Attr
nullAttr)
       -- check for keys of the form link_, which need to be resolved:
       Just ((Text
u, Text
""),Attr
_) | Text -> Int
T.length Text
u forall a. Ord a => a -> a -> Bool
> Int
1, Text -> Char
T.last Text
u forall a. Eq a => a -> a -> Bool
== Char
'_', Text -> Char
T.head Text
u forall a. Eq a => a -> a -> Bool
/= Char
'#' -> do
         let rawkey :: Text
rawkey = Text -> Text
T.init Text
u
         let newkey :: Key
newkey = Text -> Key
toKey Text
rawkey
         if Key
newkey forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
oldkeys
            then do
              forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CircularReference Text
rawkey SourcePos
pos
              forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
"",Text
""),Attr
nullAttr)
            else forall (m :: * -> *).
PandocMonad m =>
[Key] -> Key -> RSTParser m ((Text, Text), Attr)
lookupKey (Key
keyforall a. a -> [a] -> [a]
:[Key]
oldkeys) Key
newkey
       Just ((Text, Text), Attr)
val -> forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Text), Attr)
val

autoURI :: Monad m => RSTParser m Inlines
autoURI :: forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
autoURI = do
  (Text
orig, Text
src) <- forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m (Text, Text)
uri
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
B.link Text
src Text
"" forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str Text
orig

autoEmail :: Monad m => RSTParser m Inlines
autoEmail :: forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
autoEmail = do
  (Text
orig, Text
src) <- forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m (Text, Text)
emailAddress
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
B.link Text
src Text
"" forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str Text
orig

autoLink :: PandocMonad m => RSTParser m Inlines
autoLink :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
autoLink = forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
autoURI forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
autoEmail

subst :: PandocMonad m => RSTParser m Inlines
subst :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
subst = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  ([Many Inline]
_,Text
ref) <- forall (m :: * -> *) st a.
Monad m =>
ParsecT Sources st m a -> ParsecT Sources st m (a, Text)
withRaw forall a b. (a -> b) -> a -> b
$ forall end s (m :: * -> *) st t a.
(Show end, Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m t
-> ParserT s st m end -> ParserT s st m a -> ParserT s st m [a]
enclosed (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|') (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|') forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline
  ParserState
state <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let substTable :: SubstTable
substTable = ParserState -> SubstTable
stateSubstitutions ParserState
state
  let key :: Key
key = Text -> Key
toKey forall a b. (a -> b) -> a -> b
$ Text -> Text
stripFirstAndLast Text
ref
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Key
key SubstTable
substTable of
       Maybe (Many Inline)
Nothing     -> do
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ReferenceNotFound (forall a. Show a => a -> Text
tshow Key
key) SourcePos
pos
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
       Just Many Inline
target -> forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
target

note :: PandocMonad m => RSTParser m Inlines
note :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
note = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
whitespace
  Text
ref <- forall (m :: * -> *). Monad m => RSTParser m Text
noteMarker
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_'
  ParserState
state <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let notes :: NoteTable
notes = ParserState -> NoteTable
stateNotes ParserState
state
  case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ref NoteTable
notes of
    Maybe Text
Nothing   -> do
      SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ReferenceNotFound Text
ref SourcePos
pos
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    Just Text
raw  -> do
      -- We temporarily empty the note list while parsing the note,
      -- so that we don't get infinite loops with notes inside notes...
      -- Note references inside other notes are allowed in reST, but
      -- not yet in this implementation.
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ stateNotes :: NoteTable
stateNotes = [] }
      Many Block
contents <- forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' forall (m :: * -> *). PandocMonad m => RSTParser m (Many Block)
parseBlocks Text
raw
      let newnotes :: NoteTable
newnotes = if Text
ref forall a. Eq a => a -> a -> Bool
== Text
"*" Bool -> Bool -> Bool
|| Text
ref forall a. Eq a => a -> a -> Bool
== Text
"#" -- auto-numbered
                        -- delete the note so the next auto-numbered note
                        -- doesn't get the same contents:
                        then forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy forall a. Eq a => a -> a -> Bool
(==) NoteTable
notes [(Text
ref,Text
raw)]
                        else NoteTable
notes
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ stateNotes :: NoteTable
stateNotes = NoteTable
newnotes }
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Many Block -> Many Inline
B.note Many Block
contents

smart :: PandocMonad m => RSTParser m Inlines
smart :: forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
smart = forall st (m :: * -> *) s.
(HasReaderOptions st, HasLastStrPosition st, HasQuoteContext st m,
 Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m (Many Inline) -> ParserT s st m (Many Inline)
smartPunctuation forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline