{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE RecordWildCards            #-}
module Main where
import           Rebase.Prelude

import           Options.Applicative  (execParser, help, helper, info, long,
                                       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,
                                       otherReadMode)
import           System.Posix.Types   (FileMode)
import           System.Process.Typed (proc, runProcess)

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
  , pdfPrinterExecutable :: FilePath
  , spoolDirectory       :: FilePath
  }

main :: IO ()
main = execParser (info (options <**> helper) mempty) >>= runReaderT chooseMain
  where
    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
  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.
  return $ \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 = 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.

    -- 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
    -- 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)

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