add spool and executable options; choose defaults by OS

2 files changed, 57 insertions, 29 deletions

diff --git a/Main.hs b/Main.hs
index 0fba75a..1683aaa 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,13 +1,17 @@
+{-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE RecordWildCards            #-}
 module Main where
 import           Rebase.Prelude
 
 import           Options.Applicative  (execParser, help, helper, info, long,
-                                       metavar, strOption)
+                                       metavar, showDefault, strOption, value)
 import           System.Directory     (createDirectoryIfMissing, renameFile)
+
 import           System.FilePath      (takeFileName, (</>))
 import           System.FSNotify      (Event (..), watchDir, withManager)
+import           System.Info          (os)
 import           System.IO.Temp       (withSystemTempDirectory)
 import           System.Posix.Files   (fileMode, getFileStatus,
                                        intersectFileModes, nullFileMode,
@@ -15,43 +19,63 @@ import           System.Posix.Files   (fileMode, getFileStatus,
 import           System.Posix.Types   (FileMode)
 import           System.Process.Typed (proc, runProcess)
 
-pdfDirectory, seenDir, pdfPrinterExecutable :: FilePath
-pdfDirectory         = "."
-seenDir              = pdfDirectory </> "seen"
-pdfPrinterExecutable = "PDFtoPrinter.exe"
+defaultPdfPrinterExecutable, defaultSpoolDirectory :: FilePath
+defaultPdfPrinterExecutable = if os == "linux" then "lp" else "PDFtoPrinter.exe"
+defaultSpoolDirectory       = if os == "linux" then "/var/spool/cups-pdf/ANONYMOUS" else "."
 
 verbose :: Bool
 verbose = True
 
 data Options = Options
-  { sendTo :: Maybe String
+  { sendTo               :: Maybe String
+  , pdfPrinterExecutable :: FilePath
+  , spoolDirectory       :: FilePath
   }
 
 main :: IO ()
-main = execParser (info (options <**> helper) mempty) >>= chooseMain
+main = execParser (info (options <**> helper) mempty) >>= runReaderT 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 ()
+    options = Options
+      <$> optional
+          (strOption $ long "send-to"
+                    <> metavar "RSYNC-DEST"
+                    <> help "Where to send the PDFs via rsync, in rsync target format (host:path)")
+      <*> (strOption $ long "print-command"
+                    <> metavar "EXECUTABLE"
+                    <> value defaultPdfPrinterExecutable
+                    <> showDefault
+                    <> help "Command to print")
+      <*> (strOption $ long "spool"
+                    <> metavar "DIRECTORY"
+                    <> value defaultSpoolDirectory
+                    <> showDefault
+                    <> help "Directory where PDFs are received")
+
+    chooseMain = asks sendTo >>= maybe serverMain clientMain
+
+getSeenDir :: MonadReader Options m => m FilePath
+getSeenDir = asks spoolDirectory <&> (</> "seen")
+
+serverMain :: (MonadReader Options m, MonadIO m) => m ()
 serverMain = do
-  createDirectoryIfMissing False seenDir
-  handlePdfsForever pdfDirectory pdfPrinter
-
-clientMain :: String -> IO ()
-clientMain target = handlePdfsForever pdfDirectory (pdfSender target)
-
-pdfPrinter :: FilePath -> IO ()
-pdfPrinter f =
+  seenDir <- getSeenDir
+  liftIO $ createDirectoryIfMissing False seenDir
+  Options{..} <- ask
+  pr <- pdfPrinter
+  liftIO $ handlePdfsForever spoolDirectory pr
+
+clientMain :: (MonadReader Options m, MonadIO m) => String -> m ()
+clientMain target = do
+  Options{..} <- ask
+  liftIO $ handlePdfsForever spoolDirectory (pdfSender target)
+
+pdfPrinter :: MonadReader Options m => m (String -> IO ())
+pdfPrinter = do
+  Options{..} <- ask
+  seenDir <- getSeenDir
   -- 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
+  return $ \f -> runProcessVerbose pdfPrinterExecutable [f] >> moveFileIntoDir f seenDir
 
 hasMode :: FileMode -> FileMode -> Bool
 hasMode = ((.).(.)) (/= nullFileMode) intersectFileModes
@@ -78,6 +102,10 @@ pdfSender target f = do
     -- 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.
+
+    -- TODO: This doesn't work at all for ~/PDF/ directory where the files are
+    -- never changed to 644. A completely different approach is necessary! For
+    -- now, local printing simply will not work.
     waitUntilReadable f (100*1000)
 
     -- `PDFToPrinter.exe` will render text on (at least) the IRS tax forms as
@@ -92,8 +120,8 @@ 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
+handleAdds predicate handleFile (Added f _ _) | predicate f = handleFile f
+handleAdds _ _ x                              = when verbose $ print x
 
 handleEventsForever :: FilePath -> (Event -> IO ()) -> IO ()
 handleEventsForever dir eventHandler = do
diff --git a/stack.yaml b/stack.yaml
index bf51154..e414acc 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-10.8
+resolver: lts-13.1
 packages:
 - .
 extra-deps: