{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
-- |
-- Module : $header$
-- Copyright : (c) Laurent P René de Cotret, 2019 - present
-- License : GNU GPL, version 2 or above
-- Maintainer : laurent.decotret@outlook.com
-- Stability : internal
-- Portability : portable
--
-- Embedding HTML and LaTeX content
module Text.Pandoc.Filter.Plot.Embed
( extractPlot,
toFigure,
)
where
import Data.Default (def)
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import qualified Data.Text.IO as T
import Text.HTML.TagSoup
( Tag (TagClose, TagOpen),
canonicalizeTags,
parseOptionsFast,
parseTagsOptions,
partitions,
renderTags,
(~/=),
(~==),
)
import Text.Pandoc.Builder as Builder
( Inlines,
fromList,
figureWith,
imageWith,
plain,
link,
str,
simpleCaption,
toList,
)
import Text.Pandoc.Class (runPure)
import Text.Pandoc.Definition (Attr, Block (..), Format, Pandoc (..))
import Text.Pandoc.Error (handleError)
import Text.Pandoc.Filter.Plot.Monad
import Text.Pandoc.Filter.Plot.Parse (captionReader)
import Text.Pandoc.Filter.Plot.Scripting (figurePath, sourceCodePath)
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Writers.LaTeX (writeLaTeX)
import Text.Shakespeare.Text (st)
-- | Convert a @FigureSpec@ to a Pandoc figure component.
-- Note that the script to generate figure files must still
-- be run in another function.
toFigure ::
-- | text format of the caption
Format ->
FigureSpec ->
PlotM Block
toFigure fmt spec = do
target <- figurePath spec
scp <- pack <$> sourceCodePath spec
sourceLabel <- asksConfig sourceCodeLabel -- Allow the possibility for non-english labels
let srcLink = link scp mempty (str sourceLabel)
attrs' = blockAttrs spec
captionText = fromList $ fromMaybe mempty (captionReader fmt $ caption spec)
captionLinks = mconcat [" (", srcLink, ")"]
caption' = if withSource spec then captionText <> captionLinks else captionText
builder attrs' target caption'
where
builder = case saveFormat spec of
HTML -> interactiveBlock
LaTeX -> latexInput
_ -> figure
figure ::
Attr ->
FilePath ->
Inlines ->
PlotM Block
figure as fp caption' =
return . head . toList $
-- We want the attributes both on the Figure element and the contained Image element
-- so that pandoc-plot plays nice with pandoc-crossref and other filters
figureWith as (simpleCaption (plain caption')) $ plain $ imageWith mempty (pack fp) mempty caption'
-- TODO: also add the case where SVG plots can be
-- embedded in HTML output
-- embeddedSVGBlock ::
-- Attr ->
-- FilePath ->
-- Inlines ->
-- PlotM Block
-- embeddedSVGBlock _ fp caption' = do
-- svgsource <- liftIO $ T.readFile fp
-- renderedCaption <- writeHtml caption'
-- return $
-- RawBlock
-- "html5"
-- [st|
--