package with cabal

This commit is contained in:
Primrose 2026-02-01 16:50:16 +01:00
parent 81bb6fad24
commit 46f265557a
Signed by: primrose
GPG key ID: 4E887A4CA9714ADA
5 changed files with 35 additions and 85 deletions

View file

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

View file

@ -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 manage
import: common
main-is: ./Main.hs
build-depends:
, filepath
, directory
, process
, unix