{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Readers.RST
   Copyright   : Copyright (C) 2006-2020 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,
                                      readFileFromDirs, getCurrentTime)
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 Text.Printf (printf)
import Data.Time.Format

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

-- | Parse reStructuredText string and return Pandoc document.
readRST :: PandocMonad m
        => ReaderOptions -- ^ Reader options
        -> Text          -- ^ Text to parse (assuming @'\n'@ line endings)
        -> m Pandoc
readRST :: ReaderOptions -> Text -> m Pandoc
readRST ReaderOptions
opts Text
s = do
  Either PandocError Pandoc
parsed <- ParserT Text ParserState m Pandoc
-> ParserState -> Text -> m (Either PandocError Pandoc)
forall s (m :: * -> *) st a.
(Stream s m Char, ToText s) =>
ParserT s st m a -> st -> s -> m (Either PandocError a)
readWithM ParserT Text ParserState m Pandoc
forall (m :: * -> *). PandocMonad m => RSTParser m Pandoc
parseRST ParserState
forall a. Default a => a
def{ stateOptions :: ReaderOptions
stateOptions = ReaderOptions
opts }
               (Text -> Text
crFilter Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
  case Either PandocError Pandoc
parsed of
    Right Pandoc
result -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result
    Left PandocError
e       -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e

type RSTParser m = ParserT Text 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 Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
num) Attr
attr [Inline]
textBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:Int -> [Block] -> [Block]
promoteHeaders Int
num [Block]
rest
promoteHeaders Int
num (Block
other:[Block]
rest) = Block
otherBlock -> [Block] -> [Block]
forall 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 ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Block -> Bool
isHeader Int
1) [Block]
rest Bool -> Bool -> Bool
|| (Block -> Bool) -> [Block] -> 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, Text -> Many Inline -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" ([Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
head1) (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$
              Text -> Many Inline -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"subtitle" ([Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
head2) Meta
meta)
          (Header Int
1 Attr
_ [Inline]
head1:[Block]
rest)
           | Bool -> Bool
not ((Block -> Bool) -> [Block] -> Bool
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,
                Text -> Many Inline -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" ([Inline] -> Many Inline
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 (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> Meta -> Meta)
-> Meta -> [([Inline], [[Block]])] -> Meta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Inline], [[Block]]) -> Meta -> Meta
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) = Text -> Many a -> a -> a
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta (Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. Walkable Inline a => a -> Text
stringify a
k) ([Many a] -> Many a
forall a. Monoid a => [a] -> a
mconcat ([Many a] -> Many a) -> [Many a] -> Many a
forall a b. (a -> b) -> a -> b
$ ([a] -> Many a) -> [[a]] -> [Many a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Many a
forall a. [a] -> Many a
fromList [[a]]
v)
       adjustAuthors :: Meta -> Meta
adjustAuthors (Meta Map Text MetaValue
metamap) = Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta) -> Map Text MetaValue -> Meta
forall a b. (a -> b) -> a -> b
$ (MetaValue -> MetaValue)
-> Text -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
splitAuthors Text
"author"
                                           (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ (MetaValue -> MetaValue)
-> Text -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
toPlain Text
"date"
                                           (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ (MetaValue -> MetaValue)
-> Text -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
toPlain Text
"title"
                                           (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Map Text MetaValue -> Map Text MetaValue
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (\Text
k ->
                                                 if Text
k Text -> Text -> Bool
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 ([MetaValue] -> MetaValue) -> [MetaValue] -> MetaValue
forall a b. (a -> b) -> a -> b
$ ([Inline] -> MetaValue) -> [[Inline]] -> [MetaValue]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> MetaValue
MetaInlines
                                                 ([[Inline]] -> [MetaValue]) -> [[Inline]] -> [MetaValue]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]]
splitAuthors' [Inline]
xs
       splitAuthors MetaValue
x                 = MetaValue
x
       splitAuthors' :: [Inline] -> [[Inline]]
splitAuthors'                  = ([Inline] -> [Inline]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> [Inline]
normalizeSpaces ([[Inline]] -> [[Inline]])
-> ([Inline] -> [[Inline]]) -> [Inline] -> [[Inline]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                         [Inline] -> [[Inline]]
splitOnSemi ([Inline] -> [[Inline]])
-> ([Inline] -> [Inline]) -> [Inline] -> [[Inline]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
factorSemi
       normalizeSpaces :: [Inline] -> [Inline]
normalizeSpaces                = [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Inline -> Bool
isSp ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                         (Inline -> Bool) -> [Inline] -> [Inline]
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                    = (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Inline -> Inline -> Bool
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 (Char -> Char -> Bool
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 Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
";" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
                                            Inline -> [Inline]
factorSemi (Text -> Inline
Str Text
ys)
                                          (Text
xs,Text
ys) -> Text -> Inline
Str Text
xs Inline -> [Inline] -> [Inline]
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 :: RSTParser m Pandoc
parseRST = do
  ParsecT Text ParserState m Text -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text ParserState m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines -- skip blank lines at beginning of file
  SourcePos
startPos <- ParsecT Text ParserState m SourcePos
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...
  Text
docMinusKeys <- [Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Text ParserState m [Text]
-> ParsecT Text ParserState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  ParsecT Text ParserState m Text
-> ParsecT Text ParserState m ()
-> ParsecT Text ParserState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT Text ParserState m Text
forall (m :: * -> *). PandocMonad m => RSTParser m Text
referenceKey ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text ParserState m Text
forall (m :: * -> *). PandocMonad m => RSTParser m Text
anchorDef ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            ParsecT Text ParserState m Text
forall (m :: * -> *). Monad m => RSTParser m Text
noteBlock ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text ParserState m Text
forall (m :: * -> *). Monad m => RSTParser m Text
citationBlock ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            ((Blocks, Text) -> Text
forall a b. (a, b) -> b
snd ((Blocks, Text) -> Text)
-> ParsecT Text ParserState m (Blocks, Text)
-> ParsecT Text ParserState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Blocks
-> ParsecT Text ParserState m (Blocks, Text)
forall (m :: * -> *) st a.
Monad m =>
ParsecT Text st m a -> ParsecT Text st m (a, Text)
withRaw ParsecT Text ParserState m Blocks
forall (m :: * -> *). Monad m => RSTParser m Blocks
comment) ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            ParsecT Text ParserState m Text
forall (m :: * -> *). PandocMonad m => RSTParser m Text
headerBlock ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text ParserState m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
lineClump) ParsecT Text ParserState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  Text -> ParsecT Text ParserState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Text
docMinusKeys
  SourcePos -> ParsecT Text ParserState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
startPos
  ParserState
st' <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let reversedNotes :: NoteTable
reversedNotes = ParserState -> NoteTable
stateNotes ParserState
st'
  (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateNotes :: NoteTable
stateNotes = NoteTable -> NoteTable
forall a. [a] -> [a]
reverse NoteTable
reversedNotes
                        , stateIdentifiers :: Set Text
stateIdentifiers = Set Text
forall a. Monoid a => a
mempty }
  -- now parse it for real...
  [Block]
blocks <- Blocks -> [Block]
forall a. Many a -> [a]
B.toList (Blocks -> [Block])
-> ParsecT Text ParserState m Blocks
-> ParsecT Text ParserState m [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks
  NoteTable
citations <- NoteTable -> NoteTable
forall a. Ord a => [a] -> [a]
sort (NoteTable -> NoteTable)
-> (ParserState -> NoteTable) -> ParserState -> NoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> NoteTable
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Text -> NoteTable)
-> (ParserState -> Map Text Text) -> ParserState -> NoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserState -> Map Text Text
stateCitations (ParserState -> NoteTable)
-> ParsecT Text ParserState m ParserState
-> ParsecT Text ParserState m NoteTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  [(Many Inline, [Blocks])]
citationItems <- ((Text, Text)
 -> ParsecT Text ParserState m (Many Inline, [Blocks]))
-> NoteTable
-> ParsecT Text ParserState m [(Many Inline, [Blocks])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Text) -> ParsecT Text ParserState m (Many Inline, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
(Text, Text) -> RSTParser m (Many Inline, [Blocks])
parseCitation NoteTable
citations
  let refBlock :: [Block]
refBlock = [Attr -> [Block] -> Block
Div (Text
"citations",[],[]) ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$
                 Blocks -> [Block]
forall a. Many a -> [a]
B.toList (Blocks -> [Block]) -> Blocks -> [Block]
forall a b. (a -> b) -> a -> b
$ [(Many Inline, [Blocks])] -> Blocks
B.definitionList [(Many Inline, [Blocks])]
citationItems | Bool -> Bool
not ([(Many Inline, [Blocks])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Many Inline, [Blocks])]
citationItems)]
  Bool
standalone <- (ReaderOptions -> Bool) -> ParserT Text ParserState m Bool
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 <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let meta :: Meta
meta = ParserState -> Meta
stateMeta ParserState
state
  let ([Block]
blocks', Meta
meta') = if Bool
standalone
                            then ([Block], Meta) -> ([Block], Meta)
titleTransform ([Block]
blocks, Meta
meta)
                            else ([Block]
blocks, Meta
meta)
  ParsecT Text ParserState m ()
forall (m :: * -> *) st s.
(PandocMonad m, HasLogMessages st) =>
ParserT s st m ()
reportLogMessages
  Pandoc -> RSTParser m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> RSTParser m Pandoc) -> Pandoc -> RSTParser m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta' ([Block]
blocks' [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
refBlock)

parseCitation :: PandocMonad m
              => (Text, Text) -> RSTParser m (Inlines, [Blocks])
parseCitation :: (Text, Text) -> RSTParser m (Many Inline, [Blocks])
parseCitation (Text
ref, Text
raw) = do
  Blocks
contents <- ParserT Text ParserState m Blocks
-> Text -> ParserT Text ParserState m Blocks
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParserT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks Text
raw
  (Many Inline, [Blocks]) -> RSTParser m (Many Inline, [Blocks])
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),
           [Blocks
contents])


--
-- parsing blocks
--

parseBlocks :: PandocMonad m => RSTParser m Blocks
parseBlocks :: RSTParser m Blocks
parseBlocks = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Text ParserState m [Blocks] -> RSTParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RSTParser m Blocks
-> ParsecT Text ParserState m ()
-> ParsecT Text ParserState m [Blocks]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
block ParsecT Text ParserState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

block :: PandocMonad m => RSTParser m Blocks
block :: RSTParser m Blocks
block = [RSTParser m Blocks] -> RSTParser m Blocks
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ RSTParser m Blocks
forall (m :: * -> *). Monad m => RSTParser m Blocks
codeBlock
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
blockQuote
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
fieldList
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
directive
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
anchor
               , RSTParser m Blocks
forall (m :: * -> *). Monad m => RSTParser m Blocks
comment
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
header
               , RSTParser m Blocks
forall (m :: * -> *) st. Monad m => ParserT Text st m Blocks
hrule
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
lineBlock     -- must go before definitionList
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
table
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
list
               , RSTParser m Blocks
forall (m :: * -> *). Monad m => RSTParser m Blocks
lhsCodeBlock
               , RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
para
               , Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT Text ParserState m Text -> RSTParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
               ] RSTParser m Blocks -> [Char] -> RSTParser m Blocks
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 :: Int -> RSTParser m (Text, Text)
rawFieldListItem Int
minIndent = RSTParser m (Text, Text) -> RSTParser m (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Text, Text) -> RSTParser m (Text, Text))
-> RSTParser m (Text, Text) -> RSTParser m (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
  Int
indent <- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int)
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Int
indent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minIndent
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  Text
name <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParserT Text ParserState m Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParserT s st m Char -> ParserT s st m end -> ParserT s st m Text
many1TillChar ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n") (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
  (() ()
-> ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline) ParsecT Text ParserState m ()
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
  Text
first <- ParserT Text ParserState m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine
  Text
rest <- Text
-> ParserT Text ParserState m Text
-> ParserT Text ParserState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParserT Text ParserState m Text
 -> ParserT Text ParserState m Text)
-> ParserT Text ParserState m Text
-> ParserT Text ParserState m Text
forall a b. (a -> b) -> a -> b
$ ParserT Text ParserState m Text -> ParserT Text ParserState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text ParserState m Text
 -> ParserT Text ParserState m Text)
