module Text.PDF.Slave.Render(
PDFContent
, PDFRenderException(..)
, displayPDFRenderException
, renderBundleOrTemplateFromFile
, renderFromFileBundleToPDF
, renderFromFileToPDF
, renderBundleToPDF
, renderTemplateToPDF
, DepFlags
, DepFlag(..)
, renderPdfTemplate
, renderTemplate
, renderTemplateDep
, parseBundleOrTemplate
, parseBundleOrTemplateFromFile
) where
import Control.Monad (join)
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' baseDir
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' (directory filename)
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
-> FilePath
-> Sh PDFContent
renderBundleToPDF bundle baseDir = withTmpDir $ \unpackDir -> do
template <- storeTemplateInFiles bundle unpackDir
renderTemplateToPDF template baseDir
renderTemplateToPDF :: TemplateFile
-> FilePath
-> Sh PDFContent
renderTemplateToPDF t@TemplateFile{..} baseDir = withTmpDir $ \outputFolder -> do
minput <- case templateFileInput of
Nothing -> return Nothing
Just inputName -> do
cnt <- readBinary inputName
case A.eitherDecode' . BZ.fromStrict $ cnt of
Left e -> throwM $ InputFileFormatError inputName 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 templateFileBody
haskintex = bash "haskintex" $ [
"-overwrite"
, "-verbose"
, toTextArg $ baseDir </> bodyName ]
++ templateFileHaskintexOpts
case templateFileInput of
Nothing -> whenJust minput $ \input -> do
let filename = outputFolder </> (templateFileName <> "_input") <.> "json"
writeBinary filename $ BZ.toStrict . A.encode $ input
Just inputName -> do
let inputPath = baseDir </> inputName
cp inputPath $ outputFolder </> inputName
_ <- 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