diff options
author | Andrew Cady <d@jerkface.net> | 2019-01-12 02:15:53 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-01-12 02:15:53 -0500 |
commit | 3225df1388794c33143f6fd62ce7632374194e32 (patch) | |
tree | 2a6e131f4169f66b9def854635f9405240055810 /Main.hs | |
parent | 511913f92b667e8d7ca2252ec23433bcda6c43ec (diff) |
add spool and executable options; choose defaults by OS
Diffstat (limited to 'Main.hs')
-rw-r--r-- | Main.hs | 84 |
1 files changed, 56 insertions, 28 deletions
@@ -1,13 +1,17 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
2 | {-# LANGUAGE NoImplicitPrelude #-} | 3 | {-# LANGUAGE NoImplicitPrelude #-} |
4 | {-# LANGUAGE RecordWildCards #-} | ||
3 | module Main where | 5 | module Main where |
4 | import Rebase.Prelude | 6 | import Rebase.Prelude |
5 | 7 | ||
6 | import Options.Applicative (execParser, help, helper, info, long, | 8 | import Options.Applicative (execParser, help, helper, info, long, |
7 | metavar, strOption) | 9 | metavar, showDefault, strOption, value) |
8 | import System.Directory (createDirectoryIfMissing, renameFile) | 10 | import System.Directory (createDirectoryIfMissing, renameFile) |
11 | |||
9 | import System.FilePath (takeFileName, (</>)) | 12 | import System.FilePath (takeFileName, (</>)) |
10 | import System.FSNotify (Event (..), watchDir, withManager) | 13 | import System.FSNotify (Event (..), watchDir, withManager) |
14 | import System.Info (os) | ||
11 | import System.IO.Temp (withSystemTempDirectory) | 15 | import System.IO.Temp (withSystemTempDirectory) |
12 | import System.Posix.Files (fileMode, getFileStatus, | 16 | import System.Posix.Files (fileMode, getFileStatus, |
13 | intersectFileModes, nullFileMode, | 17 | intersectFileModes, nullFileMode, |
@@ -15,43 +19,63 @@ import System.Posix.Files (fileMode, getFileStatus, | |||
15 | import System.Posix.Types (FileMode) | 19 | import System.Posix.Types (FileMode) |
16 | import System.Process.Typed (proc, runProcess) | 20 | import System.Process.Typed (proc, runProcess) |
17 | 21 | ||
18 | pdfDirectory, seenDir, pdfPrinterExecutable :: FilePath | 22 | defaultPdfPrinterExecutable, defaultSpoolDirectory :: FilePath |
19 | pdfDirectory = "." | 23 | defaultPdfPrinterExecutable = if os == "linux" then "lp" else "PDFtoPrinter.exe" |
20 | seenDir = pdfDirectory </> "seen" | 24 | defaultSpoolDirectory = if os == "linux" then "/var/spool/cups-pdf/ANONYMOUS" else "." |
21 | pdfPrinterExecutable = "PDFtoPrinter.exe" | ||
22 | 25 | ||
23 | verbose :: Bool | 26 | verbose :: Bool |
24 | verbose = True | 27 | verbose = True |
25 | 28 | ||
26 | data Options = Options | 29 | data Options = Options |
27 | { sendTo :: Maybe String | 30 | { sendTo :: Maybe String |
31 | , pdfPrinterExecutable :: FilePath | ||
32 | , spoolDirectory :: FilePath | ||
28 | } | 33 | } |
29 | 34 | ||
30 | main :: IO () | 35 | main :: IO () |
31 | main = execParser (info (options <**> helper) mempty) >>= chooseMain | 36 | main = execParser (info (options <**> helper) mempty) >>= runReaderT chooseMain |
32 | where | 37 | where |
33 | options = fmap Options $ optional $ strOption $ long "send-to" | 38 | options = Options |
34 | <> metavar "RSYNC-DEST" | 39 | <$> optional |
35 | <> help "Where to send the PDFs via rsync, in rsync target format (host:path)" | 40 | (strOption $ long "send-to" |
36 | 41 | <> metavar "RSYNC-DEST" | |
37 | chooseMain :: Options -> IO () | 42 | <> help "Where to send the PDFs via rsync, in rsync target format (host:path)") |
38 | chooseMain (Options Nothing) = serverMain | 43 | <*> (strOption $ long "print-command" |
39 | chooseMain (Options (Just target)) = clientMain target | 44 | <> metavar "EXECUTABLE" |
40 | 45 | <> value defaultPdfPrinterExecutable | |
41 | serverMain :: IO () | 46 | <> showDefault |
47 | <> help "Command to print") | ||
48 | <*> (strOption $ long "spool" | ||
49 | <> metavar "DIRECTORY" | ||
50 | <> value defaultSpoolDirectory | ||
51 | <> showDefault | ||
52 | <> help "Directory where PDFs are received") | ||
53 | |||
54 | chooseMain = asks sendTo >>= maybe serverMain clientMain | ||
55 | |||
56 | getSeenDir :: MonadReader Options m => m FilePath | ||
57 | getSeenDir = asks spoolDirectory <&> (</> "seen") | ||
58 | |||
59 | serverMain :: (MonadReader Options m, MonadIO m) => m () | ||
42 | serverMain = do | 60 | serverMain = do |
43 | createDirectoryIfMissing False seenDir | 61 | seenDir <- getSeenDir |
44 | handlePdfsForever pdfDirectory pdfPrinter | 62 | liftIO $ createDirectoryIfMissing False seenDir |
45 | 63 | Options{..} <- ask | |
46 | clientMain :: String -> IO () | 64 | pr <- pdfPrinter |
47 | clientMain target = handlePdfsForever pdfDirectory (pdfSender target) | 65 | liftIO $ handlePdfsForever spoolDirectory pr |
48 | 66 | ||
49 | pdfPrinter :: FilePath -> IO () | 67 | clientMain :: (MonadReader Options m, MonadIO m) => String -> m () |
50 | pdfPrinter f = | 68 | clientMain target = do |
69 | Options{..} <- ask | ||
70 | liftIO $ handlePdfsForever spoolDirectory (pdfSender target) | ||
71 | |||
72 | pdfPrinter :: MonadReader Options m => m (String -> IO ()) | ||
73 | pdfPrinter = do | ||
74 | Options{..} <- ask | ||
75 | seenDir <- getSeenDir | ||
51 | -- Note: there is no sense in checking the return result, as PDFtoPrinter.exe | 76 | -- Note: there is no sense in checking the return result, as PDFtoPrinter.exe |
52 | -- returns success even when it fails to parse the PDF. | 77 | -- returns success even when it fails to parse the PDF. |
53 | runProcessVerbose pdfPrinterExecutable [f] >> | 78 | return $ \f -> runProcessVerbose pdfPrinterExecutable [f] >> moveFileIntoDir f seenDir |
54 | moveFileIntoDir f seenDir | ||
55 | 79 | ||
56 | hasMode :: FileMode -> FileMode -> Bool | 80 | hasMode :: FileMode -> FileMode -> Bool |
57 | hasMode = ((.).(.)) (/= nullFileMode) intersectFileModes | 81 | hasMode = ((.).(.)) (/= nullFileMode) intersectFileModes |
@@ -78,6 +102,10 @@ pdfSender target f = do | |||
78 | -- fs notifications here too. We currently do get a 'Modified' event on the | 102 | -- 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 | 103 | -- file, with which we do nothing. However, I am not sure that this event is |
80 | -- not triggered too early. | 104 | -- not triggered too early. |
105 | |||
106 | -- TODO: This doesn't work at all for ~/PDF/ directory where the files are | ||
107 | -- never changed to 644. A completely different approach is necessary! For | ||
108 | -- now, local printing simply will not work. | ||
81 | waitUntilReadable f (100*1000) | 109 | waitUntilReadable f (100*1000) |
82 | 110 | ||
83 | -- `PDFToPrinter.exe` will render text on (at least) the IRS tax forms as | 111 | -- `PDFToPrinter.exe` will render text on (at least) the IRS tax forms as |
@@ -92,8 +120,8 @@ handlePdfsForever :: FilePath -> (FilePath -> IO ()) -> IO () | |||
92 | handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h) | 120 | handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h) |
93 | 121 | ||
94 | handleAdds :: (String -> Bool) -> (FilePath -> IO ()) -> Event -> IO () | 122 | handleAdds :: (String -> Bool) -> (FilePath -> IO ()) -> Event -> IO () |
95 | handleAdds predicate handleFile (Added f _) | predicate f = handleFile f | 123 | handleAdds predicate handleFile (Added f _ _) | predicate f = handleFile f |
96 | handleAdds _ _ x = when verbose $ print x | 124 | handleAdds _ _ x = when verbose $ print x |
97 | 125 | ||
98 | handleEventsForever :: FilePath -> (Event -> IO ()) -> IO () | 126 | handleEventsForever :: FilePath -> (Event -> IO ()) -> IO () |
99 | handleEventsForever dir eventHandler = do | 127 | handleEventsForever dir eventHandler = do |