-> ParserT Text ParserState m Text
-> ParserT Text ParserState m Text
forall a b. (a -> b) -> a -> b
$ do ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Int
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
indent (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar)
                               ParserT Text ParserState m Text
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Text st m Text
indentedBlock
  let raw :: Text
raw = (if Text -> Bool
T.null Text
first then Text
"" else Text
first Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest Text -> Text -> Text
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")
  (Text, Text) -> RSTParser m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Text
raw)

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

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

--
-- line block
--

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

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

--
-- paragraph block
--

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

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

--
-- header blocks
--

header :: PandocMonad m => RSTParser m Blocks
header :: RSTParser m Blocks
header = RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
doubleHeader RSTParser m Blocks -> RSTParser m Blocks -> RSTParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
singleHeader RSTParser m Blocks -> [Char] -> RSTParser m Blocks
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 :: RSTParser m Blocks
doubleHeader = do
  (Many Inline
txt, Char
c) <- RSTParser m (Many Inline, Char)
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 <- ParsecT Text ParserState m ParserState
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 HeaderType -> [HeaderType] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Char -> HeaderType
DoubleHeader Char
c) [HeaderType]
headerTable of
        Just Int
ind -> ([HeaderType]
headerTable, Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Maybe Int
Nothing  -> ([HeaderType]
headerTable [HeaderType] -> [HeaderType] -> [HeaderType]
forall a. [a] -> [a] -> [a]
++ [Char -> HeaderType
DoubleHeader Char
c], [HeaderType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HeaderType]
headerTable Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  ParserState -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (ParserState
state { stateHeaderTable :: [HeaderType]
stateHeaderTable = [HeaderType]
headerTable' })
  Attr
attr <- Attr -> Many Inline -> ParserT Text ParserState m 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
  Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Many Inline -> Blocks
B.headerWith Attr
attr Int
level Many Inline
txt

doubleHeader' :: PandocMonad m => RSTParser m (Inlines, Char)
doubleHeader' :: RSTParser m (Many Inline, Char)
doubleHeader' = RSTParser m (Many Inline, Char) -> RSTParser m (Many Inline, Char)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline, Char)
 -> RSTParser m (Many Inline, Char))
-> RSTParser m (Many Inline, Char)
-> RSTParser m (Many Inline, Char)
forall a b. (a -> b) -> a -> b
$ do
  Char
c <- [Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
underlineChars
  [Char]
rest <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c)  -- the top line
  let lenTop :: Int
lenTop = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest)
  ParserT Text ParserState m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
skipSpaces
  ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  Many Inline
txt <- Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> ParsecT Text ParserState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m (Many Inline)
-> ParsecT Text ParserState m [Many Inline]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text ParserState m Char -> ParserT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline ParserT Text ParserState m ()
-> ParsecT Text ParserState m (Many Inline)
-> ParsecT Text ParserState m (Many Inline)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline)
  SourcePos
pos <- ParsecT Text ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let len :: Int
len = SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  Bool
-> ParserT Text ParserState m () -> ParserT Text ParserState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lenTop) (ParserT Text ParserState m () -> ParserT Text ParserState m ())
-> ParserT Text ParserState m () -> ParserT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserT Text ParserState m ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Prelude.fail [Char]
"title longer than border"
  ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline              -- spaces and newline
  Int
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
lenTop (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c)  -- the bottom line
  ParserT Text ParserState m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
  (Many Inline, Char) -> RSTParser m (Many Inline, Char)
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 :: RSTParser m Blocks
singleHeader = do
  (Many Inline
txt, Char
c) <- RSTParser m (Many Inline, Char)
forall (m :: * -> *).
PandocMonad m =>
RSTParser m (Many Inline, Char)
singleHeader'
  ParserState
state <- ParsecT Text ParserState m ParserState
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 HeaderType -> [HeaderType] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Char -> HeaderType
SingleHeader Char
c) [HeaderType]
headerTable of
        Just Int
ind -> ([HeaderType]
headerTable, Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Maybe Int
Nothing  -> ([HeaderType]
headerTable [HeaderType] -> [HeaderType] -> [HeaderType]
forall a. [a] -> [a] -> [a]
++ [Char -> HeaderType
SingleHeader Char
c], [HeaderType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HeaderType]
headerTable Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  ParserState -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (ParserState
state { stateHeaderTable :: [HeaderType]
stateHeaderTable = [HeaderType]
headerTable' })
  Attr
attr <- Attr -> Many Inline -> ParserT Text ParserState m 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
  Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Many Inline -> Blocks
B.headerWith Attr
attr Int
level Many Inline
txt

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

--
-- hrule block
--

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

--
-- code blocks
--

-- read a line indented by a given string
indentedLine :: (HasReaderOptions st, Monad m)
             => Int -> ParserT Text st m Text
indentedLine :: Int -> ParserT Text st m Text
indentedLine Int
indents = ParserT Text st m Text -> ParserT Text st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m Text -> ParserT Text st m Text)
-> ParserT Text st m Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text st m Char -> ParsecT Text st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
  Int -> ParserT Text st m Int
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParserT Text st m Int
gobbleAtMostSpaces Int
indents
  ParserT Text st m Text
forall (m :: * -> *) st. Monad m => ParserT Text 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 Text st m Text
indentedBlock :: ParserT Text st m Text
indentedBlock = ParserT Text st m Text -> ParserT Text st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m Text -> ParserT Text st m Text)
-> ParserT Text st m Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ do
  Int
indents <- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int)
-> ParsecT Text st m [Char] -> ParsecT Text st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text st m [Char] -> ParsecT Text st m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text st m Char -> ParsecT Text st m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar)
  [Text]
lns <- ParserT Text st m Text -> ParsecT Text st m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParserT Text st m Text -> ParsecT Text st m [Text])
-> ParserT Text st m Text -> ParsecT Text st m [Text]
forall a b. (a -> b) -> a -> b
$ ParserT Text st m Text -> ParserT Text st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m Text -> ParserT Text st m Text)
-> ParserT Text st m Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ do Text
b <- Text -> ParserT Text st m Text -> ParserT Text st m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" ParserT Text st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
                          Text
l <- Int -> ParserT Text st m Text
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParserT Text st m Text
indentedLine Int
indents
                          Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l)
  ParserT Text st m Text -> ParsecT Text st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParserT Text st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
  Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT Text st m Text) -> Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
lns

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

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

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

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

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

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

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

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

--
-- block quotes
--

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

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

includeDirective :: PandocMonad m
                 => Text -> [(Text, Text)] -> Text
                 -> RSTParser m Blocks
includeDirective :: Text -> NoteTable -> Text -> RSTParser m Blocks
includeDirective Text
top NoteTable
fields Text
body = do
  let f :: Text
f = Text -> Text
trim Text
top
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Text -> Bool
T.null Text
f)
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null (Text -> Text
trim Text
body)
  -- options
  let (Maybe Int
startLine :: Maybe Int) = Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start-line" NoteTable
fields Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  let (Maybe Int
endLine :: Maybe Int) = Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"end-line" NoteTable
fields Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  SourcePos
oldPos <- ParsecT Text ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Text
oldInput <- ParsecT Text ParserState m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  [Text]
containers <- ParserState -> [Text]
stateContainers (ParserState -> [Text])
-> ParsecT Text ParserState m ParserState
-> ParsecT Text ParserState m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
f Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
containers) (ParsecT Text ParserState m () -> ParsecT Text ParserState m ())
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$
    PandocError -> ParsecT Text ParserState m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT Text ParserState m ())
