{-# LANGUAGE BangPatterns #-}

{-# LANGUAGE DeriveDataTypeable #-}

{-# LANGUAGE DeriveGeneric #-}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-# LANGUAGE TupleSections #-}

{- |

Module : Text.Pandoc.Writers.AnnotatedTable

import Data.List.NonEmpty ( NonEmpty(..) )

import GHC.Generics ( Generic )

import qualified Text.Pandoc.Builder as B

-- | An annotated table type, corresponding to the Pandoc 'B.Table'

-- constructor and the HTML @\<table\>@ element. It records the data

fromCell :: Cell -> B.Cell

fromCell (Cell _ _ c) = c

{-# LANGUAGE OverloadedStrings #-}

{- |

Module : Text.Pandoc.Writers.AsciiDoc

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

import Control.Monad.State.Strict

import Data.Char (isPunctuation, isSpace)

import Data.List (intercalate, intersperse)

import Data.Maybe (fromMaybe, isJust)

import qualified Data.Set as Set

import qualified Data.Text as T

import Text.Pandoc.Templates (renderTemplate)

import Text.Pandoc.Writers.Shared

data WriterState = WriterState { defListMarker :: Text

, orderedListLevel :: Int

, bulletListLevel :: Int

, asciidoctorVariant :: Bool

, inList :: Bool

, hasMath :: Bool

}

defaultWriterState :: WriterState

, asciidoctorVariant = False

, inList = False

, hasMath = False

}

-- | Convert Pandoc to AsciiDoc.

-- | Escape special characters for AsciiDoc.

escapeString :: Text -> Text

-- | Ordered list start parser for use in Para below.

olMarker :: Parser Text ParserState Char

else contents

let bar = text "____"

return $ bar $$ chomp contents' $$ bar <> blankline

let (caption, aligns, widths, headers, rows) =

toLegacyTable blkCapt specs thead tbody tfoot

caption' <- inlineListToAsciiDoc opts caption

$ zipWith colspec aligns widths')

<> text ","

<> headerspec <> text "]"

let makeCell [Plain x] = do d <- blockListToAsciiDoc opts [Plain x]

makeCell [Para x] = makeCell [Plain x]

let makeRow cells = hsep `fmap` mapM makeCell cells

rows' <- mapM makeRow rows

head' <- makeRow headers

let head'' = if all null headers then empty else head'

let colwidth = if writerWrapText opts == WrapAuto

then writerColumns opts

else 100000

let body = if maxwidth > colwidth then vsep rows' else vcat rows'

caption'' $$ tablespec $$ border $$ head'' $$ body $$ border $$ blankline

blockToAsciiDoc opts (BulletList items) = do

inlist <- gets inList

| otherwise -> [Str "``"] ++ lst ++ [Str "''"]

inlineToAsciiDoc _ (Code _ str) = do

isAsciidoctor <- gets asciidoctorVariant

return $

if isAsciidoctor

then text "`+" <> contents <> "+`"

{- |

Module : Text.Pandoc.Writers.CommonMark

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

{-# LANGUAGE ViewPatterns #-}

{- |

Module : Text.Pandoc.Writers.ConTeXt

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

import Data.Text (Text)

import qualified Data.Text as T

import Network.URI (unEscapeString)

import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)

import Text.Pandoc.Definition

import Text.Pandoc.ImageSize

contents <- inlineListToConTeXt lst

return $ contents <> blankline

blockToConTeXt (LineBlock lns) = do

blockToConTeXt (BlockQuote lst) = do

contents <- blockListToConTeXt lst

return $ "\\startblockquote" $$ nest 0 contents $$ "\\stopblockquote" <> blankline

Period -> "stopper=."

OneParen -> "stopper=)"

TwoParens -> "left=(,stopper=)"

let specs2 = if null specs2Items

then ""

else "[" <> T.intercalate "," specs2Items <> "]"

UpperAlpha -> 'A') :

if isTightList lst then ",packed]" else "]"

let specs = T.pack style'' <> specs2

blockToConTeXt (DefinitionList lst) =

liftM vcat $ mapM defListItemToConTeXt lst

blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline

put $ st {stNextRef = next + 1}

let ref = "url" <> tshow next

contents <- inlineListToConTeXt txt

return $ "\\useURL"

<> brackets (literal ref)

<> (if isAutolink

then empty

else brackets empty <> brackets contents)

then literal "\\footnote{" <> nest 2 (chomp contents') <> char '}'

else literal "\\startbuffer " <> nest 2 (chomp contents') <>

literal "\\stopbuffer\\footnote{\\getbuffer}"

mblang <- fromBCP47 (lookup "lang" kvs)

let wrapDir txt = case lookup "dir" kvs of

Just "rtl" -> braces $ "\\righttoleft " <> txt

Just lng -> braces ("\\language" <>

brackets (literal lng) <> txt)

Nothing -> txt

-- | Craft the section header, inserting the section reference, if supplied.

sectionHeader :: PandocMonad m

-- https://tools.ietf.org/html/bcp47#section-2.1

-- http://wiki.contextgarden.net/Language_Codes

fromBCP47' :: Maybe Lang -> Maybe Text

{-# LANGUAGE OverloadedStrings #-}

{- |

Module : Text.Pandoc.Writers.CslJson

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

import Citeproc.Locale (getLocale)

import Citeproc.CslJson

import Text.Pandoc.Options (WriterOptions)

import Data.Aeson.Encode.Pretty (Config (..), Indent (Spaces),

NumberFormat (Generic),

defConfig, encodePretty')

writeCslJson :: PandocMonad m => WriterOptions -> Pandoc -> m Text

writeCslJson _opts (Pandoc meta _) = do

locale <- case getLocale lang of

Left e -> throwError $ PandocCiteprocError e

Right l -> return l

fromInlines :: [Inline] -> CslJson Text

fromInlines = foldMap fromInline . B.fromList

{-# LANGUAGE OverloadedStrings #-}

{- |

Module : Text.Pandoc.Writers.Custom

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

{-# LANGUAGE ViewPatterns #-}

{- |

Module : Text.Pandoc.Writers.Docbook

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

module Text.Pandoc.Writers.Docbook ( writeDocbook4, writeDocbook5 ) where

import Control.Monad.Reader

import Data.Generics (everywhere, mkT)

import Data.Monoid (Any (..))

import Data.Text (Text)

import qualified Data.Text as T

type DB = ReaderT DocBookVersion

-- | Convert list of authors to a docbook <author> section

authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m B.Inlines

authorToDocbook opts name' = do

let colwidth = if writerWrapText opts == WrapAuto

then Just $ writerColumns opts

else Nothing

let fromBlocks = blocksToDocbook opts .

makeSections False (Just startLvl)

auths' <- mapM (authorToDocbook opts) $ docAuthors meta

blockToDocbook _ Null = return empty

-- Add ids to paragraphs in divs with ids - this is needed for

-- pandoc-citeproc to get link anchors in bibliographies:

version <- ask

-- Docbook doesn't allow sections with no content, so insert some if needed

let bs = if null xs

then "section"

else "sect" <> tshow n

_ -> "simplesect"

title' <- inlinesToDocbook opts ils

contents <- blocksToDocbook opts bs

return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents

blockToDocbook _ h@Header{} = do

-- should be handled by Div section above, except inside lists/blockquotes

report $ BlockNotRendered h

blockToDocbook opts $ linesToPara lns

blockToDocbook opts (BlockQuote blocks) =

inTagsIndented "blockquote" <$> blocksToDocbook opts blocks

literal ("<programlisting" <> lang <> ">") <> cr <>

flush (literal (escapeStringForXML str) <> cr <> literal "</programlisting>")

where lang = if null langs

then ""

else " language=\"" <> escapeStringForXML (head langs) <>

"\""

langsFrom s = if isLang s

then [s]

langs = concatMap langsFrom classes

blockToDocbook opts (BulletList lst) = do

let attribs = [("spacing", "compact") | isTightList lst]

inTagsSimple "quote" <$> inlinesToDocbook opts lst

inlineToDocbook opts (Cite _ lst) =

inlinesToDocbook opts lst

((if T.null ident

then mempty

inlineToDocbook _ (Code _ str) =

return $ inTagsSimple "literal" $ literal (escapeStringForXML str)

inlineToDocbook opts (Math t str)

where

ident = [("id", id') | not (T.null id')]

role = [("role", T.unwords cls) | not (null cls)]

{-# LANGUAGE OverloadedStrings #-}

{- |

Module : Text.Pandoc.Writers.Docx

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

import Control.Monad.Except (catchError, throwError)

import Control.Monad.Reader

import Control.Monad.State.Strict

import qualified Data.ByteString.Lazy as BL

import Data.Char (isSpace, isLetter)

import Data.List (intercalate, isPrefixOf, isSuffixOf)

import Data.Maybe (fromMaybe, isNothing, mapMaybe, maybeToList)

import qualified Data.Set as Set

import qualified Data.Text as T

import qualified Data.Text.Lazy as TL

import Data.Time.Clock.POSIX

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

import Skylighting

import qualified Text.Pandoc.Class.PandocMonad as P

import Data.Time

import Text.Pandoc.UTF8 (fromTextLazy)

import Text.Pandoc.Error

import Text.Pandoc.ImageSize

import Text.Pandoc.Logging

import Text.Pandoc.Options

import Text.Pandoc.Writers.Docx.StyleMap

import Text.Pandoc.Shared

import Text.Pandoc.Walk

import Text.Pandoc.Writers.Math

import Text.Pandoc.Writers.Shared

import Text.TeXMath

import Text.Pandoc.Writers.OOXML

squashProps :: EnvProps -> [Element]

squashProps (EnvProps Nothing es) = es

squashProps (EnvProps (Just e) es) = e : es

renumIdMap _ [] = M.empty

renumIdMap n (e:es)

| Just oldId <- findAttr (QName "Id" Nothing Nothing) e =

| otherwise = renumIdMap n es

replaceAttr f val = map $

\a -> if f (attrKey a) then XML.Attr (attrKey a) val else a

renumId f renumMap e

| Just oldId <- findAttrBy f e

, Just newId <- M.lookup oldId renumMap =

e { elAttribs = attrs' }

| otherwise = e

renumIds f renumMap = map (renumId f renumMap)

-- | Certain characters are invalid in XML even if escaped.

-- See #1992

stripInvalidChars = T.filter isValidChar

-- | See XML reference

let doc' = Pandoc meta blocks'

username <- P.lookupEnv "USERNAME"

oldUserDataDir <- P.getUserDataDir

P.setUserDataDir Nothing

res <- P.readDefaultDataFile "reference.docx"

-- Gets the template size

let mbpgsz = mbsectpr >>= filterElementName (wname (=="pgSz"))

let mbpgmar = mbsectpr >>= filterElementName (wname (=="pgMar"))

-- Get the available area (converting the size and the margins to int and

-- doing the difference

-- styles

mblang <- toLang $ getLang opts meta

let addLang :: Element -> Element

let stylepath = "word/styles.xml"

styledoc <- addLang <$> parseXml refArchive distArchive stylepath

-- [Content_Types].xml

let mkOverrideNode (part', contentType') = mknode "Override"

let mkImageOverride (_, imgpath, mbMimeType, _) =

let mkMediaOverride imgpath =

let overrides = map mkOverrideNode (

[("/word/webSettings.xml",

"application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")

,("/word/footnotes.xml",

"application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")

] ++

"application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) headers ++

"application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) footers) ++

map mkImageOverride imgs ++

let defaultnodes = [mknode "Default"

[("Extension","xml"),("ContentType","application/xml")] (),

let renumHeaders = renumIds (\q -> qName q == "Id") idMap headers

let renumFooters = renumIds (\q -> qName q == "Id") idMap footers

let baserels = baserels' ++ renumHeaders ++ renumFooters

let imgrels = map toImgRel imgs

let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()

let linkrels = map toLinkRel $ M.toList $ stExternalLinks st

Nothing -> mknode "w:sectPr" [] ()

-- let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr'

let docContents = mknode "w:document" stdAttributes

$ mknode "w:body" [] contents'

numbering <- parseXml refArchive distArchive numpath

let newNumElts = mkNumbering (stLists st)

let pandocAdded e =

Just numid -> numid >= (990 :: Int)

Nothing ->

Just numid -> numid >= (1000 :: Int)

Nothing -> False

let oldElts = filter (not . pandocAdded) $ onlyElems (elContent numbering)

let extraCoreProps = ["subject","lang","category","description"]

let extraCorePropsMap = M.fromList $ zip extraCoreProps

["dc:subject","dc:language","cp:category","dc:description"]

lookupMetaString' key' meta' =

case key' of

"description" -> T.intercalate "_x000d_\n" (map stringify $ lookupMetaBlocks "description" meta')

: mktnode "dc:creator" [] (T.intercalate "; " (map stringify $ docAuthors meta))

: [ mktnode (M.findWithDefault "" k extraCorePropsMap) [] (lookupMetaString' k meta)

| k <- M.keys (unMeta meta), k `elem` extraCoreProps]

: (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x

, mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x

let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps

-- docProps/custom.xml

, k `notElem` (["title", "author", "keywords"]

++ extraCoreProps)]

let mkCustomProp (k, v) pid = mknode "property"

[("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")

,("name", k)] $ mknode "vt:lpwstr" [] v

let customPropsPath = "docProps/custom.xml"

let customProps = mknode "Properties"

-- adds references to footnotes or endnotes we don't have...

-- we do, however, copy some settings over from reference

let settingsPath = "word/settings.xml"

]

settingsEntry <- copyChildren refArchive distArchive settingsPath epochtime settingsList

fontTableEntry <- entryFromArchive refArchive "word/fontTable.xml"

webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml"

headerFooterEntries <- mapM (entryFromArchive refArchive . ("word/" ++)) $

let miscRelEntries = [ e | e <- zEntries refArchive

, "word/_rels/" `isPrefixOf` eRelativePath e

, ".xml.rels" `isSuffixOf` eRelativePath e

let styleId = T.filter (not . isSpace) s

in mknode "w:style" [ ("w:type", "paragraph")

, ("w:customStyle", "1")

, mknode "w:basedOn" [("w:val","BodyText")] ()

, mknode "w:qFormat" [] ()

]

let styleId = T.filter (not . isSpace) s

in mknode "w:style" [ ("w:type", "character")

, ("w:customStyle", "1")

, mknode "w:basedOn" [("w:val","BodyTextChar")] ()

]

toStyle toktype | hasStyleName (fromString $ show toktype) (smCharStyle sm) = Nothing

| otherwise = Just $

mknode "w:style" [("w:type","character"),

, mknode "w:basedOn" [("w:val","VerbatimChar")] ()

, mknode "w:rPr" [] $

| tokCol toktype /= "auto" ] ++

| tokBg toktype /= "auto" ] ++

[ mknode "w:b" [] () | tokFeature tokenBold toktype ] ++

[ mknode "w:i" [] () | tokFeature tokenItalic toktype ] ++

]

tokStyles = tokenStyles style

tokFeature f toktype = maybe False f $ M.lookup toktype tokStyles

$ (tokenColor =<< M.lookup toktype tokStyles)

`mplus` defaultColor style

$ (tokenBackground =<< M.lookup toktype tokStyles)

`mplus` backgroundColor style

parStyle | hasStyleName "Source Code" (smParaStyle sm) = Nothing

, mknode "w:pPr" []

$ mknode "w:wordWrap" [("w:val","off")] ()

:

]

copyChildren refArchive distArchive path timestamp elNames = do

ref <- parseXml refArchive distArchive path

dist <- parseXml distArchive distArchive path

return $ toEntry path timestamp $ renderXml dist{

}

where

-- this is the lowest number used for a list numId

baseListId :: Int

mkNumbering :: [ListMarker] -> [Element]

mkNumbering lists =

elts ++ zipWith mkNum lists [baseListId..(baseListId + length lists - 1)]

maxListLevel :: Int

maxListLevel = 8

mkNum :: ListMarker -> Int -> Element

mkNum marker numid =

$ mknode "w:abstractNumId" [("w:val",listMarkerToId marker)] ()

: case marker of

NoMarker -> []

BulletMarker -> []

NumberMarker _ _ start ->

[0..maxListLevel]

mknode "w:abstractNum" [("w:abstractNumId",listMarkerToId marker)]

: mknode "w:multiLevelType" [("w:val","multilevel")] ()

: map (mkLvl marker)

[0..maxListLevel]

mkLvl :: ListMarker -> Int -> Element

mkLvl marker lvl =

[ mknode "w:start" [("w:val",start)] ()

| marker /= NoMarker && marker /= BulletMarker ] ++

[ mknode "w:numFmt" [("w:val",fmt)] ()

, mknode "w:lvlJc" [("w:val","left")] ()

, mknode "w:pPr" []

] ()

]

]

NoMarker -> ("bullet"," ","1")

BulletMarker -> ("bullet",bulletFor lvl,"1")

NumberMarker st de n -> (styleFor st lvl

step = 720

hang = 480

bulletFor 0 = "\x2022" -- filled circle

styleFor DefaultStyle 5 = "lowerRoman"

styleFor DefaultStyle x = styleFor DefaultStyle (x `mod` 6)

styleFor _ _ = "decimal"

getNumId :: (PandocMonad m) => WS m Int

getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists

makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element]

makeTOC opts = do

tocTitle <- gets stTocTitle

title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para tocTitle])

return

mknode "w:docPartUnique" [] ()]

-- w:docPartObj

), -- w:sdtPr

mknode "w:p" [] (

mknode "w:r" [] [

mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),

-- | Convert Pandoc document to two lists of

-- OpenXML elements (the main document and footnotes).

writeOpenXML opts (Pandoc meta blocks) = do

let tit = docTitle meta

let auths = docAuthors meta

let toComment (kvs, ils) = do

annotation <- inlinesToOpenXML opts ils

return $

[ mknode "w:p" [] $

[ mknode "w:pPr" []

[ mknode "w:pStyle" [("w:val", "CommentText")] () ]

, mknode "w:r" []

toc <- if includeTOC

then makeTOC opts

else return []

return (meta' ++ doc', notes', comments')

-- | Convert a list of Pandoc blocks to OpenXML.

blocksToOpenXML opts = fmap concat . mapM (blockToOpenXML opts) . separateTables

-- Word combines adjacent tables unless you put an empty paragraph between

x : RawBlock (Format "openxml") "<w:p />" : separateTables xs

separateTables (x:xs) = x : separateTables xs

rStyleM :: (PandocMonad m) => CharStyleName -> WS m XML.Element

rStyleM styleName = do

cStyleMap <- gets (smCharStyle . stStyleMaps)

let sty' = getStyleIdFromName styleName cStyleMap

-- the + 20 is to ensure that there are no clashes with the rIds

-- already in word/document.xml.rel

getUniqueId = do

n <- gets stCurId

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

-- | Key for specifying user-defined docx styles.

dynamicStyleKey = "custom-style"

-- | Convert a Pandoc block element to OpenXML.

blockToOpenXML opts blk = withDirection $ blockToOpenXML' opts blk

blockToOpenXML' _ Null = return []

blockToOpenXML' opts (Div (ident,_classes,kvs) bs) = do

stylemod <- case lookup dynamicStyleKey kvs of

Just n -> do

num <- withTextPropM (rStyleM "SectionNumber")

(inlineToOpenXML opts (Str n))

Nothing -> return []

else return []

contents <- (number ++) <$> inlinesToOpenXML opts lst

if T.null ident

else do

let bookmarkName = ident

modify $ \s -> s{ stSectionIds = Set.insert bookmarkName

$ stSectionIds s }

bookmarkedContents <- wrapBookmark bookmarkName contents

blockToOpenXML' opts (Plain lst) = do

isInTable <- gets stInTable

isInList <- gets stInList

-- title beginning with fig: indicates that the image is a figure

blockToOpenXML' opts (Para [Image attr alt (src,T.stripPrefix "fig:" -> Just tit)]) = do

setFirstPara

prop <- pStyleM $

if null alt

then "Figure"

else "Captioned Figure"

paraProps <- local (\env -> env { envParaProperties = EnvProps (Just prop) [] <> envParaProperties env }) (getParaProps False)

contents <- inlinesToOpenXML opts [Image attr alt (src,tit)]

blockToOpenXML' opts (Para lst)

| null lst && not (isEnabled Ext_empty_paragraphs opts) = return []

| otherwise = do

ps -> ps

modify $ \s -> s { stFirstPara = False }

contents <- inlinesToOpenXML opts lst

blockToOpenXML' opts (LineBlock lns) = blockToOpenXML opts $ linesToPara lns

blockToOpenXML' _ b@(RawBlock format str)

| otherwise = do

report $ BlockNotRendered b

return []

wrapBookmark ident p

blockToOpenXML' _ HorizontalRule = do

setFirstPara

mknode "w:p" [] $ mknode "w:r" [] $ mknode "w:pict" []

$ mknode "v:rect" [("style","width:0;height:1.5pt"),

("o:hralign","center"),

("o:hrstd","t"),("o:hr","t")] () ]

blockToOpenXML' opts el

| BulletList lst <- el = addOpenXMLList BulletMarker lst

| OrderedList (start, numstyle, numdelim) lst <- el

setFirstPara

return l

definitionListItemToOpenXML opts (term,defs) = do

term' <- withParaPropM (pStyleM "Definition Term")

$ blockToOpenXML opts (Para term)

lists <- gets stLists

modify $ \st -> st{ stLists = lists ++ [marker] }

listItemToOpenXML opts numid (first:rest) = do

oldInList <- gets stInList

modify $ \st -> st{ stInList = True }

modify $ \st -> st{ stInList = oldInList }

return $ first'' ++ rest''

-- | Convert a list of inline elements to OpenXML.

inlinesToOpenXML opts lst = concat `fmap` mapM (inlineToOpenXML opts) lst

withNumId :: (PandocMonad m) => Int -> WS m a -> WS m a

asList :: (PandocMonad m) => WS m a -> WS m a

asList = local $ \env -> env{ envListLevel = envListLevel env + 1 }

getTextProps :: (PandocMonad m) => WS m [Element]

getTextProps = do

props <- asks envTextProperties

listLevel <- asks envListLevel

numid <- asks envListNumId

let listPr = [mknode "w:numPr" []

return $ case listPr ++ squashProps props of

[] -> []

ps -> [mknode "w:pPr" [] ps]

formattedString str =

-- properly handle soft hyphens

case splitTextBy (=='\173') str of

sh <- formattedRun [mknode "w:softHyphen" [] ()]

intercalate sh <$> mapM formattedString' ws

formattedString' str = do

inDel <- asks envInDel

formattedRun [ mktnode (if inDel then "w:delText" else "w:t")

props <- getTextProps

return [ mknode "w:r" [] $ props ++ els ]

-- | Convert an inline element to OpenXML.

inlineToOpenXML opts il = withDirection $ inlineToOpenXML' opts il

inlineToOpenXML' _ (Str str) =

inlineToOpenXML' opts Space = inlineToOpenXML opts (Str " ")

inlineToOpenXML' opts SoftBreak = inlineToOpenXML opts (Str " ")

inlineToOpenXML' opts (Span ("",["csl-block"],[]) ils) =

inlineToOpenXML' opts (Span ("",["csl-left-margin"],[]) ils) =

inlinesToOpenXML opts ils

inlineToOpenXML' opts (Span ("",["csl-right-inline"],[]) ils) =

<$> inlinesToOpenXML opts ils

inlineToOpenXML' opts (Span ("",["csl-indent"],[]) ils) =

inlinesToOpenXML opts ils

let ident' = fromMaybe ident (lookup "id" kvs)

kvs' = filter (("id" /=) . fst) kvs

modify $ \st -> st{ stComments = (("id",ident'):kvs', ils) : stComments st }

inlineToOpenXML' _ (Span (ident,["comment-end"],kvs) _) =

-- prefer the "id" in kvs, since that is the one produced by the docx

-- reader.

let ident' = fromMaybe ident (lookup "id" kvs)

inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do

stylemod <- case lookup dynamicStyleKey kvs of

Just (fromString . T.unpack -> sty) -> do

defaultAuthor <- asks envChangesAuthor

let author = fromMaybe defaultAuthor (lookup "author" kvs)

let mdate = lookup "date" kvs

insmod <- if "insertion" `elem` classes

then do

changeAuthorDate <- getChangeAuthorDate

modify $ \s -> s{stInsId = insId + 1}

return $ \f -> do

x <- f

else return id

delmod <- if "deletion" `elem` classes

then do

modify $ \s -> s{stDelId = delId + 1}

return $ \f -> local (\env->env{envInDel=True}) $ do

x <- f

else return id

contents <- insmod $ delmod $ dirmod $ stylemod $ pmod

$ inlinesToOpenXML opts ils

wrapBookmark ident contents

inlineToOpenXML' opts (Strong lst) =

inlineToOpenXML' opts (Emph lst) =

inlineToOpenXML' opts (Underline lst) =

withTextProp (mknode "w:u" [("w:val","single")] ()) $

inlinesToOpenXML opts lst

inlineToOpenXML' opts (Strikeout lst) =

withTextProp (mknode "w:strike" [] ())

$ inlinesToOpenXML opts lst

inlineToOpenXML' _ il@(RawInline f str)

| otherwise = do

report $ InlineNotRendered il

return []

when (mathType == DisplayMath) setFirstPara

res <- (lift . lift) (convertMath writeOMML mathType str)

case res of

Left il -> inlineToOpenXML' opts il

inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst

inlineToOpenXML' opts (Code attrs str) = do

let alltoktypes = [KeywordTok ..]

tokTypesMap <- mapM (\tt -> (,) tt <$> rStyleM (fromString $ show tt)) alltoktypes

mapM formattedString (T.lines str)

formatOpenXML _fmtOpts = intercalate [br] . map (map toHlTok)

toHlTok (toktype,tok) =

mknode "w:r" []

[ mknode "w:rPr" [] $

maybeToList (lookup toktype tokTypesMap)

withTextPropM (rStyleM "Verbatim Char")

$ if isNothing (writerHighlightStyle opts)

then unhighlighted

else case highlight (writerSyntaxMap opts)

formatOpenXML attrs str of

Left msg -> do

unless (T.null msg) $ report $ CouldNotHighlight msg

unhighlighted

let notemarker = mknode "w:r" []

[ mknode "w:rPr" [] footnoteStyle

, mknode "w:footnoteRef" [] () ]

let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : Space : ils) : xs

insertNoteRef (Para ils : xs) = Para (notemarkerXml : Space : ils) : xs

insertNoteRef xs = Para [notemarkerXml] : xs

$ insertNoteRef bs)

let newnote = mknode "w:footnote" [("w:id", notenum)] contents

modify $ \s -> s{ stFootnotes = newnote : notes }

[ mknode "w:rPr" [] footnoteStyle

, mknode "w:footnoteReference" [("w:id", notenum)] () ] ]

-- internal link:

inlineToOpenXML' opts (Link _ txt (T.uncons -> Just ('#', xs),_)) = do

contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt

return

-- external link:

inlineToOpenXML' opts (Link _ txt (src,_)) = do

contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt

extlinks <- gets stExternalLinks

Just i -> return i

Nothing -> do

modify $ \st -> st{ stExternalLinks =

return i

inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do

pageWidth <- asks envPrintWidth

imgs <- gets stImages

,("noChangeAspect","1")] ()

nvPicPr = mknode "pic:nvPicPr" []

[ mknode "pic:cNvPr"

, cNvPicPr ]

blipFill = mknode "pic:blipFill" []

, mknode "a:stretch" [] $

mknode "a:fillRect" [] ()

]

xfrm = mknode "a:xfrm" []

[ mknode "a:off" [("x","0"),("y","0")] ()

prstGeom = mknode "a:prstGeom" [("prst","rect")] $

mknode "a:avLst" [] ()

ln = mknode "a:ln" [("w","9525")]

imgElt = mknode "w:r" [] $

mknode "w:drawing" [] $

mknode "wp:inline" []

, mknode "wp:effectExtent"

[("b","0"),("l","0"),("r","0"),("t","0")] ()

, mknode "wp:docPr"

, ("id","1")

, ("name","Picture")

] ()

imgElt

wrapBookmark imgident =<< case stImage of

Nothing -> ( do --try

(img, mt) <- P.fetchItem src

let

imgext = case mt >>= extensionFromMimeType of

Just Eps -> ".eps"

Just Svg -> ".svg"

Just Emf -> ".emf"

Nothing -> ""

if T.null imgext

then -- without an extension there is no rule for content type

else do

-- insert mime type to use in constructing [Content_Types].xml

modify $ \st -> st { stImages = M.insert (T.unpack src) imgData $ stImages st }

)

`catchError` ( \e -> do

report $ CouldNotFetchResource src $ T.pack (show e)

br :: Element

br = mknode "w:r" [] [mknode "w:br" [] ()]

withDirection :: PandocMonad m => WS m a -> WS m a

withDirection x = do

, envTextProperties = EnvProps textStyle textProps'

}

wrapBookmark "" contents = return contents

wrapBookmark ident contents = do

id' <- getUniqueId

let bookmarkStart = mknode "w:bookmarkStart"

[("w:id", id')

bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()

-- Word imposes a 40 character limit on bookmark names and requires

-- that they begin with a letter. So we just use a hash of the

-- identifier when otherwise we'd have an illegal bookmark name.

toBookmarkName s

| Just (c, _) <- T.uncons s

, isLetter c

{- |

Module : Text.Pandoc.Writers.Docx.StyleMap

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

2015-2019 Nikolay Yakimov <root@livid.pp.ru>

License : GNU GPL, version 2 or above

{-# LANGUAGE OverloadedStrings #-}

{- |

Module : Text.Pandoc.Writers.DokuWiki

License : GNU GPL, version 2 or above

Maintainer : Clare Macrae <clare.macrae@googlemail.com>

import Control.Monad.State.Strict (StateT, evalStateT)

import Data.Default (Default (..))

import Data.List (transpose)

import Data.Text (Text)

import qualified Data.Text as T

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

then return []

else zipWithM (tableItemToDokuWiki opts) aligns headers

rows' <- mapM (zipWithM (tableItemToDokuWiki opts) aligns) rows

let padTo (width, al) s =

case width - T.length s of

x | x > 0 ->

{-# LANGUAGE ScopedTypeVariables #-}

{- |

Module : Text.Pandoc.Writers.EPUB

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

gets, lift, modify)

import qualified Data.ByteString.Lazy as B

import qualified Data.ByteString.Lazy.Char8 as B8

import Data.List (isInfixOf, isPrefixOf)

import qualified Data.Map as M

import Data.Maybe (fromMaybe, isNothing, mapMaybe, isJust)

import qualified Data.Set as Set

import qualified Data.Text.Lazy as TL

import Network.HTTP (urlEncode)

import System.FilePath (takeExtension, takeFileName, makeRelative)

ObfuscationMethod (NoObfuscation), WrapOption (..),

WriterOptions (..))

import Text.Pandoc.Shared (makeSections, normalizeDate, renderTags',

import qualified Text.Pandoc.UTF8 as UTF8

import Text.Pandoc.UUID (getRandomUUID)

import Text.Pandoc.Walk (query, walk, walkM)

import Text.Pandoc.Writers.HTML (writeHtmlStringForEPUB)

import Text.Printf (printf)

import Text.Pandoc.XML (escapeStringForXML)

import Text.DocTemplates (FromContext(lookupContext), Context(..),

ToContext(toVal), Val(..))

data EPUBState = EPUBState {

stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]

, stMediaNextId :: Int

}

type E m = StateT EPUBState m

data EPUBMetadata = EPUBMetadata{

} deriving Show

data Date = Date{

} deriving Show

data Creator = Creator{

} deriving Show

data Identifier = Identifier{

} deriving Show

data Title = Title{

} deriving Show

data ProgressionDirection = LTR | RTL deriving Show

dcName n = QName n Nothing (Just "dc")

dcNode = node . dcName

opfName n = QName n Nothing (Just "opf")

then x

else '_') . takeFileName

removeNote (Note _) = Str ""

removeNote x = x

mkEntry :: PandocMonad m => FilePath -> B.ByteString -> E m Entry

mkEntry path content = do

getEPUBMetadata :: PandocMonad m => WriterOptions -> Meta -> E m EPUBMetadata

getEPUBMetadata opts meta = do

let md = metadataFromMeta opts meta

let md' = foldr addMetadataFromXML md elts

let addIdentifier m =

if null (epubIdentifier m)

then do

randomId <- getRandomUUID

else return m

let addLanguage m =

then case lookupContext "lang" (writerVariables opts) of

Nothing -> do

mLang <- lift $ P.lookupEnv "LANG"

let localeLang =

case mLang of

Just lang ->

Nothing -> "en-US"

else return m

let fixDate m =

if null (epubDate m)

then do

return $ m{ epubDate = [ Date{

dateText = showDateTimeISO8601 currentTime

, dateEvent = Nothing } ] }

then return m

else do

let authors' = map stringify $ docAuthors meta

, creatorRole = Just "aut"

, creatorFileAs = Nothing }

return $ m{ epubCreator = map toAuthor authors' ++ epubCreator m }

| name == "relation" = md { epubRelation = Just $ strContent e }

| name == "coverage" = md { epubCoverage = Just $ strContent e }

| name == "rights" = md { epubRights = Just $ strContent e }

| otherwise = md

where getAttr n = lookupAttr (opfName n) attrs

addMetadataFromXML e@(Element (QName "meta" _ _) attrs _ _) md =

case getAttr "property" of

epubIbooksFields md }

_ -> case getAttr "name" of

md{ epubCalibreFields =

epubCalibreFields md }

_ -> md

where getAttr n = lookupAttr (unqual n) attrs

addMetadataFromXML _ md = md

metaValueToString (MetaBool True) = "true"

metaValueToString (MetaBool False) = "false"

metaValueToString _ = ""

metaValueToPaths :: MetaValue -> [FilePath]

getList s meta handleMetaValue =

case lookupMeta s meta of

Just (MetaList xs) -> map handleMetaValue xs

, titleType = metaValueToString <$> M.lookup "type" m }

handleMetaValue mv = Title (metaValueToString mv) Nothing Nothing

getCreator s meta = getList s meta handleMetaValue

where handleMetaValue (MetaMap m) =

Creator{ creatorText = maybe "" metaValueToString $ M.lookup "text" m

, creatorRole = metaValueToString <$> M.lookup "role" m }

handleMetaValue mv = Creator (metaValueToString mv) Nothing Nothing

getDate s meta = getList s meta handleMetaValue

where handleMetaValue (MetaMap m) =

Date{ dateText = fromMaybe "" $

handleMetaValue mv = Date { dateText = fromMaybe "" $ normalizeDate' $ metaValueToString mv

, dateEvent = Nothing }

simpleList s meta =

case lookupMeta s meta of

Just (MetaList xs) -> map metaValueToString xs

metadataFromMeta :: WriterOptions -> Meta -> EPUBMetadata

metadataFromMeta opts meta = EPUBMetadata{

}

where identifiers = getIdentifier meta

titles = getTitle meta

relation = metaValueToString <$> lookupMeta "relation" meta

coverage = metaValueToString <$> lookupMeta "coverage" meta

rights = metaValueToString <$> lookupMeta "rights" meta

`mplus` (metaValueToString <$> lookupMeta "cover-image" meta)

mCss = lookupMeta "css" meta <|> lookupMeta "stylesheet" meta

stylesheets = maybe [] metaValueToPaths mCss ++

case lookupContext "css" (writerVariables opts) of

Nothing ->

case lookupContext "css" (writerVariables opts) of

Nothing -> []

lookupMeta "page-progression-direction" meta of

Just "ltr" -> Just LTR

Just "rtl" -> Just RTL

_ -> Nothing

ibooksFields = case lookupMeta "ibooks" meta of

Just (MetaMap mp)

_ -> []

calibreFields = case lookupMeta "calibre" meta of

Just (MetaMap mp)

_ -> []

-- | Produce an EPUB2 file from a Pandoc document.

writeEPUB epubVersion opts doc = do

let epubSubdir = writerEpubSubdirectory opts

-- sanity check on epubSubdir

throwError $ PandocEpubSubdirectoryError epubSubdir

evalStateT (pandocToEPUB epubVersion opts doc) initState

pandocToEPUB :: PandocMonad m

[] -> case epubTitle metadata of

[] -> "UNTITLED"

(x:_) -> titleText x

-- stylesheet

stylesheets <- case epubStylesheets metadata of

(ListVal $ map

(\e -> toVal' $

(if useprefix then "../" else "") <>

stylesheetEntries)

mempty

case epubCoverImage metadata of

Nothing -> return ([],[])

Just img -> do

imgContent <- lift $ P.readFileLazy img

(coverImageWidth, coverImageHeight) <-

case imageSize opts' (B.toStrict imgContent) of

Right sz -> return $ sizeInPixels sz

Left err' -> (0, 0) <$ report

cpContent <- lift $ writeHtml

opts'{ writerVariables =

Context (M.fromList [

("coverpage", toVal' "true"),

("pagetitle", toVal $

("cover-image-width", toVal' $

("cover-image-height", toVal' $

cssvars True <> vars }

(Pandoc meta [])

coverEntry <- mkEntry "text/cover.xhtml" cpContent

imgContent

return ( [ coverEntry ]

, [ coverImageEntry ] )

("titlepage", toVal' "true"),

("body-type", toVal' "frontmatter"),

("pagetitle", toVal $

<> cssvars True <> vars }

(Pandoc meta [])

tpEntry <- mkEntry "text/title_page.xhtml" tpContent

let matchingGlob f = do

xs <- lift $ P.glob f

when (null xs) $

return xs

let mkFontEntry f = mkEntry ("fonts/" ++ takeFileName f) =<<

lift (P.readFileLazy f)

let chapters' = secsToChapters secs

extractLinkURL' num (Span (ident, _, _) _)

extractLinkURL' _ _ = []

extractLinkURL num (Div (ident, _, _) _)

extractLinkURL num (Header _ (ident, _, _) _)

extractLinkURL num b = query (extractLinkURL' num) b

let reftable = concat $ zipWith (\(Chapter bs) num ->

let fixInternalReferences :: Inline -> Inline

fixInternalReferences (Link attr lab (src, tit))

Just ys -> Link attr lab (ys, tit)

Nothing -> Link attr lab (src, tit)

fixInternalReferences x = x

chapters'

let chapToEntry num (Chapter bs) =

writeHtml opts'{ writerVariables =

Context (M.fromList

[("body-type", toVal' bodyType),

let chapterNode ent = unode "item" !

([("id", toId $ makeRelative epubSubdir

$ eRelativePath ent),

$ eRelativePath ent),

("media-type", "application/xhtml+xml")]

++ case props ent of

[] -> []

$ ()

let chapterRefNode ent = unode "itemref" !

let pictureNode ent = unode "item" !

[("id", toId $ makeRelative epubSubdir

$ eRelativePath ent),

$ eRelativePath ent),

("media-type",

$ mediaTypeOf $ eRelativePath ent)] $ ()

let fontNode ent = unode "item" !

[("id", toId $ makeRelative epubSubdir

$ eRelativePath ent),

$ eRelativePath ent),

getMimeType $ eRelativePath ent)] $ ()

let tocTitle = maybe plainTitle

uuid <- case epubIdentifier metadata of

(x:_) -> return $ identifierText x -- use first identifier as UUID

[] -> throwError $ PandocShouldNeverHappenError "epubIdentifier is null" -- shouldn't happen

unode "package" !

([("version", case version of

EPUB2 -> "2.0"

,("media-type","application/xhtml+xml")] ++

[("properties","nav") | epub3 ]) $ ()

] ++

,("media-type","text/css")] $ () |

(n :: Int, fp) <- zip [1..] (map

(makeRelative epubSubdir . eRelativePath)

let tocLevel = writerTOCDepth opts

let navPointNode :: PandocMonad m

-> Block -> StateT Int m [Element]

navPointNode formatter (Div (ident,_,_)

(Header lvl (_,_,kvs) ils : children)) =

n <- get

modify (+1)

let num = fromMaybe "" $ lookup "number" kvs

then Span ("", ["section-header-number"], [])

[Str num] : Space : ils

else ils

concat <$> mapM (navPointNode formatter) bs

navPointNode _ _ = return []

navMapFormatter n tit src subs = unode "navPoint" !

] ++ subs

let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $

, unode "content" ! [("src", "text/title_page.xhtml")]

$ () ]

navMap <- lift $ evalStateT

(concat <$> mapM (navPointNode navMapFormatter) secs) 1

unode "ncx" ! [("version","2005-1")

,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $

[ unode "head" $

]

tocEntry <- mkEntry "toc.ncx" tocData

navXhtmlFormatter n tit src subs = unode "li" !

(unode "a" !

$ titElements)

: case subs of

[] -> []

(_:_) -> [unode "ol" ! [("class","toc")] $ subs]

titRendered = case P.runPure

(writeHtmlStringForEPUB version

opts{ writerTemplate = Nothing

, writerVariables =

Context (M.fromList

[("pagetitle", toVal $

<> writerVariables opts}

(Pandoc nullMeta

[Plain $ walk clean tit])) of

tocBlocks <- lift $ evalStateT

(concat <$> mapM (navPointNode navXhtmlFormatter) secs) 1

let navBlocks = [RawBlock (Format "html")

unode navtag ! ([("epub:type","toc") | epub3] ++

[("id","toc")]) $

[ unode "h1" ! [("id","toc-title")] $ tocTitle

, unode "ol" ! [("class","toc")] $ tocBlocks ]]

let landmarkItems = if epub3

[ unode "a" ! [("href", "text/cover.xhtml")

,("epub:type", "cover")] $

isJust (epubCoverImage metadata)

] ++

[ unode "li"

[ unode "a" ! [("href", "#toc")

,("epub:type", "toc")] $

] | writerTableOfContents opts

]

else []

unode "nav" ! [("epub:type","landmarks")

,("id","landmarks")

,("hidden","hidden")] $

[ unode "ol" landmarkItems ]

| not (null landmarkItems)]

navData <- lift $ writeHtml opts'{ writerVariables =

<> cssvars False <> vars }

(Pandoc (setMeta "title"

(walk removeNote $ fromList $ docTitle' meta) nullMeta)

UTF8.fromStringLazy "application/epub+zip"

-- container.xml

unode "container" ! [("version","1.0")

,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $

unode "rootfiles" $

unode "rootfile" ! [("full-path",

(if null epubSubdir

then ""

,("media-type","application/oebps-package+xml")] $ ()

containerEntry <- mkEntry "META-INF/container.xml" containerData

-- com.apple.ibooks.display-options.xml

unode "display_options" $

unode "platform" ! [("name","*")] $

appleEntry <- mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple

-- construct archive

++ descriptionNodes ++ typeNodes ++ formatNodes

++ publisherNodes ++ sourceNodes ++ relationNodes

++ coverageNodes ++ rightsNodes ++ coverImageNodes

([1..] :: [Int]))

identifierNodes = withIds "epub-id" toIdentifierNode $

epubIdentifier md

(x:_) -> [dcNode "date" ! [("id","epub-date")]

$ dateText x]

ibooksNodes = map ibooksNode (epubIbooksFields md)

calibreNodes = map calibreNode (epubCalibreFields md)

("content", v)] $ ()

languageNodes = [dcTag "language" $ epubLanguage md]

creatorNodes = withIds "epub-creator" (toCreatorNode "creator") $

$ epubCoverImage md

modifiedNodes = [ unode "meta" ! [("property", "dcterms:modified")] $

showDateTimeISO8601 currentTime | version == EPUB3 ]

dcTag' n s = [dcTag n s]

toIdentifierNode id' (Identifier txt scheme)

| version == EPUB2 = [dcNode "identifier" !

txt]

| otherwise = (dcNode "identifier" ! [("id",id')] $ txt) :

maybe [] ((\x -> [unode "meta" !

, ("property","identifier-type")

, ("scheme","onix:codelist5")

]

(creatorRole creator >>= toRelator)) $ creatorText creator]

| otherwise = [dcNode s ! [("id",id')] $ creatorText creator] ++

maybe [] (\x -> [unode "meta" !

(creatorFileAs creator) ++

maybe [] (\x -> [unode "meta" !

("scheme","marc:relators")] $ x])

(creatorRole creator >>= toRelator)

toTitleNode id' title

| otherwise = [dcNode "title" ! [("id",id')] $ titleText title]

++

maybe [] (\x -> [unode "meta" !

(titleFileAs title) ++

maybe [] (\x -> [unode "meta" !

(titleType title)

toDateNode id' date = [dcNode "date" !

(("id",id') :

maybe [] (\x -> [("opf:event",x)]) (dateEvent date)) $

dateText date]

schemeToOnix "ISBN-10" = "02"

schemeToOnix "GTIN-13" = "03"

schemeToOnix "UPC" = "04"

schemeToOnix "OLCC" = "28"

schemeToOnix _ = "01"

transformTag :: PandocMonad m

transformTag tag@(TagOpen name attr)

| name `elem` ["video", "source", "img", "audio"] &&

isNothing (lookup "data-external" attr) = do

let src = fromAttrib "src" tag

let poster = fromAttrib "poster" tag

let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++

return $ TagOpen name attr'

transformTag tag = return tag

modifyMediaRef :: PandocMonad m

=> FilePath

modifyMediaRef "" = return ""

modifyMediaRef oldsrc = do

media <- gets stMediaPaths

case lookup oldsrc media of

Nothing -> catchError

(("." <>) <$> (mbMime >>= extensionFromMimeType))

newName <- getMediaNextNewName ext

let newPath = "media/" ++ newName

entry <- mkEntry newPath (B.fromChunks . (:[]) $ img)

modify $ \st -> st{ stMediaPaths =

(oldsrc, (newPath, Just entry)):media}

(\e -> do

getMediaNextNewName ext = do

nextId <- gets stMediaNextId

modify $ \st -> st { stMediaNextId = nextId + 1 }

transformBlock :: PandocMonad m

=> Block

-> E m Block

transformBlock (RawBlock fmt raw)

let tags = parseTags raw

tags' <- mapM transformTag tags

return $ RawBlock fmt (renderTags' tags')

=> WriterOptions

-> Inline

-> E m Inline

return $ Image attr lab ("../" <> newsrc, tit)

transformInline opts x@(Math t m)

| WebTeX url <- writerHTMLMathMethod opts = do

let mathclass = if t == DisplayMath then "display" else "inline"

return $ Span ("",["math",mathclass],[])

[Image nullAttr [x] ("../" <> newsrc, "")]

transformInline _opts (RawInline fmt raw)

let tags = parseTags raw

tags' <- mapM transformTag tags

return $ RawInline fmt (renderTags' tags')

transformInline _ x = return x

(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)

mediaTypeOf :: FilePath -> Maybe MimeType

mediaTypeOf x =

let mediaPrefixes = ["image", "video", "audio"] in

case getMimeType x of

_ -> Nothing

-- Returns filename for chapter number.

-- Add identifiers to any headers without them.

addIdentifiers :: WriterOptions -> [Block] -> [Block]

addIdentifiers opts bs = evalState (mapM go bs) Set.empty

where go (Header n (ident,classes,kvs) ils) = do

ids <- get

then uniqueIdent (writerExtensions opts) ils ids

else ident

modify $ Set.insert ident'

go x = return x

-- Variant of normalizeDate that allows partial dates: YYYY, YYYY-MM

where

go xs

| otherwise = normalizeDate xs

toRelator x

| x `elem` relators = Just x

relators = map snd relatorMap

relatorMap =

[("abridger", "abr")

,("actor", "act")

{- |

Module : Text.Pandoc.Writers.FB2

Copyright : Copyright (C) 2011-2012 Sergey Astanin

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane

module Text.Pandoc.Writers.FB2 (writeFB2) where

import Control.Monad (zipWithM)

import Control.Monad.State.Strict (StateT, evalStateT, get, gets, lift, liftM, modify)

import Data.ByteString.Base64 (encode)

import Data.Char (isAscii, isControl, isSpace)

import Data.Either (lefts, rights)

import Data.List (intercalate)

import qualified Data.Text as T

import qualified Data.Text.Encoding as TE

import Network.HTTP (urlEncode)

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

import qualified Text.Pandoc.Class.PandocMonad as P

import Text.Pandoc.Definition

import Text.Pandoc.Logging

import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def)

import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers,

makeSections, tshow, stringify)

import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable)

-- | Data to be written at the end of the document:

-- (foot)notes, URLs, references, images.

(imgs,missing) <- get >>= (lift . fetchImages . imagesToFetch)

let body' = replaceImagesWithAlt missing body

let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)

where

xml_head = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"

fb2_attrs =

description :: PandocMonad m => Meta -> FBM m Content

description meta' = do

let genre = case lookupMetaString "genre" meta' of

bt <- booktitle meta'

let as = authors meta'

dd <- docdate meta'

Just (MetaInlines [Str s]) -> [el "lang" $ iso639 s]

Just (MetaString s) -> [el "lang" $ iso639 s]

_ -> []

let coverimage url = do

let img = Image nullAttr mempty (url, "")

im <- insertImage InlineImage img

return $ el "description"

[ el "title-info" (genre :

(as ++ bt ++ annotation ++ dd ++ coverpage ++ lang))

]

booktitle :: PandocMonad m => Meta -> FBM m [Content]

author :: [Inline] -> [Content]

author ss =

names = case ws' of

[nickname] -> [ el "nickname" nickname ]

[fname, lname] -> [ el "first-name" fname

, el "last-name" lname ]

(fname:rest) -> [ el "first-name" fname

, el "last-name" (last rest) ]

[] -> []

in list $ el "author" (names ++ email)

el "body" ([uattr "name" "notes"], map renderFN (reverse fns))

where

renderFN (n, idstr, cs) =

in el "section" ([uattr "id" idstr], fn_texts)

-- | Fetch images and encode them for the FictionBook XML.

where

types = ["text","image","audio","video","application","message","multipart"]

valid c = isAscii c && not (isControl c) && not (isSpace c) &&

footnoteID :: Int -> Text

footnoteID i = "n" <> tshow i

= insertImage NormalImage (Image atr alt (src,tit))

blockToXml (Para ss) = list . el "p" <$> cMapM toXml ss

blockToXml (CodeBlock _ s) = return . spaceBeforeAfter .

blockToXml (RawBlock f str) =

if f == Format "fb2"

else return []

blockToXml (Div _ bs) = cMapM blockToXml bs

blockToXml (BlockQuote bs) = list . el "cite" <$> cMapM blockToXml bs

c <- el "emphasis" <$> cMapM toXml caption

return [el "table" (hd <> bd), el "p" c]

where

mkrow tag cells aligns' =

el "tr" <$> mapM (mkcell tag) (zip cells aligns')

--

mkcell tag (cell, align) = do

cblocks <- cMapM blockToXml cell

return $ el tag ([align_attr align], cblocks)

inner <- cMapM toXml ss

return $ [txt "“"] ++ inner ++ [txt "”"]

toXml (Cite _ ss) = cMapM toXml ss -- FIXME: support citation styles

toXml Space = return [txt " "]

toXml SoftBreak = return [txt "\n"]

toXml LineBreak = return [txt "\n"]

let imgurl = url <> T.pack (urlEncode $ T.unpack formula)

let img = Image nullAttr alt (imgurl, "")

insertImage immode img

insertImage :: PandocMonad m => ImageMode -> Inline -> FBM m [Content]

insertImage immode (Image _ alt (url,ttl)) = do

el "image" $

[ attr ("l","href") ("#" <> fname)

, attr ("l","type") (tshow immode)

++ ttlattr

insertImage _ _ = error "unexpected inline instead of image"

replaceImagesWithAlt :: [Text] -> Content -> Content

where

isMissing (Elem img@Element{}) =

let imgAttrs = elAttribs img

badAttrs = map (attr ("l","href")) missingHrefs

replaceNode :: Content -> Content

replaceNode n@(Elem img@Element{}) =

let attrs = elAttribs img

imtype = getAttrVal attrs (qname "l" "type")

in case (alt, imtype) of

(Just alt', Just imtype') ->

then el "p" alt'

_ -> n -- don't replace if alt text is not found

replaceNode n = n

--

getAttrVal attrs name =

case filter ((name ==) . attrKey) attrs of

(a:_) -> Just (attrVal a)

-- | Wrap all inlines with an XML tag (given its unqualified name).

wrap tagname inlines = el tagname `liftM` cMapM toXml inlines

-- " Create a singleton list.

list = (:[])

-- | Convert an 'Inline' to plaintext.

plain Space = " "

plain SoftBreak = " "

plain LineBreak = "\n"

plain (RawInline _ _) = ""

plain (Note _) = "" -- FIXME

-- | Create an XML element.

el :: (Node t)

-> t -- ^ node contents

-> Content -- ^ XML content

el name cs = Elem $ unode name cs

-- | Create a plain-text XML content.

txt :: Text -> Content

-- | Create an XML attribute with an unqualified name.

-- | Create an XML attribute with a qualified name from given namespace.

-- | Qualified name

qname ns name = QName name Nothing (Just ns)

-- | Abbreviation for 'concatMap'.

{-# LANGUAGE ViewPatterns #-}

{- |

Module : Text.Pandoc.Writers.HTML

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

import Control.Monad.Identity (runIdentity)

import Control.Monad.State.Strict

import Data.Char (ord)

import Data.List.NonEmpty (NonEmpty((:|)))

import qualified Data.Set as Set

import Data.Text (Text)

import qualified Data.Text as T

let stringifyHTML = escapeStringForXML . stringify

let authsMeta = map stringifyHTML $ docAuthors meta

let dateMeta = stringifyHTML $ docDate meta

slideVariant <- gets stSlideVariant

let sects = adjustNumbers opts $

makeSections (writerNumberSections opts) Nothing $

PlainMath -> defField "displaymath-css" True

WebTeX _ -> defField "displaymath-css" True

_ -> id) .

defField "document-css" (isNothing mCss && slideVariant == NoSlides) .

defField "quotes" (stQuotes st) .

-- for backwards compatibility we populate toc

defField "author-meta" authsMeta .

maybe id (defField "date-meta")

(normalizeDate dateMeta) .

defField "pagetitle"

(stringifyHTML . docTitle $ meta) .

defField "idprefix" (writerIdentifierPrefix opts) .

addAttrs :: PandocMonad m

=> WriterOptions -> Attr -> Html -> StateT WriterState m Html

toAttrs :: PandocMonad m

=> [(Text, Text)] -> StateT WriterState m [Attribute]

toAttrs kvs = do

html5 <- gets stHtml5

mbEpubVersion <- gets stEPUBVersion

attrsToHtml :: PandocMonad m

=> WriterOptions -> Attr -> StateT WriterState m [Attribute]

figure :: PandocMonad m

=> WriterOptions -> Attr -> [Inline] -> (Text, Text)

-> StateT WriterState m Html

html5 <- gets stHtml5

-- Screen-readers will normally read the @alt@ text and the figure; we

-- want to avoid them reading the same text twice. With HTML5 we can

-- use aria-hidden for the caption; with HTML4, we use an empty

-- alt-text instead.

let alt = if html5 then txt else [Str ""]

let tocapt = if html5

else H.p ! A.class_ "caption"

img <- inlineToHtml opts (Image attr alt (s,tit))

capt <- if null txt

let fragmentClass = case slideVariant of

RevealJsSlides -> "fragment"

_ -> "incremental"

<> fragmentClass <> "\">") :

(zs ++ [RawBlock (Format "html") "</div>"])

let breakOnPauses zs = case splitBy isPause zs of

[] -> []

let (titleBlocks, innerSecs) =

if titleSlide

-- title slides have no content of their own

lookup "entry-spacing" kvs' >>=

safeRead }

let isCslBibEntry = "csl-entry" `elem` classes

[("role", "doc-bibliography") | isCslBibBody && html5] ++

[("role", "doc-biblioentry") | isCslBibEntry && html5]

let speakerNotes = "notes" `elem` classes

classes' = case slideVariant of

NoSlides -> classes

_ -> filter (\k -> k /= "incremental" && k /= "nonincremental") classes

contents <- if "columns" `elem` classes'

then -- we don't use blockListToHtml because it inserts

-- a newline between the column divs, which throws

-- off widths! see #4028

let contents' = nl opts >> contents >> nl opts

let (divtag, classes'') = if html5 && "section" `elem` classes'

then (H5.section, filter (/= "section") classes')

else do

contents <- blockListToHtml opts blocks

return $ H.blockquote $ nl opts >> contents >> nl opts

contents <- inlineListToHtml opts lst

let secnum = fromMaybe mempty $ lookup "number" kvs

let contents' = if writerNumberSections opts && not (T.null secnum)

then (H.span ! A.class_ "header-section-number"

$ toHtml secnum) >> strToHtml " " >> contents

else contents

$ case level of

1 -> H.h1 contents'

2 -> H.h2 contents'

numstyle']

else [])

l <- ordList opts contents

blockToHtml opts (DefinitionList lst) = do

contents <- mapM (\(term, defs) ->

do term' <- liftM H.dt $ inlineListToHtml opts term

LineBreak -> return $ do

if html5 then H5.br else H.br

strToHtml "\n"

(Span (id',classes,kvs) ils) ->

let spanLikeTag = case classes of

return $ if T.null tit

then link'

else link' ! A.title (toValue tit)

let alternate = stringify txt

slideVariant <- gets stSlideVariant

let isReveal = slideVariant == RevealJsSlides

[A.title $ toValue tit | not (T.null tit)] ++

attrs

imageTag = (if html5 then H5.img else H.img

mediaTag tg fallbackTxt =

let linkTxt = if null txt

then fallbackTxt

Just "audio" -> mediaTag H5.audio "Audio"

Just _ -> (H5.embed, [])

_ -> imageTag

-- note: null title included, as in Markdown.pl

(Note contents) -> do

notes <- gets stNotes

else let lastBlock = last blocks

otherBlocks = init blocks

in case lastBlock of

[Para (lst ++ backlink)]

[Plain (lst ++ backlink)]

Plain backlink]

contents <- blockListToHtml opts blocks'

let noteItem = H.li ! prefixedId opts ("fn" <> ref) $ contents

_ -> noteItem

return $ nl opts >> noteItem'

html5 <- gets stHtml5

isMathEnvironment :: Text -> Bool

isMathEnvironment s = "\\begin{" `T.isPrefixOf` s &&

allowsMathEnvironments (WebTeX _) = True

allowsMathEnvironments _ = False

isRawHtml :: PandocMonad m => Format -> StateT WriterState m Bool

isRawHtml f = do

html5 <- gets stHtml5

-}

module Text.Pandoc.Writers.Haddock (writeHaddock) where

import Control.Monad.State.Strict

import Data.Default

import Data.Text (Text)

import qualified Data.Text as T

-- | Escape special characters for Haddock.

escapeString :: Text -> Text

-- | Convert Pandoc block element to haddock.

blockToHaddock :: PandocMonad m

image = inTags True "Image"

[("Self","ue6"), ("ItemTransform", scale<>" -"<>hw<>" -"<>hh)]

$ vcat [

, selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", src')]

]

doc = inTags True "CharacterStyleRange" attrs

{-# LANGUAGE ScopedTypeVariables #-}

{- |

Module : Text.Pandoc.Writers.Ipynb

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

{-# LANGUAGE ScopedTypeVariables #-}

{- |

Module : Text.Pandoc.Writers.JATS

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

, writeJatsPublishing

, writeJatsArticleAuthoring

) where

import Control.Monad.Reader

import Control.Monad.State

import Data.Generics (everywhere, mkT)

import Data.List (partition)

import qualified Data.Map as M

import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)

import qualified Data.Text as T

import Data.Text (Text)

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

import Text.Pandoc.Definition

import Text.Pandoc.Highlighting (languages, languagesByExtension)

import Text.Pandoc.Shared

import Text.Pandoc.Templates (renderTemplate)

import Text.DocTemplates (Context(..), Val(..))

import Text.Pandoc.Writers.JATS.Table (tableToJATS)

import Text.Pandoc.Writers.JATS.Types

import Text.Pandoc.Writers.Math

-- | Convert a @'Pandoc'@ document to JATS.

writeJats :: PandocMonad m => JATSTagSet -> WriterOptions -> Pandoc -> m Text

{ jatsTagSet = tagSet

, jatsInlinesWriter = inlinesToJATS

}

-- | Convert Pandoc document to string in JATS format.

docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text

-- | Convert a list of pairs of terms and definitions into a list of

-- JATS varlistentrys.

deflistItemsToJATS :: PandocMonad m

deflistItemsToJATS opts items =

vcat <$> mapM (uncurry (deflistItemToJATS opts)) items

-- | Convert a term and a list of blocks into a JATS varlistentry.

deflistItemToJATS :: PandocMonad m

deflistItemToJATS opts term defs = do

term' <- inlinesToJATS opts term

def' <- wrappedBlocksToJATS (not . isPara)

-- | Convert a list of lists of blocks to a list of JATS list items.

listItemsToJATS :: PandocMonad m

listItemsToJATS opts markers items =

case markers of

Nothing -> vcat <$> mapM (listItemToJATS opts Nothing) items

-- | Convert a list of blocks into a JATS list item.

listItemToJATS :: PandocMonad m

listItemToJATS opts mbmarker item = do

contents <- wrappedBlocksToJATS (not . isParaOrList) opts

(walk demoteHeaderAndRefs item)

return $ inTagsIndented "list-item" $

$$ contents

imageMimeType :: Text -> [(Text, Text)] -> (Text, Text)

(T.drop 1 . T.dropWhile (/='/') <$> mbMT)

in (maintype, subtype)

case langs of

(l:_) -> escapeStringForXML l

[] -> ""

langsFrom s = if isLang s

then [s]

langs = concatMap langsFrom classes

where

[("language",lang) | not (T.null lang)] ++

[(k,v) | (k,v) <- kvs, k `elem` ["code-type",

"code-version", "executable",

"language-version", "orientation",

"platforms", "position", "specific-use"]]

-- | Convert a Pandoc block element to JATS.

blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text)

blockToJATS _ Null = return empty

blockToJATS opts (Div (id',"section":_,kvs) (Header _lvl _ ils : xs)) = do

let otherAttrs = ["sec-type", "specific-use"]

let attribs = idAttr ++ [(k,v) | (k,v) <- kvs, k `elem` otherAttrs]

title' <- inlinesToJATS opts ils

return $ inTags True "sec" attribs $

inTagsSimple "title" title' $$ contents

-- Bibliography reference:

inlinesToJATS opts lst

blockToJATS opts (Div ("refs",_,_) xs) = do

return $ inTagsIndented "ref-list" contents

blockToJATS opts (Div (ident,[cls],kvs) bs) | cls `elem` ["fig", "caption", "table-wrap"] = do

contents <- blocksToJATS opts bs

[("xml:lang",l) | ("lang",l) <- kvs] ++

[(k,v) | (k,v) <- kvs, k `elem` ["specific-use",

"content-type", "orientation", "position"]]

return $ inTags True cls attr contents

blockToJATS opts (Div (ident,_,kvs) bs) = do

contents <- blocksToJATS opts bs

[("xml:lang",l) | ("lang",l) <- kvs] ++

[(k,v) | (k,v) <- kvs, k `elem` ["specific-use",

"content-type", "orientation", "position"]]

let capt = if null txt

then empty

else inTagsSimple "caption" $ inTagsSimple "p" alt

[(k,v) | (k,v) <- kvs, k `elem` ["fig-type", "orientation",

"position", "specific-use"]]

let graphicattr = [("mimetype",maintype),

capt $$ selfClosingTag "graphic" graphicattr

blockToJATS _ (Para [Image (ident,_,kvs) _ (src, tit)]) = do

let (maintype, subtype) = imageMimeType src kvs

[("mimetype", maintype),

("mime-subtype", subtype),

("xlink:href", src)] ++

blockToJATS opts $ linesToPara lns

blockToJATS opts (BlockQuote blocks) = do

tagSet <- asks jatsTagSet

inTags False tag attr (flush (text (T.unpack $ escapeStringForXML str)))

tag = if T.null lang then "preformat" else "code"

blockToJATS _ (BulletList []) = return empty

blockToJATS opts (BulletList lst) =

inlineToJATS opts (Quoted DoubleQuote lst) = do

contents <- inlinesToJATS opts lst

return $ char '“' <> contents <> char '”'

return $ inTags False tag attr $ literal (escapeStringForXML str)

tag = if T.null lang then "monospace" else "code"

inlineToJATS _ il@(RawInline f x)

| f == "jats" = return $ literal x

let notenum = case notes of

(n, _):_ -> n + 1

[] -> 1

<$> wrappedBlocksToJATS (not . isPara) opts

(walk demoteHeaderAndRefs contents)

modify $ \st -> st{ jatsNotes = (notenum, thenote) : notes }

("rid", "fn" <> tshow notenum)]

$ text (show notenum)

inlineToJATS opts (Cite _ lst) =

inlinesToJATS opts lst

contents <- inlinesToJATS opts ils

inlineToJATS _ (Math t str) = do

let addPref (Xml.Attr q v)

| Xml.qName q == "xmlns" = Xml.Attr q{ Xml.qName = "xmlns:mml" } v

| escapeURI t == email =

return $ inTagsSimple "email" $ literal (escapeStringForXML email)

inlineToJATS opts (Link (ident,_,kvs) txt (T.uncons -> Just ('#', src), _)) = do

if null txt

then return $ selfClosingTag "xref" attr

else do

contents <- inlinesToJATS opts txt

return $ inTags False "xref" attr contents

inlineToJATS opts (Link (ident,_,kvs) txt (src, tit)) = do

[("ext-link-type", "uri"),

("xlink:href", src)] ++

[("xlink:title", tit) | not (T.null tit)] ++

let subtype = fromMaybe "" $

lookup "mime-subtype" kvs `mplus`

(T.drop 1 . T.dropWhile (/='/') <$> mbMT)

[("mimetype", maintype),

("mime-subtype", subtype),

("xlink:href", src)] ++

demoteHeaderAndRefs x = x

parseDate :: Text -> Maybe Day

where parsetimeWith = parseTimeM True defaultTimeLocale

formats = ["%x","%m/%d/%Y", "%D","%F", "%d %b %Y",

"%e %B %Y", "%b. %e, %Y", "%B %e, %Y",

{-# LANGUAGE TupleSections #-}

{- |

Module : Text.Pandoc.Writers.JATS.Table

License : GNU GPL, version 2 or above

Maintainer : Albert Krewinkel <tarleb@zeitkraut.de>

import Text.Pandoc.Options (WriterOptions)

import Text.Pandoc.Shared (tshow)

import Text.Pandoc.Writers.JATS.Types

import qualified Data.Text as T

import qualified Text.Pandoc.Writers.AnnotatedTable as Ann

-> JATS m (Doc Text)

tableToJATS opts (Ann.Table attr caption colspecs thead tbodies tfoot) = do

let (Caption _maybeShortCaption captionBlocks) = caption

tbl <- captionlessTable opts attr colspecs thead tbodies tfoot

captionDoc <- if null captionBlocks

then return empty

else do

blockToJATS <- asks jatsBlockWriter

return $ inTags True "table-wrap" [] $ captionDoc $$ tbl

captionlessTable :: PandocMonad m

toAttribs :: Attr -> [Text] -> [(Text, Text)]

toAttribs (ident, _classes, kvs) knownAttribs =

filter ((`elem` knownAttribs) . fst) kvs

tableCellToJats :: PandocMonad m

inlinesToJats <- asks jatsInlinesWriter

let cellContents = \case

[Plain inlines] -> inlinesToJats opts inlines

let tag' = case ctype of

BodyCell -> "td"

HeaderCell -> "th"

. maybeCons (colspanAttrib colspan)

$ toAttribs attr validAttribs

inTags False tag' attribs <$> cellContents item

{- |

Module : Text.Pandoc.Writers.JATS.Types

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

)

where

import Control.Monad.Reader (ReaderT)

import Control.Monad.State (StateT)

import Data.Text (Text)

import Text.DocLayout (Doc)

import Text.Pandoc.Options (WriterOptions)

-- | JATS tag set variant

{ jatsNotes :: [(Int, Doc Text)]

}

data JATSEnv m = JATSEnv

, jatsInlinesWriter :: WriterOptions -> [Inline] -> JATS m (Doc Text)

}

-- | JATS writer type

{-# LANGUAGE PatternGuards #-}

{- |

Module : Text.Pandoc.Writers.Jira

License : GNU GPL, version 2 or above

Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

writeJira opts = runDefaultConverter (writerWrapText opts) (pandocToJira opts)

-- | State to keep track of footnotes.

-- | Initial converter state.

startState :: ConverterState

-- | Converter monad

type JiraConverter m = ReaderT WrapOption (StateT ConverterState m)

-> Text

-> JiraConverter m [Jira.Block]

toJiraCode (ident, classes, _attribs) code = do

-- | Creates a Jira definition list

toJiraDefinitionList :: PandocMonad m

toJiraPanel :: PandocMonad m

=> Attr -> [Block]

-> JiraConverter m [Jira.Block]

-- | Creates a Jira header

toJiraHeader :: PandocMonad m

| Just email <- T.stripPrefix "mailto:" url' = (Jira.Email, email)

| "user-account" `elem` classes = (Jira.User, dropTilde url)

| "attachment" `elem` classes = (Jira.Attachment, url)

| otherwise = (Jira.External, url)

dropTilde txt = case T.uncons txt of

Just ('~', username) -> username

spanToJira :: PandocMonad m

=> Attr -> [Inline]

-> JiraConverter m [Jira.Inline]

registerNotes :: PandocMonad m => [Block] -> JiraConverter m [Jira.Inline]

registerNotes contents = do

knownLanguages :: [Text]

knownLanguages =

[ "actionscript", "ada", "applescript", "bash", "c", "c#", "c++"

, "json", "lua", "nyan", "objc", "perl", "php", "python", "r", "ruby"

, "scala", "sql", "swift", "visualbasic", "xml", "yaml"

]

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE TupleSections #-}

{-# LANGUAGE PatternGuards #-}

{-# LANGUAGE ScopedTypeVariables #-}

{-# LANGUAGE ViewPatterns #-}

{- |

Module : Text.Pandoc.Writers.LaTeX

License : GNU GPL, version 2 or above

Maintainer : John MacFarlane <jgm@berkeley.edu>

writeLaTeX

, writeBeamer

) where

import Control.Monad.State.Strict

import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing)

import qualified Data.Map as M

import Data.Text (Text)

import Network.URI (unEscapeString)

import Text.DocTemplates (FromContext(lookupContext), renderTemplate,

Val(..), Context(..))

import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)

import Text.Pandoc.Definition

import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight,

import Text.Pandoc.ImageSize

import Text.Pandoc.Logging

import Text.Pandoc.Options

import Text.DocLayout

import Text.Pandoc.Shared

import Text.Pandoc.Slides

import Text.Pandoc.Writers.Shared

-- | Convert Pandoc to LaTeX.

writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text

evalStateT (pandocToLaTeX options document) $

(startingState options){ stBeamer = True }

pandocToLaTeX :: PandocMonad m

=> WriterOptions -> Pandoc -> LW m Text

pandocToLaTeX options (Pandoc meta blocks) = do

let dirs = query (extract "dir") blocks

let context = defField "toc" (writerTableOfContents options) $

defField "toc-depth" (tshow

(writerTOCDepth options -

defField "documentclass" documentClass $

defField "verbatim-in-note" (stVerbInNote st) $

defField "tables" (stTable st) $

defField "strikeout" (stStrikeout st) $

defField "url" (stUrl st) $

defField "numbersections" (writerNumberSections options) $

defField "has-chapters" (stHasChapters st) $

defField "has-frontmatter" (documentClass `elem` frontmatterClasses) $

defField "listings" (writerListings options || stLHS st) $

defField "beamer" beamer $

(if stHighlighting st

then case writerHighlightStyle options of

else id) $

(case writerCiteMethod options of

Natbib -> defField "biblio-title" biblioTitle .

Biblatex -> defField "biblio-title" biblioTitle .

_ -> id) $

defField "colorlinks" (any hasStringValue

["citecolor", "urlcolor", "linkcolor", "toccolor",

Nothing -> main

Just tpl -> renderTemplate tpl context'

toSlides :: PandocMonad m => [Block] -> LW m [Block]

toSlides bs = do

opts <- gets stOptions

=> Block -- ^ Block to convert

-> LW m (Doc Text)

blockToLaTeX Null = return empty

ref <- toLabel identifier

let anchor = if T.null identifier

then empty

braces (literal ref) <> braces empty

title' <- inlineListToLaTeX ils

contents <- blockListToLaTeX bs

blockToLaTeX (Div (identifier,"slide":dclasses,dkvs)

(Header _ (_,hclasses,hkvs) ils : bs)) = do

-- note: [fragile] is required or verbatim breaks

Just s -> braces (literal s))

$$ inner

$+$ "\\end{CSLReferences}"

modify $ \st -> st{ stIncremental = oldIncremental }

linkAnchor' <- hypertarget True identifier empty

let linkAnchor =

case bs of

Para _ : _

| not (isEmpty linkAnchor')

_ -> linkAnchor'

wrapNotes txt = if beamer && "notes" `elem` classes

then "\\note" <> braces txt -- speaker notes

blockToLaTeX (Para [Image attr@(ident, _, _) txt (src,tgt)])

| Just tit <- T.stripPrefix "fig:" tgt

= do

lab <- labelFor ident

let caption = "\\caption" <> captForLof <> braces capt <> lab

img <- inlineToLaTeX (Image attr txt (src,tit))

hdr <- sectionHeader classes id' level lst

modify $ \s -> s{stInHeading = False}

return hdr

blockListToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)

blockListToLaTeX lst =

vsep `fmap` mapM (\b -> setEmptyLine True >> blockToLaTeX b) lst

listItemToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)

listItemToLaTeX lst

-- we need to put some text before a header if it's the first

braces txtNoNotes

else empty

-- | Convert list of inline elements to LaTeX.

inlineListToLaTeX :: PandocMonad m

=> [Inline] -- ^ Inlines to convert

fixInitialLineBreaks xs

fixInitialLineBreaks xs = xs

-- | Convert inline element to LaTeX

inlineToLaTeX :: PandocMonad m

=> Inline -- ^ Inline to convert

inlineToLaTeX (Span (id',classes,kvs) ils) = do

linkAnchor <- hypertarget False id' empty

lang <- toLang $ lookup "lang" kvs

contents <- inlineListToLaTeX ils

inlineToLaTeX (Emph lst) = inCmd "emph" <$> inlineListToLaTeX lst

inlineToLaTeX (Underline lst) = inCmd "underline" <$> inlineListToLaTeX lst

inlineToLaTeX (Strong lst) = inCmd "textbf" <$> inlineListToLaTeX lst

st <- get

let opts = stOptions st

case writerCiteMethod opts of

_ -> inlineListToLaTeX lst

inlineToLaTeX (Code (_,classes,kvs) str) = do

let chr = case "!\"'()*,-./:;?@" \\ T.unpack str of

(c:_) -> c

[] -> '!'

-- we always put lstinline in a dummy 'passthrough' command

-- (defined in the default template) so that we don't have

-- to change the way we escape characters depending on whether

if isEnabled Ext_smart opts

then char '`' <> inner <> char '\''

else char '\x2018' <> inner <> char '\x2019'

inlineToLaTeX (Str str) = do

setEmptyLine False

liftM literal $ stringToLaTeX TextString str

inlineToLaTeX LineBreak = do

emptyLine <- gets stEmptyLine

setEmptyLine True

inlineToLaTeX SoftBreak = do

wrapText <- gets (writerWrapText . stOptions)

case wrapText of

setEmptyLine :: PandocMonad m => Bool -> LW m ()

setEmptyLine b = modify $ \st -> st{ stEmptyLine = b }

-- Extract a key from divs and spans

extract :: Text -> Block -> [Text]

extract key (Div attr _) = lookKey key attr

-- Look up a key in an attribute and give a list of its values

lookKey :: Text -> Attr -> [Text]

lookKey key (_,_,kvs) = maybe [] T.words $ lookup key kvs