{-# 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 :: Format -> FigureSpec -> PlotM Block
toFigure Format
fmt FigureSpec
spec = do
  String
target <- FigureSpec -> PlotM String
figurePath FigureSpec
spec
  Text
scp <- String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FigureSpec -> PlotM String
sourceCodePath FigureSpec
spec
  Text
sourceLabel <- forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> Text
sourceCodeLabel -- Allow the possibility for non-english labels
  let srcLink :: Inlines
srcLink = Text -> Text -> Inlines -> Inlines
link Text
scp forall a. Monoid a => a
mempty (Text -> Inlines
str Text
sourceLabel)
      attrs' :: Attr
attrs' = FigureSpec -> Attr
blockAttrs FigureSpec
spec
      captionText :: Inlines
captionText = forall a. [a] -> Many a
fromList forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (Format -> Text -> Maybe [Inline]
captionReader Format
fmt forall a b. (a -> b) -> a -> b
$ FigureSpec -> Text
caption FigureSpec
spec)
      captionLinks :: Inlines
captionLinks = forall a. Monoid a => [a] -> a
mconcat [Inlines
" (", Inlines
srcLink, Inlines
")"]
      caption' :: Inlines
caption' = if FigureSpec -> Bool
withSource FigureSpec
spec then Inlines
captionText forall a. Semigroup a => a -> a -> a
<> Inlines
captionLinks else Inlines
captionText
  Attr -> String -> Inlines -> PlotM Block
builder Attr
attrs' String
target Inlines
caption'
  where
    builder :: Attr -> String -> Inlines -> PlotM Block
builder = case FigureSpec -> SaveFormat
saveFormat FigureSpec
spec of
      SaveFormat
HTML -> Attr -> String -> Inlines -> PlotM Block
interactiveBlock
      SaveFormat
LaTeX -> Attr -> String -> Inlines -> PlotM Block
latexInput
      SaveFormat
_ -> Attr -> String -> Inlines -> PlotM Block
figure

figure ::
  Attr ->
  FilePath ->
  Inlines ->
  PlotM Block
figure :: Attr -> String -> Inlines -> PlotM Block
figure Attr
as String
fp Inlines
caption' =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
toList forall a b. (a -> b) -> a -> b
$
    -- 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
    Attr -> Caption -> Many Block -> Many Block
figureWith Attr
as (Many Block -> Caption
simpleCaption (Inlines -> Many Block
plain Inlines
caption')) forall a b. (a -> b) -> a -> b
$ Inlines -> Many Block
plain forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith forall a. Monoid a => a
mempty (String -> Text
pack String
fp) forall a. Monoid a => a
mempty Inlines
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|
-- <figure>
--     <svg>
--     #{svgsource}
--     </svg>
--     <figcaption>#{renderedCaption}</figcaption>
-- </figure>
--     |]

latexInput :: Attr -> FilePath -> Inlines -> PlotM Block
latexInput :: Attr -> String -> Inlines -> PlotM Block
latexInput Attr
_ String
fp Inlines
caption' = do
  Text
renderedCaption' <- Inlines -> StateT PlotState (ReaderT RuntimeEnv IO) Text
writeLatex Inlines
caption'
  let renderedCaption :: Text
renderedCaption =
        if Text
renderedCaption' forall a. Eq a => a -> a -> Bool
/= Text
""
          then [st|\caption{#{renderedCaption'}}|]
          else Text
""
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    Format -> Text -> Block
RawBlock
      Format
"latex"
      [st|
    \begin{figure}
        \centering
        \input{#{pack $ normalizePath $ fp}}
        #{renderedCaption}
    \end{figure}
        |]
  where
    normalizePath :: String -> String
normalizePath = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f
      where
        f :: Char -> Char
f Char
'\\' = Char
'/'
        f Char
x = Char
x

interactiveBlock ::
  Attr ->
  FilePath ->
  Inlines ->
  PlotM Block
interactiveBlock :: Attr -> String -> Inlines -> PlotM Block
interactiveBlock Attr
_ String
fp Inlines
caption' = do
  -- TODO: should we instead include the scripts in the "include-after"
  --       template variable?
  --       See https://github.com/jgm/pandoc/issues/6582
  Text
htmlpage <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
fp
  Text
renderedCaption <- Inlines -> StateT PlotState (ReaderT RuntimeEnv IO) Text
writeHtml Inlines
caption'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    Format -> Text -> Block
RawBlock
      Format
"html5"
      [st|
<figure>
    <div>
    #{extractPlot htmlpage}
    </div>
    <figcaption>#{renderedCaption}</figcaption>
</figure>
    |]

-- | Convert Pandoc inlines to html
writeHtml :: Inlines -> PlotM Text
writeHtml :: Inlines -> StateT PlotState (ReaderT RuntimeEnv IO) Text
writeHtml Inlines
is = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Either PandocError a -> IO a
handleError forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
runPure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String forall a. Default a => a
def Pandoc
document
  where
    document :: Pandoc
document = Meta -> [Block] -> Pandoc
Pandoc forall a. Monoid a => a
mempty [[Inline] -> Block
Para forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Inlines
is]

writeLatex :: Inlines -> PlotM Text
writeLatex :: Inlines -> StateT PlotState (ReaderT RuntimeEnv IO) Text
writeLatex Inlines
is = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Either PandocError a -> IO a
handleError forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
runPure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX forall a. Default a => a
def Pandoc
document
  where
    document :: Pandoc
document = Meta -> [Block] -> Pandoc
Pandoc forall a. Monoid a => a
mempty [[Inline] -> Block
Para forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Inlines
is]

-- | Extract the plot-relevant content from inside of a full HTML document.
-- Scripts contained in the <head> tag are extracted, as well as the entirety of the
-- <body> tag.
extractPlot :: Text -> Text
extractPlot :: Text -> Text
extractPlot Text
t =
  let tags :: [Tag Text]
tags = forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions forall str. StringLike str => ParseOptions str
parseOptionsFast Text
t
      extracted :: [[Tag Text]]
extracted = [Tag Text] -> [[Tag Text]]
headScripts [Tag Text]
tags forall a. Semigroup a => a -> a -> a
<> [Text -> [Tag Text] -> [Tag Text]
inside Text
"body" [Tag Text]
tags]
      -- In the past (e.g. commit 8417b011ccb20263427822c7447840ab4a30a41e), we used to
      -- make all JS scripts 'deferred'. This turned out to be problematic for plotly 
      -- specifically (see issue #39). In the future, we may want to defer scripts for
      -- certain toolkits, but that's a testing nightmare...
   in forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => [Tag str] -> str
renderTags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Tag Text]]
extracted
  where
    headScripts :: [Tag Text] -> [[Tag Text]]
headScripts = forall a. (a -> Bool) -> [a] -> [[a]]
partitions (forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== (String
"<script>" :: String)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Tag Text] -> [Tag Text]
inside Text
"head"

-- | Get content inside a tag, e.g. /inside "body"/ returns all tags
-- between /<body>/ and /</body>/
inside :: Text -> [Tag Text] -> [Tag Text]
inside :: Text -> [Tag Text] -> [Tag Text]
inside Text
t = forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> [Tag Text]
tgs
  where
    tgs :: [Tag Text] -> [Tag Text]
tgs = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~/= forall str. str -> Tag str
TagClose Text
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~/= forall str. str -> [Attribute str] -> Tag str
TagOpen Text
t [])