-> PandocError -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ Text
"Include file loop at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourcePos -> Text
forall a. Show a => a -> Text
tshow SourcePos
oldPos
  (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s{ stateContainers :: [Text]
stateContainers = Text
f Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ParserState -> [Text]
stateContainers ParserState
s }
  Maybe Text
mbContents <- [[Char]] -> [Char] -> ParsecT Text ParserState m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[[Char]] -> [Char] -> m (Maybe Text)
readFileFromDirs [[Char]
"."] ([Char] -> ParsecT Text ParserState m (Maybe Text))
-> [Char] -> ParsecT Text ParserState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
f
  [Text]
contentLines <- case Maybe Text
mbContents of
                       Just Text
s -> [Text] -> ParsecT Text ParserState m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> ParsecT Text ParserState m [Text])
-> [Text] -> ParsecT Text ParserState m [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
                       Maybe Text
Nothing -> do
                         LogMessage -> ParsecT Text ParserState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage (LogMessage -> ParsecT Text ParserState m ())
-> LogMessage -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CouldNotLoadIncludeFile Text
f SourcePos
oldPos
                         [Text] -> ParsecT Text ParserState m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  let numLines :: Int
numLines = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
contentLines
  let startLine' :: Int
startLine' = case Maybe Int
startLine of
                        Maybe Int
Nothing            -> Int
1
                        Just Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    -> Int
x
                               | Bool
otherwise -> Int
numLines Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x -- negative from end
  let endLine' :: Int
endLine' = case Maybe Int
endLine of
                        Maybe Int
Nothing            -> Int
numLines Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        Just Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    -> Int
x
                               | Bool
otherwise -> Int
numLines Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x -- negative from end
  let contentLines' :: [Text]
contentLines' =   Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
startLine' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                      ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
endLine' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
contentLines
  let contentLines'' :: [Text]
contentLines'' = (case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"end-before" NoteTable
fields of
                             Just Text
patt -> (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
patt Text -> Text -> Bool
`T.isInfixOf`))
                             Maybe Text
Nothing   -> [Text] -> [Text]
forall a. a -> a
id) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       (case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start-after" NoteTable
fields of
                             Just Text
patt -> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
patt Text -> Text -> Bool
`T.isInfixOf`))
                             Maybe Text
Nothing   -> [Text] -> [Text]
forall a. a -> a
id) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
contentLines'
  let contents' :: Text
contents' = [Text] -> Text
T.unlines [Text]
contentLines''
  case Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"code" NoteTable
fields of
       Just Text
lang -> do
         let classes :: [Text]
classes =  [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words (Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" NoteTable
fields)
         let ident :: Text
ident = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
trimr (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"name" NoteTable
fields
         Text
-> [Text]
-> NoteTable
-> Text
-> Text
-> Bool
-> RSTParser m Blocks
forall (m :: * -> *).
Text
-> [Text]
-> NoteTable
-> Text
-> Text
-> Bool
-> RSTParser m Blocks
codeblock Text
ident [Text]
classes NoteTable
fields (Text -> Text
trimr Text
lang) Text
contents' Bool
False
       Maybe Text
Nothing   -> case Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"literal" NoteTable
fields of
                         Just Text
_  -> Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
"rst" Text
contents'
                         Maybe Text
Nothing -> do
                           SourcePos -> ParsecT Text ParserState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Text ParserState m ())
-> SourcePos -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Int -> Int -> SourcePos
newPos (Text -> [Char]
T.unpack Text
f) Int
1 Int
1
                           Text -> ParsecT Text ParserState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (Text -> ParsecT Text ParserState m ())
-> Text -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Text
contents' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                           Blocks
bs <- ParsecT Text ParserState m Text -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text ParserState m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines ParsecT Text ParserState m ()
-> RSTParser m Blocks -> RSTParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                  ([Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Text ParserState m [Blocks] -> RSTParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RSTParser m Blocks -> ParsecT Text ParserState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
block)
                           Text -> ParsecT Text ParserState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Text
oldInput
                           SourcePos -> ParsecT Text ParserState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
oldPos
                           (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s{ stateContainers :: [Text]
stateContainers =
                                         [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ParserState -> [Text]
stateContainers ParserState
s }
                           Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs


--
-- list blocks
--

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

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

-- parses bullet list start and returns its length (inc. following whitespace)
bulletListStart :: Monad m => ParserT Text st m Int
bulletListStart :: ParserT Text st m Int
bulletListStart = ParserT Text st m Int -> ParserT Text st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m Int -> ParserT Text st m Int)
-> ParserT Text st m Int -> ParserT Text st m Int
forall a b. (a -> b) -> a -> b
$ do
  ParserT Text st m Blocks -> ParserT Text st m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParserT Text st m Blocks
forall (m :: * -> *) st. Monad m => ParserT Text st m Blocks
hrule  -- because hrules start out just like lists
  Char
marker <- [Char] -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
bulletListMarkers
  [Char]
white <- ParsecT Text st m Char -> ParsecT Text st m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text st m [Char]
-> ParsecT Text st m [Char] -> ParsecT Text st m [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char]
"" [Char] -> ParsecT Text st m Char -> ParsecT Text st m [Char]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text st m Char -> ParsecT Text st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n')
  Int -> ParserT Text st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParserT Text st m Int) -> Int -> ParserT Text st m Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Char
markerChar -> [Char] -> [Char]
forall 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 :: ListNumberStyle -> ListNumberDelim -> RSTParser m Int
orderedListStart ListNumberStyle
style ListNumberDelim
delim = RSTParser m Int -> RSTParser m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Int -> RSTParser m Int)
-> RSTParser m Int -> RSTParser m Int
forall a b. (a -> b) -> a -> b
$ do
  (Int
_, Int
markerLen) <- RSTParser m Int -> ParserT Text ParserState m (Int, Int)
forall s (m :: * -> *) st a.
Stream s m Char =>
ParserT s st m a -> ParserT s st m (a, Int)
withHorizDisplacement (ListNumberStyle -> ListNumberDelim -> RSTParser m Int
forall s (m :: * -> *).
Stream s m Char =>
ListNumberStyle -> ListNumberDelim -> ParserT s ParserState m Int
orderedListMarker ListNumberStyle
style ListNumberDelim
delim)
  [Char]
white <- ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char]
"" [Char]
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n')
  Int -> RSTParser m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> RSTParser m Int) -> Int -> RSTParser m Int
forall a b. (a -> b) -> a -> b
$ Int
markerLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
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 :: Int -> RSTParser m Text
listLine Int
markerLength = RSTParser m Text -> RSTParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Text -> RSTParser m Text)
-> RSTParser m Text -> RSTParser m Text
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline
  Int -> RSTParser m Text
forall s (m :: * -> *) st.
(Stream s m Char, HasReaderOptions st) =>
Int -> ParserT s st m Text
indentWith Int
markerLength
  RSTParser m Text
forall (m :: * -> *) st. Monad m => ParserT Text 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 :: RSTParser m Int -> RSTParser m (Int, Text)
rawListItem RSTParser m Int
start = RSTParser m (Int, Text) -> RSTParser m (Int, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Int, Text) -> RSTParser m (Int, Text))
-> RSTParser m (Int, Text) -> RSTParser m (Int, Text)
forall a b. (a -> b) -> a -> b
$ do
  Int
markerLength <- RSTParser m Int
start
  Text
firstLine <- ParserT Text ParserState m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLineNewline
  [Text]
restLines <- ParserT Text ParserState m Text
-> ParsecT Text ParserState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Int -> ParserT Text ParserState m Text
forall (m :: * -> *). Monad m => Int -> RSTParser m Text
listLine Int
markerLength)
  (Int, Text) -> RSTParser m (Int, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
markerLength, Text
firstLine Text -> Text -> Text
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 :: Int -> RSTParser m Text
listContinuation Int
markerLength = RSTParser m Text -> RSTParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Text -> RSTParser m Text)
-> RSTParser m Text -> RSTParser m Text
forall a b. (a -> b) -> a -> b
$ do
  Text
blanks <- ParserT Text ParserState m Char -> RSTParser m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParserT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline
  [Text]
result <- RSTParser m Text -> ParsecT Text ParserState m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Int -> RSTParser m Text
forall (m :: * -> *). Monad m => Int -> RSTParser m Text
listLine Int
markerLength)
  Text -> RSTParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> RSTParser m Text) -> Text -> RSTParser m Text
forall a b. (a -> b) -> a -> b
$ Text
blanks Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
result

listItem :: PandocMonad m
         => RSTParser m Int
         -> RSTParser m Blocks
listItem :: RSTParser m Int -> RSTParser m Blocks
listItem RSTParser m Int
start = RSTParser m Blocks -> RSTParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Blocks -> RSTParser m Blocks)
-> RSTParser m Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  (Int
markerLength, Text
first) <- RSTParser m Int -> RSTParser m (Int, Text)
forall (m :: * -> *).
Monad m =>
RSTParser m Int -> RSTParser m (Int, Text)
rawListItem RSTParser m Int
start
  [Text]
rest <- ParsecT Text ParserState m Text
-> ParsecT Text ParserState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Int -> ParsecT Text ParserState m Text
forall (m :: * -> *). Monad m => Int -> RSTParser m Text
listContinuation Int
markerLength)
  ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline ParsecT Text ParserState m ()
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () () -> RSTParser m Int -> ParsecT Text ParserState m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RSTParser m Int -> RSTParser m Int
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 <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let oldContext :: ParserContext
oldContext = ParserState -> ParserContext
stateParserContext ParserState
state
  ParserState -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (ParserState -> ParsecT Text ParserState m ())
-> ParserState -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ ParserState
state {stateParserContext :: ParserContext
stateParserContext = ParserContext
ListItemState}
  -- parse the extracted block, which may itself contain block elements
  Blocks
parsed <- RSTParser m Blocks -> Text -> RSTParser m Blocks
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks (Text -> RSTParser m Blocks) -> Text -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat (Text
firstText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
rest) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\ParserState
st -> ParserState
st {stateParserContext :: ParserContext
stateParserContext = ParserContext
oldContext})
  Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
parsed of
                [Para [Inline]
xs] ->
                   Block -> Blocks
forall a. a -> Many a
B.singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Plain [Inline]
xs
                [Para [Inline]
xs, BulletList [[Block]]
ys] ->
                   [Block] -> Blocks
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] ->
                   [Block] -> Blocks
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] ->
                   [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [[Inline] -> Block
Plain [Inline]
xs, [([Inline], [[Block]])] -> Block
DefinitionList [([Inline], [[Block]])]
ys]
                [Block]
_         -> Blocks
parsed

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

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

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

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

directiveLabel :: Monad m => RSTParser m Text
directiveLabel :: RSTParser m Text
directiveLabel = Text -> Text
T.toLower
  (Text -> Text) -> RSTParser m Text -> RSTParser m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text ParserState m Char
-> ParserT Text ParserState m [Char] -> RSTParser m Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParserT s st m Char -> ParserT s st m end -> ParserT s st m Text
many1TillChar (ParserT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParserT Text ParserState m Char
-> ParserT Text ParserState m Char
-> ParserT Text ParserState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') (ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text ParserState m [Char]
 -> ParserT Text ParserState m [Char])
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"::")

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

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

