Merge pull request 'Rewrite easyscan in haskell' (#31) from easyscan2 into trunk

Reviewed-on: https://codeberg.org/leana8959/.files/pulls/31

wtf am I doing

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

@@ -0,0 +1 @@
+dist-newstyle/

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

@@ -1,61 +0,0 @@
-# This is here because scanimage's batch mode is broken for my scanner
-
-OUTPUT_FILE="${1:-./scan_"$(date)".pdf}"
-
-if [ -e "$OUTPUT_FILE" ]; then
-	echo "$OUTPUT_FILE" already exists, you are probably making a mistake!
-	exit 1
-fi
-
-tempdir="$(mktemp -d)"
-filenames=()
-counter=1
-
-function clean() {
-	# Make sure I don't remove things other than pdf
-	rm "$tempdir/"*.pdf
-	rm -d "$tempdir"
-}
-trap clean EXIT
-
-while :; do
-	ok="true"
-	echo "Scanning page $counter"
-
-	CUR_FNAME="$tempdir/easyscan_$counter.pdf"
-
-	# If no size is set, the output will be wonky-sized
-	# 210,297 is the size of A4
-	scanimage -x 210 -y 297 --resolution 300 -o "$CUR_FNAME" >/dev/null 2>&1 ||
-		{
-			echo "Failed to scan page..."
-			ok="false"
-		}
-
-	if $ok; then
-		counter=$((counter += 1))
-		filenames+=("$CUR_FNAME")
-	fi
-
-	IFS= read -r -p "Continue scanning? [Y/n] " cont
-	case "$cont" in
-	[nN])
-		echo "Exiting..."
-		break
-		;;
-	[yY] | *) ;;
-	esac
-done
-
-# Multiple files are scanned, join them
-#
-# Note: do NOT use the * glob, because bash orders lexicographically and not
-# numerically, the merged ordering will be wrong.
-merged_filename="$tempdir/easyscan_final.pdf"
-pdfunite "${filenames[@]}" "$merged_filename"
-
-# Copy scan to current directory
-mkdir -p "$(dirname "$OUTPUT_FILE")"
-cp "$merged_filename" "$OUTPUT_FILE"
-
-clean

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

@@ -1,19 +1,28 @@
 {
-  writeShellApplication,
+  lib,
-  sane-backends,
+  haskellPackages,
-  poppler-utils,
+  haskell,
-  fzf,
+  symlinkJoin,
-  ghostscript,
+  makeWrapper,
+  sane-backends, # scanimage
+  poppler-utils, # mergepdf
 }:
-writeShellApplication {
+let
+  inherit (haskell.lib.compose) justStaticExecutables;
+
+  drv = haskellPackages.callCabal2nix "easyscan" ./src { };
+in
+symlinkJoin {
   name = "easyscan";
-
+  paths = [ (justStaticExecutables drv) ];
-  runtimeInputs = [
+  buildInputs = [ makeWrapper ];
-    sane-backends
+  postBuild = ''
-    poppler-utils
+    wrapProgram $out/bin/easyscan \
-    fzf
+      --prefix PATH : "${
-    ghostscript
+        lib.makeBinPath [
-  ];
+          sane-backends
-
+          poppler-utils
-  text = builtins.readFile ./easyscan.sh;
+        ]
+      }"
+  '';
 }

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

@@ -0,0 +1,99 @@
+#!/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 System.Directory
+import System.Environment
+import System.Exit
+import System.FilePath
+import System.Posix.Temp
+import System.IO
+import System.Process
+
+data ScanState = ScanState (Maybe ExitCode) 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 :: 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

nix/packages/by-name/easyscan/src/easyscan.cabal

@@ -0,0 +1,24 @@
+cabal-version:      3.0
+name:               easyscan
+version:            0.1.0.0
+description:        scanimage helper
+author:             Léana 江
+maintainer:         leana.jiang+git@icloud.com
+build-type:         Simple
+
+common common
+  ghc-options:
+    -Wall -Wcompat -Widentities -Wincomplete-record-updates
+    -Wincomplete-patterns -Wincomplete-uni-patterns
+    -Wredundant-constraints -Werror=missing-fields
+  build-depends: base
+  default-language: Haskell2010
+
+executable easyscan
+  import: common
+  main-is: ./Main.hs
+  build-depends:
+    , filepath
+    , directory
+    , process
+    , unix