packages feed

document-build-0.1.0.0: src/Document/Build/Pdf.hs

{-# OPTIONS_GHC -Wall #-}

{- | Commands that operate on PDF files.

These run @pdfinfo@ (poppler-utils), @pdftk@, @pdftocairo@ (poppler-utils)
and @convert@ (ImageMagick).
-}
module Document.Build.Pdf (
  -- * Information
  pdfPages,
  pdfPageCountFile,
  parsePdfinfoPages,

  -- * Pages
  pdfSelect,
  pdfPage,
  pdfFirstPage,
  pdfSplit,
  pdfBurst,
  pdfJoin,
  pdfConcatenate,
  pdftk,

  -- * Images
  pdfToImages,
  pdfToPng,
  pdfToJpg,
  pdfToGif,
  pdfToSvg,
  pdfToSvgImages,
  pageImagePaths,
) where

import Control.Lens (preview, view, _Wrapped, _head)
import Control.Monad.Trans.Class (lift)
import Data.List (sort)
import Data.Maybe (mapMaybe)
import qualified Data.Text as Text
import Document.Build.Build (Command, createParentDirectory, expectOutput, failBuild, io, process, processIn, requireDirectory, requireInput)
import Document.Build.Error (BuildError (..), CommandLine (..), ReviewBuildError)
import Document.Build.File (writeUtf8)
import System.Directory (createDirectoryIfMissing, doesFileExist, listDirectory, makeAbsolute, removePathForcibly)
import System.FilePath (equalFilePath, splitExtension, takeBaseName, takeDirectory, takeFileName, (<.>), (</>))
import System.FilePather.Combinators (hasExtension, onFile)
import Text.Read (readMaybe)

{- | The number of pages in the PDF file being operated on, using @pdfinfo@.

@since 0.1.0.0
-}
pdfPages :: (ReviewBuildError e) => Command e Int
pdfPages =
  do
    i <- requireInput
    let c = CommandLine "pdfinfo" [i]
    o <- lift (process c)
    maybe
      (lift (failBuild (ProcessOutputUnrecognised c "a line \"Pages: <number>\"")))
      pure
      (parsePdfinfoPages o)

{- | Write the number of pages in the PDF file being operated on to a file
path, and return the file path.

@since 0.1.0.0
-}
pdfPageCountFile :: (ReviewBuildError e) => FilePath -> Command e FilePath
pdfPageCountFile o =
  pdfPages >>= lift . writeUtf8 o . Text.pack . show

{- | The number of pages in the output of @pdfinfo@.

>>> parsePdfinfoPages "Creator:         Writer\nPages:           3\nEncrypted:       no\n"
Just 3

>>> parsePdfinfoPages "Creator:         Writer\n"
Nothing

@since 0.1.0.0
-}
parsePdfinfoPages :: String -> Maybe Int
parsePdfinfoPages =
  let pages l =
        case words l of
          ["Pages:", n] -> readMaybe n
          _ -> Nothing
   in preview _head . mapMaybe pages . lines

{- | Select pages from the PDF file being operated on, with a @pdftk@ page
range such as @"1"@, @"10-21"@, @"1-endodd"@ or @"1 3 5-end"@, writing them
to a file path, and return the file path.

@since 0.1.0.0
-}
pdfSelect :: (ReviewBuildError e) => String -> FilePath -> Command e FilePath
pdfSelect r o =
  do
    i <- requireInput
    onFile (takeDirectory i) (pdftk [takeFileName i, "cat"] (words r) o)

{- | Select one page, numbered from 1, from the PDF file being operated on.
See 'pdfSelect'.

@since 0.1.0.0
-}
pdfPage :: (ReviewBuildError e) => Int -> FilePath -> Command e FilePath
pdfPage n =
  pdfSelect (show n)
{-# INLINE pdfPage #-}

{- | Select the first page of the PDF file being operated on. See 'pdfSelect'.

@since 0.1.0.0
-}
pdfFirstPage :: (ReviewBuildError e) => FilePath -> Command e FilePath
pdfFirstPage =
  pdfPage 1
{-# INLINE pdfFirstPage #-}

{- | Split the PDF file being operated on into several files, given by a
@pdftk@ page range and a file path for each. See 'pdfSelect'.

@since 0.1.0.0
-}
pdfSplit :: (ReviewBuildError e) => [(String, FilePath)] -> Command e [FilePath]
pdfSplit =
  traverse (uncurry pdfSelect)
{-# INLINE pdfSplit #-}

{- | Split the PDF file being operated on into one file for each page, in a
directory, and return the file paths in page order. The file for page @n@,
numbered from 1, of @dir/name.pdf@ is @dir/name-n.pdf@.

@since 0.1.0.0
-}
pdfBurst :: (ReviewBuildError e) => FilePath -> Command e [FilePath]
pdfBurst d =
  do
    i <- requireInput
    n <- pdfPages
    lift $
      do
        io (createDirectoryIfMissing True d)
        i' <- io (makeAbsolute i)
        let b = takeBaseName i
            c = CommandLine "pdftk" [i', "burst", "output", b <> "-%d.pdf"]
        -- pdftk writes doc_data.txt to its working directory.
        _ <- processIn d c
        io (removePathForcibly (d </> "doc_data.txt"))
        traverse (\k -> expectOutput c (d </> b <> "-" <> show k <.> "pdf")) [1 .. n]

{- | Join the PDF files in the directory being operated on, in sorted order of
their names, into a file path, and return the file path. The directory must
have at least two PDF files, other than the output file, or the build fails
with 'InputFilesTooFew'. Files in subdirectories are not joined.

@since 0.1.0.0
-}
pdfJoin :: (ReviewBuildError e) => FilePath -> Command e FilePath
pdfJoin o =
  do
    d <- requireDirectory
    fs <-
      lift . io $
        do
          names <- sort . filter (hasExtension ["pdf"]) <$> listDirectory d
          files <- traverse (\n -> (\x -> [n | x]) <$> doesFileExist (d </> n)) names
          pure (concatMap (filter (not . equalFilePath o . (d </>))) files)
    if length fs < 2
      then lift (failBuild (InputFilesTooFew d (length fs) 2))
      else pdfConcatenate fs o

{- | Concatenate PDF files in the directory being operated on, given by their
paths relative to it, in order, into a file path, and return the file path.

@since 0.1.0.0
-}
pdfConcatenate :: (ReviewBuildError e) => [FilePath] -> FilePath -> Command e FilePath
pdfConcatenate fs o =
  do
    d <- requireDirectory
    _ <- lift (traverse (view _Wrapped requireInput . (d </>)) fs)
    pdftk fs ["cat"] o

{- | Run @pdftk@ in the directory being operated on, with input arguments and
operation arguments, then @output@ and a file path, and return the file path.
Input files are relative to the directory, and the output file path is not.
For example, to merge pages from two files in @public@:

@
'onFile' "public" (pdftk ["A=manual.pdf", "B=supplement.pdf", "cat"] ["A1-16", "B1", "A18-end"] "public/merged.pdf")
@

@since 0.1.0.0
-}
pdftk :: (ReviewBuildError e) => [String] -> [String] -> FilePath -> Command e FilePath
pdftk is os o =
  do
    d <- requireDirectory
    lift $
      do
        createParentDirectory o
        o' <- io (makeAbsolute o)
        let c = CommandLine "pdftk" (is <> os <> ["output", o'])
        _ <- processIn d c
        expectOutput c o

{- | Convert each page of the PDF file being operated on to an image, with
@convert@ and its options, and return the file paths of the images in page
order. The format of the images is given by the extension of the output file
path.

As with @convert@, a PDF file with one page produces the output file path,
and a PDF file with more than one page produces one file for each page,
numbered from 0, except for formats that hold more than one frame, such as
GIF. See 'pageImagePaths'.

@since 0.1.0.0
-}
pdfToImages :: (ReviewBuildError e) => [String] -> FilePath -> Command e [FilePath]
pdfToImages opts o =
  do
    i <- requireInput
    n <- pdfPages
    let c = CommandLine "convert" (opts <> [i, o])
    lift (createParentDirectory o *> process c *> traverse (expectOutput c) (pageImagePaths n o))

{- | The file paths of the images that @convert@ produces from a PDF file with
a number of pages. A format that holds more than one frame (GIF and TIFF)
produces one file, with a frame for each page.

>>> pageImagePaths 1 "public/report.pdf.png"
["public/report.pdf.png"]

>>> pageImagePaths 3 "public/report.pdf.png"
["public/report.pdf-0.png","public/report.pdf-1.png","public/report.pdf-2.png"]

>>> pageImagePaths 3 "public/report.pdf.gif"
["public/report.pdf.gif"]

@since 0.1.0.0
-}
pageImagePaths :: Int -> FilePath -> [FilePath]
pageImagePaths n o =
  let (b, e) = splitExtension o
   in if n == 1 || e `elem` [".gif", ".tif", ".tiff"]
        then [o]
        else fmap (\k -> b <> "-" <> show k <> e) [0 .. n - 1]

pdfToRaster :: (ReviewBuildError e) => String -> FilePath -> Command e [FilePath]
pdfToRaster ext d =
  requireInput >>= \i -> pdfToImages ["-density", "180"] (d </> takeBaseName i <.> ext)

{- | Convert each page of the PDF file being operated on to a PNG image, in a
directory, at 180 dots per inch. See 'pdfToImages'.

@since 0.1.0.0
-}
pdfToPng :: (ReviewBuildError e) => FilePath -> Command e [FilePath]
pdfToPng =
  pdfToRaster "png"
{-# INLINE pdfToPng #-}

{- | Convert each page of the PDF file being operated on to a JPEG image, in
a directory, at 180 dots per inch. See 'pdfToImages'.

@since 0.1.0.0
-}
pdfToJpg :: (ReviewBuildError e) => FilePath -> Command e [FilePath]
pdfToJpg =
  pdfToRaster "jpg"
{-# INLINE pdfToJpg #-}

{- | Convert each page of the PDF file being operated on to a GIF image, in a
directory, at 180 dots per inch. See 'pdfToImages'.

@since 0.1.0.0
-}
pdfToGif :: (ReviewBuildError e) => FilePath -> Command e [FilePath]
pdfToGif =
  pdfToRaster "gif"
{-# INLINE pdfToGif #-}

{- | Convert each page of the PDF file being operated on to an SVG image, in a
directory, with @pdftocairo@, and return the file paths in page order. See
'pdfToSvgImages'.

@since 0.1.0.0
-}
pdfToSvg :: (ReviewBuildError e) => FilePath -> Command e [FilePath]
pdfToSvg d =
  requireInput >>= \i -> pdfToSvgImages (d </> takeBaseName i <.> "svg")

{- | Convert each page of the PDF file being operated on to an SVG image, with
@pdftocairo@, and return the file paths in page order. The file paths follow
'pageImagePaths' for the output file path, as with 'pdfToImages'. Unlike
@convert@, @pdftocairo@ keeps text and vector graphics as vectors.

@since 0.1.0.0
-}
pdfToSvgImages :: (ReviewBuildError e) => FilePath -> Command e [FilePath]
pdfToSvgImages o =
  do
    i <- requireInput
    n <- pdfPages
    lift $
      do
        createParentDirectory o
        traverse
          ( \(k, p) ->
              let c = CommandLine "pdftocairo" ["-svg", "-f", show k, "-l", show k, i, p]
               in process c *> expectOutput c p
          )
          (zip [1 :: Int ..] (pageImagePaths n o))