tableDirective :: PandocMonad m
               => Text -> [(Text, Text)] -> Text -> RSTParser m Blocks
tableDirective :: Text -> NoteTable -> Text -> RSTParser m Blocks
tableDirective Text
top NoteTable
fields Text
body = do
  Blocks
bs <- RSTParser m Blocks -> Text -> RSTParser m Blocks
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks Text
body
  case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
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') = [ColSpec] -> ([Alignment], [ColWidth])
forall a b. [(a, b)] -> ([a], [b])
unzip [ColSpec]
tspecs'
         Many Inline
title <- ParserT Text ParserState m (Many Inline)
-> Text -> ParserT Text ParserState m (Many Inline)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' (Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> ParserT Text ParserState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text ParserState m (Many Inline)
-> ParsecT Text ParserState m [Many Inline]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParserT Text ParserState m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline) Text
top
         Int
columns <- (ReaderOptions -> Int) -> ParserT Text ParserState m Int
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 (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1.0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numOfCols))) (Double -> ColWidth) -> f Double -> f ColWidth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
ws
         let widths :: [ColWidth]
widths = case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"widths" NoteTable
fields of
                           Just Text
"auto" -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
                           Just Text
"grid" -> [ColWidth]
widths'
                           Just Text
specs -> [Double] -> [ColWidth]
forall (f :: * -> *). Functor f => f Double -> f ColWidth
normWidths
                               ([Double] -> [ColWidth]) -> [Double] -> [ColWidth]
forall a b. (a -> b) -> a -> b
$ (Text -> Double) -> [Text] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
0 :: Double) (Maybe Double -> Double)
-> (Text -> Maybe Double) -> Text -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead)
                               ([Text] -> [Double]) -> [Text] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> [Char] -> Bool
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 = [Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns' [ColWidth]
widths
         Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Block -> Blocks
forall a. a -> Many a
B.singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr (Maybe [Inline] -> Blocks -> Caption
B.caption Maybe [Inline]
forall a. Maybe a
Nothing (Many Inline -> Blocks
B.plain Many Inline
title))
                                  [ColSpec]
tspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot
       [Block]
_ -> Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
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) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Cell -> Int
cellLength (Cell -> Int) -> [Cell] -> [Int]
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]
_) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
w
    strictPos :: Double -> ColWidth
strictPos Double
w
      | Double
w Double -> Double -> Bool
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 :: Text -> NoteTable -> Text -> RSTParser m Blocks
listTableDirective Text
top NoteTable
fields Text
body = do
  Blocks
bs <- RSTParser m Blocks -> Text -> RSTParser m Blocks
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks Text
body
  Many Inline
title <- ParserT Text ParserState m (Many Inline)
-> Text -> ParserT Text ParserState m (Many Inline)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' (Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> ParserT Text ParserState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text ParserState m (Many Inline)
-> ParsecT Text ParserState m [Many Inline]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParserT Text ParserState m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline) Text
top
  let rows :: [[Blocks]]
rows = [Block] -> [[Blocks]]
takeRows ([Block] -> [[Blocks]]) -> [Block] -> [[Blocks]]
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs
      headerRowsNum :: Int
headerRowsNum = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int
0 :: Int) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
         Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"header-rows" NoteTable
fields Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
      ([Blocks]
headerRow,[[Blocks]]
bodyRows,Int
numOfCols) = case [[Blocks]]
rows of
        [Blocks]
x:[[Blocks]]
xs -> if Int
headerRowsNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                   then ([Blocks]
x, [[Blocks]]
xs, [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Blocks]
x)
                   else ([], [[Blocks]]
rows, [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Blocks]
x)
        [[Blocks]]
_ -> ([],[],Int
0)
      widths :: [ColWidth]
widths = case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"widths" NoteTable
fields of
        Just Text
"auto" -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
        Just Text
specs -> [Double] -> [ColWidth]
forall (f :: * -> *).
(Functor f, Foldable f) =>
f Double -> f ColWidth
normWidths ([Double] -> [ColWidth]) -> [Double] -> [ColWidth]
forall a b. (a -> b) -> a -> b
$ (Text -> Double) -> [Text] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
0 :: Double) (Maybe Double -> Double)
-> (Text -> Maybe Double) -> Text -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead) ([Text] -> [Double]) -> [Text] -> [Double]
forall a b. (a -> b) -> a -> b
$
                           (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" ," :: String)) Text
specs
        Maybe Text
_ -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
      toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
B.simpleCell
      toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
  Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
B.table (Blocks -> Caption
B.simpleCaption (Blocks -> Caption) -> Blocks -> Caption
forall a b. (a -> b) -> a -> b
$ Many Inline -> Blocks
B.plain Many Inline
title)
             ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
numOfCols Alignment
AlignDefault) [ColWidth]
widths)
             (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ [Blocks] -> [Row]
toHeaderRow [Blocks]
headerRow)
             [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
bodyRows]
             (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])
    where takeRows :: [Block] -> [[Blocks]]
takeRows [BulletList [[Block]]
rows] = ([Block] -> [Blocks]) -> [[Block]] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> [Blocks]
takeCells [[Block]]
rows
          takeRows [Block]
_                 = []
          takeCells :: [Block] -> [Blocks]
takeCells [BulletList [[Block]]
cells] = ([Block] -> Blocks) -> [[Block]] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [[Block]]
cells
          takeCells [Block]
_                  = []
          normWidths :: f Double -> f ColWidth
normWidths f Double
ws = Double -> ColWidth
strictPos (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (f Double -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum f Double
ws)) (Double -> ColWidth) -> f Double -> f ColWidth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
ws
          strictPos :: Double -> ColWidth
strictPos Double
w
            | Double
w Double -> Double -> Bool
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 :: Text -> NoteTable -> Text -> RSTParser m Blocks
csvTableDirective Text
top NoteTable
fields Text
rawcsv = do
  let explicitHeader :: Maybe Text
explicitHeader = Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
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 (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
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 :: Char
csvQuote = case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"quote" NoteTable
fields of
                                Just (Text -> [Char]
T.unpack -> [Char
c])
                                  -> Char
c
                                Maybe Text
_ -> Char
'"'
              , csvEscape :: Maybe Char
csvEscape = case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"escape" NoteTable
fields of
                                Just (Text -> [Char]
T.unpack -> [Char
c])
                                  -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
                                Maybe Text
_ -> Maybe Char
forall a. Maybe a
Nothing
              , csvKeepSpace :: Bool
csvKeepSpace = case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
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 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (case Maybe Text
explicitHeader of
                                       Just Text
_  -> Int
1 :: Int
                                       Maybe Text
Nothing -> Int
0 :: Int) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
           Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"header-rows" NoteTable
fields Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  Text
rawcsv' <- case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"file" NoteTable
fields Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"url" NoteTable
fields of
                  Just Text
u  -> do
                    (ByteString
bs, Maybe Text
_) <- Text -> ParsecT Text ParserState m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
u
                    Text -> ParsecT Text ParserState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Text ParserState m Text)
-> Text -> ParsecT Text ParserState m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
UTF8.toText ByteString
bs
                  Maybe Text
Nothing -> Text -> ParsecT Text ParserState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
rawcsv
  let res :: Either ParseError [[Text]]
res = CSVOptions -> Text -> Either ParseError [[Text]]
parseCSV CSVOptions
opts (case Maybe Text
explicitHeader of
                              Just Text
h  -> Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rawcsv'
                              Maybe Text
Nothing -> Text
rawcsv')
  case Either ParseError [[Text]]
res of
       Left ParseError
e  ->
         PandocError -> RSTParser m Blocks
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> RSTParser m Blocks)
-> PandocError -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> ParseError -> PandocError
PandocParsecError Text
"csv table" ParseError
e
       Right [[Text]]
rawrows -> do
         let singleParaToPlain :: Blocks -> Blocks
singleParaToPlain Blocks
bs =
               case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs of
                 [Para [Inline]
ils] -> [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [[Inline] -> Block
Plain [Inline]
ils]
                 [Block]
_          -> Blocks
bs
         let parseCell :: Text -> ParsecT Text ParserState m Blocks
parseCell Text
t = Blocks -> Blocks
singleParaToPlain
                (Blocks -> Blocks)
-> ParsecT Text ParserState m Blocks
-> ParsecT Text ParserState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Blocks
-> Text -> ParsecT Text ParserState m Blocks
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParsecT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
         let parseRow :: [Text] -> ParsecT Text ParserState m [Blocks]
parseRow = (Text -> RSTParser m Blocks)
-> [Text] -> ParsecT Text ParserState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => Text -> RSTParser m Blocks
parseCell
         [[Blocks]]
rows <- ([Text] -> ParsecT Text ParserState m [Blocks])
-> [[Text]] -> ParsecT Text ParserState m [[Blocks]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Text] -> ParsecT Text ParserState m [Blocks]
parseRow [[Text]]
rawrows
         let ([Blocks]
headerRow,[[Blocks]]
bodyRows,Int
numOfCols) =
              case [[Blocks]]
rows of
                   [Blocks]
x:[[Blocks]]
xs -> if Int
headerRowsNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                          then ([Blocks]
x, [[Blocks]]
xs, [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Blocks]
x)
                          else ([], [[Blocks]]
rows, [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Blocks]
x)
                   [[Blocks]]
_ -> ([],[],Int
0)
         Many Inline
title <- ParserT Text ParserState m (Many Inline)
-> Text -> ParserT Text ParserState m (Many Inline)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' (Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> ParserT Text ParserState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text ParserState m (Many Inline)
-> ParsecT Text ParserState m [Many Inline]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParserT Text ParserState m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline) Text
top
         let strictPos :: Double -> ColWidth
strictPos Double
w
               | Double
w Double -> Double -> Bool
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 (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (f Double -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum f Double
ws)) (Double -> ColWidth) -> f Double -> f ColWidth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
ws
         let widths :: [ColWidth]
widths =
               case Text -> Text
trim (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"widths" NoteTable
fields of
                 Just Text
"auto" -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
                 Just Text
specs -> [Double] -> [ColWidth]
forall (f :: * -> *).
(Functor f, Foldable f) =>
f Double -> f ColWidth
normWidths
                               ([Double] -> [ColWidth]) -> [Double] -> [ColWidth]
forall a b. (a -> b) -> a -> b
$ (Text -> Double) -> [Text] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
0 :: Double) (Maybe Double -> Double)
-> (Text -> Maybe Double) -> Text -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead)
                               ([Text] -> [Double]) -> [Text] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" ," :: String)) Text
