init easyscan.hs

Rewrite the easyscan script in haskell

nix/packages/by-name/easyscan/easyscan.hs

@@ -0,0 +1,104 @@
+#!/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