module Text.PDF.Slave.Render(
PDFContent
, PDFRenderException(..)
, displayPDFRenderException
, renderBundleOrTemplateFromFile
, renderFromFileBundleToPDF
, renderFromFileToPDF
, renderBundleToPDF
, renderTemplateToPDF
, loadTemplateInMemory
, storeTemplateInFiles
, DepFlags
, DepFlag(..)
, renderPdfTemplate
, renderTemplate
, renderTemplateDep
, parseBundleOrTemplate
, parseBundleOrTemplateFromFile
) where
import Control.Monad (join, forM_)
import Control.Monad.Catch
import Data.Aeson (Value(..))
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Set (Set)
import Data.Yaml (ParseException, decodeEither')
import Filesystem.Path (dropExtension, directory)
import GHC.Generics
import Prelude hiding (FilePath)
import Shelly
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BZ
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as H
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Text.PDF.Slave.Template
type PDFContent = ByteString
data PDFRenderException =
TemplateFormatError FilePath ParseException
| BundleFormatError FilePath ParseException
| BundleOrTemplateFormatError FilePath ParseException ParseException
| InputFileFormatError FilePath String
deriving (Generic, Show)
instance Exception PDFRenderException
displayPDFRenderException :: PDFRenderException -> String
displayPDFRenderException e = case e of
TemplateFormatError f pe -> "Failed to parse template file " <> show f
<> ", reason: " <> show pe
BundleFormatError f pe -> "Failed to parse template bundle file " <> show f
<> ", reason: " <> show pe
BundleOrTemplateFormatError f peBundle peTemplate -> "Failed to parse template file " <> show f <> ". "
<> "\n Tried bundle format: " <> show peBundle
<> "\n Tried template format: " <> show peTemplate
InputFileFormatError f es -> "Failed to parse template input file " <> show f
<> ", reason: " <> show es
renderBundleOrTemplateFromFile ::
FilePath
-> Maybe Value
-> Sh PDFContent
renderBundleOrTemplateFromFile filename bundleInput = do
res <- parseBundleOrTemplateFromFile filename
let baseDir = directory filename
case res of
Left bundle -> do
let bundle' = fromMaybe bundle $ fmap (\i -> bundle { templateInput = Just i }) bundleInput
renderBundleToPDF bundle'
Right template -> renderTemplateToPDF template baseDir
parseBundleOrTemplateFromFile :: FilePath
-> Sh (Either Template TemplateFile)
parseBundleOrTemplateFromFile filename =
parseBundleOrTemplate filename =<< readBinary filename
parseBundleOrTemplate :: FilePath
-> ByteString
-> Sh (Either Template TemplateFile)
parseBundleOrTemplate filename cnt = case decodeEither' cnt of
Right bundle -> return $ Left bundle
Left eBundle -> case decodeEither' cnt of
Right template -> return $ Right template
Left eTemplate -> throwM $ BundleOrTemplateFormatError filename eBundle eTemplate
renderFromFileBundleToPDF :: FilePath
-> Maybe Value
-> Sh PDFContent
renderFromFileBundleToPDF filename bundleInput = do
cnt <- readBinary filename
case decodeEither' cnt of
Left e -> throwM $ BundleFormatError filename e
Right bundle -> do
let bundle' = fromMaybe bundle $ fmap (\i -> bundle { templateInput = Just i }) bundleInput
renderBundleToPDF bundle'
renderFromFileToPDF :: FilePath
-> Sh PDFContent
renderFromFileToPDF filename = do
cnt <- readBinary filename
case decodeEither' cnt of
Left e -> throwM $ TemplateFormatError filename e
Right template -> renderTemplateToPDF template (directory filename)
renderBundleToPDF :: Template
-> Sh PDFContent
renderBundleToPDF bundle = withTmpDir $ \unpackDir -> do
template <- storeTemplateInFiles bundle unpackDir
renderTemplateToPDF template unpackDir
renderTemplateToPDF :: TemplateFile
-> FilePath
-> Sh PDFContent
renderTemplateToPDF t@TemplateFile{..} baseDir = withTmpDir $ \outputFolder -> do
minput <- case templateFileInput of
Nothing -> return Nothing
Just inputName -> do
let inputNamePath = fromText inputName
cnt <- readBinary (baseDir </> inputNamePath)
case A.eitherDecode' . BZ.fromStrict $ cnt of
Left e -> throwM $ InputFileFormatError inputNamePath e
Right a -> return $ Just a
renderPdfTemplate minput t baseDir outputFolder
readBinary (outputFolder </> templateFileName <.> "pdf")
renderPdfTemplate :: Maybe Value
-> TemplateFile
-> FilePath
-> FilePath
-> Sh ()
renderPdfTemplate minput t@TemplateFile{..} baseDir outputFolder = do
flags <- renderTemplate minput t baseDir outputFolder
let pdflatex = bash "pdflatex" [
"-synctex=1"
, "-interaction=nonstopmode"
, toTextArg $ templateFileName <.> "tex" ]
bibtex = bash "bibtex" [
toTextArg $ templateFileName <.> "aux" ]
chdir outputFolder $ do
_ <- if S.member NeedBibtex flags
then pdflatex -|- bibtex -|- pdflatex -|- pdflatex
else pdflatex
return ()
renderTemplate :: Maybe Value
-> TemplateFile
-> FilePath
-> FilePath
-> Sh DepFlags
renderTemplate minput TemplateFile{..} baseDir outputFolder = do
mkdir_p outputFolder
let renderDepenency = renderTemplateDep minput baseDir outputFolder
depFlags <- M.traverseWithKey renderDepenency templateFileDeps
let
bodyName = dropExtension (fromText templateFileBody)
haskintex = bash "haskintex" $ [
"-overwrite"
, "-verbose"
, "-werror"
, toTextArg $ baseDir </> bodyName ]
++ templateFileHaskintexOpts
let outputFixedInputName = outputFolder </> (templateFileName <> "_input") <.> "json"
case templateFileInput of
Nothing -> whenJust minput $ \input -> do
writeBinary outputFixedInputName $ BZ.toStrict . A.encode $ input
Just inputName -> do
let inputPath = baseDir </> inputName
let outputInputPaths = [outputFolder </> inputName, outputFixedInputName]
forM_ outputInputPaths $ cp inputPath
_ <- chdir outputFolder haskintex
return $ F.foldMap id depFlags
type DepFlags = Set DepFlag
data DepFlag = NeedBibtex
deriving (Generic, Show, Ord, Eq)
renderTemplateDep :: Maybe Value
-> FilePath
-> FilePath
-> TemplateName
-> TemplateDependencyFile
-> Sh DepFlags
renderTemplateDep minput baseDir outputFolder name dep = case dep of
BibtexDepFile -> do
let file = fromText name
outputFile = outputFolder </> file
mkdir_p (directory outputFile)
cp (baseDir </> file) outputFile
return $ S.singleton NeedBibtex
TemplateDepFile template -> do
let subFolder = baseDir </> fromText name
outputSubFolder = outputFolder </> fromText name
renderTemplate minput' template subFolder outputSubFolder
TemplatePdfDepFile template -> do
let subFolder = baseDir </> fromText name
outputSubFolder = outputFolder </> fromText name
renderPdfTemplate minput' template subFolder outputSubFolder
return mempty
OtherDepFile -> do
let file = fromText name
outputFile = outputFolder </> file
mkdir_p (directory outputFile)
cp (baseDir </> file) outputFile
return mempty
where
minput' :: Maybe Value
minput' = join $ flip fmap minput $ \case
Object o -> H.lookup name o
_ -> Nothing
whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f ()
whenJust Nothing _ = pure ()
whenJust (Just a) f = f a
loadTemplateInMemory :: TemplateFile -> FilePath -> Sh (Either String Template)
loadTemplateInMemory TemplateFile{..} baseDir = do
inputCnt <- case templateFileInput of
Nothing -> return $ Right Nothing
Just fname -> do
cnt <- readBinary $ baseDir </> fromText fname
return $ fmap Just . A.eitherDecode' . BZ.fromStrict $ cnt
body <- readfile $ baseDir </> fromText templateFileBody
deps <- M.traverseWithKey loadDep templateFileDeps
return $ Template
<$> pure templateFileName
<*> inputCnt
<*> pure body
<*> sequence deps
<*> pure templateFileHaskintexOpts
where
loadDep name d = let
filename = baseDir </> fromText name
in case d of
BibtexDepFile -> do
cnt <- readfile filename
return . pure $ BibtexDep cnt
TemplateDepFile body -> do
tmpl <- loadTemplateInMemory body filename
return $ TemplateDep <$> tmpl
TemplatePdfDepFile body -> do
tmpl <- loadTemplateInMemory body filename
return $ TemplatePdfDep <$> tmpl
OtherDepFile -> do
cnt <- readBinary filename
return . pure $ OtherDep cnt
storeTemplateInFiles :: Template -> FilePath -> Sh TemplateFile
storeTemplateInFiles Template{..} folder = do
mkdir_p folder
relInputName <- case templateInput of
Nothing -> return Nothing
Just input -> do
let inputName = folder </> (templateName <> "_input") <.> "json"
writeBinary inputName $ BZ.toStrict $ A.encode input
fmap Just $ relativeTo folder inputName
let bodyName = folder </> templateName <.> "htex"
mkdir_p $ directory bodyName
writefile bodyName templateBody
relBodyName <- relativeTo folder bodyName
deps <- M.traverseWithKey storeDep templateDeps
return $ TemplateFile {
templateFileName = templateName
, templateFileInput = fmap toTextIgnore relInputName
, templateFileBody = toTextIgnore relBodyName
, templateFileDeps = deps
, templateFileHaskintexOpts = templateHaskintexOpts
}
where
storeDep name d = case d of
BibtexDep body -> do
let bodyName = folder </> name
mkdir_p $ directory bodyName
writefile bodyName body
return BibtexDepFile
TemplateDep template -> do
let subfolderName = folder </> fromText name
mkdir_p subfolderName
dep <- storeTemplateInFiles template subfolderName
return $ TemplateDepFile dep
TemplatePdfDep template -> do
let subfolderName = folder </> fromText name
mkdir_p subfolderName
dep <- storeTemplateInFiles template subfolderName
return $ TemplatePdfDepFile dep
OtherDep body -> do
let bodyName = folder </> name
mkdir_p $ directory bodyName
writeBinary bodyName body
return OtherDepFile