diff options
author | Andrew Cady <d@jerkface.net> | 2018-03-15 07:46:38 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2018-03-15 07:48:26 -0400 |
commit | 511913f92b667e8d7ca2252ec23433bcda6c43ec (patch) | |
tree | 83eab1474ea9262c614b47b3c8fe82d4dcfc391e /Main.hs | |
parent | e4ad9a4b5512ed3a7779ae848f2c95df24ee46b8 (diff) |
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.
Diffstat (limited to 'Main.hs')
-rw-r--r-- | Main.hs | 43 |
1 files changed, 40 insertions, 3 deletions
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE NoImplicitPrelude #-} | 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
2 | {-# LANGUAGE NoImplicitPrelude #-} | ||
2 | module Main where | 3 | module Main where |
3 | import Rebase.Prelude | 4 | import Rebase.Prelude |
4 | 5 | ||
@@ -7,6 +8,11 @@ import Options.Applicative (execParser, help, helper, info, long, | |||
7 | import System.Directory (createDirectoryIfMissing, renameFile) | 8 | import System.Directory (createDirectoryIfMissing, renameFile) |
8 | import System.FilePath (takeFileName, (</>)) | 9 | import System.FilePath (takeFileName, (</>)) |
9 | import System.FSNotify (Event (..), watchDir, withManager) | 10 | import System.FSNotify (Event (..), watchDir, withManager) |
11 | import System.IO.Temp (withSystemTempDirectory) | ||
12 | import System.Posix.Files (fileMode, getFileStatus, | ||
13 | intersectFileModes, nullFileMode, | ||
14 | otherReadMode) | ||
15 | import System.Posix.Types (FileMode) | ||
10 | import System.Process.Typed (proc, runProcess) | 16 | import System.Process.Typed (proc, runProcess) |
11 | 17 | ||
12 | pdfDirectory, seenDir, pdfPrinterExecutable :: FilePath | 18 | pdfDirectory, seenDir, pdfPrinterExecutable :: FilePath |
@@ -47,9 +53,40 @@ pdfPrinter f = | |||
47 | runProcessVerbose pdfPrinterExecutable [f] >> | 53 | runProcessVerbose pdfPrinterExecutable [f] >> |
48 | moveFileIntoDir f seenDir | 54 | moveFileIntoDir f seenDir |
49 | 55 | ||
56 | hasMode :: FileMode -> FileMode -> Bool | ||
57 | hasMode = ((.).(.)) (/= nullFileMode) intersectFileModes | ||
58 | |||
59 | newtype Milliseconds = Milliseconds Integer deriving (Num, Show, Eq, Ord) | ||
60 | waitUntil :: (IO Bool) -> Milliseconds -> IO () | ||
61 | waitUntil cond maxWait = do | ||
62 | r <- cond | ||
63 | when (maxWait > 0 && not r) $ do | ||
64 | threadDelay $ 100 * 1000 | ||
65 | waitUntil cond (maxWait - 100) | ||
66 | |||
67 | waitUntilReadable :: FilePath -> Milliseconds -> IO () | ||
68 | waitUntilReadable f = waitUntil $ hasMode otherReadMode . fileMode <$> getFileStatus f | ||
69 | |||
50 | pdfSender :: String -> FilePath -> IO () | 70 | pdfSender :: String -> FilePath -> IO () |
51 | pdfSender target f = | 71 | pdfSender target f = do |
52 | runProcessVerbose "rsync" ["--remove-source-files", f, target] >> return () | 72 | withSystemTempDirectory "pdf-autoprint." $ \dir -> do |
73 | -- CUPS creates the file (with its final name) and then appends to it, | ||
74 | -- rather than atomically renaming a fully-written file into place. Luckily | ||
75 | -- we can still detect when the file is fully-written because CUPS will | ||
76 | -- change the permissions from 600 to 644 after it is. Thus we poll until | ||
77 | -- the permissions change. This isn't really the best approach; we could use | ||
78 | -- fs notifications here too. We currently do get a 'Modified' event on the | ||
79 | -- file, with which we do nothing. However, I am not sure that this event is | ||
80 | -- not triggered too early. | ||
81 | waitUntilReadable f (100*1000) | ||
82 | |||
83 | -- `PDFToPrinter.exe` will render text on (at least) the IRS tax forms as | ||
84 | -- horrible pixelated smudgy blobs. This `convert` command will render the | ||
85 | -- text into a rasterized PDF that `PDFToPrinter.exe` can handle well. | ||
86 | let converted = dir </> takeFileName f | ||
87 | void $ runProcessVerbose "convert" ["-density", "300", f, converted] | ||
88 | |||
89 | void $ runProcessVerbose "rsync" ["--remove-source-files", converted, target] | ||
53 | 90 | ||
54 | handlePdfsForever :: FilePath -> (FilePath -> IO ()) -> IO () | 91 | handlePdfsForever :: FilePath -> (FilePath -> IO ()) -> IO () |
55 | handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h) | 92 | handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h) |