#!/usr/bin/env runhaskell
{-# LANGUAGE LambdaCase #-}

-- This is here because scanimage's batch mode is broken for my scanner

import Control.Monad
import Data.Char
import Data.List (dropWhileEnd)
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.Posix.Files
import System.Posix.Temp
import System.IO
import System.Process

data ScanState = ScanState
  { sExitCode :: Maybe ExitCode
  , sNumbering :: Word
  }

defaultScanimageArgs :: [String]
defaultScanimageArgs =
  -- If no size is set, the output will be wonky-sized
  -- 210,297 is the size of A4
  [ "-x", "210"
  , "-y", "297"
  , "--resolution", "300"
  ]

main :: IO ()
main = do
  let confirmP = ( \c -> c == "y" || null c ) . map toLower

  getArgs >>= \case
    ( targetFile : [] ) -> do
      workingDir <- mkdtemp "/tmp/"

      (ScanState mExitCode nextIndex) <- loop
        ( do; putStr "Continue? [Y/n] "; confirmP <$> getLine
        )
        ( readPage workingDir
        )
        ( ScanState Nothing 1
        )
      when (mExitCode /= Just ExitSuccess) $ exitWith (ExitFailure 1)

      let mergedFilename = workingDir </> "easyscan_joined.pdf"
          allFiles = map (\n -> workingDir </> show n <.> "pdf" ) [1 .. nextIndex - 1 ]

      if null allFiles
      then do
        putStrLn "No file was scanned, exiting."
        exitWith (ExitFailure 1)
      else do
        readProcessWithExitCodeTraced "pdfunite" (allFiles ++ [ mergedFilename ]) ""
        copyFile mergedFilename targetFile
        removeDirectoryRecursive workingDir

    -- TODO: help page
    _ -> exitWith (ExitFailure 1)
  where
    loop :: forall s. IO Bool -> (s -> IO s) -> s -> IO s
    loop cond action state0 = do
            x <- action state0
            c <- cond
            if c then loop cond action x
            else      pure x

-- |
-- Invariant: the counter is only incremented upon success
readPage :: FilePath -> ScanState -> IO ScanState
readPage dir (ScanState _ n) = do
  (c, _out, err) <- readProcessWithExitCodeTraced
    "scanimage"
    ( defaultScanimageArgs <> [ "-o", dir </> show n <.> "pdf" ]
    )
    ""
  case c of
    ExitSuccess -> pure (ScanState (Just c) (n+1))
    ExitFailure _ -> do
      putStr (redForeground err)
      pure (ScanState (Just c) n)

--
-- Helpers
--

quote :: String -> String
quote x = "\"" <> x <> "\""

-- https://stackoverflow.com/a/70162369
blueForeground :: String -> String
blueForeground x = "\ESC[34m" <> x <> "\ESC[0m"

redForeground :: String -> String
redForeground x = "\ESC[31m" <> x <> "\ESC[0m"

readProcessWithExitCodeTraced :: String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCodeTraced cmdName args inp = do
  hPutStrLn stderr
    $ "Executing: " <> (quote . blueForeground) (showCommandForUser cmdName args)
  readProcessWithExitCode cmdName args inp