1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
{-# LANGUAGE NoImplicitPrelude #-}
module Main where
import Rebase.Prelude
import Options.Applicative (execParser, help, helper, info, long,
metavar, strOption)
import System.Directory (createDirectoryIfMissing, renameFile)
import System.FilePath (takeFileName, (</>))
import System.FSNotify (Event (..), watchDir, withManager)
import System.Process.Typed (proc, runProcess)
pdfDirectory, seenDir, pdfPrinterExecutable :: FilePath
pdfDirectory = "."
seenDir = pdfDirectory </> "seen"
pdfPrinterExecutable = "PDFtoPrinter.exe"
verbose :: Bool
verbose = True
data Options = Options
{ sendTo :: Maybe String
}
main :: IO ()
main = execParser (info (options <**> helper) mempty) >>= chooseMain
where
options = fmap Options $ optional $ strOption $ long "send-to"
<> metavar "RSYNC-DEST"
<> help "Where to send the PDFs via rsync, in rsync target format (host:path)"
chooseMain :: Options -> IO ()
chooseMain (Options Nothing) = serverMain
chooseMain (Options (Just target)) = clientMain target
serverMain :: IO ()
serverMain = do
createDirectoryIfMissing False seenDir
handlePdfsForever pdfDirectory pdfPrinter
clientMain :: String -> IO ()
clientMain target = handlePdfsForever pdfDirectory (pdfSender target)
pdfPrinter :: FilePath -> IO ()
pdfPrinter f =
-- Note: there is no sense in checking the return result, as PDFtoPrinter.exe
-- returns success even when it fails to parse the PDF.
runProcessVerbose pdfPrinterExecutable [f] >>
moveFileIntoDir f seenDir
pdfSender :: String -> FilePath -> IO ()
pdfSender target f =
runProcessVerbose "rsync" ["--remove-source-files", f, target] >> return ()
handlePdfsForever :: FilePath -> (FilePath -> IO ()) -> IO ()
handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h)
handleAdds :: (String -> Bool) -> (FilePath -> IO ()) -> Event -> IO ()
handleAdds predicate handleFile (Added f _) | predicate f = handleFile f
handleAdds _ _ x = when verbose $ print x
handleEventsForever :: FilePath -> (Event -> IO ()) -> IO ()
handleEventsForever dir eventHandler = do
withManager $ \mgr -> do
void $ watchDir mgr dir (const True) eventHandler
forever $ threadDelay 1000000
runProcessVerbose :: FilePath -> [String] -> IO ExitCode
runProcessVerbose exe args = do
when verbose $ putStrLn $ "+ " ++ exe ++ " " ++ unwords args
runProcess (proc exe args)
moveFileIntoDir :: FilePath -> FilePath -> IO ()
moveFileIntoDir f d = renameFile f $ d </> takeFileName f
|
