diff --git a/src/Yesod/Content/PDF.hs b/src/Yesod/Content/PDF.hs --- a/src/Yesod/Content/PDF.hs +++ b/src/Yesod/Content/PDF.hs @@ -1,22 +1,49 @@ --- | Utilities for serving PDF from Yesod --- Uses and depends on command line utility wkhtmltopdf to render PDF from HTML +-- | Utilities for serving PDF from Yesod. +-- Uses and depends on command line utility wkhtmltopdf to render PDF from HTML. +module Yesod.Content.PDF + ( -- * Conversion + uri2PDF + , html2PDF + -- * Data type + , PDF(..) + , typePDF + -- * Options + , def + , WkhtmltopdfOptions + , wkCollate + , wkCopies + , wkGrayscale + , wkLowQuality + , wkPageSize + , wkOrientation + , wkTitle + , wkMarginBottom + , wkMarginLeft + , wkMarginRight + , wkMarginTop + , wkZoom + , PageSize(..) + , Orientation(..) + , UnitReal(..) + ) where -module Yesod.Content.PDF where import Prelude -import Yesod.Core.Content +import Blaze.ByteString.Builder.ByteString +import Control.Monad.IO.Class (MonadIO(..)) import Data.ByteString +import Data.Conduit +import Data.Default (Default(..)) +import Network.URI +import System.IO +import System.IO.Temp +import System.Process import Text.Blaze.Html import Text.Blaze.Html.Renderer.String -import Blaze.ByteString.Builder.ByteString -import System.Process -import System.IO.Temp -import System.IO -import Network.URI -import Data.Conduit +import Yesod.Core.Content newtype PDF = PDF ByteString --- | Provide MIME type "application/pdf" as a ContentType for Yesod +-- | Provide MIME type "application/pdf" as a ContentType for Yesod. typePDF :: ContentType typePDF = "application/pdf" @@ -30,27 +57,132 @@ toContent (PDF bs) = ContentSource $ do yield $ Chunk $ fromByteString bs --- | Use wkhtmltopdf to render a PDF given the URI pointing to an HTML document -uri2PDF :: URI -> IO PDF -uri2PDF uri = withSystemTempFile "output.pdf" $ uri2PDF' uri - where - uri2PDF' :: URI -> FilePath -> Handle -> IO PDF - uri2PDF' uri' tempPDFFile tempHandle = do - hClose tempHandle - (_,_,_, pHandle) <- createProcess (proc "wkhtmltopdf" ["--quiet", show uri', tempPDFFile]) +-- | Use wkhtmltopdf to render a PDF given the URI pointing to an HTML document. +uri2PDF :: MonadIO m => WkhtmltopdfOptions -> URI -> m PDF +uri2PDF opts = wkhtmltopdf opts . flip ($) . show + +-- | Use wkhtmltopdf to render a PDF from an HTML (Text.Blaze.Html) type. +html2PDF :: MonadIO m => WkhtmltopdfOptions -> Html -> m PDF +html2PDF opts html = + wkhtmltopdf opts $ \inner -> + withSystemTempFile "input.html" $ \tempHtmlFp tempHtmlHandle -> do + System.IO.hPutStrLn tempHtmlHandle $ renderHtml html + hClose tempHtmlHandle + inner tempHtmlFp + +-- | (Internal) Call wkhtmltopdf. +wkhtmltopdf :: MonadIO m => WkhtmltopdfOptions -> ((String -> IO PDF) -> IO PDF) -> m PDF +wkhtmltopdf opts setupInput = + liftIO $ + withSystemTempFile "output.pdf" $ \tempOutputFp tempOutputHandle -> do + hClose tempOutputHandle + setupInput $ \inputArg -> do + let args = toArgs opts ++ [inputArg, tempOutputFp] + (_, _, _, pHandle) <- createProcess (proc "wkhtmltopdf" args) _ <- waitForProcess pHandle - PDF <$> Data.ByteString.readFile tempPDFFile + PDF <$> Data.ByteString.readFile tempOutputFp --- | Use wkhtmltopdf to render a PDF from an HTML (Text.Blaze.Html) type -html2PDF :: Html -> IO PDF -html2PDF html = withSystemTempFile "output.pdf" (html2PDF' html) - where - html2PDF' :: Html -> FilePath -> Handle -> IO PDF - html2PDF' html' tempPDFFile tempPDFHandle = do - hClose tempPDFHandle - withSystemTempFile "input.html" $ \tempHtmlFile tempHtmlHandle -> do - System.IO.hPutStrLn tempHtmlHandle $ renderHtml html' - hClose tempHtmlHandle - (_,_,_, pHandle) <- createProcess (proc "wkhtmltopdf" ["--quiet", tempHtmlFile, tempPDFFile]) - _ <- waitForProcess pHandle - PDF <$> Data.ByteString.readFile tempPDFFile +-- | Options passed to wkhtmltopdf. Please use the 'def' value +-- and then modify individual settings. For more information, see +-- . +data WkhtmltopdfOptions = + WkhtmltopdfOptions + { wkCollate :: Bool + -- ^ Collate when printing multiple copies. + , wkCopies :: Int + -- ^ Number of copies to print into the PDF file. + , wkGrayscale :: Bool + -- ^ Whether output PDF should be in grayscale. + , wkLowQuality :: Bool + -- ^ Generate lower quality output to conserve space. + , wkPageSize :: PageSize + -- ^ Page size (e.g. "A4", "Letter"). + , wkOrientation :: Orientation + -- ^ Orientation of the output. + , wkTitle :: Maybe String + -- ^ Title of the generated PDF file. + , wkMarginBottom :: UnitReal + -- ^ Bottom margin size. + , wkMarginLeft :: UnitReal + -- ^ Left margin size. + , wkMarginRight :: UnitReal + -- ^ Right margin size. + , wkMarginTop :: UnitReal + -- ^ Top margin size. + , wkZoom :: Double + -- ^ Zoom factor. + } deriving (Eq, Ord, Show) + +instance Default WkhtmltopdfOptions where + def = WkhtmltopdfOptions + { wkCollate = True + , wkCopies = 1 + , wkGrayscale = False + , wkLowQuality = False + , wkPageSize = A4 + , wkOrientation = Portrait + , wkTitle = Nothing + , wkMarginBottom = Mm 10 + , wkMarginLeft = Mm 0 + , wkMarginRight = Mm 0 + , wkMarginTop = Mm 10 + , wkZoom = 1 + } + +-- | Cf. 'wkPageSize'. +data PageSize = + A4 + | Letter + | OtherPageSize String -- ^ . + | CustomPageSize UnitReal UnitReal -- ^ Height and width. + deriving (Eq, Ord, Show) + +-- | Cf. 'wkOrientation'. +data Orientation = + Portrait + | Landscape + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | A unit of measure. +data UnitReal = + Mm Double + | Cm Double + | OtherUnitReal String + deriving (Eq, Ord, Show) + +-- | (Internal) Convert options to arguments. +class ToArgs a where + toArgs :: a -> [String] + +instance ToArgs WkhtmltopdfOptions where + toArgs opts = + [ "--quiet" + , if wkCollate opts then "--collate" else "--no-collate" + , "--copies", show (wkCopies opts) + , "--zoom", show (wkZoom opts) + ] ++ + Prelude.concat + [ [ "--grayscale" | True <- [wkGrayscale opts] ] + , [ "--lowquality" | True <- [wkLowQuality opts] ] + , toArgs (wkPageSize opts) + , toArgs (wkOrientation opts) + , maybe [] (\t -> ["--title", t]) (wkTitle opts) + , "--margin-bottom" : toArgs (wkMarginBottom opts) + , "--margin-left" : toArgs (wkMarginLeft opts) + , "--margin-right" : toArgs (wkMarginRight opts) + , "--margin-top" : toArgs (wkMarginTop opts) + ] + +instance ToArgs PageSize where + toArgs A4 = ["--page-size", "A4"] + toArgs Letter = ["--page-size", "Letter"] + toArgs (OtherPageSize s) = ["--page-size", s] + toArgs (CustomPageSize h w) = ("--page-height" : toArgs h) ++ ("--page-width" : toArgs w) + +instance ToArgs Orientation where + toArgs o = ["--orientation", show o] + +instance ToArgs UnitReal where + toArgs (Mm x) = [show x ++ "mm"] + toArgs (Cm x) = [show x ++ "cm"] + toArgs (OtherUnitReal s) = [s] diff --git a/yesod-content-pdf.cabal b/yesod-content-pdf.cabal --- a/yesod-content-pdf.cabal +++ b/yesod-content-pdf.cabal @@ -1,5 +1,5 @@ name: yesod-content-pdf -version: 0.1.0.2 +version: 0.2.0.0 synopsis: PDF Content Type for Yesod description: Please see README.md homepage: https://github.com/alexkyllo/yesod-content-pdf#readme @@ -30,6 +30,8 @@ , temporary , yesod-core , conduit + , data-default + , transformers default-language: Haskell2010