{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Readers.CommonMark

Copyright : Copyright (C) 2015-2019 John MacFarlane

import Prelude

import CMarkGFM

import Control.Monad.State

import qualified Data.Set as Set

import Text.Pandoc.Class (PandocMonad)

import Text.Pandoc.Definition

import Text.Pandoc.Emoji (emojiToInline)

[ extTable | isEnabled Ext_pipe_tables opts ] ++

[ extAutolink | isEnabled Ext_autolink_bare_uris opts ]

case emojiToInline ys of

Just em -> em : convertEmojis zs

_ -> [Str s]

convertEmojis s =

("","") -> []

(_,"") -> [Str s]

addHeaderIdentifiers :: ReaderOptions -> Pandoc -> Pandoc

addHeaderIdentifiers opts doc = evalState (walkM (addHeaderId opts) doc) mempty

addHeaderId opts (Header lev (_,classes,kvs) ils) = do

ids <- get

let ident = uniqueIdent (readerExtensions opts) ils ids

addBlock opts (Node _ BLOCK_QUOTE nodes) =

(BlockQuote (addBlocks opts nodes) :)

addBlock opts (Node _ (HTML_BLOCK t) _)

| otherwise = id

-- Note: the cmark parser will never generate CUSTOM_BLOCK,

-- so we don't need to handle it:

addBlock _ (Node _ (CUSTOM_BLOCK _onEnter _onExit) _nodes) =

id

addBlock _ (Node _ (CODE_BLOCK info t) _) =

addBlock opts (Node _ (HEADING lev) nodes) =

(Header lev ("",[],[]) (addInlines opts nodes) :)

addBlock opts (Node _ (LIST listAttrs) nodes) =

addInline :: ReaderOptions -> Node -> [Inline] -> [Inline]

addInline opts (Node _ (TEXT t) _) = (foldr ((++) . toinl) [] clumps ++)

samekind ' ' ' ' = True

samekind ' ' _ = False

samekind _ ' ' = False

samekind _ _ = True

addInline _ (Node _ LINEBREAK _) = (LineBreak :)

addInline opts (Node _ SOFTBREAK _)

| isEnabled Ext_hard_line_breaks opts = (LineBreak :)

| otherwise = (SoftBreak :)

addInline opts (Node _ (HTML_INLINE t) _)

| otherwise = id

-- Note: the cmark parser will never generate CUSTOM_BLOCK,

-- so we don't need to handle it:

addInline _ (Node _ (CUSTOM_INLINE _onEnter _onExit) _nodes) =

id

addInline _ (Node _ (CODE t) _) =

addInline opts (Node _ EMPH nodes) =

(Emph (addInlines opts nodes) :)

addInline opts (Node _ STRONG nodes) =

addInline opts (Node _ STRIKETHROUGH nodes) =

(Strikeout (addInlines opts nodes) :)

addInline opts (Node _ (LINK url title) nodes) =

addInline opts (Node _ (IMAGE url title) nodes) =

addInline _ _ = id

import qualified Data.Foldable as F

import Data.Maybe (fromMaybe)

import Data.Text (Text)

import qualified Text.Pandoc.Builder as B

import Text.Pandoc.Class (PandocMonad (..))

import Text.Pandoc.Definition

eof

return $ B.doc bs

--

-- block parsers

--

>> manyTill content nowikiEnd)

where

content = brackets <|> line

eol = lookAhead $ try $ nowikiEnd <|> newline

nowikiStart = optional newline >> string "{{{" >> skipMany spaceChar >> newline

nowikiEnd = try $ linebreak >> string "}}}" >> skipMany spaceChar >> newline

fmap length (many1 (char '='))

guard $ level <= 6

skipSpaces

return $ B.header level content

where

headerEnd = try $ skipSpaces >> many (char '=') >> skipSpaces >> newline

escapedChar :: PandocMonad m => CRLParser m B.Inlines

escapedChar =

escapedLink :: PandocMonad m => CRLParser m B.Inlines

escapedLink = try $ do

(orig, src) <- wikiImg

return $ B.image src "" (B.str orig)

where

wikiImg = try $ do

string "{{"

src <- linkSrc

(orig, src) <- uriLink <|> wikiLink

return $ B.link src "" orig

where

linkDsc otxt = B.str