specs
                 Maybe Text
_ -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numOfCols ColWidth
ColWidthDefault
         let toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
B.simpleCell
             toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
         Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
B.table (Blocks -> Caption
B.simpleCaption (Blocks -> Caption) -> Blocks -> Caption
forall a b. (a -> b) -> a -> b
$ Many Inline -> Blocks
B.plain Many Inline
title)
                          ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
numOfCols Alignment
AlignDefault) [ColWidth]
widths)
                          (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ [Blocks] -> [Row]
toHeaderRow [Blocks]
headerRow)
                          [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
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 :: Text -> NoteTable -> RSTParser m Blocks
addNewRole Text
roleText NoteTable
fields = do
    SourcePos
pos <- ParsecT Text ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    (Text
role, Text
parentRole) <- ParserT Text ParserState m (Text, Text)
-> Text -> ParserT Text ParserState m (Text, Text)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParserT Text ParserState m (Text, Text)
inheritedRole Text
roleText
    Map Text (Text, Maybe Text, Attr)
customRoles <- ParserState -> Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles (ParserState -> Map Text (Text, Maybe Text, Attr))
-> ParsecT Text ParserState m ParserState
-> ParsecT Text ParserState m (Map Text (Text, Maybe Text, Attr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m ParserState
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 a -> Map a (a, b, c) -> Maybe (a, b, c)
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) =
               (Text, Maybe Text, Attr)
-> Map Text (Text, Maybe Text, Attr) -> (Text, Maybe Text, Attr)
forall a b c. Ord a => (a, b, c) -> Map a (a, b, c) -> (a, b, c)
getBaseRole (Text
parentRole, Maybe Text
forall a. Maybe a
Nothing, Attr
nullAttr) Map Text (Text, Maybe Text, Attr)
customRoles
        fmt :: Maybe Text
fmt = if Text
parentRole Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"raw" then Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"format" NoteTable
fields else Maybe Text
baseFmt
        annotate :: [Text] -> [Text]
        annotate :: [Text] -> [Text]
annotate = ([Text] -> [Text])
-> (Text -> [Text] -> [Text]) -> Maybe Text -> [Text] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text] -> [Text]
forall a. a -> a
id (:) (Maybe Text -> [Text] -> [Text]) -> Maybe Text -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
            if Text
baseRole Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"code"
               then Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"language" NoteTable
fields
               else Maybe Text
forall a. Maybe a
Nothing
        attr :: Attr
attr = let (Text
ident, [Text]
classes, NoteTable
keyValues) = Attr
baseAttr
        -- nub in case role name & language class are the same
               in (Text
ident, [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
role Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
annotate ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
classes, NoteTable
keyValues)

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

    (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s {
        stateRstCustomRoles :: Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles =
          Text
-> (Text, Maybe Text, Attr)
-> Map Text (Text, Maybe Text, Attr)
-> Map Text (Text, Maybe Text, Attr)
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
    }

    Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
  where
    countKeys :: Text -> Int
countKeys Text
k = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> (NoteTable -> [Text]) -> NoteTable -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k) ([Text] -> [Text]) -> (NoteTable -> [Text]) -> NoteTable -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> NoteTable -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst (NoteTable -> Int) -> NoteTable -> Int
forall a b. (a -> b) -> a -> b
$ NoteTable
fields
    inheritedRole :: ParserT Text ParserState m (Text, Text)
inheritedRole =
        (,) (Text -> Text -> (Text, Text))
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Text
forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleName ParsecT Text ParserState m (Text -> (Text, Text))
-> ParsecT Text ParserState m Text
-> ParserT Text ParserState m (Text, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState m Text
forall (m :: * -> *). PandocMonad m => RSTParser m Text
roleName ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')')
                            ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> ParsecT Text ParserState m Text
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\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 = Text -> ((Char, Text) -> Text) -> Maybe (Char, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
"&#x" Text -> Text -> Text
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
unicodeTransform (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
s)
                                       (Maybe (Char, Text) -> Text) -> Maybe (Char, Text) -> Text
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 (Text -> Text) -> Text -> Text
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 = Text -> ((Char, Text) -> Text) -> Maybe (Char, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
pref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
unicodeTransform Text
zs)
                     (\(Char
c,Text
s) -> Char -> Text -> Text
T.cons Char
c (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
unicodeTransform Text
s)
                     (Maybe (Char, Text) -> Text) -> Maybe (Char, Text) -> Text
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 = (Char -> (Char, Text)) -> Maybe Char -> Maybe (Char, Text)
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 = Text -> Maybe Char
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text
"'\\x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")

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

-- divide string by blanklines, and surround with
-- \begin{aligned}...\end{aligned} if needed.
toChunks :: Text -> [Text]
toChunks :: Text -> [Text]
toChunks = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Text -> Bool
T.null
           ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
addAligned (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines)
           ([[Text]] -> [Text]) -> (Text -> [[Text]]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [[Text]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy ((Char -> Bool) -> Text -> Bool
T.all (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" \t" :: String))) ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\\end{aligned}"
                          else Text
s

codeblock :: Text -> [Text] -> [(Text, Text)] -> Text -> Text -> Bool
          -> RSTParser m Blocks
codeblock :: Text
-> [Text]
-> NoteTable
-> Text
-> Text
-> Bool
-> RSTParser m Blocks
codeblock Text
ident [Text]
classes NoteTable
fields Text
lang Text
body Bool
rmTrailingNewlines =
  Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith Attr
attribs (Text -> Blocks) -> Text -> Blocks
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 Text -> Text
forall a. a -> a
id
          attribs :: Attr
attribs = (Text
ident, [Text]
classes', NoteTable
kvs)
          classes' :: [Text]
classes' = Text
lang
                    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text
"numberLines" | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number-lines" NoteTable
fields)]
                    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
classes
          kvs :: NoteTable
kvs = [(Text
k,Text
v) | (Text
k,Text
v) <- NoteTable
fields, Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"number-lines", Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"class",
                                          Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"id", Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"name"]
                NoteTable -> NoteTable -> NoteTable
forall a. [a] -> [a] -> [a]
++ case Text -> NoteTable -> Maybe Text
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
_ -> []

---
--- note block
---

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

citationBlock :: Monad m => RSTParser m Text
citationBlock :: RSTParser m Text
citationBlock = RSTParser m Text -> RSTParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Text -> RSTParser m Text)
-> RSTParser m Text -> RSTParser m Text
forall a b. (a -> b) -> a -> b
$ do
  (Text
ref, Text
raw, Text
replacement) <- RSTParser m Text -> RSTParser m (Text, Text, Text)
forall (m :: * -> *).
Monad m =>
RSTParser m Text -> RSTParser m (Text, Text, Text)
noteBlock' RSTParser m Text
forall (m :: * -> *). Monad m => RSTParser m Text
citationMarker
  (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s ->
     ParserState
s { stateCitations :: Map Text Text
stateCitations = Text -> Text -> Map Text Text -> Map Text Text
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 = Key -> ((Text, Text), Attr) -> KeyTable -> KeyTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text -> Key
toKey Text
ref) ((Text
"#" Text -> Text -> 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
  Text -> RSTParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
replacement

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

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

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

--
-- reference key
--

quotedReferenceName :: PandocMonad m => RSTParser m Text
quotedReferenceName :: RSTParser m Text
quotedReferenceName = RSTParser m Text -> RSTParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Text -> RSTParser m Text)
-> RSTParser m Text -> RSTParser m Text
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`') -- `` means inline code!
  ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char -> RSTParser m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m 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 Text st m Text
simpleReferenceName :: ParserT Text st m Text
simpleReferenceName = do
  Char
x <- ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
  [Char]
xs <- ParsecT Text st m Char -> ParsecT Text st m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text st m Char -> ParsecT Text st m [Char])
-> ParsecT Text st m Char -> ParsecT Text st m [Char]
forall a b. (a -> b) -> a -> b
$  ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
            ParsecT Text st m Char
-> ParsecT Text st m Char -> ParsecT Text st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text st m Char -> ParsecT Text st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"-_:+." ParsecT Text st m Char
-> ParsecT Text st m Char -> ParsecT Text st m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text st m Char -> ParsecT Text st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum)
  Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT Text st m Text) -> Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)

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

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

targetURI :: Monad m => ParserT Text st m Text
targetURI :: ParserT Text st m Text
targetURI = do
  ParserT Text st m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
skipSpaces
  ParserT Text st m () -> ParserT Text st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParserT Text st m () -> ParserT Text st m ())
-> ParserT Text st m () -> ParserT Text st m ()
forall a b. (a -> b) -> a -> b
$ ParserT Text st m () -> ParserT Text st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m () -> ParserT Text st m ())
-> ParserT Text st m () -> ParserT Text st m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT Text st m Char
-> ParserT Text st m () -> ParserT Text st m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text st m Char -> ParserT Text st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline
  Text
contents <- Text -> Text
trim (Text -> Text) -> ParserT Text st m Text -> ParserT Text st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     ParsecT Text st m Char -> ParserT Text st m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ((Char -> Bool) -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n')
     ParsecT Text st m Char
-> ParsecT Text st m Char -> ParsecT Text st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text st m Char -> ParsecT Text st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT Text st m Char
-> ParsecT Text st m [Char] -> ParsecT Text st m [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text st m Char -> ParsecT Text st m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text st m [Char]
-> ParsecT Text st m Char -> ParsecT Text st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
" \t\n"))
  ParserT Text st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
  Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT Text st m Text) -> Text -> ParserT Text st m Text
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'`') Text
xs Text -> Text -> Text
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 :: RSTParser m ()
substKey = RSTParser m () -> RSTParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m () -> RSTParser m ())
-> RSTParser m () -> RSTParser m ()
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
".."
  ParsecT Text ParserState m Char -> RSTParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar
  (Many Inline
alt,Text
ref) <- ParsecT Text ParserState m (Many Inline)
-> ParsecT Text ParserState m (Many Inline, Text)
forall (m :: * -> *) st a.
Monad m =>
ParsecT Text st m a -> ParsecT Text st m (a, Text)
withRaw (ParsecT Text ParserState m (Many Inline)
 -> ParsecT Text ParserState m (Many Inline, Text))
-> ParsecT Text ParserState m (Many Inline)
-> ParsecT Text ParserState m (Many Inline, Text)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat
                      ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> ParsecT Text ParserState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m (Many Inline)
-> ParsecT Text ParserState m [Many Inline]
forall end s (m :: * -> *) st t a.
(Show end, Stream s m Char) =>
ParserT s st m t
-> ParserT s st m end -> ParserT s st m a -> ParserT s st m [a]
enclosed (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|') (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|') ParsecT Text ParserState m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline
  [Block]
res <- Blocks -> [Block]
forall a. Many a -> [a]
B.toList (Blocks -> [Block])
-> ParsecT Text ParserState m Blocks
-> ParsecT Text ParserState m [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
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)]] ->
                Many Inline -> ParsecT Text ParserState m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> ParsecT Text ParserState m (Many Inline))
