{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- |
-- Module      : $header$
-- Copyright   : (c) Laurent P René de Cotret, 2019 - present
-- License     : GNU GPL, version 2 or above
-- Maintainer  : [email protected]
-- Stability   : internal
-- Portability : portable
--
-- Rendering PlantUML markup
module Text.Pandoc.Filter.Plot.Renderers.PlantUML
  ( plantuml,
    plantumlSupportedSaveFormats,
  )
where

import Data.Char
import System.FilePath (takeDirectory, (</>))
import Text.Pandoc.Filter.Plot.Renderers.Prelude

plantuml :: PlotM Renderer
plantuml :: PlotM Renderer
plantuml = do
  cmdargs <- (Configuration -> Text) -> PlotM Text
forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> Text
plantumlCmdArgs
  return
    $ Renderer
      { rendererToolkit = PlantUML,
        rendererCapture = plantumlCapture,
        rendererCommand = plantumlCommand cmdargs,
        rendererAvailability = CommandSuccess $ \Executable
exe -> [st|#{pathToExe exe} #{cmdargs} -h|],
        rendererSupportedSaveFormats = plantumlSupportedSaveFormats,
        rendererChecks = mempty,
        rendererLanguage = "plantuml",
        rendererComment = mappend "' ",
        rendererScriptExtension = ".txt"
      }

plantumlSupportedSaveFormats :: [SaveFormat]
plantumlSupportedSaveFormats :: [SaveFormat]
plantumlSupportedSaveFormats = [SaveFormat
PNG, SaveFormat
PDF, SaveFormat
SVG]

plantumlCommand :: Text -> OutputSpec -> Text
plantumlCommand :: Text -> OutputSpec -> Text
plantumlCommand Text
cmdargs OutputSpec {FilePath
FigureSpec
Executable
oFigureSpec :: FigureSpec
oScriptPath :: FilePath
oFigurePath :: FilePath
oExecutable :: Executable
oCWD :: FilePath
oCWD :: OutputSpec -> FilePath
oExecutable :: OutputSpec -> Executable
oFigurePath :: OutputSpec -> FilePath
oScriptPath :: OutputSpec -> FilePath
oFigureSpec :: OutputSpec -> FigureSpec
..} =
  let fmt :: FilePath
fmt = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower (FilePath -> FilePath)
-> (FigureSpec -> FilePath) -> FigureSpec -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SaveFormat -> FilePath
forall a. Show a => a -> FilePath
show (SaveFormat -> FilePath)
-> (FigureSpec -> SaveFormat) -> FigureSpec -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FigureSpec -> SaveFormat
saveFormat (FigureSpec -> FilePath) -> FigureSpec -> FilePath
forall a b. (a -> b) -> a -> b
$ FigureSpec
oFigureSpec
      dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
oFigurePath
   in -- the command below works as long as the script name is the same basename
      -- as the target figure path. E.g.: script basename of pandocplot123456789.txt
      -- will result in pandocplot123456789.(extension)
      [st|#{pathToExe oExecutable} #{cmdargs} -t#{fmt} -output "#{oCWD </> dir}" "#{normalizePath oScriptPath}"|]

normalizePath :: String -> String
normalizePath :: FilePath -> FilePath
normalizePath = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f
  where
    f :: Char -> Char
f Char
'\\' = Char
'/'
    f Char
x = Char
x

-- PlantUML export is entirely based on command-line arguments
-- so there is no need to modify the script itself.
plantumlCapture :: FigureSpec -> FilePath -> Script
plantumlCapture :: FigureSpec -> FilePath -> Text
plantumlCapture FigureSpec {Bool
Int
FilePath
[FilePath]
[(Text, Text)]
Attr
Text
Renderer
SaveFormat
Executable
saveFormat :: FigureSpec -> SaveFormat
renderer_ :: Renderer
fsExecutable :: Executable
caption :: Text
withSource :: Bool
script :: Text
saveFormat :: SaveFormat
directory :: FilePath
dpi :: Int
dependencies :: [FilePath]
extraAttrs :: [(Text, Text)]
blockAttrs :: Attr
blockAttrs :: FigureSpec -> Attr
extraAttrs :: FigureSpec -> [(Text, Text)]
dependencies :: FigureSpec -> [FilePath]
dpi :: FigureSpec -> Int
directory :: FigureSpec -> FilePath
script :: FigureSpec -> Text
withSource :: FigureSpec -> Bool
caption :: FigureSpec -> Text
fsExecutable :: FigureSpec -> Executable
renderer_ :: FigureSpec -> Renderer
..} FilePath
_ = Text
script