<$> try (option otxt

linkImg = try $ char '|' >> image

wikiLink = try $ do

string "[["

return (B.str orig, src)

inlineNowiki :: PandocMonad m => CRLParser m B.Inlines

where

start = try $ string "{{{"

end = try $ string "}}}" >> lookAhead (noneOf "}")

innerNewline = return B.space

symbol :: PandocMonad m => CRLParser m B.Inlines

str :: PandocMonad m => CRLParser m B.Inlines

str = let strChar = noneOf ("\t\n " ++ specialChars) in

bold :: PandocMonad m => CRLParser m B.Inlines

bold = B.strong . mconcat <$>

{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Readers.DocBook

Copyright : Copyright (C) 2006-2019 John MacFarlane

readDocBook :: PandocMonad m => ReaderOptions -> Text -> m Pandoc

readDocBook _ inp = do

(bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock tree

return $ Pandoc (dbMeta st') (toList . mconcat $ bs)

-- We treat <?asciidoc-br?> specially (issue #1236), converting it

-- to <br/>, since xml-light doesn't parse the instruction correctly.

-- Other xml instructions are simply removed from the input stream.

(ys, []) -> ys

getFigure :: PandocMonad m => Element -> DB m Blocks

getFigure e = do

convertEntity e = Data.Maybe.fromMaybe (map toUpper e) (lookupEntity e)

-- convenience function to get an attribute value, defaulting to ""

attrValue attr elt =

-- convenience function

--

[z] -> getInlines z >>= addMeta fieldname

zs -> mapM getInlines zs >>= addMeta fieldname

addMeta field val = modify (setMeta field val)

instance HasMeta DBState where

admonitionTags = ["important","caution","note","tip","warning"]

-- Trim leading and trailing newline characters

-- meld text into beginning of first paragraph of Blocks.

-- assumes Blocks start with a Para; if not, does nothing.

h = case atVal "depth" of

"" -> []

d -> [("height", d)]

in return (atVal "fileref", atr)

let getCaption el = case filterChild (\x -> named "caption" x

|| named "textobject" x

parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE

parseBlock (Text (CData _ s _)) = if all isSpace s

then return mempty

parseBlock (Elem e) =

case qName (elName e) of

"toc" -> skip -- skip TOC, since in pandoc it's autogenerated

"refsect2" -> sect 2

"refsect3" -> sect 3

"refsection" -> gets dbSectionLevel >>= sect . (+1)

"area" -> skip

"areaset" -> skip

"areaspec" -> skip

"subtitle" -> return mempty -- handled in parent element

_ -> skip >> getBlocks e

where skip = do

return mempty

parseMixed container conts = do

"" -> []

x -> [x]

return $ codeBlockWith (attrValue "id" e, classes', [])

parseBlockquote = do

attrib <- case filterChild (named "attribution") e of

Nothing -> return mempty

_ -> AlignDefault

let toWidth c = case findAttr (unqual "colwidth") c of

Just w -> fromMaybe 0

(x >= '0' && x <= '9')

Nothing -> 0 :: Double

let numrows = case bodyrows of

[] -> 0

elementToStr x = x

parseInline :: PandocMonad m => Content -> DB m Inlines

parseInline (CRef ref) =

parseInline (Elem e) =

case qName (elName e) of

"equation" -> equation e displayMath

"constant" -> codeWithLang

"userinput" -> codeWithLang

"varargs" -> return $ code "(...)"

"keycombo" -> keycombo <$>

mapM parseInline (elContent e)

"menuchoice" -> menuchoice <$>

let title = case attrValue "endterm" e of

"" -> maybe "???" xrefTitleByElem

(findElementById linkend content)

(findElementById endterm content)

"ulink" -> link (attrValue "url" e) "" <$> innerInlines

"link" -> do

ils <- innerInlines

let href = case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of

let ils' = if ils == mempty then str href else ils

return $ linkWith attr href "" ils'

"foreignphrase" -> emph <$> innerInlines

"emphasis" -> case attrValue "role" e of

"br" -> return linebreak

_ -> skip >> innerInlines

where skip = do

return mempty

innerInlines = (trimInlines . mconcat) <$>

let classes' = case attrValue "language" e of

"" -> []

l -> [l]

simpleList = (mconcat . intersperse (str "," <> space)) <$> mapM getInlines

(filterChildren (named "member") e)

segmentedList = do

-- if there's no such attribute, employ some heuristics based on what

-- docbook-xsl does.

xrefTitleByElem el

"chapter" -> descendantContent "title" el

"section" -> descendantContent "title" el

"sect1" -> descendantContent "title" el

"sect5" -> descendantContent "title" el

"cmdsynopsis" -> descendantContent "command" el

"funcsynopsis" -> descendantContent "function" el

where

xrefLabel = attrValue "xreflabel" el

. filterElementName (\n -> qName n == name)

-- | Extract a math equation from an element

:: Monad m

=> Element

-- ^ The element from which to extract a mathematical equation

-- ^ A constructor for some Inlines, taking the TeX code as input

-> m Inlines

equation e constructor =

where

mathMLEquations = map writeTeX $ rights $ readMath

(\x -> qName (elName x) == "math" && qPrefix (elName x) == Just "mml")

latexEquations = readMath (\x -> qName (elName x) == "mathphrase")

readMath :: (Element -> Bool) -> (Element -> b) -> [b]

readMath childPredicate fromElement =

-- | Get the actual text stored in a CData block. 'showContent'

-- returns the text still surrounded by the [[CDATA]] tags.

-- | Set the prefix of a name to 'Nothing'

removePrefix :: QName -> QName

{-# LANGUAGE PatternGuards #-}

{-# LANGUAGE MultiWayIf #-}

{-# LANGUAGE FlexibleContexts #-}

{- |

Module : Text.Pandoc.Readers.Docx

Copyright : Copyright (C) 2014-2019 Jesse Rosenthal

import Data.List (delete, intersect)

import Data.Char (isSpace)

import qualified Data.Map as M

import Data.Maybe (isJust, fromMaybe)

import Data.Sequence (ViewL (..), viewl)

import qualified Data.Sequence as Seq

import qualified Data.Set as Set

import Text.Pandoc.Builder

import Text.Pandoc.MediaBag (MediaBag)

import Text.Pandoc.Options

import Text.Pandoc.Readers.Docx.Combine

readDocx _ _ =

throwError $ PandocSomeError "couldn't parse docx file"

, docxMediaBag :: MediaBag

, docxDropCap :: Inlines

-- keep track of (numId, lvl) values for

-- restarting

, docxPrevPara :: Inlines

}

divsToKeep :: [ParaStyleName]

divsToKeep = ["Definition", "Definition Term"]

metaStyles = M.fromList [ ("Title", "title")

, ("Subtitle", "subtitle")

, ("Author", "author")

isEmptyElem _ = True

isEmptyPar _ = False

bodyPartsToMeta' [] = return M.empty

bodyPartsToMeta' (bp : bps)

| (Paragraph pPr parParts) <- bp

runElemToInlines SoftHyphen = text "\xad"

runElemToInlines NoBreakHyphen = text "\x2011"

blacklistedCharStyles :: [CharStyleName]

blacklistedCharStyles = ["Hyperlink"]

runToInlines (Run rs runElems)

| maybe False isCodeCharStyle $ rParentStyle rs = do

rPr <- resolveDependentRunStyle rs

return $ case rVertAlign rPr of

Just SupScrpt -> superscript codeString

Just SubScrpt -> subscript codeString

return $ note blksList

runToInlines (InlineDrawing fp title alt bs ext) = do

(lift . lift) $ P.insertMedia fp Nothing bs

runToInlines InlineChart = return $ spanWith ("", ["chart"], []) $ text "[CHART]"

extentToAttr :: Extent -> Attr

extentToAttr (Just (w, h)) =

("", [], [("width", showDim w), ("height", showDim h)] )

where

extentToAttr _ = nullAttr

blocksToInlinesWarn cmtId blks = do

let blkList = toList blks

notParaOrPlain :: Block -> Bool

notParaOrPlain _ = True

unless ( not (any notParaOrPlain blkList)) $

lift $ P.report $ DocxParserWarning $

return $ blocksToInlines' blkList

-- The majority of work in this function is done in the primed

return $ spanWith (newAnchor, ["anchor"], []) mempty

parPartToInlines' (Drawing fp title alt bs ext) = do

(lift . lift) $ P.insertMedia fp Nothing bs

parPartToInlines' Chart =

return $ spanWith ("", ["chart"], []) $ text "[CHART]"

parPartToInlines' (InternalHyperLink anchor runs) = do

ils <- smushInlines <$> mapM runToInlines runs

parPartToInlines' (ExternalHyperLink target runs) = do

ils <- smushInlines <$> mapM runToInlines runs

return $ link target "" ils

null kvs

isAnchorSpan _ = False

dummyAnchors = ["_GoBack"]

makeHeaderAnchor :: PandocMonad m => Blocks -> DocxContext m Blocks

, (Span (anchIdent, ["anchor"], _) cIls) <- c = do

hdrIDMap <- gets docxAnchorMap

exts <- readerExtensions <$> asks docxOptions

then uniqueIdent exts ils (Set.fromList $ M.elems hdrIDMap)

else ident

newIls = concatMap f ils where f il | il == c = cIls

do

hdrIDMap <- gets docxAnchorMap

exts <- readerExtensions <$> asks docxOptions

then uniqueIdent exts ils (Set.fromList $ M.elems hdrIDMap)

else ident

modify $ \s -> s {docxAnchorMap = M.insert newIdent newIdent hdrIDMap}

else transform

parStyleToTransform _ = return id

where go c | isSpace c = '-'

| otherwise = c

return $

transform $

codeBlock $

| Just (style, n) <- pHeading pPr = do

ils <-local (\s-> s{docxInHeaderBlock=True})

(smushInlines <$> mapM parPartToInlines parparts)

, ("num-id", numId)

, ("format", fmt)

, ("text", txt)

]

modify $ \st -> st{ docxListState =

-- expire all the continuation data for lists of level > this one:

-- replace targets with generated anchors.

rewriteLink' :: PandocMonad m => Inline -> DocxContext m Inline

anchorMap <- gets docxAnchorMap

case M.lookup target anchorMap of

Just newTarget -> do

modify $ \s -> s{docxAnchorSet = Set.insert newTarget (docxAnchorSet s)}

Nothing -> do

modify $ \s -> s{docxAnchorSet = Set.insert target (docxAnchorSet s)}

return l

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE PatternGuards #-}

{-# LANGUAGE TypeSynonymInstances #-}

{- |

Module : Text.Pandoc.Readers.Docx.Combine

Copyright : © 2014-2019 Jesse Rosenthal <jrosenthal@jhu.edu>,

{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Readers.Docx.Fields

Copyright : Copyright (C) 2014-2019 Jesse Rosenthal

) where

import Prelude

import Text.Parsec

data FieldInfo = HyperlinkField URL

| UnknownField

deriving (Show)

parseFieldInfo = parse fieldInfo ""

fieldInfo :: Parser FieldInfo

<|>

return UnknownField

inQuotes =

quotedString = do

char '"'

fieldArgument = quotedString <|> unquotedString

-- there are other switches, but this is the only one I've seen in the wild so far, so it's the first one I'll implement. See §17.16.5.25

hyperlinkSwitch = do

sw <- string "\\l"

spaces

farg <- fieldArgument

hyperlink :: Parser URL

hyperlink = do

farg <- fieldArgument

switches <- spaces *> many hyperlinkSwitch

let url = case switches of

_ -> farg

return url

import Data.List

import Data.Maybe

import Data.String (fromString)

import Text.Pandoc.Generic (bottomUp)

import Text.Pandoc.JSON

import Text.Pandoc.Readers.Docx.Parse (ParaStyleName)

getNumIdN :: Block -> Integer

getNumIdN b = fromMaybe (-1) (getNumId b)

getText (Div (_, _, kvs) _) = lookup "text" kvs

getText _ = Nothing

data ListType = Itemized | Enumerated ListAttributes

listStyleMap = [("upperLetter", UpperAlpha),

("lowerLetter", LowerAlpha),

("upperRoman", UpperRoman),

("lowerRoman", LowerRoman),

("decimal", Decimal)]

listDelimMap = [("%1)", OneParen),

("(%1)", TwoParens),

("%1.", Period)]

_ -> Nothing

getListType _ = Nothing

listParagraphDivs = ["list-paragraph"]

listParagraphStyles :: [ParaStyleName]

-- This is a first stab at going through and attaching meaning to list

-- paragraphs, without an item marker, following a list item. We

{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE ViewPatterns #-}

{- |

Module : Text.Pandoc.Readers.Docx.Parse

Copyright : Copyright (C) 2014-2019 Jesse Rosenthal

import Data.Char (chr, ord, readLitChar)

import Data.List

import qualified Data.Map as M

import Data.Maybe

import System.FilePath

import Text.Pandoc.Readers.Docx.Util

import qualified Text.Pandoc.UTF8 as UTF8

import Text.TeXMath (Exp)

import Text.TeXMath.Readers.OMML (readOMML)

import Text.XML.Light

import qualified Text.XML.Light.Cursor as XMLC

}

deriving Show

, stateFldCharState :: FldCharState

}

deriving Show

concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]

concatMapM f xs = liftM concat (mapM f xs)

-- This is similar to `mapMaybe`: it maps a function returning the D

-- monad over a list, and only keeps the non-erroring return values.

mapD :: (a -> D b) -> [a] -> D [b]

data Numbering = Numbering NameSpaces [Numb] [AbstractNumb]

deriving Show

deriving Show

-- ilvl startOverride lvl

deriving Show

deriving Show

-- ilvl format string start

deriving Show

data DocumentLocation = InDocument | InFootnote | InEndnote

deriving Show

data Notes = Notes NameSpaces

deriving Show

deriving Show

data ParIndentation = ParIndentation { leftParIndent :: Maybe Integer

data BodyPart = Paragraph ParagraphStyle [ParPart]

| OMathPara [Exp]

deriving Show

| BookMark BookMarkId Anchor

| InternalHyperLink Anchor [Run]

| ExternalHyperLink URL [Run]

| Chart -- placeholder for now

| PlainOMath [Exp]

| Field FieldInfo [Run]

data Run = Run RunStyle [RunElem]

| Footnote [BodyPart]

| Endnote [BodyPart]

| InlineChart -- placeholder

deriving Show

deriving Show

archiveToDocx :: Archive -> Either DocxError Docx

archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive

archiveToDocxWithWarnings archive = do

docXmlPath <- case getDocumentXmlPath archive of

Just fp -> Right fp

Right doc -> Right (Docx doc, stateWarnings st)

Left e -> Left e

getDocumentXmlPath zf = do

entry <- findEntryByPath "_rels/.rels" zf

relsElem <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry

, numInfo = Nothing

, psParentStyle = Nothing

, pStyleName = stName

}

archiveToNotes :: Archive -> Notes

relElemToRelationship :: DocumentLocation -> Element -> Maybe Relationship

relElemToRelationship relType element | qName (elName element) == "Relationship" =

do

return $ Relationship relType relId target

relElemToRelationship _ _ = Nothing

in

(dir == "word/media/")

lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do

(absNumId, ovrrides) <- lookup numId $

map (\(Numb nid absnumid ovrRides) -> (nid, (absnumid, ovrRides))) numbs

loElemToLevelOverride :: NameSpaces -> Element -> Maybe LevelOverride

loElemToLevelOverride ns element

| isElem ns "w" "lvlOverride" element = do

let startOverride = findChildByName ns "w" "startOverride" element

>>= findAttrByName ns "w" "val"

>>= (\s -> listToMaybe (map fst (reads s :: [(Integer, String)])))

numElemToNum :: NameSpaces -> Element -> Maybe Numb

numElemToNum ns element

| isElem ns "w" "num" element = do

absNumId <- findChildByName ns "w" "abstractNumId" element

let lvlOverrides = mapMaybe

(loElemToLevelOverride ns)

(findChildrenByName ns "w" "lvlOverride" element)

absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb

absNumElemToAbsNum ns element

| isElem ns "w" "abstractNum" element = do

let levelElems = findChildrenByName ns "w" "lvl" element

levels = mapMaybe (levelElemToLevel ns) levelElems

return $ AbstractNumb absNumId levels

levelElemToLevel :: NameSpaces -> Element -> Maybe Level

levelElemToLevel ns element

| isElem ns "w" "lvl" element = do

fmt <- findChildByName ns "w" "numFmt" element

txt <- findChildByName ns "w" "lvlText" element

let start = findChildByName ns "w" "start" element

>>= findAttrByName ns "w" "val"

>>= (\s -> listToMaybe (map fst (reads s :: [(Integer, String)])))

archiveToNumbering archive =

fromMaybe (Numbering [] [] []) (archiveToNumbering' archive)

elemToNotes ns notetype element

let pairs = mapMaybe

(\a -> Just (a, e)))

(findChildrenByName ns "w" notetype element)

in

M.fromList pairs

elemToNotes _ _ _ = Nothing

elemToComments ns element

| isElem ns "w" "comments" element =

let pairs = mapMaybe

(\a -> Just (a, e)))

(findChildrenByName ns "w" "comment" element)

in

pHeading :: ParagraphStyle -> Maybe (ParaStyleName, Int)

pHeading = getParStyleField headingLev . pStyle

pNumInfo = getParStyleField numInfo . pStyle

elemToBodyPart :: NameSpaces -> Element -> D BodyPart

| isElem ns "w" "p" element

, (c:_) <- findChildrenByName ns "m" "oMathPara" element =

do

return $ OMathPara expsLst

elemToBodyPart ns element

| isElem ns "w" "p" element

| isElem ns "w" "tbl" element = do

let caption' = findChildByName ns "w" "tblPr" element

>>= findChildByName ns "w" "tblCaption"

caption = fromMaybe "" caption'

grid' = case findChildByName ns "w" "tblGrid" element of

Just g -> elemToTblGrid ns g

where

pairs = map (\(Relationship loc relid' target) -> ((loc, relid'), target)) rels

expandDrawingId s = do

location <- asks envLocation

case target of

Just filepath -> do

bytes <- asks (lookup ("word/" ++ filepath) . envMedia)

Nothing -> throwError DocxError

Nothing -> throwError DocxError

getTitleAndAlt ns element =

let mbDocPr = findChildByName ns "wp" "inline" element >>=

findChildByName ns "wp" "docPr"

in (title, alt)

elemToParPart :: NameSpaces -> Element -> D ParPart

= let (title, alt) = getTitleAndAlt ns drawingElem

a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"

drawing = findElement (QName "blip" (Just a_ns) (Just "a")) picElem

in

case drawing of

Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp title alt bs $ elemToExtent drawingElem)

| isElem ns "w" "r" element

, Just _ <- findChildByName ns "w" "pict" element =

let drawing = findElement (elemName ns "v" "imagedata") element

in

case drawing of

-- Todo: check out title and attr for deprecated format.

fldCharState <- gets stateFldCharState

case fldCharState of

FldCharOpen -> do

modify $ \st -> st{stateFldCharState = FldCharFieldInfo info}

return NullParPart

_ -> return NullParPart

return $ ChangedRuns change runs

elemToParPart ns element

| isElem ns "w" "bookmarkStart" element

return $ BookMark bmId bmName

elemToParPart ns element

| isElem ns "w" "hyperlink" element

location <- asks envLocation

runs <- mapD (elemToRun ns) (elChildren element)

rels <- asks envRelationships

case lookupRelationship location relId rels of

Just target ->

Nothing -> return $ ExternalHyperLink target runs

Nothing -> return $ ExternalHyperLink "" runs

elemToParPart ns element

| isElem ns "w" "hyperlink" element

runs <- mapD (elemToRun ns) (elChildren element)

return $ InternalHyperLink anchor runs

elemToParPart ns element

| isElem ns "w" "commentRangeStart" element

(Comments _ commentMap) <- asks envComments

case M.lookup cmtId commentMap of

Just cmtElem -> elemToCommentStart ns cmtElem

Nothing -> throwError WrongElem

elemToParPart ns element

| isElem ns "w" "commentRangeEnd" element

return $ CommentEnd cmtId

elemToParPart ns element

| isElem ns "m" "oMath" element =

elemToParPart _ _ = throwError WrongElem

elemToCommentStart :: NameSpaces -> Element -> D ParPart

elemToCommentStart ns element

| isElem ns "w" "comment" element

bps <- mapD (elemToBodyPart ns) (elChildren element)

return $ CommentStart cmtId cmtAuthor cmtDate bps

elemToCommentStart _ _ = throwError WrongElem

lookupFootnote s (Notes _ fns _) = fns >>= M.lookup s

lookupEndnote s (Notes _ _ ens) = ens >>= M.lookup s

elemToExtent :: Element -> Extent

where

wp_ns = "http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing"

getDim at = findElement (QName "extent" (Just wp_ns) (Just "wp")) drawingElem

childElemToRun :: NameSpaces -> Element -> D Run

= let (title, alt) = getTitleAndAlt ns element

a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"

drawing = findElement (QName "blip" (Just a_ns) (Just "a")) picElem

in

case drawing of

Just s -> expandDrawingId s >>=

= return InlineChart

childElemToRun ns element

| isElem ns "w" "footnoteReference" element

notes <- asks envNotes

case lookupFootnote fnId notes of

Just e -> do bps <- local (\r -> r {envLocation=InFootnote}) $ mapD (elemToBodyPart ns) (elChildren e)

Nothing -> return $ Footnote []

childElemToRun ns element

| isElem ns "w" "endnoteReference" element

notes <- asks envNotes

case lookupEndnote enId notes of

Just e -> do bps <- local (\r -> r {envLocation=InEndnote}) $ mapD (elemToBodyPart ns) (elChildren e)

getTrackedChange :: NameSpaces -> Element -> Maybe TrackedChange

getTrackedChange ns element

| isElem ns "w" "ins" element || isElem ns "w" "moveTo" element

Just $ TrackedChange Insertion (ChangeInfo cId cAuthor cDate)

getTrackedChange ns element

| isElem ns "w" "del" element || isElem ns "w" "moveFrom" element

Just $ TrackedChange Deletion (ChangeInfo cId cAuthor cDate)

getTrackedChange _ _ = Nothing

| Just pPr <- findChildByName ns "w" "pPr" element =

let style =

mapMaybe

(findChildrenByName ns "w" "pStyle" pPr)

in ParagraphStyle

{pStyle = mapMaybe (`M.lookup` sty) style

charStyles <- asks envCharStyles

let parentSty =

findChildByName ns "w" "rStyle" rPr >>=

flip M.lookup charStyles . CharStyleId

return $ elemToRunStyle ns element parentSty

elemToRunStyleD _ _ = return defaultRunStyle

| isElem ns "w" "t" element

|| isElem ns "w" "delText" element

|| isElem ns "m" "t" element = do

font <- asks envFont

case font of

Nothing -> return $ TextRun str

Just f -> return . TextRun $

| isElem ns "w" "br" element = return LnBrk

| isElem ns "w" "tab" element = return Tab

| isElem ns "w" "softHyphen" element = return SoftHyphen

| Just s <- lowerFromPrivate <$> getCodepoint

, Just font <- getFont =

case readLitChar ("\\x" ++ s) of

_ -> TextRun ""

where

getCodepoint = findAttrByName ns "w" "char" element

lowerFromPrivate ('F':xs) = '0':xs

lowerFromPrivate xs = xs

getSymChar _ _ = TextRun ""

let qualName = elemName ns "w"

let font = do

fontElem <- findElement (qualName "rFonts") element

foldr ((<|>) . (flip findAttr fontElem . qualName)) Nothing ["ascii", "hAnsi"]

local (setFont font) (mapD (elemToRunElem ns) (elChildren element))

elemToRunElems _ _ = throwError WrongElem

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE TypeFamilies #-}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{- |

Module : Text.Pandoc.Readers.Docx.Parse.Styles

Copyright : Copyright (C) 2014-2019 Jesse Rosenthal

import Codec.Archive.Zip

import Control.Applicative ((<|>))

import Control.Monad.Except

import Data.Function (on)

import Data.String (IsString(..))

import qualified Data.Map as M

import Data.Maybe

import Data.Coerce

import Text.Pandoc.Readers.Docx.Util

import qualified Text.Pandoc.UTF8 as UTF8

import Text.XML.Light

deriving (Show, Eq, Ord, IsString, FromStyleId)

deriving (Show, Eq, Ord, IsString, FromStyleId)

newtype CharStyleName = CharStyleName CIString

deriving (Show, Eq, Ord, IsString, FromStyleName)

-- Case-insensitive comparisons

class FromStyleName a where

instance FromStyleName String where

fromStyleName = id

class FromStyleId a where

instance FromStyleId String where

fromStyleId = id

instance Eq CIString where

instance Ord CIString where

data VertAlign = BaseLn | SupScrpt | SubScrpt

deriving Show

deriving Show

data ParStyle = ParStyle { headingLev :: Maybe (ParaStyleName, Int)

, psParentStyle :: Maybe ParStyle

, pStyleName :: ParaStyleName

, pStyleId :: ParaStyleId

, Just styleType <- findAttrByName ns "w" "type" element

, styleType == cStyleType parentStyle

, Just basedOnVal <- findChildByName ns "w" "basedOn" element >>=

, Just ps <- parentStyle = basedOnVal == fromStyleId (getStyleId ps)

| isElem ns "w" "style" element

, Just styleType <- findAttrByName ns "w" "type" element

elemToCharStyle :: NameSpaces

-> Element -> Maybe CharStyle -> Maybe CharStyle

elemToCharStyle ns element parentStyle

<*> getElementStyleName ns element

<*> (Just $ elemToRunStyle ns element parentStyle)

getHeaderLevel :: NameSpaces -> Element -> Maybe (ParaStyleName, Int)

getHeaderLevel ns element

| Just styleName <- getElementStyleName ns element

fromStyleName styleName)

, n > 0 = Just (styleName, fromInteger n)

getHeaderLevel _ _ = Nothing

getElementStyleName ns el = coerce <$>

getNumInfo ns element = do

let numPr = findChildByName ns "w" "pPr" element >>=

findChildByName ns "w" "numPr"

lvl = fromMaybe "0" (numPr >>=

findChildByName ns "w" "ilvl" >>=

numId <- numPr >>=

findChildByName ns "w" "numId" >>=

return (numId, lvl)

elemToParStyleData :: NameSpaces -> Element -> Maybe ParStyle -> Maybe ParStyle

elemToParStyleData ns element parentStyle

, Just styleName <- getElementStyleName ns element

= Just $ ParStyle

{

, elemToNameSpaces

, findChildByName

, findChildrenByName

, findAttrByName

) where

import Prelude

import Data.Maybe (mapMaybe)

import Text.XML.Light

type NameSpaces = [(String, String)]

let ns' = ns ++ elemToNameSpaces el

in findChildren (elemName ns' pref name) el

findAttrByName :: NameSpaces -> String -> String -> Element -> Maybe String

findAttrByName ns pref name el =

let ns' = ns ++ elemToNameSpaces el

in findAttr (elemName ns' pref name) el

{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE TupleSections #-}

{- |

Module : Text.Pandoc.Readers.DokuWiki

Copyright : Copyright (C) 2018-2019 Alexander Krotov

import Control.Monad.Except (throwError)

import Data.Char (isAlphaNum, isDigit)

import qualified Data.Foldable as F

import Data.Maybe (fromMaybe, catMaybes)

import Data.Text (Text)

import qualified Data.Text as T

import Text.Pandoc.Error (PandocError (PandocParsecError))

import Text.Pandoc.Options

import Text.Pandoc.Parsing hiding (enclosed, nested)

-- | Read DokuWiki from an input string and return a Pandoc document.

readDokuWiki :: PandocMonad m

let input = crFilter s

res <- runParserT parseDokuWiki def {stateOptions = opts } "source" input

case res of

Right d -> return d

type DWParser = ParserT Text ParserState

B.doc . mconcat <$> many block <* spaces <* eof

-- | Parse <code> and <file> attributes

codeLanguage = try $ do

let attr = case rawLang of

"-" -> []

l -> [l]

-- | Generic parser for <code> and <file> tags

codeTag :: PandocMonad m

-> DWParser m a

codeTag f tag = try $ f

<$ char '<'

<*> codeLanguage

<* manyTill anyChar (char '>')

<* optional (manyTill spaceChar eol)

-- * Inline parsers

underlined = try $ underlineSpan <$> enclosed (string "__") nestedInlines

nowiki :: PandocMonad m => DWParser m B.Inlines

percent :: PandocMonad m => DWParser m B.Inlines

where

monospaced :: PandocMonad m => DWParser m B.Inlines

subscript :: PandocMonad m => DWParser m B.Inlines

subscript = try $ B.subscript <$> between (string "_{") (try $ string "}") nestedInlines

inlineFile = codeTag B.codeWith "file"

inlineHtml :: PandocMonad m => DWParser m B.Inlines

inlinePhp :: PandocMonad m => DWParser m B.Inlines

makeLink (text, url) = B.link url "" $ B.str text

autoEmail :: PandocMonad m => DWParser m B.Inlines

state <- getState

guard $ stateAllowLinks state

(text, url) <- uri

return $ makeLink (text, url)

where

checkLink c

nocache = try $ mempty <$ string "~~NOCACHE~~"

str :: PandocMonad m => DWParser m B.Inlines

symbol :: PandocMonad m => DWParser m B.Inlines

link :: PandocMonad m => DWParser m B.Inlines

link = try $ do

setState $ st{ stateAllowLinks = True }

return l

normalizeInternalPath path =

if isAbsolutePath path

then ensureAbsolute normalizedPath

else normalizedPath

where

normalizePath path =

if isExternalLink path

then path

else normalizeInternalPath path

urlToText url =

if isExternalLink url

then url

-- Parse link or image

parseLink :: PandocMonad m

-> DWParser m B.Inlines

parseLink f l r = f

-- | Split Interwiki link into left and right part

-- | Return Nothing if it is not Interwiki link

splitInterwiki path =

_ -> Nothing

linkText :: PandocMonad m => DWParser m B.Inlines

linkText = parseLink fromRaw "[[" "]]"

Just (_, r) -> r

-- Matches strings like "100x100" (width x height) and "50" (width)

isWidthHeightParameter s =

_ -> False

_ -> False

parseWidthHeight s = (width, height)

where

height =

_ -> Nothing

image :: PandocMonad m => DWParser m B.Inlines

then B.link normalizedPath "" (fromMaybe defaultDescription description)

else B.imageWith ("", classes, attributes) normalizedPath "" (fromMaybe defaultDescription description)

where

normalizedPath = normalizePath path'

classes =

case (leftPadding, rightPadding) of

(False, False) -> []

(False, True) -> ["align-left"]

(True, False) -> ["align-right"]

(True, True) -> ["align-center"]

linkOnly = "linkonly" `elem` parameterList

(width, height) = maybe (Nothing, Nothing) parseWidthHeight (F.find isWidthHeightParameter parameterList)

attributes = catMaybes [fmap ("width",) width, fmap ("height",) height]

<|> blockElements

<|> para

skipMany blankline

return res

blockElements :: PandocMonad m => DWParser m B.Blocks

attr <- registerHeader nullAttr contents

return $ B.headerWith attr (7 - lev) contents

list prefix = bulletList prefix <|> orderedList prefix

bulletList prefix = try $ B.bulletList <$> parseList prefix '*'

orderedList prefix = try $ B.orderedList <$> parseList prefix '-'

parseList :: PandocMonad m

-> Char

-> DWParser m [B.Blocks]

parseList prefix marker =

many1 ((<>) <$> item <*> fmap mconcat (many continuation))

where

itemContents = B.plain . mconcat <$> many1Till inline' eol

indentedCode :: PandocMonad m => DWParser m B.Blocks

where

quote :: PandocMonad m => DWParser m B.Blocks

quote = try $ nestedQuote 0

blockHtml = try $ B.rawBlock "html"

<$ string "<HTML>"

<* optional (manyTill spaceChar eol)

blockPhp :: PandocMonad m => DWParser m B.Blocks

blockPhp = try $ B.codeBlockWith ("", ["php"], [])

<$ string "<PHP>"

<* optional (manyTill spaceChar eol)

table :: PandocMonad m => DWParser m B.Blocks

table = do

{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE TupleSections #-}

{-# LANGUAGE ViewPatterns #-}

{- |

Module : Text.Pandoc.Readers.EPUB

Copyright : Copyright (C) 2014-2019 Matthew Pickering

import Control.Monad (guard, liftM, liftM2, mplus)

import Control.Monad.Except (throwError)

import qualified Data.ByteString.Lazy as BL (ByteString)

import qualified Data.Map as M (Map, elems, fromList, lookup)

import Data.Maybe (fromMaybe, mapMaybe)

import qualified Data.Text.Lazy as TL

-- No need to collapse here as the image path is from the manifest file

let coverDoc = fromMaybe mempty (imageToPandoc <$> cover)

spine <- parseSpine items content

Pandoc _ bs <-

`liftM` parseSpineElem root b) mempty spine

let ast = coverDoc <> Pandoc meta bs

fetchImages (M.elems items) root archive ast

parseSpineElem :: PandocMonad m => FilePath -> (FilePath, MimeType) -> m Pandoc

parseSpineElem (normalise -> r) (normalise -> path, mime) = do

doc <- mimeToReader mime r path

return $ docSpan <> doc

mimeToReader :: PandocMonad m => MimeType -> FilePath -> FilePath -> m Pandoc

mimeToReader "application/xhtml+xml" (unEscapeString -> root)

<$> findEntryByPath abslink arc

iq :: Inline -> [FilePath]

iq _ = []

-- Remove relative paths

renameImages :: FilePath -> Inline -> Inline

renameImages root img@(Image attr a (url, b))

renameImages _ x = x

imageToPandoc :: FilePath -> Pandoc

imageMimes :: [MimeType]

imageMimes = ["image/gif", "image/jpeg", "image/png"]

uid <- findAttrE (emptyName "id") e

href <- findAttrE (emptyName "href") e

mime <- findAttrE (emptyName "media-type") e

parseSpine :: PandocMonad m => Items -> Element -> m [(FilePath, MimeType)]

parseSpine is e = do

-- http://www.idpf.org/epub/30/spec/epub30-publications.html#sec-metadata-elem

parseMetaItem :: Element -> Meta -> Meta

parseMetaItem e@(stripNamespace . elName -> field) meta =

renameMeta "creator" = "author"

getManifest :: PandocMonad m => Archive -> m (String, Element)

getManifest archive = do

fixInternalReferences :: FilePath -> Pandoc -> Pandoc

fixInternalReferences pathToFile =

walk (renameImages root)

. walk (fixInlineIRs filename)

where

fixInlineIRs :: String -> Inline -> Inline

fixInlineIRs s (Span as v) =

Span (fixAttrs s as) v

fixInlineIRs s (Code as code) =

Code (fixAttrs s as) code

Link (fixAttrs s as) is (addHash s url, tit)

fixInlineIRs s (Link as is t) =

Link (fixAttrs s as) is t

fixInlineIRs _ v = v

prependHash ps l@(Link attr is (url, tit))

| otherwise = l

prependHash _ i = i

fixBlockIRs _ b = b

fixAttrs :: FilePath -> B.Attr -> B.Attr

addHash _ "" = ""

removeEPUBAttrs kvs = filter (not . isEPUBAttr) kvs

-- Library

findElementE e x = mkE ("Unable to find element: " ++ show e) $ findElement e x

mkE :: PandocMonad m => String -> Maybe a -> m a

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE TupleSections #-}

{- |

Module : Text.Pandoc.Readers.FB2

Copyright : Copyright (C) 2018-2019 Alexander Krotov

import Control.Monad.State.Strict

import Data.ByteString.Lazy.Char8 ( pack )

import Data.ByteString.Base64.Lazy

import Data.Functor

import qualified Data.Map as M

import Data.Text (Text)

import Data.Default

import Data.Maybe

import Text.HTML.TagSoup.Entity (lookupEntity)

data FB2State = FB2State{ fb2SectionLevel :: Int

, fb2Meta :: Meta

} deriving Show

instance Default FB2State where

-- * Utility functions

parseInline :: PandocMonad m => Content -> FB2 m Inlines

parseInline (Elem e) =

"strong" -> strong <$> parseStyleType e

"emphasis" -> emph <$> parseStyleType e

"style" -> parseNamedStyle e

"strikethrough" -> strikeout <$> parseStyleType e

"sub" -> subscript <$> parseStyleType e

"sup" -> superscript <$> parseStyleType e

"image" -> parseInlineImageElement e

name -> do

report $ IgnoredElement name

pure mempty

parseInline (CRef r) = pure $ str $ convertEntity r

parseSubtitle :: PandocMonad m => Element -> FB2 m Blocks

parseRootElement :: PandocMonad m => Element -> FB2 m Blocks

parseRootElement e =

"FictionBook" -> do

-- Parse notes before parsing the rest of the content.

case filterChild isNotesBody e of

Just sectionId -> do

content <- mconcat <$> mapM parseSectionChild (dropTitle $ elChildren e)

oldNotes <- gets fb2Notes

pure ()

where

isTitle x = qName (elName x) == "title"

-- | Parse a child of @\<FictionBook>@ element.

parseFictionBookChild :: PandocMonad m => Element -> FB2 m Blocks

parseFictionBookChild e =

"stylesheet" -> pure mempty -- stylesheet is ignored

"description" -> mempty <$ mapM_ parseDescriptionChild (elChildren e)

"body" -> if isNotesBody e

-- | Parse a child of @\<description>@ element.

parseDescriptionChild :: PandocMonad m => Element -> FB2 m ()

parseDescriptionChild e =

"title-info" -> mapM_ parseTitleInfoChild (elChildren e)

"src-title-info" -> pure () -- ignore

"document-info" -> pure ()

"custom-info" -> pure ()

"output" -> pure ()

name -> do

pure mempty

-- | Parse a child of @\<body>@ element.

parseBodyChild :: PandocMonad m => Element -> FB2 m Blocks

parseBodyChild e =

"image" -> parseImageElement e

"title" -> header <$> gets fb2SectionLevel <*> parseTitleType (elContent e)

"epigraph" -> parseEpigraph e

(Nothing, _) -> report $ IgnoredElement "binary without id attribute"

(Just _, Nothing) ->

report $ IgnoredElement "binary without content-type attribute"

-- * Type parsers

-- | Parse @authorType@

parseAuthorChild e =

name -> do

pure Nothing

-- | Parse @titleType@

parseImageElement :: PandocMonad m => Element -> FB2 m Blocks

parseImageElement e =

case href of

Nothing -> do

report $ IgnoredElement " image without href"

pure mempty

href = findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e

-- | Parse @pType@

-- | Parse @citeType@ child

parseCiteChild :: PandocMonad m => Element -> FB2 m Blocks

parseCiteChild e =

"p" -> para <$> parsePType e

"poem" -> parsePoem e

"empty-line" -> pure horizontalRule

parsePoemChild :: PandocMonad m => Element -> FB2 m Blocks

parsePoemChild e =

"title" -> parseTitle e

"subtitle" -> parseSubtitle e

"epigraph" -> parseEpigraph e

"stanza" -> parseStanza e

"text-author" -> para <$> parsePType e

name -> report (UnexpectedXmlElement name "poem") $> mempty

parseStanza :: PandocMonad m => Element -> FB2 m Blocks

parseStanzaChild :: PandocMonad m => Element -> FB2 m Blocks

parseStanzaChild e =

"title" -> parseTitle e

"subtitle" -> parseSubtitle e

"v" -> lineBlock . (:[]) <$> parsePType e

parseEpigraph :: PandocMonad m => Element -> FB2 m Blocks

parseEpigraph e =

divWith (divId, ["epigraph"], []) . mconcat <$> mapM parseEpigraphChild (elChildren e)

parseEpigraphChild :: PandocMonad m => Element -> FB2 m Blocks

parseEpigraphChild e =

"p" -> para <$> parsePType e

"poem" -> parsePoem e

"cite" -> parseCite e

parseAnnotationChild :: PandocMonad m => Element -> FB2 m Blocks

parseAnnotationChild e =

"p" -> para <$> parsePType e

"poem" -> parsePoem e

"cite" -> parseCite e

parseSection e = do

n <- gets fb2SectionLevel

modify $ \st -> st{ fb2SectionLevel = n + 1 }

bs <- divWith (sectionId, ["section"], []) . mconcat <$> mapM parseSectionChild (elChildren e)

modify $ \st -> st{ fb2SectionLevel = n }

pure bs

parseSectionChild :: PandocMonad m => Element -> FB2 m Blocks

parseSectionChild e =

"title" -> parseBodyChild e

"epigraph" -> parseEpigraph e

"image" -> parseImageElement e

parseNamedStyle :: PandocMonad m => Element -> FB2 m Inlines

parseNamedStyle e = do

content <- mconcat <$> mapM parseNamedStyleChild (elContent e)

case findAttr (unqual "name") e of

Nothing -> do

report $ IgnoredElement "link without required name"

pure mempty

parseNamedStyleChild :: PandocMonad m => Content -> FB2 m Inlines

parseNamedStyleChild (Elem e) =

"strong" -> strong <$> parseStyleType e

"emphasis" -> emph <$> parseStyleType e

"style" -> parseNamedStyle e

"strikethrough" -> strikeout <$> parseStyleType e

"sub" -> subscript <$> parseStyleType e

"sup" -> superscript <$> parseStyleType e

"image" -> parseInlineImageElement e

name -> do

pure mempty

parseNamedStyleChild x = parseInline x

parseLinkType e = do

content <- mconcat <$> mapM parseStyleLinkType (elContent e)

notes <- gets fb2Notes

Just href -> case findAttr (QName "type" Nothing Nothing) e of

Just "note" -> case M.lookup href notes of

Nothing -> pure $ link href "" content

-- | Parse @title-infoType@

parseTitleInfoChild :: PandocMonad m => Element -> FB2 m ()

parseTitleInfoChild e =

"genre" -> pure ()

"author" -> parseAuthor e >>= \author -> modify (\st -> st {fb2Authors = author:fb2Authors st})

"annotation" -> parseAnnotation e >>= modify . setMeta "abstract"

"coverpage" -> parseCoverPage e

"lang" -> pure ()

"src-lang" -> pure ()

"translator" -> pure ()

"sequence" -> pure ()

parseCoverPage :: PandocMonad m => Element -> FB2 m ()

parseCoverPage e =

Just img -> case href of

Just src -> modify (setMeta "cover-image" (MetaString $ removeHash src))

Nothing -> pure ()

Nothing -> pure ()

-- | Parse @inlineImageType@ element

Nothing -> do

report $ IgnoredElement "inline image without href"

pure mempty

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE MultiParamTypeClasses #-}

import Data.Char (isAlphaNum, isLetter)

import Data.Default (Default (..), def)

import Data.Foldable (for_)

import qualified Data.Map as M

import Data.Maybe (fromMaybe, isJust, isNothing)

import Data.Monoid (First (..))

extensionEnabled)

import Text.Pandoc.Parsing hiding ((<|>))

import Text.Pandoc.Shared (addMetaField, blocksToInlines', crFilter, escapeURI,

import Text.Pandoc.Walk

import Text.Parsec.Error

import Text.TeXMath (readMathML, writeTeX)

"source" tags

case result of

Right doc -> return doc

replaceNotes :: PandocMonad m => [Block] -> TagParser m [Block]

replaceNotes bs = do

st <- getState

return $ walk (replaceNotes' (noteTable st)) bs

replaceNotes' noteTbl (RawInline (Format "noteref") ref) =

maybe (Str "") (Note . B.toList) $ lookup ref noteTbl

replaceNotes' _ x = x

data HTMLState =

HTMLState

{ parserState :: ParserState,

baseHref :: Maybe URI,

logMessages :: [LogMessage],

macros :: M.Map Text Macro

}

pHtml = try $ do

(TagOpen "html" attr) <- lookAhead pAny

for_ (lookup "lang" attr) $

pInTags "html" block

pBody :: PandocMonad m => TagParser m Blocks

setTitle t = mempty <$ updateState (B.setMeta "title" t)

pMetaTag = do

mt <- pSatisfy (matchTagOpen "meta" [])

then return mempty

else do

updateState $ \s ->

let ps = parserState s in

s{ parserState = ps{

, pFigure

, pRawHtmlBlock

]

return res

namespaces = [(mathMLNamespace, pMath True)]

mathMLNamespace = "http://www.w3.org/1998/Math/MathML"

eSwitch :: (PandocMonad m, Monoid a)

content <- pInTags tag block

addNote ident content

addNote uid cont = updateState (\s -> s {noteTable = (uid, cont) : noteTable s})

eNoteref :: PandocMonad m => TagParser m Inlines

-> (lookup "type" as <|> lookup "epub:type" as)

== Just "noteref"

_ -> False)

_ -> mzero

_ <- manyTill pAny (pSatisfy (\case

TagClose t -> t == tag

maybe id addId (lookup "id" attr) <$>

pInTags "li" block <* skipMany nonItem

parseListStyleType "lower-roman" = LowerRoman

parseListStyleType "upper-roman" = UpperRoman

parseListStyleType "lower-alpha" = LowerAlpha

parseListStyleType "decimal" = Decimal

parseListStyleType _ = DefaultStyle

parseTypeAttr "i" = LowerRoman

parseTypeAttr "I" = UpperRoman

parseTypeAttr "a" = LowerAlpha

pRawHtmlBlock :: PandocMonad m => TagParser m Blocks

pRawHtmlBlock = do

exts <- getOption readerExtensions

then return $ B.rawBlock "html" raw

else ignore raw

ignore raw = do

pos <- getPosition

-- raw can be null for tags like <!DOCTYPE>; see paRawTag

-- in this case we don't want a warning:

logMessage $ SkippedContent raw pos

return mempty

headerLevel :: Text -> TagParser m Int

headerLevel tagtype =

Just level ->

-- try (do

-- guardEnabled Ext_epub_html_exts

level <- headerLevel tagtype

contents <- trimInlines . mconcat <$> manyTill inline (pCloses tagtype <|> eof)

let ident = fromMaybe "" $ lookup "id" attr

let keyvals = [(k,v) | (k,v) <- attr, k /= "class", k /= "id"]

attr'' <- registerHeader (ident, classes, keyvals) contents

return $ if bodyTitle

optional $ pSatisfy (matchTagClose "col")

skipMany pBlank

let width = case lookup "width" attribs of

if width > 0.0

then return $ width / 100.0

else return 0.0

let extractAlign' [] = ""

extractAlign' ("text-align":x:_) = x

extractAlign' (_:xs) = extractAlign' xs

let align = case maybeFromAttrib "align" tag `mplus`

(extractAlign <$> maybeFromAttrib "style" tag) of

Just "left" -> AlignLeft

let caption = fromMaybe mempty mbcap

case B.toList <$> mbimg of

Just [Image attr _ (url, tit)] ->

_ -> mzero

pCodeBlock :: PandocMonad m => TagParser m Blocks

TagOpen _ attr' <- pSatisfy (matchTagOpen "pre" [])

let attr = toStringAttr attr'

contents <- manyTill pAny (pCloses "pre" <|> eof)

-- drop leading newline if any

-- drop trailing newline if any

return $ B.codeBlockWith (mkAttr attr) result

inline :: PandocMonad m => TagParser m Inlines

inline = choice

pSat :: PandocMonad m => (Tag Text -> Bool) -> TagParser m (Tag Text)

pSat f = do

pos <- getPosition

pSatisfy :: PandocMonad m => (Tag Text -> Bool) -> TagParser m (Tag Text)

pSatisfy f = try $ optional pLocation >> pSat f

where citedQuote = do

tag <- pSatisfy $ tagOpenLit "q" (any ((=="cite") . fst))

maybeFromAttrib "id" tag

makeQuote $ B.spanWith (uid, cls, [("cite", escapeURI url)])

normalQuote = do

TagOpen _ attrs <- pSatisfy $ tagOpenLit tagName (const True)

let (ids, cs, kvs) = mkAttr . toStringAttr $ attrs

content <- mconcat <$> manyTill inline (pCloses tagName <|> eof)

pSmall :: PandocMonad m => TagParser m Inlines

pSmall = pInlinesInTags "small" (B.spanWith ("",["small"],[]))

-- Unlike fromAttrib from tagsoup, this distinguishes

-- between a missing attribute and an attribute with empty content.

maybeFromAttrib _ _ = Nothing

pLink :: PandocMonad m => TagParser m Inlines

pLink = try $ do

tag <- pSatisfy $ tagOpenLit "a" (const True)

-- take id from id attribute if present, otherwise name

maybeFromAttrib "id" tag

lab <- mconcat <$> manyTill inline (pCloses "a")

-- check for href; if href, then a link, otherwise a span

case maybeFromAttrib "href" tag of

pImage :: PandocMonad m => TagParser m Inlines

pImage = do

tag <- pSelfClosing (=="img") (isJust . lookup "src")

let getAtt k = case fromAttrib k tag of

"" -> []

let kvs = concatMap getAtt ["width", "height", "sizes", "srcset"]

return $ B.imageWith (uid, cls, kvs) (escapeURI url) title (B.text alt)

let tagTest = flip elem . fmap fst $ elemToClass

TagOpen open attr' <- pSatisfy $ tagOpen tagTest (const True)

result <- manyTill pAny (pCloses open)

let (ids,cs,kvs) = mkAttr . toStringAttr $ attr'

cs' = maybe cs (:cs) . lookup open $ elemToClass

return . B.codeWith (ids,cs',kvs) .

pCode :: PandocMonad m => TagParser m Inlines

pCode = try $ do

(TagOpen open attr') <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)

let attr = toStringAttr attr'

result <- manyTill pAny (pCloses open)

pSpan :: PandocMonad m => TagParser m Inlines

pSpan = try $ do

where styleAttr = fromMaybe "" $ lookup "style" attr

fontVariant = fromMaybe "" $ pickStyleAttrProps ["font-variant"] styleAttr

classes = fromMaybe [] $

let tag = if isSmallCaps then B.smallcaps else B.spanWith (mkAttr attr)

return $ tag contents

then pSatisfy (not . isBlockTag)

else pSatisfy isInlineTag

exts <- getOption readerExtensions

if extensionEnabled Ext_raw_html exts

then return $ B.rawInline "html" raw

else ignore raw

mathMLToTeXMath s = writeTeX <$> readMathML s

toStringAttr = map go

pScriptMath :: PandocMonad m => TagParser m Inlines

pScriptMath = try $ do

Just x | "math/tex" `T.isPrefixOf` x

-> return $ "display" `T.isSuffixOf` x

_ -> mzero

return $ (if isdisplay then B.displayMath else B.math) contents

pMath :: PandocMonad m => Bool -> TagParser m Inlines

unless inCase $

guard (maybe True (== mathMLNamespace) (lookup "xmlns" attr))

contents <- manyTill pAny (pSatisfy (matchTagClose "math"))

[open] <> contents <> [TagClose "math"]) of

Left _ -> return $ B.spanWith ("",["math"],attr) $ B.text $

Right x -> return $ case lookup "display" attr of

Just "block" -> B.displayMath x

_ -> B.math x

parsed <- lift $ lift $

flip runReaderT qu $ runParserT (many pTagContents) st "text" str

case parsed of

Right result -> return $ mconcat result

pBlank :: PandocMonad m => TagParser m ()

guardEnabled Ext_raw_tex

inp <- getInput

st <- getState

case res of

Left _ -> mzero

Right (contents, raw) -> do

return $ B.rawInline "tex" contents

pStr :: PandocMonad m => InlinesParser m Inlines

result <- many1 $ satisfy $ \c ->

not (isSpace c) && not (isSpecial c) && not (isBad c)

updateLastStrPos

isSpecial :: Char -> Bool

isSpecial '"' = True

isSpecial _ = False

pSymbol :: PandocMonad m => InlinesParser m Inlines

isBad :: Char -> Bool

isBad c = c >= '\128' && c <= '\159' -- not allowed in HTML

'\158' -> '\382'

'\159' -> '\376'

_ -> '?'

pSpace :: PandocMonad m => InlinesParser m Inlines

pSpace = many1 (satisfy isSpace) >>= \xs ->

-- | Matches a stretch of HTML in balanced tags.

htmlInBalanced :: Monad m

htmlInBalanced f = try $ do

lookAhead (char '<')

inp <- getInput

(TagClose _ : TagPosition er ec : _) -> do

let ls = er - sr

let cs = ec - sc

cscontents <- count cs anyChar

closetag <- do

x <- many (satisfy (/='>'))

char '>'

return (x <> ">")

_ -> mzero

_ -> mzero

htmlInBalanced' tagname ts = fromMaybe [] $ go 0 ts

go n (t@(TagOpen tn' _):rest) | tn' == tagname =

(t :) <$> go (n + 1) rest

go 1 (t@(TagClose tn'):_) | tn' == tagname =

-- | Matches a tag meeting a certain condition.

htmlTag :: (HasReaderOptions st, Monad m)

htmlTag f = try $ do

lookAhead (char '<')

startpos <- getPosition

let ts = canonicalizeTags $ parseTagsOptions

parseOptions{ optTagWarning = False

, optTagPosition = True }

-- we get a TagPosition after the tag

(next, ln, col) <- case ts of

(TagPosition{} : next : TagPosition ln col : _)

-- so we exclude . even though it's a valid character

-- in XML element names

let isNameChar c = isAlphaNum c || c == ':' || c == '-' || c == '_'

let endpos = if ln == 1

then setSourceColumn startpos

(sourceColumn startpos + (col - 1))

-- basic sanity check, since the parser is very forgiving

-- and finds tags in stuff like x<y)

guard $ isName tagname || isPI tagname

-- <https://example.org> should NOT be a tag either.

-- tagsoup will parse it as TagOpen "https:" [("example.org","")]

char '<'

rendered <- manyTill anyChar endAngle

case next of

TagComment s

string "<!--"

string "-->"

stripComments <- getOption readerStripComments

if stripComments

handleTag tagname

_ -> mzero

mkAttr attr = (attribsId, attribsClasses, attribsKV)

where attribsId = fromMaybe "" $ lookup "id" attr

attribsKV = filter (\(k,_) -> k /= "class" && k /= "id") attr

-- Strip namespace prefixes

stripPrefixes :: [Tag Text] -> [Tag Text]

-- Utilities

-- | Adjusts a url according to the document's base URL.

canonicalizeUrl url = do

mbBaseHref <- baseHref <$> getState

_ -> url

{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Readers.Haddock

Copyright : Copyright (C) 2013 David Lazar

import Prelude

import Control.Monad.Except (throwError)

import Data.Maybe (fromMaybe)

import Data.Text (Text, unpack)

import Documentation.Haddock.Parser

import Documentation.Haddock.Types as H

import Text.Pandoc.Builder (Blocks, Inlines)

import Text.Pandoc.Definition

import Text.Pandoc.Error

import Text.Pandoc.Options

-- | Parse Haddock markup and return a 'Pandoc' document.

case d' of

DocEmpty -> mempty

DocAppend (DocParagraph (DocHeader h)) (DocParagraph (DocAName ident)) ->

(docHToInlines False $ headerTitle h)

DocAppend d1 d2 -> mappend (docHToBlocks d1) (docHToBlocks d2)

DocString _ -> inlineFallback

DocDefList items -> B.definitionList (map (\(d,t) ->

(docHToInlines False d,

[consolidatePlains $ docHToBlocks t])) items)

DocCodeBlock d -> B.para $ docHToInlines True d

DocHyperlink _ -> inlineFallback

DocPic _ -> inlineFallback

DocAName _ -> inlineFallback

DocExamples es -> mconcat $ map (\e ->

makeExample ">>>" (exampleExpression e) (exampleResult e)) es

DocTable H.Table{ tableHeaderRows = headerRows

(docHToInlines isCode d2)

DocString s

| isCode -> mconcat $ intersperse B.linebreak

DocParagraph _ -> mempty

DocIdentifier ident ->

case toRegular (DocIdentifier ident) of

_ -> mempty

DocWarning _ -> mempty -- TODO

DocEmphasis d -> B.emph (docHToInlines isCode d)

DocMonospaced d -> docHToInlines True d

DocBold d -> B.strong (docHToInlines isCode d)

DocHeader _ -> mempty

DocUnorderedList _ -> mempty

DocOrderedList _ -> mempty

DocDefList _ -> mempty

DocCodeBlock _ -> mempty

(hyperlinkLabel h))

DocProperty _ -> mempty

DocExamples _ -> mempty

DocTable _ -> mempty

-- | Create an 'Example', stripping superfluous characters as appropriate

makeExample prompt expression result =

B.para $ B.codeWith ("",["prompt"],[]) prompt

<> B.space

<> B.linebreak

<> mconcat (intersperse B.linebreak $ map coder result')

where

-- 1. drop trailing whitespace from the prompt, remember the prefix

-- 2. drop, if possible, the exact same sequence of whitespace

-- characters from each result line

--

-- 3. interpret lines that only contain the string "<BLANKLINE>" as an

-- empty line

where

substituteBlankLine "<BLANKLINE>" = ""

substituteBlankLine line = line

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE ScopedTypeVariables #-}

{- |

Module : Text.Pandoc.Readers.Ipynb

Copyright : Copyright (C) 2019 John MacFarlane

where

import Prelude

import Data.Char (isDigit)

import Data.Maybe (fromMaybe)

import Data.Digest.Pure.SHA (sha1, showDigest)

import Text.Pandoc.Options

import Data.Ipynb as Ipynb

import Text.Pandoc.Class

import Text.Pandoc.MIME (extensionFromMimeType)

import Text.Pandoc.UTF8

import Text.Pandoc.Walk (walk)

import Text.Pandoc.Error

Left _ ->

case eitherDecode src of

Right (notebook3 :: Notebook NbV3) -> notebookToPandoc opts notebook3

notebookToPandoc :: PandocMonad m

=> ReaderOptions -> Notebook a -> m Pandoc

notebookToPandoc opts notebook = do

let cells = notebookCells notebook

let (fmt,fmtminor) = notebookFormat notebook

jsonMetaToMeta (notebookMetadata notebook)

let lang = case M.lookup "kernelspec" m of

Just (MetaMap ks) ->

return $ Pandoc (Meta $ M.insert "jupyter" (MetaMap m) mempty) blocks

cellToBlocks :: PandocMonad m

cellToBlocks opts lang c = do

let Source ts = cellSource c

let source = mconcat ts

"text/markdown" -> "markdown"

"text/x-rsrt" -> "rst"

_ -> format

Ipynb.Code{ codeOutputs = outputs, codeExecutionCount = ec } -> do

outputBlocks <- mconcat <$> mapM outputToBlock outputs

return $ B.divWith ("",["cell","code"],kvs') $

<> outputBlocks

-- Remove attachment: prefix from images...

fixImage :: Inline -> Inline

fixImage (Image attr lab (src,tit))

fixImage x = x

addAttachment :: PandocMonad m => (Text, MimeBundle) -> m ()

let fp = T.unpack fname

case M.toList (unMimeBundle mimeBundle) of

(mimeType, BinaryData bs):_ ->

(mimeType, TextualData t):_ ->

(BL.fromStrict $ TE.encodeUtf8 t)

(mimeType, JsonData v):_ ->

outputToBlock :: PandocMonad m => Output a -> m B.Blocks

outputToBlock Stream{ streamName = sName,

streamText = Source text } = do

outputToBlock DisplayData{ displayData = data',

displayMetadata = metadata' } =

B.divWith ("",["output", "display_data"],[]) <$>

outputToBlock ExecuteResult{ executeCount = ec,

executeData = data',

executeMetadata = metadata' } =

<$> handleData metadata' data'

outputToBlock Err{ errName = ename,

errValue = evalue,

errTraceback = traceback } = do

return $ B.divWith ("",["output","error"],

-- We want to display the richest output possible given

-- the output format.

let metaPairs = jsonMetaToPairs meta

let bl = BL.fromStrict bs

-- SHA1 hash for filename

Nothing -> ""

return $ B.para $ B.imageWith ("",[],metaPairs) fname "" mempty

| otherwise = return mempty

dataBlock ("text/html", TextualData t)

dataBlock ("text/latex", TextualData t)

dataBlock ("text/plain", TextualData t) =

dataBlock (_, JsonData v) =

dataBlock _ = return mempty

where

valueToMetaValue :: Value -> MetaValue

valueToMetaValue x@(Object{}) =

case fromJSON x of

Success jm' -> MetaMap $ jsonMetaToMeta jm'

valueToMetaValue x@(Array{}) =

case fromJSON x of

Success xs -> MetaList $ map valueToMetaValue xs

valueToMetaValue (Bool b) = MetaBool b

valueToMetaValue (Number n)

valueToMetaValue Aeson.Null = MetaString ""

(\case

String t

| not (T.all isDigit t)

, t /= "true"

, t /= "false"

{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE TupleSections #-}

{- |

Module : Text.Pandoc.Readers.JATS

Copyright : Copyright (C) 2017-2019 Hamish Mackenzie

convertEntity e = Data.Maybe.fromMaybe (map toUpper e) (lookupEntity e)

-- convenience function to get an attribute value, defaulting to ""

attrValue attr =

fromMaybe "" . maybeAttrValue attr

maybeAttrValue attr elt =

-- convenience function

named :: String -> Element -> Bool

--

addMeta field val = modify (setMeta field val)

instance HasMeta JATSState where

isBlockElement _ = False

-- Trim leading and trailing newline characters

-- function that is used by both graphic (in parseBlock)

-- and inline-graphic (in parseInline)

getGraphic :: PandocMonad m

getGraphic mbfigdata e = do

let atVal a = attrValue a e

(ident, title, caption) =

Just (capt, i) -> (i, "fig:" <> atVal "title", capt)

Nothing -> (atVal "id", atVal "title",

text (atVal "alt-text"))

imageUrl = atVal "href"

return $ imageWith attr imageUrl title caption

parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE

parseBlock (Text (CData _ s _)) = if all isSpace s

then return mempty

parseBlock (Elem e) =

case qName (elName e) of

"p" -> parseMixed para (elContent e)

"bullet" -> bulletList <$> listitems

listType -> do

let start = fromMaybe 1 $

>>= filterElement (named "label")))

>>= safeRead

orderedListWith (start, parseListStyleType listType, DefaultDelim)

"" -> []

x -> [x]

return $ codeBlockWith (attrValue "id" e, classes', [])

parseBlockquote = do

attrib <- case filterChild (named "attribution") e of

Nothing -> return mempty

Just "right" -> AlignRight

Just "center" -> AlignCenter

_ -> AlignDefault

Just w -> fromMaybe 0

isDigit x || x == '.') w

Nothing -> 0 :: Double

let numrows = foldl' max 0 $ map length bodyrows

return mempty

parseRef :: PandocMonad m

parseRef e = do

let refId = text $ attrValue "id" e

let getInlineText n = maybe (return mempty) getInlines . filterChild (named n)

family <- maybe (return mempty) getInlines

$ filterChild (named "surname") nm

return $ toMetaValue $ Map.fromList [

, ("family", family)

]

personGroups <- mapM (\pg ->

toMetaValue names))

personGroups'

return $ Map.fromList $

, ("type", toMetaValue refType)

, ("title", toMetaValue refTitle)

, ("container-title", toMetaValue refContainerTitle)

, ("title", toMetaValue refTitle)

, ("issued", toMetaValue

$ Map.fromList [

])

, ("volume", toMetaValue refVolume)

, ("page", toMetaValue refPages)

Nothing -> return $ Map.insert "id" (toMetaValue refId) mempty

-- TODO handle mixed-citation

strContentRecursive :: Element -> String

strContentRecursive = strContent .

(\e' -> e'{ elContent = map elementToStr $ elContent e' })

elementToStr x = x

parseInline :: PandocMonad m => Content -> JATS m Inlines

parseInline (CRef ref) =

parseInline (Elem e) =

case qName (elName e) of

"italic" -> emph <$> innerInlines

"xref" -> do

ils <- innerInlines

let rid = attrValue "rid" e

let refType = ("ref-type",) <$> maybeAttrValue "ref-type" e

let attr = (attrValue "id" e, [], maybeToList refType)

return $ if refType == Just ("ref-type","bibr")

, citationNoteNum = 0

, citationHash = 0}) rids)

ils

"ext-link" -> do

ils <- innerInlines

let href = case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of

let ils' = if ils == mempty then str href else ils

let attr = (attrValue "id" e, [], [])

return $ linkWith attr href title ils'

"disp-formula" -> formula displayMath

"inline-formula" -> formula math

"math" | qPrefix (elName e) == Just "mml" -> return . math $ mathML e

"fn" -> (note . mconcat) <$>

mapM parseBlock (elContent e)

_ -> innerInlines

where innerInlines = (trimInlines . mconcat) <$>

mapM parseInline (elContent e)

mathML x =

Left _ -> mempty

Right m -> writeTeX m

formula constructor = do

let whereToLook = fromMaybe e $ filterElement (named "alternatives") e

filterChildren (named "tex-math") whereToLook

mathMLs = map mathML $

filterChildren isMathML whereToLook

let classes' = case attrValue "language" e of

"" -> []

l -> [l]

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE MultiParamTypeClasses #-}

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE PatternGuards #-}

{-# LANGUAGE ScopedTypeVariables #-}

{- |

Module : Text.Pandoc.Readers.LaTeX

Copyright : Copyright (C) 2006-2019 John MacFarlane

import Control.Applicative (many, optional, (<|>))

import Control.Monad

import Control.Monad.Except (throwError)

import Data.Default

import qualified Data.Map as M

import Data.Maybe (fromMaybe, maybeToList)

import qualified Data.Set as Set

import Text.Pandoc.Class (PandocMonad, PandocPure, getResourcePath, lookupEnv,

readFileFromDirs, report, setResourcePath,

setTranslations, translateTerm, trace, fileExists)

import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)

import Text.Pandoc.ImageSize (numUnit, showFl)

import Text.Pandoc.Logging

(tokenize "source" (crFilter ltx))

case parsed of

Right result -> return result

parseLaTeX :: PandocMonad m => LP m Pandoc

parseLaTeX = do

walk (resolveRefs (sLabels st)) doc'

return $ Pandoc meta bs'

resolveRefs labels x@(Link (ident,classes,kvs) _ _) =

case (lookup "reference-type" kvs,

lookup "reference" kvs) of

(Just "ref", Just lab) ->

case M.lookup lab labels of

Nothing -> x

_ -> x

resolveRefs _ x = x

rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)

rawLaTeXBlock = do

lookAhead (try (char '\\' >> letter))

inp <- getInput

snd <$> (rawLaTeXParser toks False (macroDef (const mempty)) blocks

<|> (rawLaTeXParser toks True

(do choice (map controlSeq

(inlineEnvironments :: M.Map Text (LP PandocPure Inlines))

then mzero

else return $ rawBlock "latex"

rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)

rawLaTeXInline = do

lookAhead (try (char '\\' >> letter))

inp <- getInput

raw <- snd <$>

( rawLaTeXParser toks True

(mempty <$ (controlSeq "input" >> skipMany opt >> braced))

inlines

)

finalbraces <- mconcat <$> many (try (string "{}")) -- see #5439

inlineCommand = do

lookAhead (try (char '\\' >> letter))

inp <- getInput

fst <$> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')

inlines

-- inline elements:

word :: PandocMonad m => LP m Inlines

regularSymbol :: PandocMonad m => LP m Inlines

where isRegularSymbol (Tok _ Symbol t) = not $ T.any isSpecial t

isRegularSymbol _ = False

isSpecial c = c `Set.member` specialChars

doLHSverb :: PandocMonad m => LP m Inlines

doLHSverb =

<$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')

let replaceTextwidth (k,v) =

case numUnit v of

_ -> (k, v)

let kvs = map replaceTextwidth

$ filter (\(k,_) -> k `elem` ["width", "height"]) options

then return s'

else findFile s es

src' <- case takeExtension src of

| otherwise -> findFile src exts

_ -> return src

doxspace :: PandocMonad m => LP m Inlines

doxspace =

, ("zetta", str "Z")

]

lit = pure . str

removeDoubleQuotes :: Text -> Text

-> LP m ()

-> LP m Inlines

quoted' f starter ender = do

smart <- extensionEnabled Ext_smart <$> getOption readerExtensions

if smart

then do

enquote :: PandocMonad m => Bool -> Maybe Text -> LP m Inlines

enquote starred mblang = do

skipopts

let langspan = case lang of

Nothing -> id

Just l -> spanWith ("",[],[("lang", renderLang l)])

cs <- cites NormalCitation False

return $ para (cite cs mempty)

else return mempty

let langdiv = case lang of

Nothing -> id

Just l -> divWith ("",[],[("lang", renderLang l)])

bs <- grouped block

return $ blockQuote . langdiv $ (bs <> citePar)

doAcronym form = do

acro <- braced

doAcronymPlural form = do

acro <- braced

plural <- lit "s"

doverb :: PandocMonad m => LP m Inlines

doverb = do

Just (c, ts) | T.null ts -> return c

_ -> mzero

withVerbatimMode $

manyTill (notFollowedBy newlineTok >> verbTok marker) (symbol marker)

verbTok :: PandocMonad m => Char -> LP m Tok

: totoks (incSourceColumn pos (i + 1)) (T.drop 1 t2) ++ inp

return $ Tok pos toktype t1

listingsLanguage opts =

case lookup "language" opts of

Nothing -> Nothing

domintinline :: PandocMonad m => LP m Inlines

domintinline = do

skipopts

doinlinecode [cls]

doinlinecode classes = do

Tok _ Symbol t <- anySymbol

marker <- case T.uncons t of

_ -> mzero

let stopchar = if marker == '{' then '}' else marker

withVerbatimMode $

manyTill (verbTok stopchar) (symbol stopchar)

nlToSpace :: Char -> Char

nlToSpace '\n' = ' '

nlToSpace x = x

keyval = try $ do

Tok _ Word key <- satisfyTok isWordTok

optional sp

_ -> True))))))

optional (symbol ',')

optional sp

keyvals = try $ symbol '[' >> manyTill keyval (symbol ']')

accent :: PandocMonad m => Char -> Maybe Char -> LP m Inlines

accent combiningAccent fallBack = try $ do

ils <- tok

case toList ils of

-- try to normalize to the combined character:

_ -> return ils

mathDisplay = displayMath . trimMath

mathInline = math . trimMath

dollarsMath :: PandocMonad m => LP m Inlines

dollarsMath = do

symbol '$'

display <- option False (True <$ symbol '$')

if display

then (mathDisplay contents <$ symbol '$')

else return $ mathInline contents)

}

return $ addPrefix pre $ addSuffix suf $ map conv keys

citationLabel = do

optional spaces

(many1 (satisfyTok isWordTok <|> symbolIn bibtexKeyChar)

<* optional spaces

<* optional (symbol ',')

addMprenote _ _ = []

addMpostnote = addSuffix . mpostnote

citation name mode multi = do

(c,raw) <- withRaw $ cites mode multi

handleCitationPart :: Inlines -> [Citation]

handleCitationPart ils =

case cs of

[] -> mzero

(c:cits) -> return $ cite (c{ citationMode = mode }:cits)

inNote :: Inlines -> Inlines

inNote ils =

tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar'

where singleChar' = do

Tok _ _ t <- singleChar

opt :: PandocMonad m => LP m Inlines

paropt :: PandocMonad m => LP m Inlines

paropt = parenWrapped inline

inBrackets :: Inlines -> Inlines

inBrackets x = str "[" <> x <> str "]"

mathEnvWith :: PandocMonad m

=> (Inlines -> a) -> Maybe Text -> Text -> LP m a

mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name

where inner x = case innerEnv of

Nothing -> x

mathEnv name = do

skipopts

optional blankline

res <- manyTill anyTok (end_ name)

inlineEnvironment :: PandocMonad m => LP m Inlines

inlineEnvironment = try $ do

, ("mbox", rawInlineOr "mbox" $ processHBox <$> tok)

, ("hbox", rawInlineOr "hbox" $ processHBox <$> tok)

, ("lettrine", optional opt >> extractSpaces (spanWith ("",["lettrine"],[])) <$> tok)

, ("texorpdfstring", const <$> tok <*> tok)

, ("P", lit "¶")

, ("S", lit "§")

, ("lstinline", dolstinline)

, ("mintinline", domintinline)

, ("Verb", doverb)

pure (link url "" (str url)))

pure (code url))

bracedUrl <* optional sp) >>= \url ->

tok >>= \lab -> pure (link url "" lab))

, ("includegraphics", do options <- option [] keyvals

mkImage options src)

, ("enquote*", enquote True Nothing)

, ("enquote", enquote False Nothing)

ifdim :: PandocMonad m => LP m Inlines

ifdim = do

contents <- manyTill anyTok (controlSeq "fi")

makeUppercase :: Inlines -> Inlines

makeLowercase :: Inlines -> Inlines

alterStr f (Str xs) = Str (f xs)

alterStr _ x = x

foreignlanguage :: PandocMonad m => LP m Inlines

foreignlanguage = do

case babelLangToBCP47 babelLang of

Just lang -> spanWith ("", [], [("lang", renderLang lang)]) <$> tok

_ -> tok

inlineLanguageCommands = M.fromList $ mk <$> M.toList polyglossiaLangToBCP47

where

mk (polyglossia, bcp47Func) =

inlineLanguage bcp47Func = do

<$> rawopt

let lang = renderLang $ bcp47Func o

extractSpaces (spanWith ("", [], [("lang", lang)])) <$> tok

hyperlink :: PandocMonad m => LP m Inlines

hyperlink = try $ do

lab <- tok

hypertargetBlock :: PandocMonad m => LP m Blocks

hypertargetBlock = try $ do

bs <- grouped block

case toList bs of

[Header 1 (ident,_,_) _] | ident == ref -> return bs

hypertargetInline :: PandocMonad m => LP m Inlines

hypertargetInline = try $ do

ils <- grouped inline

return $ spanWith (ref, [], []) ils

romanNumeralLower :: (PandocMonad m) => LP m Inlines

romanNumeralLower =

romanNumeralArg :: (PandocMonad m) => LP m Int

romanNumeralArg = spaces *> (parser <|> inBraces)

let (digits, rest) = T.span isDigit s

unless (T.null rest) $

Prelude.fail "Non-digits in argument to \\Rn or \\RN"

newToggle :: (Monoid a, PandocMonad m) => [Tok] -> LP m a

newToggle name = do

updateState $ \st ->

return mempty

setToggle :: (Monoid a, PandocMonad m) => Bool -> [Tok] -> LP m a

setToggle on name = do

updateState $ \st ->

return mempty

ifToggle :: PandocMonad m => LP m ()

no <- braced

toggles <- sToggles <$> getState

inp <- getInput

case M.lookup name' toggles of

Just True -> setInput (yes ++ inp)

Just False -> setInput (no ++ inp)

else getInput >>= setInput . (ifnotequal ++)

return mempty

coloredInline stylename = do

skipopts

color <- braced

ttfamily :: PandocMonad m => LP m Inlines

ttfamily = (code . stringify . toList) <$> tok

processHBox :: Inlines -> Inlines

processHBox = walk convert

where

convert LineBreak = Str ""

convert x = x

getRawCommand name txt = do

(_, rawargs) <- withRaw $

case name of

skipopts

option "" (try dimenarg)

void $ many braced

isFontSizeCommand :: Text -> Bool

isFontSizeCommand "tiny" = True

dolabel :: PandocMonad m => LP m Inlines

dolabel = do

v <- braced

return $ spanWith (refstr,[],[("label", refstr)])

doref cls = do

v <- braced

return $ linkWith ("",[],[ ("reference-type", cls)

, ("reference", refstr)])

""

(inBrackets $ str refstr)

<|> (str "\160" <$ symbol '~')

<|> dollarsMath

<|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)

<|> regularSymbol

<|> (do res <- symbolIn "#^'`\"[]&"

pos <- getPosition

report $ ParsingUnescaped s pos

return $ str s)

-- note, we can have cc_by_4.0 for example...

_ | name == "usepackage" -> addExtension f ".sty"

| otherwise -> addExtension f ".tex"

mapM_ (insertIncluded dirs) (map addExt fs)

return mempty

insertIncluded dirs f = do

pos <- getPosition

containers <- getIncludeFiles <$> getState

mbcontents <- readFileFromDirs dirs f

contents <- case mbcontents of

Just s -> return s

Nothing -> do

return ""

updateState dropLatestIncludeFile

addMeta field val = updateState $ \st ->

st{ sMeta = addMetaField field val $ sMeta st }

egroup

addMeta "author" (map trimInlines auths)

macroDef constructor = do

(_, s) <- withRaw (commandDef <|> environmentDef)

guardDisabled Ext_latex_macros)

<|> return mempty

where commandDef = do

case M.lookup name macros of

Just macro

| mtype == "newcommand" -> do

return (name, macro)

| mtype == "providecommand" -> return (name, macro)

_ -> return (name, Macro ExpandWhenUsed argspecs optarg contents)

case M.lookup name macros of

Just _

| mtype == "newenvironment" -> do

return Nothing

| mtype == "provideenvironment" -> do

return Nothing

bracketedNum :: PandocMonad m => LP m Int

bracketedNum = do

ds <- untokenize <$> bracketedToks

Just i -> return i

_ -> return 0

contents <- grouped inline

lab <- option ident $

try (spaces >> controlSeq "label"

when (lvl == 0) $

updateState $ \st -> st{ sHasChapters = True }

unless ("unnumbered" `elem` classes) $ do

, ("centerline", (para . trimInlines) <$> (skipopts *> tok))

, ("caption", skipopts *> setCaption)

, ("bibliography", mempty <$ (skipopts *> braced >>=

, ("addbibresource", mempty <$ (skipopts *> braced >>=

, ("endinput", mempty <$ skipMany tok)

-- includes

, ("lstinputlisting", inputListing)

(bs, raw) <- withRaw $ env name blocks

if parseRaw

then return $ rawBlock "latex"

else do

pos2 <- getPosition

return bs

rawVerbEnv :: PandocMonad m => Text -> LP m Blocks

rawVerbEnv name = do

pos <- getPosition

(_, raw) <- withRaw $ verbEnv name

exts <- getOption readerExtensions

let parseRaw = extensionEnabled Ext_raw_tex exts

if parseRaw

report $ SkippedContent raw' pos

return mempty

verbEnv name = withVerbatimMode $ do

optional blankline

res <- manyTill anyTok (end_ name)

$ untokenize

$ res

mintedAttr :: PandocMonad m => LP m Attr

mintedAttr = do

options <- option [] keyvals

let kvs = [ (if k == "firstnumber"

then "startFrom"

else k, v) | (k,v) <- options ]

[ "numberLines" |

lookup "linenos" options == Just "true" ]

return ("",classes,kvs)

inputMinted = do

pos <- getPosition

attr <- mintedAttr

rawcode <- case mbCode of

Just s -> return s

Nothing -> do

report $ CouldNotLoadIncludeFile f pos

return $ B.codeBlockWith attr rawcode

letterContents :: PandocMonad m => LP m Blocks

addImageCaption :: PandocMonad m => Blocks -> LP m Blocks

addImageCaption = walkM go

where go (Image attr@(_, cls, kvs) alt (src,tit))

(mbcapt, mblab) <- sCaption <$> getState

let (alt', tit') = case mbcapt of

Nothing -> (alt, tit)

attr' = case mblab of

Just lab -> (lab, cls, kvs)

return $ Image attr' alt' (src, tit')

go x = return x

coloredBlock stylename = try $ do

skipopts

color <- braced

notFollowedBy (grouped inline)

constructor <$> grouped block

graphicsPath :: PandocMonad m => LP m Blocks

graphicsPath = do

(bgroup *> spaces *> manyTill (braced <* spaces) egroup)

return mempty

alltt :: Blocks -> Blocks

alltt = walk strToCode

strToCode SoftBreak = LineBreak

strToCode x = x

parseListingsOptions options =

let kvs = [ (if k == "firstnumber"

then "startFrom"

inputListing = do

pos <- getPosition

options <- option [] keyvals

codeLines <- case mbCode of

Nothing -> do

report $ CouldNotLoadIncludeFile f pos

return []

let (ident,classes,kvs) = parseListingsOptions options

let classes' =

(case listingsLanguage options of

Just _ -> id) classes

let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead

let lastline = fromMaybe (length codeLines) $

lookup "lastline" options >>= safeRead

drop (firstline - 1) codeLines

return $ codeBlockWith (ident,classes',kvs) codeContents

spaces

let markerSpec = do

symbol '['

case runParser anyOrderedListMarker def "option" ts of

Right r -> return r

Left _ -> do

pos <- getPosition

return (1, DefaultStyle, DefaultDelim)

(_, style, delim) <- option (1, DefaultStyle, DefaultDelim) markerSpec

spaces

spaces

start <- option 1 $ try $ do pos <- getPosition

controlSeq "setcounter"

optional sp

case safeRead num of

Just i -> return (i + 1 :: Int)

Nothing -> do

report $ SkippedContent

return 1

bs <- listenv "enumerate" (many item)

return $ orderedListWith (start, style, delim) bs

inp <- getInput

case inp of

(Tok spos Word t : rest) ->

_ -> return ()

parseAligns :: PandocMonad m => LP m [(Alignment, Double, ([Tok], [Tok]))]

let alignSuffix = symbol '<' >> braced

let colWidth = try $ do

symbol '{'

spaces

symbol '}'

case safeRead ds of

pref <- option [] alignPrefix

spaces

al <- alignChar

pos <- getPosition

report $ SkippedContent s pos

return 0.0)

let starAlign = do -- '*{2}{r}' == 'rr', we just expand like a macro

symbol '*'

spaces

spaces

spec <- braced

case safeRead ds of

Just n ->

getInput >>= setInput . (mconcat (replicate n spec) ++)

bgroup

spaces

maybeBar

<|> blockCommand

<|> paragraph

<|> grouped block

return res

blocks :: PandocMonad m => LP m Blocks

setDefaultLanguage :: PandocMonad m => LP m Blocks

setDefaultLanguage = do

<$> rawopt

case M.lookup polylang polyglossiaLangToBCP47 of

Nothing -> return mempty -- TODO mzero? warning?

Just langFunc -> do

{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Readers.LaTeX.Lang

Copyright : Copyright (C) 2018-2019 John MacFarlane

where

import Prelude

import qualified Data.Map as M

import Text.Pandoc.BCP47 (Lang(..))

polyglossiaLangToBCP47 = M.fromList

"locale=algeria" -> Lang "ar" "" "DZ" []

"locale=mashriq" -> Lang "ar" "" "SY" []

"locale=libya" -> Lang "ar" "" "LY" []

"locale=mauritania" -> Lang "ar" "" "MR" []

"locale=tunisia" -> Lang "ar" "" "TN" []

_ -> Lang "ar" "" "" [])

"spelling=old" -> Lang "de" "" "DE" ["1901"]

"variant=austrian,spelling=old"

-> Lang "de" "" "AT" ["1901"]

"variant=swiss" -> Lang "de" "" "CH" []

_ -> Lang "de" "" "" [])

, ("lsorbian", \_ -> Lang "dsb" "" "" [])

"variant=poly" -> Lang "el" "" "polyton" []

"variant=ancient" -> Lang "grc" "" "" []

_ -> Lang "el" "" "" [])

"variant=australian" -> Lang "en" "" "AU" []

"variant=canadian" -> Lang "en" "" "CA" []

"variant=british" -> Lang "en" "" "GB" []

"variant=american" -> Lang "en" "" "US" []

_ -> Lang "en" "" "" [])

, ("usorbian", \_ -> Lang "hsb" "" "" [])

"variant=classic" -> Lang "la" "" "" ["x-classic"]

_ -> Lang "la" "" "" [])

, ("slovenian", \_ -> Lang "sl" "" "" [])

, ("vietnamese", \_ -> Lang "vi" "" "" [])

]

babelLangToBCP47 s =

case s of

"austrian" -> Just $ Lang "de" "" "AT" ["1901"]

newtype DottedNum = DottedNum [Int]

deriving (Show)

intercalate "." (map show xs)

incrementDottedNum :: Int -> DottedNum -> DottedNum

, sMeta :: Meta

, sQuoteContext :: QuoteContext

, sMacros :: M.Map Text Macro

, sLogMessages :: [LogMessage]

, sVerbatimMode :: Bool

, sInListItem :: Bool

, sInTableCell :: Bool

, sLastHeaderNum :: DottedNum

, sLastFigureNum :: DottedNum

, sHasChapters :: Bool

, sExpanded :: Bool

}

deriving Show

rawLaTeXParser :: (PandocMonad m, HasMacros s, HasReaderOptions s)

=> [Tok] -> Bool -> LP m a -> LP m a

rawLaTeXParser toks retokenize parser valParser = do

pstate <- getState

let lstate = def{ sOptions = extractReaderOptions pstate }

, not (" " `T.isSuffixOf` result)

-> result <> " "

_ -> result

applyMacros :: (PandocMonad m, HasMacros s, HasReaderOptions s)

applyMacros s = (guardDisabled Ext_latex_macros >> return s) <|>

pstate <- getState

let lstate = def{ sOptions = extractReaderOptions pstate

, sMacros = extractMacros pstate }

case res of

Left e -> Prelude.fail (show e)

Right s' -> return s'

: totoks (incSourceColumn pos 2) rest'

| c == '#' ->

let (t1, t2) = T.span (\d -> d >= '0' && d <= '9') rest

Just i ->

Tok pos (Arg i) ("#" <> t1)

: totoks (incSourceColumn pos (1 + T.length t1)) t2

handleMacros n' spos name ts = do

when (n' > 20) -- detect macro expansion loops

macros <- sMacros <$> getState

case M.lookup name macros of

Nothing -> mzero

| c >= '\64' && c <= '\127' -> return (chr (ord c - 64))

| otherwise -> return (chr (ord c + 64))

Nothing -> Prelude.fail "Empty content of Esc1"

Just x -> return (chr x)

Nothing -> Prelude.fail $ "Could not read: " ++ T.unpack t

_ -> Prelude.fail "Expected an Esc1 or Esc2 token" -- should not happen

guard $ rest `elem` ["", "pt","pc","in","bp","cm","mm","dd","cc","sp"]

return $ T.pack ['=' | ch] <> minus <> s

ignore raw = do

pos <- getPosition

report $ SkippedContent raw pos

{- |

Module : Text.Pandoc.Readers.Man

Copyright : Copyright (C) 2018-2019 Yan Pashkovsky and John MacFarlane

-> [RoffToken] -- ^ input

-> m (Either PandocError a)

readWithMTokens parser state input =

in mapLeft leftF `liftM` runParserT parser state "source" input

parseMan :: PandocMonad m => ManParser m Pandoc

isHrule ([cellfmt], _) = columnType cellfmt `elem` ['_','-','=']

isHrule (_, [RoffTokens ss]) =

case Foldable.toList ss of

_ -> False

isHrule _ = False

isEmptyLine EmptyLine = True

isEmptyLine _ = False

mmacro mk = msatisfy isControlLine where

isControlLine (ControlLine mk' _ _) | mk == mk' = True

| otherwise = False

_ -> mzero

handleInlineMacro :: PandocMonad m

handleInlineMacro mname args _pos = do

case mname of

"UR" -> parseLink args

isBareIP (ControlLine "IP" [] _) = True

isBareIP _ = False

endmacro name = void (mmacro name)

<|> lookAhead (void newBlockMacro)

<|> lookAhead eof

toks <- (mmacro "nf" *> manyTill codeline (endmacro "fi"))

<|> (mmacro "EX" *> manyTill codeline (endmacro "EE"))

optional (mmacro "in")

where

ControlLine "PP" _ _ -> return $ Just "" -- .PP sometimes used for blank line

ControlLine mname args pos -> do

(Just . query getText <$> handleInlineMacro mname args pos) <|>

return Nothing

Tbl _ _ pos -> do

report $ SkippedContent "TABLE" pos

TextLine ss

| not (null ss)

, all isFontToken ss -> return Nothing

isFontToken Font{} = True

isFontToken _ = False

getText (Str s) = s

getText Space = " "

getText (Code _ s) = s

(ControlLine _ args _) <- mmacro "IP"

case args of

(arg1 : _) -> do

let lt = case Parsec.runParser anyOrderedListMarker defaultParserState

"list marker" cs' of

Right (start, listtype, listdelim)

ControlLine _ endargs _ <- mmacro "UE"

let url = case args of

[] -> ""

return $ link url "" contents <>

case endargs of

[] -> mempty

ControlLine _ endargs _ <- mmacro "ME"

let url = case args of

[] -> ""

return $ link url "" contents <>

case endargs of

[] -> mempty

tok <- mmacroAny

case tok of

ControlLine mkind _ pos -> do

return mempty

_ -> Prelude.fail "the impossible happened"

{-# LANGUAGE RelaxedPolyRec #-}

{-# LANGUAGE ScopedTypeVariables #-}

{- |

Module : Text.Pandoc.Readers.Markdown

Copyright : Copyright (C) 2006-2019 John MacFarlane

import Control.Monad

import Control.Monad.Except (throwError)

import qualified Data.ByteString.Lazy as BS

import qualified Data.Map as M

import Data.Maybe

import Data.Ord (comparing)

import qualified Data.Set as Set

import Data.Text (Text)

import qualified Data.Text as T

import qualified Data.YAML as YAML

import qualified Data.YAML.Event as YE

import System.FilePath (addExtension, takeExtension)

import qualified Text.Pandoc.UTF8 as UTF8

import Text.Pandoc.XML (fromEntities)

-- | Read markdown from an input string and return a Pandoc document.

readMarkdown :: PandocMonad m

-> m Pandoc

readMarkdown opts s = do

parsed <- readWithM parseMarkdown def{ stateOptions = opts }

case parsed of

Right result -> return result

Left e -> throwError e

isHruleChar '_' = True

isHruleChar _ = False

setextHChars = "=-"

isBlank :: Char -> Bool

ctx <- stateParserContext <$> getState

guard (ctx == ListItemState)

spnl = try $ do

skipSpaces

optional newline

skipSpaces

notFollowedBy (char '\n')

spnl' = try $ do

xs <- many spaceChar

ys <- option "" $ try $ (:) <$> newline

<*> (many spaceChar <* notFollowedBy (char '\n'))

indentSpaces = try $ do

tabStop <- getOption readerTabStop

nonindentSpaces = do

n <- skipNonindentSpaces

-- returns number of spaces parsed

skipNonindentSpaces :: PandocMonad m => MarkdownParser m Int

inlinesInBalancedBrackets =

try $ char '[' >> withRaw (go 1) >>=

parseFromString inlines . stripBracket . snd

go :: PandocMonad m => Int -> MarkdownParser m ()

go 0 = return ()

go openBrackets =

-- document structure

--

rawTitleBlockLine = do

char '%'

skipSpaces

notFollowedBy blankline

skipSpaces

anyLine

titleLine :: PandocMonad m => MarkdownParser m (F Inlines)

titleLine = try $ do

notFollowedBy blankline -- if --- is followed by a blank it's an HRULE

rawYamlLines <- manyTill anyLine stopLine

-- by including --- and ..., we allow yaml blocks with just comments:

optional blanklines

-- Since `<>` is left-biased, existing values are not touched:

updateState $ \st -> st{ stateMeta' = (stateMeta' st) <> newMetaF }

return mempty

return . return $ mempty

Left (_pos, err') -> do

logMessage $ CouldNotParseYamlMetadata

return . return $ mempty

nodeToKey :: PandocMonad m => YAML.Node YE.Pos -> m Text

-- Note: a standard quoted or unquoted YAML value will

-- not end in a newline, but a "block" set off with

-- `|` or `>` will.

else parseFromString'

((asInlines <$> try pInlines) <|> (asBlocks <$> parseBlocks))

where pInlines = trimInlinesF . mconcat <$> manyTill inline eof

asBlocks p = do

p' <- p

asInlines p = do

p' <- p

return $ MetaInlines (B.toList p')

checkBoolean :: Text -> Maybe Bool

checkBoolean t =

case x of

YAML.SStr t -> toMetaValue t

YAML.SBool b -> return $ return $ MetaBool b

YAML.SUnknown _ t ->

case checkBoolean t of

Just b -> return $ return $ MetaBool b

yamlMap :: PandocMonad m

=> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)

yamlMap o = do

kvs <- forM (M.toList o) $ \(key, v) -> do

k <- nodeToKey key

let kvs' = filter (not . ignorable . fst) kvs

(fmap M.fromList . sequence) <$> mapM toMeta kvs'

where

toMeta (k, v) = do

fv <- yamlToMetaValue v

return $ do

v' <- fv

stopLine :: PandocMonad m => MarkdownParser m ()

stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()

updateState $ \st -> st{ stateMeta' = stateMeta' st <>

return (Meta $ M.fromList kvPairs) }

kvPair allowEmpty = try $ do

(try $ newline >> lookAhead (blankline <|> nonspaceChar))

return (key',val')

parseMarkdown :: PandocMonad m => MarkdownParser m Pandoc

(_,raw) <- reference

char ':'

skipSpaces >> optional newline >> skipSpaces >> notFollowedBy (char '[')

skipMany spaceChar

notFollowedBy' referenceTitle

notFollowedBy' $ guardEnabled Ext_link_attributes >> attributes

notFollowedBy' (() <$ reference)

src <- try betweenAngles <|> sourceURL

tit <- option "" referenceTitle

attr <- option nullAttr $ try $

updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys }

return $ return mempty

referenceTitle = try $ do

skipSpaces >> optional newline >> skipSpaces

quotedTitle '"' <|> quotedTitle '\'' <|> charsInBalanced '(' ')' litChar

-- A link title in quotes

quotedTitle c = try $ do

char c

notFollowedBy spaces

let pEnder = try $ char c >> notFollowedBy (satisfy isAlphaNum)

-- | PHP Markdown Extra style abbreviation key. Currently

-- we just skip them, since Pandoc doesn't have an element for

blanklines

return $ return mempty

rawLine = try $ do

notFollowedBy blankline

notFollowedBy' $ try $ skipNonindentSpaces >> noteMarker

optional indentSpaces

anyLine

rawLines = do

first <- anyLine

rest <- many rawLine

noteBlock :: PandocMonad m => MarkdownParser m (F Blocks)

noteBlock = try $ do

optional indentSpaces

first <- rawLines

rest <- many $ try $ blanklines >> indentSpaces >> rawLines

optional blanklines

parsed <- parseFromString' parseBlocks raw

oldnotes <- stateNotes' <$> getState

, para

, plain

] <?> "block"

return res

--

mmdHeaderIdentifier = do

(_, raw) <- reference

let raw' = trim $ stripFirstAndLast raw

let attr = (ident, [], [])

guardDisabled Ext_implicit_header_references

<|> registerImplicitHeader raw' attr

<|> registerImplicitHeader raw attr'

return $ B.headerWith attr' level <$> text

registerImplicitHeader raw attr@(ident, _, _)

| otherwise = do

updateState $ \s ->

(stateHeaderKeys s) }

--

-- hrule block

--

hrule = try $ do

skipSpaces

start <- satisfy isHruleChar

-- code blocks

--

indentedLine = indentSpaces >> anyLineNewline

blockDelimiter :: PandocMonad m

=> (Char -> Bool)

-> Maybe Int

blockDelimiter f len = try $ do

skipNonindentSpaces

c <- lookAhead (satisfy f)

attribute :: PandocMonad m => MarkdownParser m (Attr -> Attr)

attribute = identifierAttr <|> classAttr <|> keyValAttr <|> specialAttr

identifier = do

first <- letter

rest <- many $ alphaNum <|> oneOf "-_:."

identifierAttr :: PandocMonad m => MarkdownParser m (Attr -> Attr)

identifierAttr = try $ do

keyValAttr = try $ do

key <- identifier

char '='

<|> ("" <$ try (string "\"\""))

<|> ("" <$ try (string "''"))

return $ \(id',cs,kvs) ->

case key of

"id" -> (val,cs,kvs)

_ -> (id',cs,kvs ++ [(key,val)])

specialAttr :: PandocMonad m => MarkdownParser m (Attr -> Attr)

char '-'

return $ \(id',cs,kvs) -> (id',cs ++ ["unnumbered"],kvs)

rawAttribute = do

char '{'

skipMany spaceChar

char '='

skipMany spaceChar

char '}'

return format

codeBlockFenced :: PandocMonad m => MarkdownParser m (F Blocks)

codeBlockFenced = try $ do

indentchars <- nonindentSpaces

c <- try (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~'))

<|> (guardEnabled Ext_backtick_code_blocks >> lookAhead (char '`'))

size <- blockDelimiter (== c) Nothing

<|>

(Right <$> option ("",[],[])

(try (guardEnabled Ext_fenced_code_attributes >> attributes)

blankline

manyTill (gobbleAtMostSpaces indentLevel >> anyLine)

(try $ do

blockDelimiter (== c) (Just size)

Right attr -> B.codeBlockWith attr contents

-- correctly handle github language identifiers

where go "c++" = "cpp"

go "objective-c" = "objectivec"

go x = x

contents <- many1 (indentedLine <|>

try (do b <- blanklines

l <- indentedLine

optional blanklines

classes <- getOption readerIndentedCodeClasses

return $ return $ B.codeBlockWith ("", classes, []) $

lhsCodeBlock :: PandocMonad m => MarkdownParser m (F Blocks)

lhsCodeBlock = do

<|> (return . B.codeBlockWith ("",["haskell"],[]) <$>

lhsCodeBlockInverseBird)

lhsCodeBlockLaTeX = try $ do

string "\\begin{code}"

manyTill spaceChar newline

blanklines

return $ stripTrailingNewlines contents

lhsCodeBlockBird = lhsCodeBlockBirdWith '>'

lhsCodeBlockInverseBird = lhsCodeBlockBirdWith '<'

lhsCodeBlockBirdWith c = try $ do

pos <- getPosition

when (sourceColumn pos /= 1) $ Prelude.fail "Not in first column"

lns <- many1 $ birdTrackLine c

-- if (as is normal) there is always a space after >, drop it

else lns

blanklines

birdTrackLine c = try $ do

char c

-- allow html tags on left margin:

emailBlockQuoteStart :: PandocMonad m => MarkdownParser m Char

emailBlockQuoteStart = try $ skipNonindentSpaces >> char '>' <* optional (char ' ')

emailBlockQuote = try $ do

emailBlockQuoteStart

let emailSep = try (newline >> emailBlockQuoteStart)

first <- emailLine

rest <- many $ try $ emailSep >> emailLine

blockQuote = do

raw <- emailBlockQuote

-- parse the extracted block, which may contain various block elements:

return $ B.blockQuote <$> contents

--

skipNonindentSpaces

notFollowedBy $ string "p." >> spaceChar >> digit -- page number

(do guardDisabled Ext_fancy_lists

char '.'

gobbleSpaces 1 <|> () <$ lookAhead newline

optional $ try (gobbleAtMostSpaces 3 >> notFollowedBy spaceChar)

listStart :: PandocMonad m => MarkdownParser m ()

listStart = bulletListStart <|> Control.Monad.void (orderedListStart Nothing)

listLine continuationIndent = try $ do

notFollowedBy' (do gobbleSpaces continuationIndent

skipMany spaceChar

optional (() <$ gobbleSpaces continuationIndent)

listLineCommon

<|> fmap snd (withRaw code)

<|> fmap snd (htmlTag isCommentTag)

) newline

-- parse raw text for one list item, excluding start marker and continuations

rawListItem :: PandocMonad m

=> Bool -- four space rule

-> MarkdownParser m a

rawListItem fourSpaceRule start = try $ do

pos1 <- getPosition

start

notFollowedBy (() <$ codeBlockFenced)

notFollowedBy blankline

listLine continuationIndent)

return (result, continuationIndent)

-- continuation of a list item - indented and separated by blankline

-- or (in compact lists) endline.

-- note: nested lists are parsed as continuations

listContinuation continuationIndent = try $ do

x <- try $ do

notFollowedBy blankline

notFollowedByDivCloser

gobbleSpaces continuationIndent <|> notFollowedBy' listStart

anyLineNewline

-- Variant of blanklines that doesn't require blank lines

-- before a fence or eof.

blanklines' = blanklines <|> try checkDivCloser

where checkDivCloser = do

guardEnabled Ext_fenced_divs

(first, continuationIndent) <- rawListItem fourSpaceRule start

continuations <- many (listContinuation continuationIndent)

-- parse the extracted block, which may contain various block elements:

contents <- parseFromString' parseBlocks raw

updateState (\st -> st {stateParserContext = oldContext})

exts <- getOption readerExtensions

sps <- nonindentSpaces

char ':' <|> char '~'

tabStop <- getOption readerTabStop

if remaining > 0

then try (count remaining (char ' ')) <|> string "\t" <|> many1 spaceChar

else mzero

rawLine' <- anyLine

raw <- many1 $ defRawBlock compact

term <- parseFromString' (trimInlinesF <$> inlines) rawLine'

optional blanklines

return $ liftM2 (,) term (sequence contents)

defRawBlock compact = try $ do

hasBlank <- option False $ blankline >> return True

defListMarker

<|> notFollowedBy defListMarker

anyLine )

rawlines <- many dline

trailing <- option "" blanklines

ln <- indentSpaces >> notFollowedBy blankline >> anyLine

lns <- many dline

definitionList :: PandocMonad m => MarkdownParser m (F Blocks)

definitionList = try $ do

| not (null alt) ->

-- the fig: at beginning of title indicates a figure

return $ B.singleton

_ -> return x'

| otherwise = x

result <- implicitFigures . trimInlinesF <$> inlines1

inHtmlBlock <- stateInHtmlBlock <$> getState

case inHtmlBlock of

Just "div" -> () <$

_ -> mzero

<|> do guardEnabled Ext_fenced_divs

divLevel <- stateFencedDivLevel <$> getState

-- raw html

--

htmlElement = rawVerbatimBlock

<|> strictHtmlBlock

<|> fmap snd (htmlTag isBlockTag)

first <- htmlElement

skipMany spaceChar

optional blanklines

then mempty

else return $ B.rawBlock "html" first

strictHtmlBlock = htmlInBalanced (not . isInlineTag)

rawVerbatimBlock = htmlInBalanced isVerbTag

where isVerbTag (TagOpen "pre" _) = True

isVerbTag (TagOpen "style" _) = True

rawTeXBlock :: PandocMonad m => MarkdownParser m (F Blocks)

rawTeXBlock = do

guardEnabled Ext_raw_tex

return $ case B.toList result of

[RawBlock _ cs]

-- don't create a raw block for suppressed macro defs

_ -> return result

return result

-- remove markdown="1" attribute

stripMarkdownAttribute s = renderTags' $ map filterAttrib $ parseTags s

where filterAttrib (TagOpen t as) = TagOpen t

[(k,v) | (k,v) <- as, k /= "markdown"]

-- and the length including trailing space.

dashedLine :: PandocMonad m

=> Char

dashedLine ch = do

dashes <- many1 (char ch)

sp <- many spaceChar

dashes <- many1 (dashedLine '-')

newline

let (lengths, lines') = unzip dashes

-- If no header, calculate alignment on basis of first row of text

if headless

then lookAhead anyLine

else return rawContent

-- Returns an alignment type for a table, based on a list of strings

-- (the rows of the column header) and a number (the length of the

-- dashed line under the rows.

-> Int

-> Alignment

alignType [] _ = AlignDefault

alignType strLst len =

(leftSpace, rightSpace) =

[] -> (False, False)

in case (leftSpace, rightSpace) of

(True, False) -> AlignRight

(False, False) -> AlignDefault

-- Parse a table footer - dashed lines followed by blank line.

tableFooter = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> blanklines'

-- Parse a table separator - dashed line.

-- Parse a raw line and split it into chunks by indices.

rawTableLine :: PandocMonad m

=> [Int]

rawTableLine indices = do

notFollowedBy' (blanklines' <|> tableFooter)

return $ map trim $ tail $

-- Parse a table line and return a list of lists of blocks (columns).

tableLine :: PandocMonad m

-> MarkdownParser m (F [Blocks])

multilineRow indices = do

colLines <- many1 (rawTableLine indices)

fmap sequence $ mapM (parseFromString' (mconcat <$> many plain)) cols

-- Parses a table caption: inlines beginning with 'Table:'

dashes <- many1 (dashedLine '-')

newline

let (lengths, lines') = unzip dashes

-- compensate for the fact that intercolumn spaces are

-- not included in the last index:

let indices' = case reverse indices of

(x:xs) -> reverse (x+1:xs)

rawHeadsList <- if headless

then fmap (map (:[]) . tail .

else return $ transpose $ map

rawContent

let aligns = zipWith alignType rawHeadsList lengths

let rawHeads = if headless

then replicate (length dashes) ""

heads <- fmap sequence $

mapM ((parseFromString' (mconcat <$> many plain)).trim) rawHeads

return (heads, aligns, indices')

lines' <- many pipeTableRow

let lines'' = map (take (length aligns) <$>) lines'

let maxlength = maximum $

numColumns <- getOption readerColumns

let widths = if maxlength > numColumns

then map (\len ->

return $ B.plain <$> result)

<|> return mempty

pipeTableHeaderPart = try $ do

skipMany spaceChar

left <- optionMaybe (char ':')

(Just _,Just _) -> AlignCenter, len)

-- Succeed only if current line contains a pipe.

scanForPipe = do

inp <- getInput

-- | Parse a table using 'headerParser', 'rowParser',

-- 'lineParser', and 'footerParser'. Variant of the version in

result <- escapedChar'

case result of

' ' -> return $ return $ B.str "\160" -- "\ " is a nonbreaking space

ltSign :: PandocMonad m => MarkdownParser m (F Inlines)

ltSign = do

exampleRef = try $ do

guardEnabled Ext_example_lists

char '@'

return $ do

st <- askF

return $ case M.lookup lab (stateExamples st) of

symbol :: PandocMonad m => MarkdownParser m (F Inlines)

symbol = do

<|> try (do lookAhead $ char '\\'

notFollowedBy' (() <$ rawTeXBlock)

char '\\')

-- parses inline code, between n `s and n `s

code :: PandocMonad m => MarkdownParser m (F Inlines)

code = try $ do

starts <- many1 (char '`')

skipSpaces

manyTill (notFollowedBy (inList >> listStart) >>

(char '\n' >> notFollowedBy' blankline >> return " ")))

(try (skipSpaces >> count (length starts) (char '`') >>

notFollowedBy (char '`')))

guardDisabled Ext_intraword_underscores

<|> guard (c == '*')

<|> (guard =<< notAfterString)

(return (B.str cs) <>) <$> whitespace

<|>

3 -> three c

2 -> two c mempty

1 -> one c mempty

(ender c 3 >> updateLastStrPos >> return ((B.strong . B.emph) <$> contents))

<|> (ender c 2 >> updateLastStrPos >> one c (B.strong <$> contents))

<|> (ender c 1 >> updateLastStrPos >> two c (B.emph <$> contents))

-- Parse inlines til you hit two c's, and emit strong.

-- If you never do hit two cs, emit ** plus inlines parsed.

contents <- mconcat <$> many (try $ notFollowedBy (ender c 2) >> inline)

(ender c 2 >> updateLastStrPos >>

return (B.strong <$> (prefix' <> contents)))

-- Parse inlines til you hit a c, and emit emph.

-- If you never hit a c, emit * plus inlines parsed.

notFollowedBy (ender c 1) >>

two c mempty) )

(ender c 1 >> updateLastStrPos >> return (B.emph <$> (prefix' <> contents)))

strongOrEmph :: PandocMonad m => MarkdownParser m (F Inlines)

strongOrEmph = enclosure '*' <|> enclosure '_'

where lb = spaceChar >> skipMany spaceChar >> option B.space (endline >> return B.linebreak)

regsp = skipMany spaceChar >> return B.space

nonEndline = satisfy (/='\n')

str :: PandocMonad m => MarkdownParser m (F Inlines)

str = do

updateLastStrPos

(do guardEnabled Ext_smart

abbrevs <- getOption readerAbbreviations

then try (do ils <- whitespace

-- ?? lookAhead alphaNum

-- replace space after with nonbreaking space

--

-- a reference label for a link

reference = do

guardDisabled Ext_footnotes <|> notFollowedBy' (string "[^")

guardDisabled Ext_citations <|> notFollowedBy' (string "[@")

withRaw $ trimInlinesF <$> inlinesInBalancedBrackets

parenthesizedChars = do

result <- charsInBalanced '(' ')' litChar

-- source for a link, with optional title

source = do

char '('

skipSpaces

let urlChunk =

try parenthesizedChars

let betweenAngles = try $

src <- try betweenAngles <|> sourceURL

tit <- option "" $ try $ spnl >> linkTitle

skipSpaces

char ')'

return (escapeURI $ trimr src, tit)

linkTitle = quotedTitle '"' <|> quotedTitle '\''

link :: PandocMonad m => MarkdownParser m (F Inlines)

isSmallCaps ("",["smallcaps"],[]) = True

isSmallCaps ("",[],kvs) =

case lookup "style" kvs of

"font-variant:small-caps"

Nothing -> False

isSmallCaps _ = False

regLink :: PandocMonad m

-> F Inlines

-> MarkdownParser m (F Inlines)

regLink constructor lab = try $ do

-- a link like [this][ref] or [this][] or [this]

referenceLink :: PandocMonad m

-> MarkdownParser m (F Inlines)

referenceLink constructor (lab, raw) = do

sp <- (True <$ lookAhead (char ' ')) <|> return False

parsedRaw' <- parsedRaw

fallback' <- fallback

return $ B.str "[" <> fallback' <> B.str "]" <>

parsedRaw'

return $ do

keys <- asksF stateKeys

else makeFallback

Just ((src,tit), attr) -> constructor attr src tit <$> lab

bareURL :: PandocMonad m => MarkdownParser m (F Inlines)

bareURL = try $ do

guardEnabled Ext_autolink_bare_uris

getState >>= guard . stateAllowLinks

(cls, (orig, src)) <- (("uri",) <$> uri) <|> (("email",) <$> emailAddress)

return $ return $ B.linkWith ("",[cls],[]) src "" (B.str orig)

autoLink :: PandocMonad m => MarkdownParser m (F Inlines)

-- is finished, because the uri parser tries to avoid parsing

-- final punctuation. for example: in `<http://hi---there>`,

-- the URI parser will stop before the dashes.

attr <- option ("", [cls], []) $ try $

guardEnabled Ext_link_attributes >> attributes

image :: PandocMonad m => MarkdownParser m (F Inlines)

image = try $ do

char '!'

(lab,raw) <- reference

defaultExt <- getOption readerDefaultImageExtension

_ -> B.imageWith attr' src

regLink constructor lab <|> referenceLink constructor (lab,raw)

return $ do

notes <- asksF stateNotes'

case M.lookup ref notes of

Just (_pos, contents) -> do

st <- askF

-- process the note in a context that doesn't resolve

s <- rawLaTeXInline

return $ return $ B.rawInline "tex" s -- "tex" because it might be context

rawConTeXtEnvironment = try $ do

string "\\start"

completion <- inBrackets (letter <|> digit <|> spaceChar)

inBrackets parser = do

char '['

char ']'

spanHtml :: PandocMonad m => MarkdownParser m (F Inlines)

spanHtml = try $ do

guardEnabled Ext_native_spans

let ident = fromMaybe "" $ lookup "id" attrs

let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]

return $ if isSmallCaps (ident, classes, keyvals)

then B.smallcaps <$> contents

divHtml :: PandocMonad m => MarkdownParser m (F Blocks)

divHtml = try $ do

guardEnabled Ext_native_divs

-- we set stateInHtmlBlock so that closing tags that can be either block or

-- inline will not be parsed as inline tags

oldInHtmlBlock <- stateInHtmlBlock <$> getState

updateState $ \st -> st{ stateInHtmlBlock = Just "div" }

bls <- option "" (blankline >> option "" blanklines)

contents <- mconcat <$>

if closed

then do

updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }

let ident = fromMaybe "" $ lookup "id" attrs

let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]

return $ B.divWith (ident, classes, keyvals) <$> contents

else -- avoid backtracing

string ":::"

skipMany (char ':')

skipMany spaceChar

skipMany spaceChar

skipMany (char ':')

blankline

emoji = try $ do

guardEnabled Ext_emoji

char ':'

char ':'

case emojiToInline emojikey of

Just i -> return (return $ B.singleton i)

mbrest <- option Nothing $ try $ spnl >> Just <$> withRaw normalCite

case mbrest of

Just (rest, raw) ->

<$> rest

Nothing ->

(do

(cs, raw) <- withRaw $ bareloc first

lab <- parseFromString' inlines $ dropBrackets raw'

fallback <- referenceLink B.linkWith (lab,raw')

return $ do

cs' <- cs

return $

case B.toList fallback' of

<|> return (do st <- askF

return $ case M.lookup key (stateExamples st) of

bareloc :: PandocMonad m => Citation -> MarkdownParser m (F [Citation])

bareloc c = try $ do

{-# LANGUAGE NoImplicitPrelude #-}

-- RelaxedPolyRec needed for inlinesBetween on GHC < 7

{- |

Module : Text.Pandoc.Readers.MediaWiki

import Control.Monad.Except (throwError)

import Data.Char (isDigit, isSpace)

import qualified Data.Foldable as F

import Data.Maybe (fromMaybe, maybeToList)

import Data.Sequence (ViewL (..), viewl, (<|))

import qualified Data.Set as Set

import Text.HTML.TagSoup

import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)

import qualified Text.Pandoc.Builder as B

import Text.Pandoc.Parsing hiding (nested)

import Text.Pandoc.Readers.HTML (htmlTag, isBlockTag, isCommentTag)

import Text.Pandoc.Shared (crFilter, safeRead, stringify, stripTrailingNewlines,

import Text.Pandoc.Walk (walk)

import Text.Pandoc.XML (fromEntities)

, mwLogMessages = []

, mwInTT = False

}

case parsed of

Right result -> return result

Left e -> throwError e

, mwMaxNestingLevel :: Int

, mwNextLinkNumber :: Int

, mwCategoryLinks :: [Inlines]

, mwLogMessages :: [LogMessage]

, mwInTT :: Bool

}

instance HasReaderOptions MWState where

extractReaderOptions = mwOptions

spaceChars :: [Char]

spaceChars = " \n\t"

newBlockTags = ["haskell","syntaxhighlight","source","gallery","references"]

isBlockTag' tag@(TagOpen t _) = (isBlockTag tag || t `elem` newBlockTags) &&

t `notElem` eitherBlockOrInline

isBlockTag' tag@(TagClose t) = (isBlockTag tag || t `elem` newBlockTags) &&

t `notElem` eitherBlockOrInline

isBlockTag' tag = isBlockTag tag

isInlineTag' (TagComment _) = True

isInlineTag' t = not (isBlockTag' t)

eitherBlockOrInline = ["applet", "button", "del", "iframe", "ins",

"map", "area", "object"]

htmlComment :: PandocMonad m => MWParser m ()

htmlComment = () <$ htmlTag isCommentTag

inlinesInTags tag = try $ do

(_,raw) <- htmlTag (~== TagOpen tag [])

then return mempty

else trimInlines . mconcat <$>

manyTill inline (htmlTag (~== TagClose tag))

blocksInTags tag = try $ do

(_,raw) <- htmlTag (~== TagOpen tag [])

let closer = if tag == "li"

<|> lookAhead (

else htmlTag (~== TagClose tag)

then return mempty

else mconcat <$> manyTill block closer

(_,raw) <- htmlTag (~== TagOpen tag [])

then return ""

--

-- main parser

<|> blockTag

<|> (B.rawBlock "mediawiki" <$> template)

<|> para

return res

para :: PandocMonad m => MWParser m Blocks

else (replicate cols mempty, hdr:rows')

return $ B.table caption cellspecs headers rows

parseAttrs = many1 parseAttr

parseAttr = try $ do

skipMany spaceChar

char '='

return (k,v)

tableStart :: PandocMonad m => MWParser m ()

notFollowedBy (char '|')

skipMany spaceChar

pos' <- getPosition

bs <- parseFromString (do setPosition pos'

mconcat <$> many block) ls

let align = case lookup "align" attrs of

Nothing -> 0.0

return ((align, width), bs)

parseWidth s =

template = try $ do

string "{{"

notFollowedBy (char '{')

lookAhead $ letter <|> digit <|> char ':'

contents <- manyTill chunk (try $ string "}}")

blockTag :: PandocMonad m => MWParser m Blocks

blockTag = do

(tag, _) <- lookAhead $ htmlTag isBlockTag'

case tag of

TagOpen "blockquote" _ -> B.blockQuote <$> blocksInTags "blockquote"

TagOpen "syntaxhighlight" attrs -> syntaxhighlight "syntaxhighlight" attrs

TagOpen "source" attrs -> syntaxhighlight "source" attrs

TagOpen "haskell" _ -> B.codeBlockWith ("",["haskell"],[]) . trimCode <$>

TagOpen "gallery" _ -> blocksInTags "gallery"

TagOpen "p" _ -> mempty <$ htmlTag (~== tag)

TagClose "p" -> mempty <$ htmlTag (~== tag)

_ -> B.rawBlock "html" . snd <$> htmlTag (~== tag)

syntaxhighlight tag attrs = try $ do

let mblang = lookup "lang" attrs

let mbstart = lookup "start" attrs

let mbline = lookup "line" attrs

let classes = maybeToList mblang ++ maybe [] (const ["numberLines"]) mbline

let kvs = maybe [] (\x -> [("startFrom",x)]) mbstart

return $ B.codeBlockWith ("",classes,kvs) $ trimCode contents

hrule :: PandocMonad m => MWParser m Blocks

guardColumnOne

char ' '

let endline' = B.linebreak <$ try (newline <* char ' ')

let spToNbsp ' ' = '\160'

spToNbsp x = x

let nowiki' = mconcat . intersperse B.linebreak . map B.str .

let inline' = whitespace' <|> endline' <|> nowiki'

<|> try (notFollowedBy newline *> inline)

contents <- mconcat <$> many1 inline'

spacesStr _ = False

if F.all spacesStr contents

then return mempty

strToCode x = x

normalizeCode [] = []

normalizeCode (Code a1 x : Code a2 y : zs) | a1 == a2 =

normalizeCode (x:xs) = x : normalizeCode xs

header :: PandocMonad m => MWParser m Blocks

-- See #4731:

modifyIdentifier :: Attr -> Attr

modifyIdentifier (ident,cl,kv) = (ident',cl,kv)

bulletList :: PandocMonad m => MWParser m Blocks

bulletList = B.bulletList <$>

( many1 (listItem '*')

orderedList :: PandocMonad m => MWParser m Blocks

orderedList =

(B.orderedList <$> many1 (listItem '#'))

<|> try

spaces

items <- many (listItem '#' <|> li)

let start = fromMaybe 1 $ safeRead $ fromAttrib "start" tag

return $ B.orderedListWith (start, DefaultStyle, DefaultDelim) items)

anyListStart = guardColumnOne >> oneOf "*#:;"

li :: PandocMonad m => MWParser m Blocks

(firstParaToPlain <$> blocksInTags "li") <* spaces

listItem :: PandocMonad m => Char -> MWParser m Blocks

else do

skipMany spaceChar

pos' <- getPosition

rest <- many

(try $ string extras *> lookAhead listStartChar *>

contents <- parseFromString (do setPosition pos'

many1 $ listItem' c)

case c of

'*' -> return $ B.bulletList contents

'#' -> return $ B.orderedList contents

-- }}

-- * next list item

-- which seems to be valid mediawiki.

listItem' :: PandocMonad m => Char -> MWParser m Blocks

listItem' c = try $ do

listStart c

skipMany spaceChar

pos' <- getPosition

rest <- many (try $ char c *> lookAhead listStartChar *>

parseFromString (do setPosition pos'

firstParaToPlain . mconcat <$> many1 block)

firstParaToPlain :: Blocks -> Blocks

firstParaToPlain contents =

<|> special

str :: PandocMonad m => MWParser m Inlines

math :: PandocMonad m => MWParser m Inlines

where dmStart = string "\\["

dmEnd = try (string "\\]")

mStart = string "\\("

mEnd = try (string "\\)")

variable = try $ do

string "{{{"

inlineTag :: PandocMonad m => MWParser m Inlines

inlineTag = do

TagOpen "ref" _ -> B.note . B.plain <$> inlinesInTags "ref"

TagOpen "nowiki" _ -> try $ do

(_,raw) <- htmlTag (~== tag)

then return mempty

else B.text . fromEntities <$>

*> optional blankline)

TagOpen "strike" _ -> B.strikeout <$> inlinesInTags "strike"

TagOpen "del" _ -> B.strikeout <$> inlinesInTags "del"

result <- encode <$> inlinesInTags "tt"

updateState $ \st -> st{ mwInTT = inTT }

return result

_ -> B.rawInline "html" . snd <$> htmlTag (~== tag)

special :: PandocMonad m => MWParser m Inlines

inlineHtml :: PandocMonad m => MWParser m Inlines

inlineHtml = B.rawInline "html" . snd <$> htmlTag isInlineTag'

notFollowedBy anyListStart)

imageIdentifiers :: PandocMonad m => [MWParser m ()]

where identifiers = ["File", "Image", "Archivo", "Datei", "Fichier",

"Bild"]

image = try $ do

sym "[["

choice imageIdentifiers

_ <- many imageOption

<|> return []

_ <- many imageOption

let kvs = case dims of

let attr = ("", [], kvs)

caption <- (B.str fname <$ sym "]]")

<|> try (char '|' *> (mconcat <$> manyTill inline (sym "]]")))

imageOption = try $ char '|' *> opt

where

opt = try (oneOfStrings [ "border", "thumbnail", "frameless"

, "center", "none", "baseline", "sub"

, "super", "top", "text-top", "middle"

, "bottom", "text-bottom" ])

<|> try (oneOfStrings ["link=","alt=","page=","class="] <* many (noneOf "|]"))

internalLink :: PandocMonad m => MWParser m Inlines

internalLink = try $ do

sym "[["

label <- option (B.text pagename) $ char '|' *>

( (mconcat <$> many1 (notFollowedBy (char ']') *> inline))

-- the "pipe trick"

-- [[Help:Contents|] -> "Contents"

sym "]]"

let link = B.link (addUnderscores pagename) "wikilink" (label <> linktrail)

then do

updateState $ \st -> st{ mwCategoryLinks = link : mwCategoryLinks st }

return mempty

<|> do char ']'

num <- mwNextLinkNumber <$> getState

updateState $ \st -> st{ mwNextLinkNumber = num + 1 }

return $ B.link src "" lab

url :: PandocMonad m => MWParser m Inlines

{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Readers.Muse

Copyright : Copyright (C) 2017-2019 Alexander Krotov

import Control.Monad.Except (throwError)

import Data.Bifunctor

import Data.Default

import qualified Data.Map as M

import qualified Data.Set as Set

import Data.Maybe (fromMaybe, isNothing, maybeToList)

import Text.Pandoc.Builder (Blocks, Inlines)

import qualified Text.Pandoc.Builder as B

import Text.Pandoc.Class (PandocMonad (..))

import Text.Pandoc.Logging

import Text.Pandoc.Options

import Text.Pandoc.Parsing hiding (F)

-- | Read Muse from an input string and return a Pandoc document.

readMuse :: PandocMonad m

let input = crFilter s

res <- flip runReaderT def $ runParserT parseMuse def{ museOptions = opts } "source" input

case res of

Right d -> return d

type F = Future MuseState

data MuseState = MuseState { museMeta :: F Meta -- ^ Document metadata

, museOptions :: ReaderOptions

, museLastSpacePos :: Maybe SourcePos -- ^ Position after last space or newline parsed

, museLastStrPos :: Maybe SourcePos -- ^ Position after last str parsed

, museLogMessages :: [LogMessage]

}

instance Default MuseState where

-- * Utility functions

-- | Trim up to one newline from the beginning of the string.

-- | Trim up to one newline from the end of the string.

where isSpaceChar c = c == ' ' || c == '\t'

atStart :: PandocMonad m => MuseParser m ()

atStart = do

-- ** HTML parsers

openTag tag = try $

where

attr = try $ (,)

<$ many1 spaceChar

<* string "=\""

-- | Convert HTML attributes to Pandoc 'Attr'

htmlAttrToPandoc attrs = (ident, classes, keyvals)

where

ident = fromMaybe "" $ lookup "id" attrs

keyvals = [(k,v) | (k,v) <- attrs, k /= "id", k /= "class"]

parseHtmlContent :: PandocMonad m

-> MuseParser m (Attr, F Blocks)

parseHtmlContent tag = try $ getIndent >>= \indent -> (,)

<$> fmap htmlAttrToPandoc (openTag tag)

-- ** Directive parsers

-- While not documented, Emacs Muse allows "-" in directive name

parseEmacsDirective = (,)

<$> parseDirectiveKey

<* spaceChar

<*> (trimInlinesF . mconcat <$> manyTill inline' eol)

parseAmuseDirective = (,)

<$> parseDirectiveKey

<* many1 spaceChar

parseBlock :: PandocMonad m => MuseParser m (F Blocks)

parseBlock = do

res <- blockElements <|> para

return res

where para = fst <$> paraUntil (try (eof <|> void (lookAhead blockElements)))

<* string "* * * * *"

<* manyTill spaceChar eol

headingStart = try $ (,)

<$> option "" (try (parseAnchor <* manyTill spaceChar eol))

<* firstColumn

example = try $ pure . B.codeBlock

<$ string "{{{"

<* many spaceChar

-- | Parse an @\<example>@ tag.

exampleTag :: PandocMonad m => MuseParser m (F Blocks)

exampleTag = try $ fmap pure $ B.codeBlockWith

<$ many spaceChar

<*> (htmlAttrToPandoc <$> openTag "example")

<* manyTill spaceChar eol

-- | Parse a @\<literal>@ tag as a raw block.

<$ many spaceChar

<*> (fromMaybe "html" . lookup "style" <$> openTag "literal") -- FIXME: Emacs Muse inserts <literal> without style into all output formats, but we assume HTML

<* manyTill spaceChar eol

<* manyTill spaceChar eol

-- | Parse @\<center>@ tag.

verseLine :: PandocMonad m => MuseParser m (F Inlines)

verseLine = (<>)

<*> fmap (trimInlinesF . mconcat) (manyTill inline' eol)

-- | Parse @\<verse>@ tag.

noteMarker' :: PandocMonad m

=> Char

-> Char

<$ char l

<*> oneOf "123456789"

<*> manyTill digit (char r)

noteMarker = noteMarker' '[' ']' <|> noteMarker' '{' '}'

addNote :: PandocMonad m

-> SourcePos

-> F Blocks

-> MuseParser m ()

-> MuseParser m (F [Blocks])

museGridTableRow indent indices = try $ do

lns <- many1 $ try (indentWith indent *> museGridTableRawLine indices)

indentWith indent *> museGridTableHeader

sequence <$> mapM (parseFromString' parseBlocks) cols

museGridTableRawLine :: PandocMonad m

=> [Int]

museGridTableRawLine indices =

museGridTable :: PandocMonad m => MuseParser m (F Blocks)

museGridTable = try $ do

endline :: PandocMonad m => MuseParser m (F Inlines)

endline = try $ pure B.softbreak <$ newline <* notFollowedBy blankline <* updateLastSpacePos

<$ firstColumn

<* char '#'

<*> letter

anchor :: PandocMonad m => MuseParser m (F Inlines)

anchor = try $ do

-- | Parse an inline tag, such as @\<em>@ and @\<strong>@.

inlineTag :: PandocMonad m

-> MuseParser m (F Inlines)

inlineTag tag = try $ mconcat

<$ openTag tag

verbatimTag :: PandocMonad m => MuseParser m (F Inlines)

verbatimTag = return . B.text

<$ openTag "verbatim"

-- | Parse @\<class>@ tag.

classTag :: PandocMonad m => MuseParser m (F Inlines)

classTag = do

fmap (B.spanWith ("", classes, [])) . mconcat <$> manyTill inline (closeTag "class")

-- | Parse @\<\<\<RTL>>>@ text.

-- | Parse code markup, indicated by @\'=\'@ characters.

code :: PandocMonad m => MuseParser m (F Inlines)

<$ atStart

<* char '='

<* notFollowedBy (spaceChar <|> newline)

<* notFollowedBy alphaNum

-- | Parse @\<code>@ tag.

codeTag :: PandocMonad m => MuseParser m (F Inlines)

codeTag = fmap pure $ B.codeWith

<$> (htmlAttrToPandoc <$> openTag "code")

-- | Parse @\<math>@ tag.

-- @\<math>@ tag is an Emacs Muse extension enabled by @(require 'muse-latex2png)@

mathTag :: PandocMonad m => MuseParser m (F Inlines)

mathTag = return . B.math

<$ openTag "math"

-- | Parse inline @\<literal>@ tag as a raw inline.

inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines)

inlineLiteralTag = try $ fmap pure $ B.rawInline

<$> (fromMaybe "html" . lookup "style" <$> openTag "literal") -- FIXME: Emacs Muse inserts <literal> without style into all output formats, but we assume HTML

str :: PandocMonad m => MuseParser m (F Inlines)

-- | Consume asterisks that were not used as emphasis opening.

-- This prevents series of asterisks from being split into

-- literal asterisk and emphasis opening.

asterisks :: PandocMonad m => MuseParser m (F Inlines)

symbol :: PandocMonad m => MuseParser m (F Inlines)

-- | Parse a link or image.

linkOrImage :: PandocMonad m => MuseParser m (F Inlines)

<*> manyTill inline (char ']')

-- | Parse a link starting with (possibly null) prefix

link prefix = try $ do

inLink <- asks museInLink

guard $ not inLink

content <- option (pure $ B.str url) (local (\s -> s { museInLink = True }) linkContent)

char ']'

return $ B.link url "" <$> content

image :: PandocMonad m => MuseParser m (F Inlines)

image = try $ do

string "[["

content <- option mempty linkContent

char ']'

let widthAttr = case align of

let alignClass = case align of

Just 'r' -> ["align-right"]

Just 'l' -> ["align-left"]

Just 'f' -> []

_ -> []

where -- Taken from muse-image-regexp defined in Emacs Muse file lisp/muse-regexps.el

imageExtensions = [".eps", ".gif", ".jpg", ".jpeg", ".pbm", ".png", ".tiff", ".xbm", ".xpm"]

imageExtensionAndOptions = do

ext <- imageExtension

(width, align) <- option (Nothing, Nothing) imageAttrs

return (ext, width, align)

imageAttrs = (,)

<$ many1 spaceChar

<* many spaceChar

<*> optionMaybe (oneOf "rlf")

{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Readers.Native

Copyright : Copyright (C) 2011-2019 John MacFarlane

import Text.Pandoc.Shared (safeRead)

import Control.Monad.Except (throwError)

import Text.Pandoc.Class

import Text.Pandoc.Error

-> Text -- ^ String to parse (assuming @'\n'@ line endings)

-> m Pandoc

readNative _ s =

Right doc -> return doc

Left _ -> throwError $ PandocParseError "couldn't read native"

readBlocks :: Text -> Either PandocError [Block]

readBlock :: Text -> Either PandocError Block

readInlines :: Text -> Either PandocError [Inline]

readInline :: Text -> Either PandocError Inline

{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Readers.OPML

Copyright : Copyright (C) 2013-2019 John MacFarlane

import Data.Default

import Data.Generics

import Data.Maybe (fromMaybe)

import Text.HTML.TagSoup.Entity (lookupEntity)

import Text.Pandoc.Builder

import Text.Pandoc.Class (PandocMonad)

readOPML opts inp = do

(bs, st') <- runStateT

(mapM parseBlock $ normalizeTree $

return $

setTitle (opmlDocTitle st') $

setAuthors (opmlDocAuthors st') $

convertEntity e = Data.Maybe.fromMaybe (map toUpper e) (lookupEntity e)

-- convenience function to get an attribute value, defaulting to ""

attrValue attr elt =

-- exceptT :: PandocMonad m => Either PandocError a -> OPML m a

-- exceptT = either throwError return

asHtml s = do

opts <- gets opmlOptions

return $ blocksToInlines' bs

asMarkdown s = do

opts <- gets opmlOptions

return $ fromList bs

getBlocks :: PandocMonad m => Element -> OPML m Blocks

parseBlock (Elem e) =

case qName (elName e) of

"ownerName" -> mempty <$ modify (\st ->

"dateModified" -> mempty <$ modify (\st ->

"title" -> mempty <$ modify (\st ->

"outline" -> gets opmlSectionLevel >>= sect . (+1)

"?xml" -> return mempty

_ -> getBlocks e

modify $ \st -> st{ opmlSectionLevel = n }

bs <- getBlocks e

modify $ \st -> st{ opmlSectionLevel = n - 1 }

"LINK" -> link

(attrValue "url" e) "" headerText

_ -> headerText

{-# LANGUAGE NoImplicitPrelude #-}

{- |

Module : Text.Pandoc.Reader.Odt

Copyright : Copyright (C) 2015 Martin Linnemann

{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{- |

Module : Text.Pandoc.Readers.Odt.ContentReader

Copyright : Copyright (C) 2015 Martin Linnemann

import qualified Data.ByteString.Lazy as B

import Data.Foldable (fold)

import qualified Data.Map as M

import Data.Maybe

import Data.Semigroup (First(..), Option(..))

-- State

--------------------------------------------------------------------------------

type Media = [(FilePath, B.ByteString)]

data ReaderState

)

>>^ fst

lookupResource = proc target -> do

state <- getExtraState -< ()

case lookup target (getMediaEnv state) of

Just bs -> returnV (target, bs) -<< ()

Nothing -> returnV ("", B.empty) -< ()

-- | An adaptation of 'uniqueIdent' from "Text.Pandoc.Shared" that generates a

-- unique identifier but without assuming that the id should be for a header.

-- Second argument is a list of already used identifiers.

uniqueIdentFrom :: AnchorPrefix -> [Anchor] -> Anchor

uniqueIdentFrom baseIdent usedIdents =

in if baseIdent `elem` usedIdents

then case find (\x -> numIdent x `notElem` usedIdents) ([1..60000] :: [Int]) of

Just x -> numIdent x

isCodeStyle _ = False

inlineCode :: Inlines -> Inlines

type PropertyTriple = (ReaderState, TextProperties, Maybe StyleFamily)

type InlineModifier = Inlines -> Inlines

-> OdtReaderSafe _x result

matchChildContent ls fallback = returnV mempty >>> matchContent ls fallback

--------------------------------------------

-- Matchers

--------------------------------------------

)

>>?% mappend

--

extractText _ = failEmpty

read_text_seq :: InlineMatcher

read_link :: InlineMatcher

read_link = matchingElement NsText "a"

$ liftA3 link

( matchChildContent [ read_span

, read_note

, read_citation

read_citation = matchingElement NsText "bibliography-mark"

$ liftA2 cite

( liftA2 makeCitation