-> Many Inline -> ParsecT Text ParserState m (Many Inline)
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')]] ->
                Many Inline -> ParsecT Text ParserState m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> ParsecT Text ParserState m (Many Inline))
-> Many Inline -> ParsecT Text ParserState m (Many Inline)
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] -> Many Inline -> ParsecT Text ParserState m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> ParsecT Text ParserState m (Many Inline))
-> Many Inline -> ParsecT Text ParserState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList [Inline]
ils
             [Block]
_          -> ParsecT Text ParserState m (Many Inline)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  let key :: Key
key = Text -> Key
toKey (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripFirstAndLast Text
ref
  (ParserState -> ParserState) -> RSTParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> RSTParser m ())
-> (ParserState -> ParserState) -> RSTParser m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s{ stateSubstitutions :: SubstTable
stateSubstitutions =
                          Key -> Many Inline -> SubstTable -> SubstTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
key Many Inline
il (SubstTable -> SubstTable) -> SubstTable -> SubstTable
forall a b. (a -> b) -> a -> b
$ ParserState -> SubstTable
stateSubstitutions ParserState
s }

anonymousKey :: Monad m => RSTParser m ()
anonymousKey :: RSTParser m ()
anonymousKey = RSTParser m () -> RSTParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m () -> RSTParser m ())
-> RSTParser m () -> RSTParser m ()
forall a b. (a -> b) -> a -> b
$ do
  [Text] -> ParserT Text ParserState m Text
forall s (m :: * -> *) st.
Stream s m Char =>
[Text] -> ParserT s st m Text
oneOfStrings [Text
".. __:", Text
"__"]
  Text
src <- ParserT Text ParserState m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
targetURI
  SourcePos
pos <- ParsecT Text ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let key :: Key
key = Text -> Key
toKey (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%09d" (SourcePos -> Int
sourceLine SourcePos
pos))
  (ParserState -> ParserState) -> RSTParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> RSTParser m ())
-> (ParserState -> ParserState) -> RSTParser m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateKeys :: KeyTable
stateKeys = Key -> ((Text, Text), Attr) -> KeyTable -> KeyTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
key ((Text
src,Text
""), Attr
nullAttr) (KeyTable -> KeyTable) -> KeyTable -> KeyTable
forall a b. (a -> b) -> a -> b
$
                          ParserState -> KeyTable
stateKeys ParserState
s }

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

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

anchorDef :: PandocMonad m => RSTParser m Text
anchorDef :: RSTParser m Text
anchorDef = RSTParser m Text -> RSTParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Text -> RSTParser m Text)
-> RSTParser m Text -> RSTParser m Text
forall a b. (a -> b) -> a -> b
$ do
  ([Text]
refs, Text
raw) <- ParsecT Text ParserState m [Text]
-> ParsecT Text ParserState m ([Text], Text)
forall (m :: * -> *) st a.
Monad m =>
ParsecT Text st m a -> ParsecT Text st m (a, Text)
withRaw (ParsecT Text ParserState m [Text]
 -> ParsecT Text ParserState m ([Text], Text))
-> ParsecT Text ParserState m [Text]
-> ParsecT Text ParserState m ([Text], Text)
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState m [Text]
-> ParsecT Text ParserState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState m [Text]
forall (m :: * -> *). PandocMonad m => RSTParser m [Text]
referenceNames ParsecT Text ParserState m [Text]
-> RSTParser m Text -> ParsecT Text ParserState m [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RSTParser m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines)
  [Text]
-> (Text -> ParsecT Text ParserState m ())
-> ParsecT Text ParserState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
refs ((Text -> ParsecT Text ParserState m ())
 -> ParsecT Text ParserState m ())
-> (Text -> ParsecT Text ParserState m ())
-> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \Text
rawkey ->
    (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s { stateKeys :: KeyTable
stateKeys =
       Key -> ((Text, Text), Attr) -> KeyTable -> KeyTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text -> Key
toKey Text
rawkey) ((Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rawkey,Text
""), Attr
nullAttr) (KeyTable -> KeyTable) -> KeyTable -> KeyTable
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)
  Text -> RSTParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
raw

anchor :: PandocMonad m => RSTParser m Blocks
anchor :: RSTParser m Blocks
anchor = RSTParser m Blocks -> RSTParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Blocks -> RSTParser m Blocks)
-> RSTParser m Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  [Text]
refs <- RSTParser m [Text]
forall (m :: * -> *). PandocMonad m => RSTParser m [Text]
referenceNames
  ParserT Text ParserState m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
  Blocks
b <- RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
block
  let addDiv :: Text -> Blocks -> Blocks
addDiv Text
ref = Attr -> Blocks -> Blocks
B.divWith (Text
ref, [], [])
  let emptySpanWithId :: Text -> Inline
emptySpanWithId Text
id' = Attr -> [Inline] -> Inline
Span (Text
id',[],[]) []
  -- put identifier on next block:
  case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
b of
       [Header Int
lev (Text
_,[Text]
classes,NoteTable
kvs) [Inline]
txt] ->
         case [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
refs of
              [] -> Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
b
              (Text
r:[Text]
rs) -> Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ Block -> Blocks
forall a. a -> Many a
B.singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$
                           Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
r,[Text]
classes,NoteTable
kvs)
                             ([Inline]
txt [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Text -> Inline) -> [Text] -> [Inline]
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]
_ -> Blocks -> RSTParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RSTParser m Blocks) -> Blocks -> RSTParser m Blocks
forall a b. (a -> b) -> a -> b
$ (Text -> Blocks -> Blocks) -> Blocks -> [Text] -> Blocks
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Blocks -> Blocks
addDiv Blocks
b [Text]
refs

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

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

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

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

-- Parse a table footer
simpleTableFooter :: Monad m => RSTParser m Text
simpleTableFooter :: RSTParser m Text
simpleTableFooter = RSTParser m Text -> RSTParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m Text -> RSTParser m Text)
-> RSTParser m Text -> RSTParser m Text
forall a b. (a -> b) -> a -> b
$ Char -> RSTParser m Char
forall (m :: * -> *). Monad m => Char -> RSTParser m Char
simpleTableSep Char
'=' RSTParser m Char -> RSTParser m Text -> RSTParser m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RSTParser m Text
forall s (m :: * -> *) st. Stream s m 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 :: [Int] -> RSTParser m [Text]
simpleTableRawLine [Int]
indices = [Int] -> Text -> [Text]
simpleTableSplitLine [Int]
indices (Text -> [Text])
-> ParsecT Text ParserState m Text -> RSTParser m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine

simpleTableRawLineWithEmptyCell :: Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLineWithEmptyCell :: [Int] -> RSTParser m [Text]
simpleTableRawLineWithEmptyCell [Int]
indices = RSTParser m [Text] -> RSTParser m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m [Text] -> RSTParser m [Text])
-> RSTParser m [Text] -> RSTParser m [Text]
forall a b. (a -> b) -> a -> b
$ do
  [Text]
cs <- [Int] -> RSTParser m [Text]
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
isEmptyCell [Text]
cs
  [Text] -> RSTParser m [Text]
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 :: [Int] -> RSTParser m [Blocks]
simpleTableRow [Int]
indices = do
  ParserT Text ParserState m Text -> ParserT Text ParserState m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParserT Text ParserState m Text
forall (m :: * -> *). Monad m => RSTParser m Text
simpleTableFooter
  [Text]
firstLine <- [Int] -> RSTParser m [Text]
forall (m :: * -> *). Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLine [Int]
indices
  [[Text]]
