content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  -- |
  -- 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
  --
  -- Scripting
  module Text.Pandoc.Filter.Plot.Scripting
    ( ScriptResult (..),
      runTempScript,
      runScriptIfNecessary,
      figurePath,
      sourceCodePath,
    )
  where
  
  import Control.Concurrent.MVar (withMVar)
  import Data.Default (def)
  import Data.Functor.Identity (Identity (..))
  import Data.Hashable (hash)
  import Data.Text (Text, pack, unpack)
  import qualified Data.Text as T
  import qualified Data.Text.IO as T
  import Paths_pandoc_plot (version)
  import System.Directory
    ( createDirectoryIfMissing,
      doesFileExist,
      getTemporaryDirectory,
    )
  import System.Exit (ExitCode (..))
  import System.FilePath
    ( addExtension,
      normalise,
      replaceExtension,
      takeBaseName,
      takeDirectory,
      (</>),
    )
  import Text.Pandoc.Class (runPure)
  import Text.Pandoc.Definition (Block (CodeBlock), Pandoc (Pandoc))
  import Text.Pandoc.Filter.Plot.Monad
  import Text.Pandoc.Filter.Plot.Scripting.Template
  import Text.Pandoc.Options (WriterOptions (..))
  import Text.Pandoc.SelfContained (makeSelfContained)
  import Text.Pandoc.Templates
  import Text.Pandoc.Writers (writeHtml5String)
  import Text.Printf (printf)
  
  -- Run script as described by the spec, only if necessary
  runScriptIfNecessary :: FigureSpec -> PlotM ScriptResult
  runScriptIfNecessary spec = do
    target <- figurePath spec
    liftIO $ createDirectoryIfMissing True . takeDirectory $ target
  
    fileAlreadyExists <- liftIO . doesFileExist $ target
    result <-
      if fileAlreadyExists
        then return ScriptSuccess
        else runTempScript spec
  
    logScriptResult result
  
    case result of
      ScriptSuccess -> writeSource spec >> return ScriptSuccess
      other -> return other
    where
      logScriptResult ScriptSuccess = return ()
      logScriptResult r = err . pack . show $ r
  
  -- | Possible result of running a script
  data ScriptResult
    = ScriptSuccess
    | ScriptChecksFailed Text -- Message
    | ScriptFailure Text Int Script -- Command, exit code, and source script
  
  instance Show ScriptResult where
    show ScriptSuccess = "Script success."
    show (ScriptChecksFailed msg) = unpack $ "Script checks failed: " <> msg
    show (ScriptFailure cmd ec s) = mconcat ["Command \"", unpack cmd, "\" failed with exit code ", show ec, ". The script source was: \n\n", unpack . formatScript $ s, "\n"]
  
  -- | Format a script to show in error messages
  formatScript :: Script -> Text
  formatScript s = T.unlines . fmap (uncurry formatLine) $ zip linenos (T.lines s)
    where
      nlines = length (T.lines s)
      linenos = [1 .. nlines]
  
      -- No version of ceil in Prelude, so 1 + floor will have to do
      maxdigits :: Int
      maxdigits = 1 + floor (logBase 10 (fromIntegral nlines :: Double))
  
      formatLine :: Int -> Text -> Text
      formatLine n l = pack (printf ("%" <> show maxdigits <> "d") n) <> " > " <> l
  
  -- Run script as described by the spec
  -- Checks are performed, according to the renderer
  -- Note that stdout from the script is suppressed, but not
  -- stderr.
  runTempScript :: FigureSpec -> PlotM ScriptResult
  runTempScript spec@FigureSpec {..} = do
    let checks = rendererChecks renderer_
        checkResult = mconcat $ checks <*> [script]
    case checkResult of
      CheckFailed msg -> return $ ScriptChecksFailed msg
      CheckPassed -> do
        scriptPath <- tempScriptPath spec
        target <- figurePath spec
        cwd <- asks envCWD
  
        let scriptWithCapture = rendererCapture renderer_ spec target
  
        -- Note the use of a lock. This is a crude solution for issue #53, where
        -- multiple identical figures can cause a race condition to write to the
        -- same output file.
        sem <- asks envIOLock
        liftIO $ withMVar sem $ \_ -> T.writeFile scriptPath scriptWithCapture
        let outputSpec =
              OutputSpec
                { oFigureSpec = spec,
                  oScriptPath = scriptPath,
                  oFigurePath = target,
                  oExecutable = fsExecutable,
                  oCWD = cwd
                }
        let command_ = rendererCommand renderer_ outputSpec
  
        -- It is important that the CWD be inherited from the
        -- parent process. See #2.
        (ec, _) <- runCommand cwd command_
        case ec of
          ExitSuccess -> return ScriptSuccess
          ExitFailure code -> return $ ScriptFailure command_ code script
  
  -- | Determine the temp script path from Figure specifications
  -- Note that for certain renderers, the appropriate file extension
  -- is important.
  tempScriptPath :: FigureSpec -> PlotM FilePath
  tempScriptPath fs@FigureSpec {..} = do
    let ext = rendererScriptExtension renderer_
    -- Note that this hash is only so that we are running scripts from unique
    -- file names; it does NOT determine whether this figure should
    -- be rendered or not.
    fp <- figurePath fs
    let hashedPath = takeBaseName fp <> ext
    liftIO $ (</> hashedPath) <$> getTemporaryDirectory
  
  -- | Determine the path to the source code that generated the figure.
  -- To ensure that the source code path is distinguished from HTML figures, we use the extension .src.html.
  sourceCodePath :: FigureSpec -> PlotM FilePath
  sourceCodePath = fmap (normalise . flip replaceExtension ".src.html") . figurePath
  
  -- | Hash of the content of a @FigureSpec@. Note that unlike usual hashes,
  -- two @FigureSpec@ with the same @figureContentHash@ does not mean that they are equal!
  --
  -- Not all parts of a FigureSpec are related to running code.
  -- For example, changing the caption should not require running the figure again.
  figureContentHash :: FigureSpec -> PlotM Word
  figureContentHash FigureSpec {..} = do
    dependenciesHash <- mapM fileHash dependencies
    -- hash looks strange because instances only exist for 7-tuples or less
    return $
      fromIntegral $
        hash
          ( ( fromEnum (rendererToolkit renderer_),
              script,
              fromEnum saveFormat,
              directory
            ),
            ( dpi,
              dependenciesHash,
              extraAttrs,
              show version -- Included version because capture scripts may change between releases
            )
          )
  
  -- | Determine the path a figure should have.
  -- The path for this file is unique to the content of the figure,
  -- so that @figurePath@ can be used to determine whether a figure should
  -- be rendered again or not.
  figurePath :: FigureSpec -> PlotM FilePath
  figurePath spec = do
    fh <- figureContentHash spec
    let ext = extension . saveFormat $ spec
        -- MATLAB will refuse to process files that don't start with
        -- a letter so it is simplest to use filenames that start
        -- with "pandocplot" throughout
        stem = flip addExtension ext . mappend "pandocplot" . show $ fh
    return $ normalise $ directory spec </> stem
  
  -- | Write the source code of a figure to an HTML file with appropriate syntax highlighting.
  writeSource :: FigureSpec -> PlotM ()
  writeSource spec = do
    let rdr = renderer_ spec
        language = rendererLanguage rdr
    scp <- sourceCodePath spec
    let doc = Pandoc mempty [CodeBlock (mempty, [language], mempty) (script spec)]
        renderSource = \template -> do
          let opts = def {writerTemplate = Just template}
              -- Note that making the document self-contained is absolutely required so that the CSS for
              -- syntax highlighting is included directly in the document.
              t = either (const mempty) id $ runPure (writeHtml5String opts doc >>= makeSelfContained)
  
          -- Note the use of a lock. This is a crude solution for issue #53, where
          -- multiple identical figures can cause a race condition to write to the
          -- same output file.
          sem <- asks envIOLock
          liftIO $ withMVar sem $ \_ -> T.writeFile scp t
  
    either (err . pack) renderSource $ runIdentity $ compileTemplate mempty sourceTemplate
  
  sourceTemplate :: Text
  sourceTemplate = pack $(sourceTemplate_)
  