From 511913f92b667e8d7ca2252ec23433bcda6c43ec Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Thu, 15 Mar 2018 07:46:38 -0400
Subject: Two fixes

1. Avoid a race condition (PDF gets copied before CUPS fully writes it).

2. Work aaround PDFToPrinter.exe limitation (cannot render some text) by
running PDFs through ImageMagick to rasterize them.
---
 Main.hs      | 43 ++++++++++++++++++++++++++++++++++++++++---
 package.yaml |  2 ++
 2 files changed, 42 insertions(+), 3 deletions(-)

diff --git a/Main.hs b/Main.hs
index 2e00d1e..0fba75a 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
 module Main where
 import           Rebase.Prelude
 
@@ -7,6 +8,11 @@ import           Options.Applicative  (execParser, help, helper, info, long,
 import           System.Directory     (createDirectoryIfMissing, renameFile)
 import           System.FilePath      (takeFileName, (</>))
 import           System.FSNotify      (Event (..), watchDir, withManager)
+import           System.IO.Temp       (withSystemTempDirectory)
+import           System.Posix.Files   (fileMode, getFileStatus,
+                                       intersectFileModes, nullFileMode,
+                                       otherReadMode)
+import           System.Posix.Types   (FileMode)
 import           System.Process.Typed (proc, runProcess)
 
 pdfDirectory, seenDir, pdfPrinterExecutable :: FilePath
@@ -47,9 +53,40 @@ pdfPrinter f =
   runProcessVerbose pdfPrinterExecutable [f] >>
   moveFileIntoDir f seenDir
 
+hasMode :: FileMode -> FileMode -> Bool
+hasMode = ((.).(.)) (/= nullFileMode) intersectFileModes
+
+newtype Milliseconds = Milliseconds Integer deriving (Num, Show, Eq, Ord)
+waitUntil :: (IO Bool) -> Milliseconds -> IO ()
+waitUntil cond maxWait = do
+  r <- cond
+  when (maxWait > 0 && not r) $ do
+    threadDelay $ 100 * 1000
+    waitUntil cond (maxWait - 100)
+
+waitUntilReadable :: FilePath -> Milliseconds -> IO ()
+waitUntilReadable f = waitUntil $ hasMode otherReadMode . fileMode <$> getFileStatus f
+
 pdfSender :: String -> FilePath -> IO ()
-pdfSender target f =
-  runProcessVerbose "rsync" ["--remove-source-files", f, target] >> return ()
+pdfSender target f = do
+  withSystemTempDirectory "pdf-autoprint." $ \dir -> do
+    -- CUPS creates the file (with its final name) and then appends to it,
+    -- rather than atomically renaming a fully-written file into place. Luckily
+    -- we can still detect when the file is fully-written because CUPS will
+    -- change the permissions from 600 to 644 after it is. Thus we poll until
+    -- the permissions change. This isn't really the best approach; we could use
+    -- fs notifications here too. We currently do get a 'Modified' event on the
+    -- file, with which we do nothing. However, I am not sure that this event is
+    -- not triggered too early.
+    waitUntilReadable f (100*1000)
+
+    -- `PDFToPrinter.exe` will render text on (at least) the IRS tax forms as
+    -- horrible pixelated smudgy blobs. This `convert` command will render the
+    -- text into a rasterized PDF that `PDFToPrinter.exe` can handle well.
+    let converted = dir </> takeFileName f
+    void $ runProcessVerbose "convert" ["-density", "300", f, converted]
+
+    void $ runProcessVerbose "rsync" ["--remove-source-files", converted, target]
 
 handlePdfsForever :: FilePath -> (FilePath -> IO ()) -> IO ()
 handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h)
diff --git a/package.yaml b/package.yaml
index 3dfc2f3..1af60b7 100644
--- a/package.yaml
+++ b/package.yaml
@@ -13,6 +13,8 @@ dependencies:
 - typed-process
 - filepath
 - optparse-applicative
+- temporary
+- unix
 
 executables:
   pdf-autoprint:
-- 
cgit v1.2.3