conLines  <- RSTParser m [Text] -> ParsecT Text ParserState m [[Text]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (RSTParser m [Text] -> ParsecT Text ParserState m [[Text]])
-> RSTParser m [Text] -> ParsecT Text ParserState m [[Text]]
forall a b. (a -> b) -> a -> b
$ [Int] -> RSTParser m [Text]
forall (m :: * -> *). Monad m => [Int] -> RSTParser m [Text]
simpleTableRawLineWithEmptyCell [Int]
indices
  let cols :: [Text]
cols = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
T.unlines ([[Text]] -> [Text])
-> ([[Text]] -> [[Text]]) -> [[Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
firstLine [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: [[Text]]
conLines [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
++
                                  [Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
indices) Text
""
                                    | Bool -> Bool
not ([[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
conLines)]
  (Text -> ParsecT Text ParserState m Blocks)
-> [Text] -> RSTParser m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParsecT Text ParserState m Blocks
-> Text -> ParsecT Text ParserState m Blocks
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParsecT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks) [Text]
cols

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

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

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

gridTable :: PandocMonad m
          => Bool -- ^ Headerless table
          -> RSTParser m Blocks
gridTable :: Bool -> RSTParser m Blocks
gridTable Bool
headerless = Identity Blocks -> Blocks
forall a. Identity a -> a
runIdentity (Identity Blocks -> Blocks)
-> ParsecT Text ParserState m (Identity Blocks)
-> RSTParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ParsecT Text ParserState m (Identity Blocks)
-> Bool -> ParsecT Text ParserState m (Identity Blocks)
forall s (m :: * -> *) st (mf :: * -> *).
(Stream s m Char, HasReaderOptions st, HasLastStrPosition st,
 Monad mf, IsString s) =>
ParserT s st m (mf Blocks) -> Bool -> ParserT s st m (mf Blocks)
gridTableWith (Blocks -> Identity Blocks
forall a. a -> Identity a
Identity (Blocks -> Identity Blocks)
-> RSTParser m Blocks
-> ParsecT Text ParserState m (Identity Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks) Bool
headerless

table :: PandocMonad m => RSTParser m Blocks
table :: RSTParser m Blocks
table = Bool -> RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => Bool -> RSTParser m Blocks
gridTable Bool
False RSTParser m Blocks -> RSTParser m Blocks -> RSTParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => Bool -> RSTParser m Blocks
simpleTable Bool
False RSTParser m Blocks -> RSTParser m Blocks -> RSTParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        Bool -> RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => Bool -> RSTParser m Blocks
gridTable Bool
True  RSTParser m Blocks -> RSTParser m Blocks -> RSTParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> RSTParser m Blocks
forall (m :: * -> *). PandocMonad m => Bool -> RSTParser m Blocks
simpleTable Bool
True RSTParser m Blocks -> [Char] -> RSTParser m Blocks
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 :: RSTParser m (Many Inline)
inline = [RSTParser m (Many Inline)] -> RSTParser m (Many Inline)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
note          -- can start with whitespace, so try before ws
                , RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
link
                , RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
strong
                , RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
emph
                , RSTParser m (Many Inline)
forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
code
                , RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
subst
                , RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
interpretedRole
                , RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inlineContent ] RSTParser m (Many Inline) -> [Char] -> RSTParser m (Many Inline)
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 :: RSTParser m (Many Inline)
inlineContent = [RSTParser m (Many Inline)] -> RSTParser m (Many Inline)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
whitespace
                       , RSTParser m (Many Inline)
forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
str
                       , RSTParser m (Many Inline)
forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
endline
                       , RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
smart
                       , RSTParser m (Many Inline)
forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
hyphens
                       , RSTParser m (Many Inline)
forall (m :: * -> *) st. Monad m => ParserT Text st m (Many Inline)
escapedChar
                       , RSTParser m (Many Inline)
forall (m :: * -> *). Monad m => RSTParser m (Many Inline)
symbol ] RSTParser m (Many Inline) -> [Char] -> RSTParser m (Many Inline)
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 :: Text -> RSTParser m (Many Inline)
parseInlineFromText = RSTParser m (Many Inline) -> Text -> RSTParser m (Many Inline)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' (Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> RSTParser m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RSTParser m (Many Inline)
-> ParsecT Text ParserState m [Many Inline]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline)

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

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

symbol :: Monad m => RSTParser m Inlines
symbol :: RSTParser m (Many Inline)
symbol = do
  Char
result <- [Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
specialChars
  Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str (Text -> Many Inline) -> Text -> Many Inline
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 :: RSTParser m (Many Inline)
code = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"``"
  Text
result <- ParserT Text ParserState m Char
-> ParsecT Text ParserState m [Char]
-> ParserT Text ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ParserT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Text ParserState m [Char]
-> ParsecT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"``"))
  Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.code
         (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Text
trim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
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 :: RSTParser m a -> RSTParser m a
atStart RSTParser m a
p = do
  SourcePos
pos <- ParsecT Text ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParserState
st <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  -- single quote start can't be right after str
  Bool -> ParsecT Text ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text ParserState m ())
-> Bool -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ ParserState -> Maybe SourcePos
stateLastStrPos ParserState
st Maybe SourcePos -> Maybe SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
/= SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just SourcePos
pos
  RSTParser m a
p

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

strong :: PandocMonad m => RSTParser m Inlines
strong :: RSTParser m (Many Inline)
strong = Many Inline -> Many Inline
B.strong (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> RSTParser m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
-> RSTParser m (Many Inline)
-> ParsecT Text ParserState m [Many Inline]
forall end s (m :: * -> *) st t a.
(Show end, Stream s m Char) =>
ParserT s st m t
-> ParserT s st m end -> ParserT s st m a -> ParserT s st m [a]
enclosed (ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall (m :: * -> *) a. Monad m => RSTParser m a -> RSTParser m a
atStart (ParserT Text ParserState m [Char]
 -> ParserT Text ParserState m [Char])
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"**") (ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text ParserState m [Char]
 -> ParserT Text ParserState m [Char])
-> ParserT Text ParserState m [Char]
-> ParserT Text ParserState m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"**") RSTParser m (Many Inline)
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 :: RSTParser m (Many Inline)
interpretedRole = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  (Text
role, Text
contents) <- RSTParser m (Text, Text)
forall (m :: * -> *). PandocMonad m => RSTParser m (Text, Text)
roleBefore RSTParser m (Text, Text)
-> RSTParser m (Text, Text) -> RSTParser m (Text, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RSTParser m (Text, Text)
forall (m :: * -> *). PandocMonad m => RSTParser m (Text, Text)
roleAfter
  Text -> Maybe Text -> Text -> Attr -> RSTParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Text -> Text -> Attr -> RSTParser m (Many Inline)
renderRole Text
contents Maybe Text
forall a. Maybe a
Nothing Text
role Attr
nullAttr

renderRole :: PandocMonad m
           => Text -> Maybe Text -> Text -> Attr -> RSTParser m Inlines
renderRole :: 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"  -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.superscript (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"superscript" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.superscript (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"sub"  -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.subscript (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"subscript"  -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.subscript (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"emphasis" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.emph (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"strong" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
B.strong (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"rfc-reference" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
rfcLink Text
contents
    Text
"RFC" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
rfcLink Text
contents
    Text
"pep-reference" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
pepLink Text
contents
    Text
"PEP" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
pepLink Text
contents
    Text
"literal" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Inline
B.codeWith Attr
attr Text
contents
    Text
"math" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.math Text
contents
    Text
"title-reference" -> Text -> RSTParser m (Many Inline)
forall (m :: * -> *). Monad m => Text -> m (Many Inline)
titleRef Text
contents
    Text
"title" -> Text -> RSTParser m (Many Inline)
forall (m :: * -> *). Monad m => Text -> m (Many Inline)
titleRef Text
contents
    Text
"t" -> Text -> RSTParser m (Many Inline)
forall (m :: * -> *). Monad m => Text -> m (Many Inline)
titleRef Text
contents
    Text
"code" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Inline
B.codeWith Attr
attr Text
contents
    Text
"span" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith Attr
attr (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
treatAsText Text
contents
    Text
"raw" -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline
B.rawInline (Text -> Maybe Text -> Text
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 (ParserState -> Map Text (Text, Maybe Text, Attr))
-> ParsecT Text ParserState m ParserState
-> ParsecT Text ParserState m (Map Text (Text, Maybe Text, Attr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        case Text
-> Map Text (Text, Maybe Text, Attr)
-> Maybe (Text, Maybe Text, Attr)
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) ->
                Text -> Maybe Text -> Text -> Attr -> RSTParser m (Many Inline)
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
                Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
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 = Many Inline -> m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"title-ref"],[]) (Many Inline -> Many Inline) -> Many Inline -> Many Inline
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rfcNo) (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str (Text
"RFC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rfcNo)
     where rfcUrl :: Text
rfcUrl = Text
"http://www.faqs.org/rfcs/rfc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rfcNo Text -> Text -> Text
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pepNo) (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str (Text
"PEP " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pepNo)
     where padNo :: Text
padNo = Int -> Text -> Text
T.replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pepNo) Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pepNo
           pepUrl :: Text
pepUrl = Text
"http://www.python.org/dev/peps/pep-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
padNo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
   treatAsText :: Text -> Many Inline
treatAsText = Text -> Many Inline
B.text (Text -> Many Inline) -> (Text -> Text) -> Text -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
handleEscapes
   handleEscapes :: Text -> Text
handleEscapes = [Text] -> Text
T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
removeSpace ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"\\"
     where headSpace :: Text -> Text
headSpace Text
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> Maybe Text -> Text
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
headSpace [Text]
xs
           removeSpace []     = []

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

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

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

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

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

whitespace :: PandocMonad m => RSTParser m Inlines
whitespace :: RSTParser m (Many Inline)
whitespace = Many Inline
B.space Many Inline
-> ParsecT Text ParserState m () -> RSTParser m (Many Inline)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar RSTParser m (Many Inline) -> [Char] -> RSTParser m (Many Inline)
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 :: RSTParser m (Many Inline)
str = do
  let strChar :: ParsecT Text u m Char
strChar = [Char] -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf ([Char]
"\t\n " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
specialChars)
  Text
result <- ParserT Text ParserState m Char -> ParserT Text ParserState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParserT Text ParserState m Char
forall u. ParsecT Text u m Char
strChar
  ParserT Text ParserState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParserT s st m ()
updateLastStrPos
  Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
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 :: RSTParser m (Many Inline)
endline = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline
  -- parse potential list-starts at beginning of line differently in a list:
  ParserState
st <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ParserState -> ParserContext
stateParserContext ParserState
st ParserContext -> ParserContext -> Bool
forall a. Eq a => a -> a -> Bool
== ParserContext
ListItemState) (ParsecT Text ParserState m () -> ParsecT Text ParserState m ())
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParserT Text ParserState m ListAttributes
forall s (m :: * -> *).
Stream s m Char =>
ParserT s ParserState m ListAttributes
anyOrderedListMarker ParserT Text ParserState m ListAttributes
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar) ParsecT Text ParserState m ()
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          ParserT Text ParserState m Int -> ParsecT Text ParserState m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParserT Text ParserState m Int
forall (m :: * -> *) st. Monad m => ParserT Text st m Int
bulletListStart
  Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
B.softbreak

--
-- links
--

link :: PandocMonad m => RSTParser m Inlines
link :: RSTParser m (Many Inline)
link = [RSTParser m (Many Inline)] -> RSTParser m (Many Inline)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
explicitLink, RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
referenceLink, RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
autoLink]  RSTParser m (Many Inline) -> [Char] -> RSTParser m (Many Inline)
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 :: RSTParser m (Many Inline)
explicitLink = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`'
  ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`') -- `` marks start of inline code
  Many Inline
label' <- Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> RSTParser m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             RSTParser m (Many Inline)
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m [Many Inline]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`') ParsecT Text ParserState m ()
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inlineContent) (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<')
  Text
src <- Text -> Text
trim (Text -> Text)
-> ParsecT Text ParserState m Text
-> ParsecT Text ParserState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ([Char] -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
">\n") (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>')
  ParsecT Text ParserState m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
skipSpaces
  [Char] -> ParsecT Text ParserState m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"`_"
  ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Text ParserState m Char -> ParsecT Text ParserState m ())
-> ParsecT Text ParserState m Char -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' -- anonymous form
  let label'' :: Many Inline
label'' = if Many Inline
label' Many Inline -> Many Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Many Inline
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 ((Text, Text), Attr)
-> ParsecT Text ParserState m ((Text, Text), Attr)
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
'_') -> [Key] -> Key -> ParsecT Text ParserState m ((Text, Text), Attr)
forall (m :: * -> *).
PandocMonad m =>
[Key] -> Key -> RSTParser m ((Text, Text), Attr)
lookupKey [] (Text -> Key
toKey Text
xs)
           Maybe (Text, Char)
