{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}

-- | IO functions for invoking PDFTk as an external process

module Tax.PDFtk where

import Data.ByteString.Lazy qualified as Lazy
import System.Process.Typed (ExitCode (ExitFailure, ExitSuccess), byteStringInput, readProcess, setStdin, shell)

-- | Convert a PDF file to an FDF bytestring via @pdftk generate_fdf@
pdfFile2fdf :: FilePath -> IO (Either String Lazy.ByteString)
pdfFile2fdf :: String -> IO (Either String ByteString)
pdfFile2fdf String
pdfPath = do
   (ExitCode
exitCode, ByteString
fdf, ByteString
errors) <- ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (String -> ProcessConfig () () ()
shell (String -> ProcessConfig () () ())
-> String -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ String
"pdftk " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pdfPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" generate_fdf output -")
   case ExitCode
exitCode of
      ExitCode
ExitSuccess -> Either String ByteString -> IO (Either String ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
fdf)
      ExitFailure Int
n -> Either String ByteString -> IO (Either String ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"Error converting PDF to FDF (exit code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
").\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
errors)

-- | Convert a PDF bytestring to FDF via @pdftk generate_fdf@
pdf2fdf :: Lazy.ByteString -> IO (Either String Lazy.ByteString)
pdf2fdf :: ByteString -> IO (Either String ByteString)
pdf2fdf ByteString
pdf = do
   (ExitCode
exitCode, ByteString
fdf, ByteString
errors) <- ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
pdf) (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ String -> ProcessConfig () () ()
shell String
"pdftk - generate_fdf output -")
   case ExitCode
exitCode of
      ExitCode
ExitSuccess -> Either String ByteString -> IO (Either String ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
fdf)
      ExitFailure Int
n -> Either String ByteString -> IO (Either String ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"Error converting PDF to FDF (exit code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
").\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
errors)

-- | Given a PDF file, convert an FDF bytestring to filled PDF via @pdftk fill_form@
fdf2pdf :: FilePath -> Lazy.ByteString -> IO (Either String Lazy.ByteString)
fdf2pdf :: String -> ByteString -> IO (Either String ByteString)
fdf2pdf String
pdfPath ByteString
fdf = do
   (ExitCode
exitCode, ByteString
pdf, ByteString
errors)
      <- ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
fdf) (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ String -> ProcessConfig () () ()
shell (String -> ProcessConfig () () ())
-> String -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ String
"pdftk " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pdfPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" fill_form - output -")
   case ExitCode
exitCode of
      ExitCode
ExitSuccess -> Either String ByteString -> IO (Either String ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
pdf)
      ExitFailure Int
n -> Either String ByteString -> IO (Either String ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"Error converting FDF to PDF (exit code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
").\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
errors)