mirror of
https://codeberg.org/leana8959/.files.git
synced 2026-02-01 22:49:41 +00:00
104 lines
2.8 KiB
Haskell
Executable file
104 lines
2.8 KiB
Haskell
Executable file
#!/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
|