_              -> ((Text, Text), Attr)
-> ParsecT Text ParserState m ((Text, Text), Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
src, Text
""), Attr
nullAttr)
  Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
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 :: RSTParser m Text
citationName = do
  Text
raw <- RSTParser m Text
forall (m :: * -> *). Monad m => RSTParser m Text
citationMarker
  Text -> RSTParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> RSTParser m Text) -> Text -> RSTParser m Text
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
raw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

referenceLink :: PandocMonad m => RSTParser m Inlines
referenceLink :: RSTParser m (Many Inline)
referenceLink = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  Text
ref <- (RSTParser m Text
forall (m :: * -> *). PandocMonad m => RSTParser m Text
referenceName RSTParser m Text -> RSTParser m Text -> RSTParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RSTParser m Text
forall (m :: * -> *). PandocMonad m => RSTParser m Text
citationName) RSTParser m Text
-> ParsecT Text ParserState m Char -> RSTParser m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
  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 <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let keyTable :: KeyTable
keyTable = ParserState -> KeyTable
stateKeys ParserState
state
  Key
key <- Key
-> ParsecT Text ParserState m Key -> ParsecT Text ParserState m 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) (ParsecT Text ParserState m Key -> ParsecT Text ParserState m Key)
-> ParsecT Text ParserState m Key -> ParsecT Text ParserState m Key
forall a b. (a -> b) -> a -> b
$
                do Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
                   let anonKeys :: [Key]
anonKeys = [Key] -> [Key]
forall a. Ord a => [a] -> [a]
sort ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter Key -> Bool
isAnonKey ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ KeyTable -> [Key]
forall k a. Map k a -> [k]
M.keys KeyTable
keyTable
                   case [Key]
anonKeys of
                        []    -> ParsecT Text ParserState m Key
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                        (Key
k:[Key]
_) -> Key -> ParsecT Text ParserState m Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
k
  ((Text
src,Text
tit), Attr
attr) <- [Key] -> Key -> RSTParser m ((Text, Text), 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
  Bool
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Bool
isAnonKey Key
key) (ParsecT Text ParserState m () -> ParsecT Text ParserState m ())
-> ParsecT Text ParserState m () -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s ->
                          ParserState
s{ stateKeys :: KeyTable
stateKeys = Key -> KeyTable -> KeyTable
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Key
key KeyTable
keyTable }
  Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
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 :: [Key] -> Key -> RSTParser m ((Text, Text), Attr)
lookupKey [Key]
oldkeys Key
key = do
  SourcePos
pos <- ParsecT Text ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParserState
state <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let keyTable :: KeyTable
keyTable = ParserState -> KeyTable
stateKeys ParserState
state
  case Key -> KeyTable -> Maybe ((Text, Text), Attr)
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
         LogMessage -> ParserT Text ParserState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage (LogMessage -> ParserT Text ParserState m ())
-> LogMessage -> ParserT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ReferenceNotFound Text
key' SourcePos
pos
         ((Text, Text), Attr) -> RSTParser m ((Text, Text), Attr)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1, Text -> Char
T.last Text
u Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_', Text -> Char
T.head Text
u Char -> Char -> Bool
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 Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
oldkeys
            then do
              LogMessage -> ParserT Text ParserState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage (LogMessage -> ParserT Text ParserState m ())
-> LogMessage -> ParserT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CircularReference Text
rawkey SourcePos
pos
              ((Text, Text), Attr) -> RSTParser m ((Text, Text), Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
"",Text
""),Attr
nullAttr)
            else [Key] -> Key -> RSTParser m ((Text, Text), Attr)
forall (m :: * -> *).
PandocMonad m =>
[Key] -> Key -> RSTParser m ((Text, Text), Attr)
lookupKey (Key
keyKey -> [Key] -> [Key]
forall a. a -> [a] -> [a]
:[Key]
oldkeys) Key
newkey
       Just ((Text, Text), Attr)
val -> ((Text, Text), Attr) -> RSTParser m ((Text, Text), Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Text), Attr)
val

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

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

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

subst :: PandocMonad m => RSTParser m Inlines
subst :: RSTParser m (Many Inline)
subst = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  ([Many Inline]
_,Text
ref) <- ParsecT Text ParserState m [Many Inline]
-> ParsecT Text ParserState m ([Many Inline], Text)
forall (m :: * -> *) st a.
Monad m =>
ParsecT Text st m a -> ParsecT Text st m (a, Text)
withRaw (ParsecT Text ParserState m [Many Inline]
 -> ParsecT Text ParserState m ([Many Inline], Text))
-> ParsecT Text ParserState m [Many Inline]
-> ParsecT Text ParserState m ([Many Inline], Text)
forall a b. (a -> b) -> a -> b
$ ParserT Text ParserState m Char
-> ParserT Text ParserState m Char
-> RSTParser m (Many Inline)
-> ParsecT Text ParserState m [Many Inline]
forall end s (m :: * -> *) st t a.
(Show end, Stream s m Char) =>
ParserT s st m t
-> ParserT s st m end -> ParserT s st m a -> ParserT s st m [a]
enclosed (Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|') (Char -> ParserT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|') RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline
  ParserState
state <- ParsecT Text ParserState m ParserState
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 (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripFirstAndLast Text
ref
  case Key -> SubstTable -> Maybe (Many Inline)
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 <- ParsecT Text ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         LogMessage -> ParserT Text ParserState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage (LogMessage -> ParserT Text ParserState m ())
-> LogMessage -> ParserT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ReferenceNotFound (Key -> Text
forall a. Show a => a -> Text
tshow Key
key) SourcePos
pos
         Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty
       Just Many Inline
target -> Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
target

note :: PandocMonad m => RSTParser m Inlines
note :: RSTParser m (Many Inline)
note = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  RSTParser m (Many Inline) -> ParsecT Text ParserState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
whitespace
  Text
ref <- RSTParser m Text
forall (m :: * -> *). Monad m => RSTParser m Text
noteMarker
  Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
  ParserState
state <- ParsecT Text ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let notes :: NoteTable
notes = ParserState -> NoteTable
stateNotes ParserState
state
  case Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ref NoteTable
notes of
    Maybe Text
Nothing   -> do
      SourcePos
pos <- ParsecT Text ParserState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      LogMessage -> ParsecT Text ParserState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage (LogMessage -> ParsecT Text ParserState m ())
-> LogMessage -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ReferenceNotFound Text
ref SourcePos
pos
      Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
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.
      (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ stateNotes :: NoteTable
stateNotes = [] }
      Blocks
contents <- ParserT Text ParserState m Blocks
-> Text -> ParserT Text ParserState m Blocks
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParserT Text ParserState m Blocks
forall (m :: * -> *). PandocMonad m => RSTParser m Blocks
parseBlocks Text
raw
      let newnotes :: NoteTable
newnotes = if Text
ref Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" Bool -> Bool -> Bool
|| Text
ref Text -> Text -> Bool
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 ((Text, Text) -> (Text, Text) -> Bool)
-> NoteTable -> NoteTable -> NoteTable
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy (Text, Text) -> (Text, Text) -> Bool
forall a. Eq a => a -> a -> Bool
(==) NoteTable
notes [(Text
ref,Text
raw)]
                        else NoteTable
notes
      (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT Text ParserState m ())
-> (ParserState -> ParserState) -> ParsecT Text ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ stateNotes :: NoteTable
stateNotes = NoteTable
newnotes }
      Many Inline -> RSTParser m (Many Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> RSTParser m (Many Inline))
-> Many Inline -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Blocks -> Many Inline
B.note Blocks
contents

smart :: PandocMonad m => RSTParser m Inlines
smart :: RSTParser m (Many Inline)
smart = do
  Extension -> ParserT Text ParserState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_smart
  RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
doubleQuoted RSTParser m (Many Inline)
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
singleQuoted RSTParser m (Many Inline)
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
    [RSTParser m (Many Inline)] -> RSTParser m (Many Inline)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [RSTParser m (Many Inline)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (Many Inline)
apostrophe, RSTParser m (Many Inline)
forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char) =>
ParserT s st m (Many Inline)
dash, RSTParser m (Many Inline)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (Many Inline)
ellipses]

singleQuoted :: PandocMonad m => RSTParser m Inlines
singleQuoted :: RSTParser m (Many Inline)
singleQuoted = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  ParserT Text ParserState m ()
forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char) =>
ParserT s st m ()
singleQuoteStart
  QuoteContext
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InSingleQuote (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$
    Many Inline -> Many Inline
B.singleQuoted (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> RSTParser m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      RSTParser m (Many Inline)
-> ParserT Text ParserState m ()
-> ParsecT Text ParserState m [Many Inline]
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 RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline ParserT Text ParserState m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
singleQuoteEnd

doubleQuoted :: PandocMonad m => RSTParser m Inlines
doubleQuoted :: RSTParser m (Many Inline)
doubleQuoted = RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  ParserT Text ParserState m ()
forall st (m :: * -> *) s.
(HasQuoteContext st m, Stream s m Char) =>
ParserT s st m ()
doubleQuoteStart
  QuoteContext
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InDoubleQuote (RSTParser m (Many Inline) -> RSTParser m (Many Inline))
-> RSTParser m (Many Inline) -> RSTParser m (Many Inline)
forall a b. (a -> b) -> a -> b
$
    Many Inline -> Many Inline
B.doubleQuoted (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT Text ParserState m [Many Inline]
-> RSTParser m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      RSTParser m (Many Inline)
-> ParserT Text ParserState m ()
-> ParsecT Text ParserState m [Many Inline]
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 RSTParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => RSTParser m (Many Inline)
inline ParserT Text ParserState m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
doubleQuoteEnd