Merge pull request #1947 from mpickering/Fmonad
Remove F Monad from Markdown and Org readers.
This commit is contained in:
John MacFarlane
commit
c302bdcdbe
4 changed files with 566 additions and 618 deletions
|
|
@ -65,7 +65,8 @@ module Text.Pandoc.Parsing ( anyLine,
|
|||
widthsFromIndices,
|
||||
gridTableWith,
|
||||
readWith,
|
||||
readWithWarnings,
|
||||
returnWarnings,
|
||||
returnState,
|
||||
readWithM,
|
||||
testStringWith,
|
||||
guardEnabled,
|
||||
|
|
@ -104,11 +105,8 @@ module Text.Pandoc.Parsing ( anyLine,
|
|||
applyMacros',
|
||||
Parser,
|
||||
ParserT,
|
||||
F(..),
|
||||
runF,
|
||||
askF,
|
||||
asksF,
|
||||
token,
|
||||
generalize,
|
||||
-- * Re-exports from Text.Pandoc.Parsec
|
||||
Stream,
|
||||
runParser,
|
||||
|
|
@ -188,7 +186,7 @@ import Data.Default
|
|||
import qualified Data.Set as Set
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Identity
|
||||
import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), Applicative)
|
||||
import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$))
|
||||
import Data.Monoid
|
||||
import Data.Maybe (catMaybes)
|
||||
|
||||
|
|
@ -196,22 +194,6 @@ type Parser t s = Parsec t s
|
|||
|
||||
type ParserT = ParsecT
|
||||
|
||||
newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Applicative, Functor)
|
||||
|
||||
runF :: F a -> ParserState -> a
|
||||
runF = runReader . unF
|
||||
|
||||
askF :: F ParserState
|
||||
askF = F ask
|
||||
|
||||
asksF :: (ParserState -> a) -> F a
|
||||
asksF f = F $ asks f
|
||||
|
||||
instance Monoid a => Monoid (F a) where
|
||||
mempty = return mempty
|
||||
mappend = liftM2 mappend
|
||||
mconcat = liftM mconcat . sequence
|
||||
|
||||
-- | Parse any line of text
|
||||
anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char]
|
||||
anyLine = do
|
||||
|
|
@ -884,15 +866,18 @@ readWith :: Parser [Char] st a
|
|||
-> a
|
||||
readWith p t inp = runIdentity $ readWithM p t inp
|
||||
|
||||
readWithWarnings :: Parser [Char] ParserState a
|
||||
-> ParserState
|
||||
-> String
|
||||
-> (a, [String])
|
||||
readWithWarnings p = readWith $ do
|
||||
returnWarnings :: (Stream s m c)
|
||||
=> ParserT s ParserState m a
|
||||
-> ParserT s ParserState m (a, [String])
|
||||
returnWarnings p = do
|
||||
doc <- p
|
||||
warnings <- stateWarnings <$> getState
|
||||
return (doc, warnings)
|
||||
|
||||
-- | Return the final internal state with the result of a parser
|
||||
returnState :: (Stream s m c) => ParsecT s st m a -> ParsecT s st m (a, st)
|
||||
returnState p = (,) <$> p <*> getState
|
||||
|
||||
-- | Parse a string with @parser@ (for testing).
|
||||
testStringWith :: (Show a, Stream [Char] Identity Char)
|
||||
=> ParserT [Char] ParserState Identity a
|
||||
|
|
@ -914,7 +899,6 @@ data ParserState = ParserState
|
|||
stateNotes :: NoteTable, -- ^ List of notes (raw bodies)
|
||||
stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies)
|
||||
stateMeta :: Meta, -- ^ Document metadata
|
||||
stateMeta' :: F Meta, -- ^ Document metadata
|
||||
stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
|
||||
stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links)
|
||||
stateIdentifiers :: [String], -- ^ List of header identifiers used
|
||||
|
|
@ -929,7 +913,8 @@ data ParserState = ParserState
|
|||
stateCaption :: Maybe Inlines, -- ^ Caption in current environment
|
||||
stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed
|
||||
stateMarkdownAttribute :: Bool, -- ^ True if in markdown=1 context
|
||||
stateWarnings :: [String] -- ^ Warnings generated by the parser
|
||||
stateWarnings :: [String], -- ^ Warnings generated by the parser
|
||||
stateInFootnote :: Bool -- ^ True if in a footnote block.
|
||||
}
|
||||
|
||||
instance Default ParserState where
|
||||
|
|
@ -1011,7 +996,6 @@ defaultParserState =
|
|||
stateNotes = [],
|
||||
stateNotes' = [],
|
||||
stateMeta = nullMeta,
|
||||
stateMeta' = return nullMeta,
|
||||
stateHeaderTable = [],
|
||||
stateHeaders = M.empty,
|
||||
stateIdentifiers = [],
|
||||
|
|
@ -1024,7 +1008,8 @@ defaultParserState =
|
|||
stateCaption = Nothing,
|
||||
stateInHtmlBlock = Nothing,
|
||||
stateMarkdownAttribute = False,
|
||||
stateWarnings = []}
|
||||
stateWarnings = [],
|
||||
stateInFootnote = False }
|
||||
|
||||
-- | Succeed only if the extension is enabled.
|
||||
guardEnabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()
|
||||
|
|
@ -1063,7 +1048,7 @@ data QuoteContext
|
|||
|
||||
type NoteTable = [(String, String)]
|
||||
|
||||
type NoteTable' = [(String, F Blocks)] -- used in markdown reader
|
||||
type NoteTable' = [(String, Blocks)] -- used in markdown reader
|
||||
|
||||
newtype Key = Key String deriving (Show, Read, Eq, Ord)
|
||||
|
||||
|
|
@ -1259,8 +1244,11 @@ applyMacros' target = do
|
|||
else return target
|
||||
|
||||
-- | Append a warning to the log.
|
||||
addWarning :: Maybe SourcePos -> String -> Parser [Char] ParserState ()
|
||||
addWarning :: (Stream s m c) => Maybe SourcePos -> String -> ParserT s ParserState m ()
|
||||
addWarning mbpos msg =
|
||||
updateState $ \st -> st{
|
||||
stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) :
|
||||
stateWarnings st }
|
||||
|
||||
generalize :: (Monad m) => Parser s st a -> ParserT s st m a
|
||||
generalize m = mkPT (\ s -> (return $ (return . runIdentity) <$> runIdentity (runParsecT m s)))
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -1,6 +1,9 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-
|
||||
Copyright (C) 2014 Albert Krewinkel <tarleb@moltkeplatz.de>
|
||||
|
||||
|
|
@ -36,8 +39,7 @@ import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..), (<>)
|
|||
import Text.Pandoc.Definition
|
||||
import Text.Pandoc.Options
|
||||
import qualified Text.Pandoc.Parsing as P
|
||||
import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
|
||||
, newline, orderedListMarker
|
||||
import Text.Pandoc.Parsing hiding ( newline, orderedListMarker
|
||||
, parseFromString, blanklines
|
||||
)
|
||||
import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)
|
||||
|
|
@ -45,36 +47,45 @@ import Text.Pandoc.Shared (compactify', compactify'DL)
|
|||
import Text.TeXMath (readTeX, writePandoc, DisplayType(..))
|
||||
import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap
|
||||
|
||||
import Control.Applicative ( Applicative, pure
|
||||
import Control.Applicative ( pure
|
||||
, (<$>), (<$), (<*>), (<*), (*>) )
|
||||
import Control.Arrow (first)
|
||||
import Control.Monad (foldM, guard, liftM, liftM2, mplus, mzero, when)
|
||||
import Control.Monad.Reader (Reader, runReader, ask, asks, local)
|
||||
import Control.Monad (guard, mplus, mzero, when)
|
||||
import Control.Monad.Reader (Reader, runReader, asks, local)
|
||||
import Data.Char (isAlphaNum, toLower)
|
||||
import Data.Default
|
||||
import Data.List (intersperse, isPrefixOf, isSuffixOf)
|
||||
import Data.List (intersperse, isPrefixOf, isSuffixOf, foldl')
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Monoid (Monoid, mconcat, mempty, mappend)
|
||||
import Data.Monoid (mconcat, mempty, mappend)
|
||||
import Network.HTTP (urlEncode)
|
||||
|
||||
-- | Parse org-mode string and return a Pandoc document.
|
||||
readOrg :: ReaderOptions -- ^ Reader options
|
||||
-> String -- ^ String to parse (assuming @'\n'@ line endings)
|
||||
-> Pandoc
|
||||
readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")
|
||||
readOrg opts s = runOrg opts s parseOrg
|
||||
|
||||
data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }
|
||||
data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext
|
||||
, finalState :: OrgParserState }
|
||||
|
||||
type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)
|
||||
|
||||
runOrg :: ReaderOptions -> String -> OrgParser a -> a
|
||||
runOrg opts inp p = fst res
|
||||
where
|
||||
imd = readWithM (returnState p) def{ orgStateOptions = opts } (inp ++ "\n\n")
|
||||
res = runReader imd def { finalState = s }
|
||||
s :: OrgParserState
|
||||
s = snd $ runReader imd (def { finalState = s })
|
||||
|
||||
parseOrg :: OrgParser Pandoc
|
||||
parseOrg = do
|
||||
blocks' <- parseBlocks
|
||||
st <- getState
|
||||
let meta = runF (orgStateMeta' st) st
|
||||
let meta = orgStateMeta st
|
||||
let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)
|
||||
return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ runF blocks' st)
|
||||
return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ blocks')
|
||||
|
||||
-- | Drop COMMENT headers and the document tree below those headers.
|
||||
dropCommentTrees :: [Block] -> [Block]
|
||||
|
|
@ -104,7 +115,7 @@ isHeaderLevelLowerEq n blk =
|
|||
-- Parser State for Org
|
||||
--
|
||||
|
||||
type OrgNoteRecord = (String, F Blocks)
|
||||
type OrgNoteRecord = (String, Blocks)
|
||||
type OrgNoteTable = [OrgNoteRecord]
|
||||
|
||||
type OrgBlockAttributes = M.Map String String
|
||||
|
|
@ -123,12 +134,11 @@ data OrgParserState = OrgParserState
|
|||
, orgStateLastStrPos :: Maybe SourcePos
|
||||
, orgStateLinkFormatters :: OrgLinkFormatters
|
||||
, orgStateMeta :: Meta
|
||||
, orgStateMeta' :: F Meta
|
||||
, orgStateNotes' :: OrgNoteTable
|
||||
}
|
||||
|
||||
instance Default OrgParserLocal where
|
||||
def = OrgParserLocal NoQuote
|
||||
def = OrgParserLocal NoQuote def
|
||||
|
||||
instance HasReaderOptions OrgParserState where
|
||||
extractReaderOptions = orgStateOptions
|
||||
|
|
@ -162,13 +172,13 @@ defaultOrgParserState = OrgParserState
|
|||
, orgStateLastStrPos = Nothing
|
||||
, orgStateLinkFormatters = M.empty
|
||||
, orgStateMeta = nullMeta
|
||||
, orgStateMeta' = return nullMeta
|
||||
, orgStateNotes' = []
|
||||
}
|
||||
|
||||
recordAnchorId :: String -> OrgParser ()
|
||||
recordAnchorId i = updateState $ \s ->
|
||||
s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }
|
||||
let as = orgStateAnchorIds s in
|
||||
s{ orgStateAnchorIds = i : as }
|
||||
|
||||
addBlockAttribute :: String -> String -> OrgParser ()
|
||||
addBlockAttribute key val = updateState $ \s ->
|
||||
|
|
@ -247,30 +257,6 @@ parseFromString parser str' = do
|
|||
-- Adaptions and specializations of parsing utilities
|
||||
--
|
||||
|
||||
newtype F a = F { unF :: Reader OrgParserState a
|
||||
} deriving (Monad, Applicative, Functor)
|
||||
|
||||
runF :: F a -> OrgParserState -> a
|
||||
runF = runReader . unF
|
||||
|
||||
askF :: F OrgParserState
|
||||
askF = F ask
|
||||
|
||||
asksF :: (OrgParserState -> a) -> F a
|
||||
asksF f = F $ asks f
|
||||
|
||||
instance Monoid a => Monoid (F a) where
|
||||
mempty = return mempty
|
||||
mappend = liftM2 mappend
|
||||
mconcat = fmap mconcat . sequence
|
||||
|
||||
trimInlinesF :: F Inlines -> F Inlines
|
||||
trimInlinesF = liftM trimInlines
|
||||
|
||||
returnF :: a -> OrgParser (F a)
|
||||
returnF = return . return
|
||||
|
||||
|
||||
-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
|
||||
newline :: OrgParser Char
|
||||
newline =
|
||||
|
|
@ -289,10 +275,10 @@ blanklines =
|
|||
-- parsing blocks
|
||||
--
|
||||
|
||||
parseBlocks :: OrgParser (F Blocks)
|
||||
parseBlocks :: OrgParser Blocks
|
||||
parseBlocks = mconcat <$> manyTill block eof
|
||||
|
||||
block :: OrgParser (F Blocks)
|
||||
block :: OrgParser Blocks
|
||||
block = choice [ mempty <$ blanklines
|
||||
, optionalAttributes $ choice
|
||||
[ orgBlock
|
||||
|
|
@ -303,14 +289,14 @@ block = choice [ mempty <$ blanklines
|
|||
, drawer
|
||||
, specialLine
|
||||
, header
|
||||
, return <$> hline
|
||||
, hline
|
||||
, list
|
||||
, latexFragment
|
||||
, noteBlock
|
||||
, paraOrPlain
|
||||
] <?> "block"
|
||||
|
||||
optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)
|
||||
optionalAttributes :: OrgParser Blocks -> OrgParser Blocks
|
||||
optionalAttributes parser = try $
|
||||
resetBlockAttributes *> parseBlockAttributes *> parser
|
||||
|
||||
|
|
@ -330,7 +316,7 @@ parseAndAddAttribute key value = do
|
|||
let key' = map toLower key
|
||||
() <$ addBlockAttribute key' value
|
||||
|
||||
lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))
|
||||
lookupInlinesAttr :: String -> OrgParser (Maybe Inlines)
|
||||
lookupInlinesAttr attr = try $ do
|
||||
val <- lookupBlockAttribute attr
|
||||
maybe (return Nothing)
|
||||
|
|
@ -344,20 +330,20 @@ lookupInlinesAttr attr = try $ do
|
|||
|
||||
type BlockProperties = (Int, String) -- (Indentation, Block-Type)
|
||||
|
||||
orgBlock :: OrgParser (F Blocks)
|
||||
orgBlock :: OrgParser Blocks
|
||||
orgBlock = try $ do
|
||||
blockProp@(_, blkType) <- blockHeaderStart
|
||||
($ blockProp) $
|
||||
case blkType of
|
||||
"comment" -> withRaw' (const mempty)
|
||||
"html" -> withRaw' (return . (B.rawBlock blkType))
|
||||
"latex" -> withRaw' (return . (B.rawBlock blkType))
|
||||
"ascii" -> withRaw' (return . (B.rawBlock blkType))
|
||||
"example" -> withRaw' (return . exampleCode)
|
||||
"quote" -> withParsed (fmap B.blockQuote)
|
||||
"html" -> withRaw' (B.rawBlock blkType)
|
||||
"latex" -> withRaw' (B.rawBlock blkType)
|
||||
"ascii" -> withRaw' (B.rawBlock blkType)
|
||||
"example" -> withRaw' exampleCode
|
||||
"quote" -> withParsed B.blockQuote
|
||||
"verse" -> verseBlock
|
||||
"src" -> codeBlock
|
||||
_ -> withParsed (fmap $ divWithClass blkType)
|
||||
_ -> withParsed (divWithClass blkType)
|
||||
|
||||
blockHeaderStart :: OrgParser (Int, String)
|
||||
blockHeaderStart = try $ (,) <$> indent <*> blockType
|
||||
|
|
@ -365,10 +351,10 @@ blockHeaderStart = try $ (,) <$> indent <*> blockType
|
|||
indent = length <$> many spaceChar
|
||||
blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)
|
||||
|
||||
withRaw' :: (String -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
|
||||
withRaw' :: (String -> Blocks) -> BlockProperties -> OrgParser Blocks
|
||||
withRaw' f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))
|
||||
|
||||
withParsed :: (F Blocks -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
|
||||
withParsed :: (Blocks -> Blocks) -> BlockProperties -> OrgParser Blocks
|
||||
withParsed f blockProp = (ignHeaders *> (f <$> parsedBlockContent blockProp))
|
||||
|
||||
ignHeaders :: OrgParser ()
|
||||
|
|
@ -377,11 +363,11 @@ ignHeaders = (() <$ newline) <|> (() <$ anyLine)
|
|||
divWithClass :: String -> Blocks -> Blocks
|
||||
divWithClass cls = B.divWith ("", [cls], [])
|
||||
|
||||
verseBlock :: BlockProperties -> OrgParser (F Blocks)
|
||||
verseBlock :: BlockProperties -> OrgParser Blocks
|
||||
verseBlock blkProp = try $ do
|
||||
ignHeaders
|
||||
content <- rawBlockContent blkProp
|
||||
fmap B.para . mconcat . intersperse (pure B.linebreak)
|
||||
B.para . mconcat . intersperse B.linebreak
|
||||
<$> mapM (parseFromString parseInlines) (lines content)
|
||||
|
||||
exportsCode :: [(String, String)] -> Bool
|
||||
|
|
@ -398,7 +384,7 @@ followingResultsBlock =
|
|||
*> blankline
|
||||
*> (unlines <$> many1 exampleLine))
|
||||
|
||||
codeBlock :: BlockProperties -> OrgParser (F Blocks)
|
||||
codeBlock :: BlockProperties -> OrgParser Blocks
|
||||
codeBlock blkProp = do
|
||||
skipSpaces
|
||||
(classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
|
||||
|
|
@ -408,17 +394,15 @@ codeBlock blkProp = do
|
|||
let includeCode = exportsCode kv
|
||||
let includeResults = exportsResults kv
|
||||
let codeBlck = B.codeBlockWith ( id', classes, kv ) content
|
||||
labelledBlck <- maybe (pure codeBlck)
|
||||
(labelDiv codeBlck)
|
||||
labelledBlck <- maybe codeBlck (labelDiv codeBlck)
|
||||
<$> lookupInlinesAttr "caption"
|
||||
let resultBlck = pure $ maybe mempty (exampleCode) resultsContent
|
||||
let resultBlck = maybe mempty exampleCode resultsContent
|
||||
return $ (if includeCode then labelledBlck else mempty)
|
||||
<> (if includeResults then resultBlck else mempty)
|
||||
where
|
||||
labelDiv blk value =
|
||||
B.divWith nullAttr <$> (mappend <$> labelledBlock value
|
||||
<*> pure blk)
|
||||
labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
|
||||
B.divWith nullAttr (labelledBlock value <> blk)
|
||||
labelledBlock = B.plain . B.spanWith ("", ["label"], [])
|
||||
|
||||
rawBlockContent :: BlockProperties -> OrgParser String
|
||||
rawBlockContent (indent, blockType) = try $
|
||||
|
|
@ -427,7 +411,7 @@ rawBlockContent (indent, blockType) = try $
|
|||
indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)
|
||||
blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)
|
||||
|
||||
parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)
|
||||
parsedBlockContent :: BlockProperties -> OrgParser Blocks
|
||||
parsedBlockContent blkProps = try $ do
|
||||
raw <- rawBlockContent blkProps
|
||||
parseFromString parseBlocks (raw ++ "\n")
|
||||
|
|
@ -518,9 +502,9 @@ commaEscaped (',':cs@('*':_)) = cs
|
|||
commaEscaped (',':cs@('#':'+':_)) = cs
|
||||
commaEscaped cs = cs
|
||||
|
||||
example :: OrgParser (F Blocks)
|
||||
example :: OrgParser Blocks
|
||||
example = try $ do
|
||||
return . return . exampleCode =<< unlines <$> many1 exampleLine
|
||||
return . exampleCode =<< unlines <$> many1 exampleLine
|
||||
|
||||
exampleCode :: String -> Blocks
|
||||
exampleCode = B.codeBlockWith ("", ["example"], [])
|
||||
|
|
@ -529,7 +513,7 @@ exampleLine :: OrgParser String
|
|||
exampleLine = try $ skipSpaces *> string ": " *> anyLine
|
||||
|
||||
-- Drawers for properties or a logbook
|
||||
drawer :: OrgParser (F Blocks)
|
||||
drawer :: OrgParser Blocks
|
||||
drawer = try $ do
|
||||
drawerStart
|
||||
manyTill drawerLine (try drawerEnd)
|
||||
|
|
@ -555,14 +539,12 @@ drawerEnd = try $
|
|||
--
|
||||
|
||||
-- Figures (Image on a line by itself, preceded by name and/or caption)
|
||||
figure :: OrgParser (F Blocks)
|
||||
figure :: OrgParser Blocks
|
||||
figure = try $ do
|
||||
(cap, nam) <- nameAndCaption
|
||||
src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline
|
||||
guard (isImageFilename src)
|
||||
return $ do
|
||||
cap' <- cap
|
||||
return $ B.para $ B.image src nam cap'
|
||||
return $ B.para $ B.image src nam cap
|
||||
where
|
||||
nameAndCaption =
|
||||
do
|
||||
|
|
@ -578,8 +560,8 @@ figure = try $ do
|
|||
|
||||
--
|
||||
-- Comments, Options and Metadata
|
||||
specialLine :: OrgParser (F Blocks)
|
||||
specialLine = fmap return . try $ metaLine <|> commentLine
|
||||
specialLine :: OrgParser Blocks
|
||||
specialLine = try $ metaLine <|> commentLine
|
||||
|
||||
metaLine :: OrgParser Blocks
|
||||
metaLine = try $ mempty
|
||||
|
|
@ -599,14 +581,14 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
|
|||
declarationLine :: OrgParser ()
|
||||
declarationLine = try $ do
|
||||
key <- metaKey
|
||||
inlinesF <- metaInlines
|
||||
inlines <- metaInlines
|
||||
updateState $ \st ->
|
||||
let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta
|
||||
in st { orgStateMeta' = orgStateMeta' st <> meta' }
|
||||
let meta' = B.setMeta key inlines nullMeta
|
||||
in st { orgStateMeta = orgStateMeta st <> meta' }
|
||||
return ()
|
||||
|
||||
metaInlines :: OrgParser (F MetaValue)
|
||||
metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
|
||||
metaInlines :: OrgParser MetaValue
|
||||
metaInlines = (MetaInlines . B.toList) <$> inlinesTillNewline
|
||||
|
||||
metaKey :: OrgParser String
|
||||
metaKey = map toLower <$> many1 (noneOf ": \n\r")
|
||||
|
|
@ -647,11 +629,11 @@ parseFormat = try $ do
|
|||
--
|
||||
|
||||
-- | Headers
|
||||
header :: OrgParser (F Blocks)
|
||||
header :: OrgParser Blocks
|
||||
header = try $ do
|
||||
level <- headerStart
|
||||
title <- inlinesTillNewline
|
||||
return $ B.header level <$> title
|
||||
return $ B.header level title
|
||||
|
||||
headerStart :: OrgParser Int
|
||||
headerStart = try $
|
||||
|
|
@ -675,7 +657,7 @@ hline = try $ do
|
|||
-- Tables
|
||||
--
|
||||
|
||||
data OrgTableRow = OrgContentRow (F [Blocks])
|
||||
data OrgTableRow = OrgContentRow [Blocks]
|
||||
| OrgAlignRow [Alignment]
|
||||
| OrgHlineRow
|
||||
|
||||
|
|
@ -686,13 +668,13 @@ data OrgTable = OrgTable
|
|||
, orgTableRows :: [[Blocks]]
|
||||
}
|
||||
|
||||
table :: OrgParser (F Blocks)
|
||||
table :: OrgParser Blocks
|
||||
table = try $ do
|
||||
lookAhead tableStart
|
||||
do
|
||||
rows <- tableRows
|
||||
cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"
|
||||
return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows
|
||||
(cptn :: Inlines) <- fromMaybe "" <$> lookupInlinesAttr "caption"
|
||||
return $ ($ cptn) . orgToPandocTable . normalizeTable . rowsToTable $ rows
|
||||
|
||||
orgToPandocTable :: OrgTable
|
||||
-> Inlines
|
||||
|
|
@ -708,11 +690,11 @@ tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
|
|||
|
||||
tableContentRow :: OrgParser OrgTableRow
|
||||
tableContentRow = try $
|
||||
OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline)
|
||||
OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)
|
||||
|
||||
tableContentCell :: OrgParser (F Blocks)
|
||||
tableContentCell :: OrgParser Blocks
|
||||
tableContentCell = try $
|
||||
fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell
|
||||
B.plain . trimInlines . mconcat <$> many1Till inline endOfCell
|
||||
|
||||
endOfCell :: OrgParser Char
|
||||
endOfCell = try $ char '|' <|> lookAhead newline
|
||||
|
|
@ -744,8 +726,8 @@ tableHline = try $
|
|||
OrgHlineRow <$ (tableStart *> char '-' *> anyLine)
|
||||
|
||||
rowsToTable :: [OrgTableRow]
|
||||
-> F OrgTable
|
||||
rowsToTable = foldM (flip rowToContent) zeroTable
|
||||
-> OrgTable
|
||||
rowsToTable = foldl' (flip rowToContent) zeroTable
|
||||
where zeroTable = OrgTable 0 mempty mempty mempty
|
||||
|
||||
normalizeTable :: OrgTable
|
||||
|
|
@ -764,45 +746,43 @@ normalizeTable (OrgTable cols aligns heads lns) =
|
|||
-- line as a header. All other horizontal lines are discarded.
|
||||
rowToContent :: OrgTableRow
|
||||
-> OrgTable
|
||||
-> F OrgTable
|
||||
-> OrgTable
|
||||
rowToContent OrgHlineRow t = maybeBodyToHeader t
|
||||
rowToContent (OrgAlignRow as) t = setLongestRow as =<< setAligns as t
|
||||
rowToContent (OrgContentRow rf) t = do
|
||||
rs <- rf
|
||||
setLongestRow rs =<< appendToBody rs t
|
||||
rowToContent (OrgAlignRow as) t = setLongestRow as . setAligns as $ t
|
||||
rowToContent (OrgContentRow rf) t = setLongestRow rf . appendToBody rf $ t
|
||||
|
||||
setLongestRow :: [a]
|
||||
-> OrgTable
|
||||
-> F OrgTable
|
||||
-> OrgTable
|
||||
setLongestRow rs t =
|
||||
return t{ orgTableColumns = max (length rs) (orgTableColumns t) }
|
||||
t{ orgTableColumns = max (length rs) (orgTableColumns t) }
|
||||
|
||||
maybeBodyToHeader :: OrgTable
|
||||
-> F OrgTable
|
||||
-> OrgTable
|
||||
maybeBodyToHeader t = case t of
|
||||
OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->
|
||||
return t{ orgTableHeader = b , orgTableRows = [] }
|
||||
_ -> return t
|
||||
t{ orgTableHeader = b , orgTableRows = [] }
|
||||
_ -> t
|
||||
|
||||
appendToBody :: [Blocks]
|
||||
-> OrgTable
|
||||
-> F OrgTable
|
||||
appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] }
|
||||
-> OrgTable
|
||||
appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }
|
||||
|
||||
setAligns :: [Alignment]
|
||||
-> OrgTable
|
||||
-> F OrgTable
|
||||
setAligns aligns t = return $ t{ orgTableAlignments = aligns }
|
||||
-> OrgTable
|
||||
setAligns aligns t = t{ orgTableAlignments = aligns }
|
||||
|
||||
|
||||
--
|
||||
-- LaTeX fragments
|
||||
--
|
||||
latexFragment :: OrgParser (F Blocks)
|
||||
latexFragment :: OrgParser Blocks
|
||||
latexFragment = try $ do
|
||||
envName <- latexEnvStart
|
||||
content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)
|
||||
return . return $ B.rawBlock "latex" (content `inLatexEnv` envName)
|
||||
return $ B.rawBlock "latex" (content `inLatexEnv` envName)
|
||||
where
|
||||
c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"
|
||||
, c
|
||||
|
|
@ -832,7 +812,7 @@ latexEnvName = try $ do
|
|||
--
|
||||
-- Footnote defintions
|
||||
--
|
||||
noteBlock :: OrgParser (F Blocks)
|
||||
noteBlock :: OrgParser Blocks
|
||||
noteBlock = try $ do
|
||||
ref <- noteMarker <* skipSpaces
|
||||
content <- mconcat <$> blocksTillHeaderOrNote
|
||||
|
|
@ -844,37 +824,37 @@ noteBlock = try $ do
|
|||
<|> () <$ lookAhead headerStart)
|
||||
|
||||
-- Paragraphs or Plain text
|
||||
paraOrPlain :: OrgParser (F Blocks)
|
||||
paraOrPlain :: OrgParser Blocks
|
||||
paraOrPlain = try $ do
|
||||
ils <- parseInlines
|
||||
nl <- option False (newline >> return True)
|
||||
try (guard nl >> notFollowedBy (orderedListStart <|> bulletListStart) >>
|
||||
return (B.para <$> ils))
|
||||
<|> (return (B.plain <$> ils))
|
||||
(return $ B.para ils))
|
||||
<|> (return $ B.plain ils)
|
||||
|
||||
inlinesTillNewline :: OrgParser (F Inlines)
|
||||
inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
|
||||
inlinesTillNewline :: OrgParser Inlines
|
||||
inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline
|
||||
|
||||
|
||||
--
|
||||
-- list blocks
|
||||
--
|
||||
|
||||
list :: OrgParser (F Blocks)
|
||||
list :: OrgParser Blocks
|
||||
list = choice [ definitionList, bulletList, orderedList ] <?> "list"
|
||||
|
||||
definitionList :: OrgParser (F Blocks)
|
||||
definitionList :: OrgParser Blocks
|
||||
definitionList = try $ do n <- lookAhead (bulletListStart' Nothing)
|
||||
fmap B.definitionList . fmap compactify'DL . sequence
|
||||
B.definitionList . compactify'DL
|
||||
<$> many1 (definitionListItem $ bulletListStart' (Just n))
|
||||
|
||||
bulletList :: OrgParser (F Blocks)
|
||||
bulletList :: OrgParser Blocks
|
||||
bulletList = try $ do n <- lookAhead (bulletListStart' Nothing)
|
||||
fmap B.bulletList . fmap compactify' . sequence
|
||||
B.bulletList . compactify'
|
||||
<$> many1 (listItem (bulletListStart' $ Just n))
|
||||
|
||||
orderedList :: OrgParser (F Blocks)
|
||||
orderedList = fmap B.orderedList . fmap compactify' . sequence
|
||||
orderedList :: OrgParser Blocks
|
||||
orderedList = B.orderedList . compactify'
|
||||
<$> many1 (listItem orderedListStart)
|
||||
|
||||
genericListStart :: OrgParser String
|
||||
|
|
@ -911,7 +891,7 @@ orderedListStart = genericListStart orderedListMarker
|
|||
where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")
|
||||
|
||||
definitionListItem :: OrgParser Int
|
||||
-> OrgParser (F (Inlines, [Blocks]))
|
||||
-> OrgParser (Inlines, [Blocks])
|
||||
definitionListItem parseMarkerGetLength = try $ do
|
||||
markerLength <- parseMarkerGetLength
|
||||
term <- manyTill (noneOf "\n\r") (try $ string "::")
|
||||
|
|
@ -920,12 +900,12 @@ definitionListItem parseMarkerGetLength = try $ do
|
|||
cont <- concat <$> many (listContinuation markerLength)
|
||||
term' <- parseFromString parseInlines term
|
||||
contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont
|
||||
return $ (,) <$> term' <*> fmap (:[]) contents'
|
||||
return (term', [contents'])
|
||||
|
||||
|
||||
-- parse raw text for one list item, excluding start marker and continuations
|
||||
listItem :: OrgParser Int
|
||||
-> OrgParser (F Blocks)
|
||||
-> OrgParser Blocks
|
||||
listItem start = try $ do
|
||||
markerLength <- try start
|
||||
firstLine <- anyLineNewline
|
||||
|
|
@ -951,7 +931,7 @@ anyLineNewline = (++ "\n") <$> anyLine
|
|||
-- inline
|
||||
--
|
||||
|
||||
inline :: OrgParser (F Inlines)
|
||||
inline :: OrgParser Inlines
|
||||
inline =
|
||||
choice [ whitespace
|
||||
, linebreak
|
||||
|
|
@ -978,31 +958,31 @@ inline =
|
|||
] <* (guard =<< newlinesCountWithinLimits)
|
||||
<?> "inline"
|
||||
|
||||
parseInlines :: OrgParser (F Inlines)
|
||||
parseInlines = trimInlinesF . mconcat <$> many1 inline
|
||||
parseInlines :: OrgParser Inlines
|
||||
parseInlines = trimInlines . mconcat <$> many1 inline
|
||||
|
||||
-- treat these as potentially non-text when parsing inline:
|
||||
specialChars :: [Char]
|
||||
specialChars = "\"$'()*+-,./:<=>[\\]^_{|}~"
|
||||
|
||||
|
||||
whitespace :: OrgParser (F Inlines)
|
||||
whitespace = pure B.space <$ skipMany1 spaceChar
|
||||
whitespace :: OrgParser Inlines
|
||||
whitespace = B.space <$ skipMany1 spaceChar
|
||||
<* updateLastPreCharPos
|
||||
<* updateLastForbiddenCharPos
|
||||
<?> "whitespace"
|
||||
|
||||
linebreak :: OrgParser (F Inlines)
|
||||
linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline
|
||||
linebreak :: OrgParser Inlines
|
||||
linebreak = try $ B.linebreak <$ string "\\\\" <* skipSpaces <* newline
|
||||
|
||||
str :: OrgParser (F Inlines)
|
||||
str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
|
||||
str :: OrgParser Inlines
|
||||
str = B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
|
||||
<* updateLastStrPos
|
||||
|
||||
-- | An endline character that can be treated as a space, not a structural
|
||||
-- break. This should reflect the values of the Emacs variable
|
||||
-- @org-element-pagaraph-separate@.
|
||||
endline :: OrgParser (F Inlines)
|
||||
endline :: OrgParser Inlines
|
||||
endline = try $ do
|
||||
newline
|
||||
notFollowedBy blankline
|
||||
|
|
@ -1020,77 +1000,72 @@ endline = try $ do
|
|||
decEmphasisNewlinesCount
|
||||
guard =<< newlinesCountWithinLimits
|
||||
updateLastPreCharPos
|
||||
return . return $ B.space
|
||||
return $ B.space
|
||||
|
||||
cite :: OrgParser (F Inlines)
|
||||
cite :: OrgParser Inlines
|
||||
cite = try $ do
|
||||
guardEnabled Ext_citations
|
||||
(cs, raw) <- withRaw normalCite
|
||||
return $ (flip B.cite (B.text raw)) <$> cs
|
||||
return $ flip B.cite (B.text raw) cs
|
||||
|
||||
normalCite :: OrgParser (F [Citation])
|
||||
normalCite :: OrgParser [Citation]
|
||||
normalCite = try $ char '['
|
||||
*> skipSpaces
|
||||
*> citeList
|
||||
<* skipSpaces
|
||||
<* char ']'
|
||||
|
||||
citeList :: OrgParser (F [Citation])
|
||||
citeList = sequence <$> sepBy1 citation (try $ char ';' *> skipSpaces)
|
||||
citeList :: OrgParser [Citation]
|
||||
citeList = sepBy1 citation (try $ char ';' *> skipSpaces)
|
||||
|
||||
citation :: OrgParser (F Citation)
|
||||
citation :: OrgParser Citation
|
||||
citation = try $ do
|
||||
pref <- prefix
|
||||
(suppress_author, key) <- citeKey
|
||||
suff <- suffix
|
||||
return $ do
|
||||
x <- pref
|
||||
y <- suff
|
||||
return $ Citation{ citationId = key
|
||||
, citationPrefix = B.toList x
|
||||
, citationSuffix = B.toList y
|
||||
, citationMode = if suppress_author
|
||||
then SuppressAuthor
|
||||
else NormalCitation
|
||||
, citationNoteNum = 0
|
||||
, citationHash = 0
|
||||
}
|
||||
return $ Citation{ citationId = key
|
||||
, citationPrefix = B.toList pref
|
||||
, citationSuffix = B.toList suff
|
||||
, citationMode = if suppress_author
|
||||
then SuppressAuthor
|
||||
else NormalCitation
|
||||
, citationNoteNum = 0
|
||||
, citationHash = 0
|
||||
}
|
||||
where
|
||||
prefix = trimInlinesF . mconcat <$>
|
||||
prefix = trimInlines . mconcat <$>
|
||||
manyTill inline (char ']' <|> (']' <$ lookAhead citeKey))
|
||||
suffix = try $ do
|
||||
hasSpace <- option False (notFollowedBy nonspaceChar >> return True)
|
||||
skipSpaces
|
||||
rest <- trimInlinesF . mconcat <$>
|
||||
rest <- trimInlines . mconcat <$>
|
||||
many (notFollowedBy (oneOf ";]") *> inline)
|
||||
return $ if hasSpace
|
||||
then (B.space <>) <$> rest
|
||||
else rest
|
||||
return $
|
||||
if hasSpace
|
||||
then B.space <> rest
|
||||
else rest
|
||||
|
||||
footnote :: OrgParser (F Inlines)
|
||||
footnote :: OrgParser Inlines
|
||||
footnote = try $ inlineNote <|> referencedNote
|
||||
|
||||
inlineNote :: OrgParser (F Inlines)
|
||||
inlineNote :: OrgParser Inlines
|
||||
inlineNote = try $ do
|
||||
string "[fn:"
|
||||
ref <- many alphaNum
|
||||
char ':'
|
||||
note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')
|
||||
note <- B.para . trimInlines . mconcat <$> many1Till inline (char ']')
|
||||
when (not $ null ref) $
|
||||
addToNotesTable ("fn:" ++ ref, note)
|
||||
return $ B.note <$> note
|
||||
return $ B.note note
|
||||
|
||||
referencedNote :: OrgParser (F Inlines)
|
||||
referencedNote :: OrgParser Inlines
|
||||
referencedNote = try $ do
|
||||
ref <- noteMarker
|
||||
return $ do
|
||||
notes <- asksF orgStateNotes'
|
||||
notes <- asks (orgStateNotes' . finalState)
|
||||
return $
|
||||
case lookup ref notes of
|
||||
Nothing -> return $ B.str $ "[" ++ ref ++ "]"
|
||||
Just contents -> do
|
||||
st <- askF
|
||||
let contents' = runF contents st{ orgStateNotes' = [] }
|
||||
return $ B.note contents'
|
||||
Just contents -> B.note contents
|
||||
Nothing -> B.str $ "[" ++ ref ++ "]"
|
||||
|
||||
noteMarker :: OrgParser String
|
||||
noteMarker = try $ do
|
||||
|
|
@ -1100,37 +1075,37 @@ noteMarker = try $ do
|
|||
<*> many1Till (noneOf "\n\r\t ") (char ']')
|
||||
]
|
||||
|
||||
linkOrImage :: OrgParser (F Inlines)
|
||||
linkOrImage :: OrgParser Inlines
|
||||
linkOrImage = explicitOrImageLink
|
||||
<|> selflinkOrImage
|
||||
<|> angleLink
|
||||
<|> plainLink
|
||||
<?> "link or image"
|
||||
|
||||
explicitOrImageLink :: OrgParser (F Inlines)
|
||||
explicitOrImageLink :: OrgParser Inlines
|
||||
explicitOrImageLink = try $ do
|
||||
char '['
|
||||
srcF <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget
|
||||
src <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget
|
||||
title <- enclosedRaw (char '[') (char ']')
|
||||
title' <- parseFromString (mconcat <$> many inline) title
|
||||
char ']'
|
||||
return $ do
|
||||
src <- srcF
|
||||
if isImageFilename src && isImageFilename title
|
||||
then pure $ B.link src "" $ B.image title mempty mempty
|
||||
else linkToInlinesF src =<< title'
|
||||
alt <- internalLink src title'
|
||||
return $
|
||||
(if isImageFilename src && isImageFilename title
|
||||
then B.link src "" $ B.image title mempty mempty
|
||||
else fromMaybe alt (linkToInlines src title'))
|
||||
|
||||
selflinkOrImage :: OrgParser (F Inlines)
|
||||
selflinkOrImage :: OrgParser Inlines
|
||||
selflinkOrImage = try $ do
|
||||
src <- char '[' *> linkTarget <* char ']'
|
||||
return $ linkToInlinesF src (B.str src)
|
||||
return $ fromMaybe "" (linkToInlines src (B.str src))
|
||||
|
||||
plainLink :: OrgParser (F Inlines)
|
||||
plainLink :: OrgParser Inlines
|
||||
plainLink = try $ do
|
||||
(orig, src) <- uri
|
||||
returnF $ B.link src "" (B.str orig)
|
||||
return $ B.link src "" (B.str orig)
|
||||
|
||||
angleLink :: OrgParser (F Inlines)
|
||||
angleLink :: OrgParser Inlines
|
||||
angleLink = try $ do
|
||||
char '<'
|
||||
link <- plainLink
|
||||
|
|
@ -1146,26 +1121,31 @@ linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]")
|
|||
possiblyEmptyLinkTarget :: OrgParser String
|
||||
possiblyEmptyLinkTarget = try linkTarget <|> ("" <$ string "[]")
|
||||
|
||||
applyCustomLinkFormat :: String -> OrgParser (F String)
|
||||
applyCustomLinkFormat :: String -> OrgParser String
|
||||
applyCustomLinkFormat link = do
|
||||
let (linkType, rest) = break (== ':') link
|
||||
return $ do
|
||||
formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters
|
||||
return $ maybe link ($ drop 1 rest) formatter
|
||||
fmts <- asks finalState
|
||||
return $
|
||||
case M.lookup linkType (orgStateLinkFormatters fmts) of
|
||||
Just v -> (v (drop 1 rest))
|
||||
Nothing -> link
|
||||
|
||||
-- TODO: might be a lot smarter/cleaner to use parsec and ADTs for this kind
|
||||
-- of parsing.
|
||||
linkToInlinesF :: String -> Inlines -> F Inlines
|
||||
linkToInlinesF s =
|
||||
linkToInlines :: String -> Inlines -> Maybe Inlines
|
||||
linkToInlines = \s ->
|
||||
case s of
|
||||
"" -> pure . B.link "" ""
|
||||
('#':_) -> pure . B.link s ""
|
||||
_ | isImageFilename s -> const . pure $ B.image s "" ""
|
||||
_ | isFileLink s -> pure . B.link (dropLinkType s) ""
|
||||
_ | isUri s -> pure . B.link s ""
|
||||
_ | isAbsoluteFilePath s -> pure . B.link ("file://" ++ s) ""
|
||||
_ | isRelativeFilePath s -> pure . B.link s ""
|
||||
_ -> internalLink s
|
||||
_ | null s -> Just . B.link "" ""
|
||||
_ | isAnchor s -> Just . B.link s ""
|
||||
_ | isImageFilename s -> const . Just $ B.image s "" ""
|
||||
_ | isFileLink s -> Just . B.link (dropLinkType s) ""
|
||||
_ | isUri s -> Just . B.link s ""
|
||||
_ | isAbsoluteFilePath s -> Just . B.link ("file://" ++ s) ""
|
||||
_ | isRelativeFilePath s -> Just . B.link s ""
|
||||
_ -> const Nothing
|
||||
|
||||
isAnchor :: String -> Bool
|
||||
isAnchor s = "#" `isPrefixOf` s
|
||||
|
||||
isFileLink :: String -> Bool
|
||||
isFileLink s = ("file:" `isPrefixOf` s) && not ("file://" `isPrefixOf` s)
|
||||
|
|
@ -1194,12 +1174,13 @@ isImageFilename filename =
|
|||
imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
|
||||
protocols = [ "file", "http", "https" ]
|
||||
|
||||
internalLink :: String -> Inlines -> F Inlines
|
||||
internalLink :: String -> Inlines -> OrgParser Inlines
|
||||
internalLink link title = do
|
||||
anchorB <- (link `elem`) <$> asksF orgStateAnchorIds
|
||||
if anchorB
|
||||
then return $ B.link ('#':link) "" title
|
||||
else return $ B.emph title
|
||||
anchorB <- asks finalState
|
||||
return $
|
||||
if link `elem` (orgStateAnchorIds anchorB)
|
||||
then B.link ('#':link) "" title
|
||||
else B.emph title
|
||||
|
||||
-- | Parse an anchor like @<<anchor-id>>@ and return an empty span with
|
||||
-- @anchor-id@ set as id. Legal anchors in org-mode are defined through
|
||||
|
|
@ -1207,11 +1188,11 @@ internalLink link title = do
|
|||
-- @anchor-id@ contains spaces, we are more restrictive in what is accepted as
|
||||
-- an anchor.
|
||||
|
||||
anchor :: OrgParser (F Inlines)
|
||||
anchor :: OrgParser Inlines
|
||||
anchor = try $ do
|
||||
anchorId <- parseAnchor
|
||||
recordAnchorId anchorId
|
||||
returnF $ B.spanWith (solidify anchorId, [], []) mempty
|
||||
return $ B.spanWith (solidify anchorId, [], []) mempty
|
||||
where
|
||||
parseAnchor = string "<<"
|
||||
*> many1 (noneOf "\t\n\r<>\"' ")
|
||||
|
|
@ -1229,7 +1210,7 @@ solidify = map replaceSpecialChar
|
|||
| otherwise = '-'
|
||||
|
||||
-- | Parses an inline code block and marks it as an babel block.
|
||||
inlineCodeBlock :: OrgParser (F Inlines)
|
||||
inlineCodeBlock :: OrgParser Inlines
|
||||
inlineCodeBlock = try $ do
|
||||
string "src_"
|
||||
lang <- many1 orgArgWordChar
|
||||
|
|
@ -1237,7 +1218,7 @@ inlineCodeBlock = try $ do
|
|||
inlineCode <- enclosedByPair '{' '}' (noneOf "\n\r")
|
||||
let attrClasses = [translateLang lang, rundocBlockClass]
|
||||
let attrKeyVal = map toRundocAttrib (("language", lang) : opts)
|
||||
returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode
|
||||
return $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode
|
||||
|
||||
enclosedByPair :: Char -- ^ opening char
|
||||
-> Char -- ^ closing char
|
||||
|
|
@ -1245,41 +1226,40 @@ enclosedByPair :: Char -- ^ opening char
|
|||
-> OrgParser [a]
|
||||
enclosedByPair s e p = char s *> many1Till p (char e)
|
||||
|
||||
emph :: OrgParser (F Inlines)
|
||||
emph = fmap B.emph <$> emphasisBetween '/'
|
||||
emph :: OrgParser Inlines
|
||||
emph = B.emph <$> emphasisBetween '/'
|
||||
|
||||
strong :: OrgParser (F Inlines)
|
||||
strong = fmap B.strong <$> emphasisBetween '*'
|
||||
strong :: OrgParser Inlines
|
||||
strong = B.strong <$> emphasisBetween '*'
|
||||
|
||||
strikeout :: OrgParser (F Inlines)
|
||||
strikeout = fmap B.strikeout <$> emphasisBetween '+'
|
||||
strikeout :: OrgParser Inlines
|
||||
strikeout = B.strikeout <$> emphasisBetween '+'
|
||||
|
||||
-- There is no underline, so we use strong instead.
|
||||
underline :: OrgParser (F Inlines)
|
||||
underline = fmap B.strong <$> emphasisBetween '_'
|
||||
underline :: OrgParser Inlines
|
||||
underline = B.strong <$> emphasisBetween '_'
|
||||
|
||||
verbatim :: OrgParser (F Inlines)
|
||||
verbatim = return . B.code <$> verbatimBetween '='
|
||||
verbatim :: OrgParser Inlines
|
||||
verbatim = B.code <$> verbatimBetween '='
|
||||
|
||||
code :: OrgParser (F Inlines)
|
||||
code = return . B.code <$> verbatimBetween '~'
|
||||
code :: OrgParser Inlines
|
||||
code = B.code <$> verbatimBetween '~'
|
||||
|
||||
subscript :: OrgParser (F Inlines)
|
||||
subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr)
|
||||
subscript :: OrgParser Inlines
|
||||
subscript = B.subscript <$> try (char '_' *> subOrSuperExpr)
|
||||
|
||||
superscript :: OrgParser (F Inlines)
|
||||
superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)
|
||||
superscript :: OrgParser Inlines
|
||||
superscript = B.superscript <$> try (char '^' *> subOrSuperExpr)
|
||||
|
||||
math :: OrgParser (F Inlines)
|
||||
math = return . B.math <$> choice [ math1CharBetween '$'
|
||||
math :: OrgParser Inlines
|
||||
math = B.math <$> choice [ math1CharBetween '$'
|
||||
, mathStringBetween '$'
|
||||
, rawMathBetween "\\(" "\\)"
|
||||
]
|
||||
|
||||
displayMath :: OrgParser (F Inlines)
|
||||
displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
|
||||
, rawMathBetween "$$" "$$"
|
||||
]
|
||||
displayMath :: OrgParser Inlines
|
||||
displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
|
||||
, rawMathBetween "$$" "$$" ]
|
||||
|
||||
updatePositions :: Char
|
||||
-> OrgParser (Char)
|
||||
|
|
@ -1288,11 +1268,11 @@ updatePositions c = do
|
|||
when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos
|
||||
return c
|
||||
|
||||
symbol :: OrgParser (F Inlines)
|
||||
symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
|
||||
symbol :: OrgParser Inlines
|
||||
symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
|
||||
|
||||
emphasisBetween :: Char
|
||||
-> OrgParser (F Inlines)
|
||||
-> OrgParser Inlines
|
||||
emphasisBetween c = try $ do
|
||||
startEmphasisNewlinesCounting emphasisAllowedNewlines
|
||||
res <- enclosedInlines (emphasisStart c) (emphasisEnd c)
|
||||
|
|
@ -1369,9 +1349,9 @@ mathEnd c = try $ do
|
|||
|
||||
enclosedInlines :: OrgParser a
|
||||
-> OrgParser b
|
||||
-> OrgParser (F Inlines)
|
||||
-> OrgParser Inlines
|
||||
enclosedInlines start end = try $
|
||||
trimInlinesF . mconcat <$> enclosed start end inline
|
||||
trimInlines . mconcat <$> enclosed start end inline
|
||||
|
||||
enclosedRaw :: OrgParser a
|
||||
-> OrgParser b
|
||||
|
|
@ -1450,7 +1430,7 @@ notAfterForbiddenBorderChar = do
|
|||
return $ lastFBCPos /= Just pos
|
||||
|
||||
-- | Read a sub- or superscript expression
|
||||
subOrSuperExpr :: OrgParser (F Inlines)
|
||||
subOrSuperExpr :: OrgParser Inlines
|
||||
subOrSuperExpr = try $
|
||||
choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")
|
||||
, enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")
|
||||
|
|
@ -1465,10 +1445,10 @@ simpleSubOrSuperString = try $
|
|||
<*> many1 alphaNum
|
||||
]
|
||||
|
||||
inlineLaTeX :: OrgParser (F Inlines)
|
||||
inlineLaTeX :: OrgParser Inlines
|
||||
inlineLaTeX = try $ do
|
||||
cmd <- inlineLaTeXCommand
|
||||
maybe mzero returnF $
|
||||
maybe mzero return $
|
||||
parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd
|
||||
where
|
||||
parseAsMath :: String -> Maybe Inlines
|
||||
|
|
@ -1501,30 +1481,30 @@ inlineLaTeXCommand = try $ do
|
|||
return cs
|
||||
_ -> mzero
|
||||
|
||||
smart :: OrgParser (F Inlines)
|
||||
smart :: OrgParser Inlines
|
||||
smart = do
|
||||
getOption readerSmart >>= guard
|
||||
doubleQuoted <|> singleQuoted <|>
|
||||
choice (map (return <$>) [orgApostrophe, dash, ellipses])
|
||||
choice [orgApostrophe, dash, ellipses]
|
||||
where orgApostrophe =
|
||||
(char '\'' <|> char '\8217') <* updateLastPreCharPos
|
||||
<* updateLastForbiddenCharPos
|
||||
*> return (B.str "\x2019")
|
||||
|
||||
singleQuoted :: OrgParser (F Inlines)
|
||||
singleQuoted :: OrgParser Inlines
|
||||
singleQuoted = try $ do
|
||||
singleQuoteStart
|
||||
withQuoteContext InSingleQuote $
|
||||
fmap B.singleQuoted . trimInlinesF . mconcat <$>
|
||||
B.singleQuoted . trimInlines . mconcat <$>
|
||||
many1Till inline singleQuoteEnd
|
||||
|
||||
-- doubleQuoted will handle regular double-quoted sections, as well
|
||||
-- as dialogues with an open double-quote without a close double-quote
|
||||
-- in the same paragraph.
|
||||
doubleQuoted :: OrgParser (F Inlines)
|
||||
doubleQuoted :: OrgParser Inlines
|
||||
doubleQuoted = try $ do
|
||||
doubleQuoteStart
|
||||
contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
|
||||
(withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return
|
||||
(fmap B.doubleQuoted . trimInlinesF $ contents))
|
||||
<|> (return $ return (B.str "\8220") <> contents)
|
||||
(B.doubleQuoted . trimInlines $ contents))
|
||||
<|> (return $ (B.str "\8220") <> contents)
|
||||
|
|
|
|||
|
|
@ -58,7 +58,7 @@ readRST :: ReaderOptions -- ^ Reader options
|
|||
readRST opts s = (readWith parseRST) def{ stateOptions = opts } (s ++ "\n\n")
|
||||
|
||||
readRSTWithWarnings :: ReaderOptions -> String -> (Pandoc, [String])
|
||||
readRSTWithWarnings opts s = (readWithWarnings parseRST) def{ stateOptions = opts } (s ++ "\n\n")
|
||||
readRSTWithWarnings opts s = (readWith (returnWarnings parseRST)) def{ stateOptions = opts } (s ++ "\n\n")
|
||||
|
||||
type RSTParser = Parser [Char] ParserState
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue