From bbe73c757a12abc857d263aac04fc1cdeaa78f6e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 1 Mar 2017 07:27:36 -0700 Subject: implement most of processScanSessDir --- Main.hs | 94 ++++++++++++++++++++++++++++++++++++++++++++++++------------- sscan.cabal | 3 +- 2 files changed, 76 insertions(+), 21 deletions(-) diff --git a/Main.hs b/Main.hs index ecc2fed..c2ba55d 100644 --- a/Main.hs +++ b/Main.hs @@ -23,27 +23,74 @@ along with sscan. If not, see . {-# LANGUAGE OverloadedStrings #-} -import Control.Concurrent (forkIO) -import Control.Monad (void) -import Lens.Micro ((&), (.~), (^.)) -import System.Directory (getHomeDirectory, removeDirectoryRecursive) -import System.FilePath ((), (<.>)) -import System.IO (openFile, hClose, IOMode(WriteMode)) -import System.IO.Temp (withSystemTempDirectory) +import Control.Concurrent (forkIO) +import Control.Monad (void, when) +import Data.Time.Clock.POSIX (getPOSIXTime) +import Lens.Micro ((&), (.~), (^.)) +import System.Directory (getHomeDirectory, + removeDirectoryRecursive, renamePath, + withCurrentDirectory) +import System.FilePath ((<.>), ()) +import System.IO (IOMode (WriteMode), hClose, openFile) +import System.IO.Temp (withSystemTempDirectory) import System.Process import Types.State import UI -processScanSessDir :: St -> IO () -processScanSessDir = undefined --- -- rather than do any error handling here, we write a logfile to --- -- the outdir for user inspection --- void $ forkFinally process $ \_ -> nukeScanSessDir ss --- where --- -- run OCRmyPDF, pdftk etc., and if any process existed non-zero, --- -- record to a log file in the outdir --- process = undefined +processScanSessDir :: St -> FilePath -> IO () +processScanSessDir st dir = withCurrentDirectory dir $ do + stamp <- round <$> getPOSIXTime + logH <- openFile (logFile stamp) WriteMode + outH <- openFile (outFile stamp) WriteMode + case st^.stOutFormat of + PDF -> do + -- 1. convert tiff->PDF + createProcessWait_ "convert" + (proc "convert" (allPages ++ ["temp.pdf"])) + -- 2. set metadata with pdftk + renamePath "temp.pdf" "temp2.pdf" + writeFile "metadata" metadata + createProcessWait_ "pdftk" + (proc "pdftk" ["temp2.pdf", "update_info", "metadata", "temp.pdf"]) + { std_in = NoStream + , std_out = NoStream + , std_err = UseHandle logH + } + -- 3. maybe ocrmypdf + when (st^.stOCR) $ renamePath "temp.pdf" "temp2.pdf" + >> createProcessWait_ "OCRmyPDF" + (proc "ocrmypdf" ["-c", "-i", "-r", "temp2.pdf", "temp.pdf"]) + { std_in = NoStream + , std_out = NoStream + , std_err = UseHandle logH + } + -- 4. qpdf (ocrmypdf might invoke this; do it again as I + -- think that OCRmyPDF isn't using its --linearize option, + -- which shrinks the PDF) + createProcessWait_ "qpdf" (proc "qpdf" ["--linearize", "temp.pdf"]) + { std_in = NoStream + , std_out = UseHandle outH + , std_err = UseHandle logH + } + -- assume that only one page was scanned. Not clear how we + -- can avoid this assumption when producing a PNG + PNG -> createProcessWait_ "convert" + (proc "convert" ["page1" <.> "tiff", "png:-"]) + { std_in = NoStream + , std_out = UseHandle outH + , std_err = UseHandle logH + } + hClose outH + hClose logH + where + logFile stamp = (st^.stOutdir) show stamp <.> "log" + outFile stamp = (st^.stOutdir) show stamp <.> outExt + outExt = case st^.stOutFormat of + PDF -> "pdf" + PNG -> "png" + allPages = map (\n -> "page" ++ show n <.> "tiff") [1..(getLatestPage st)] + metadata = undefined makeInitialState :: IO St makeInitialState = do @@ -64,7 +111,7 @@ makeInitialState = do scanPage :: St -> FilePath -> IO () scanPage st dir = do outH <- openFile outF WriteMode - createProcess (proc "scanimage" (scanimageArgs st)) + createProcessWait_ "scanimage" (proc "scanimage" (scanimageArgs st)) { std_in = NoStream , std_out = UseHandle outH , std_err = Inherit -- let the user see progress bar @@ -104,17 +151,24 @@ processCommand st = case st^.stScanSess of Abort -> newSession NextPage -> scanPage st dir >> presentUI (incrementPages st) FinalPage -> scanPage st dir - >> finaliseSession (incrementPages st) >> newSession - Finalise -> finaliseSession st >> newSession + >> finaliseSession (incrementPages st) dir >> newSession + Finalise -> finaliseSession st dir >> newSession where newSession = presentUI $ resetScanSess st - finaliseSession = forkIO . processScanSessDir + finaliseSession st dir = forkIO $ processScanSessDir st dir presentUI :: St -> IO () presentUI st = runTheApp st >>= processCommand main = makeInitialState >>= presentUI +-- | Create a process, wait for it to finish, don't close any +-- handles used by the CreateProcess record +createProcessWait_ :: String -> CreateProcess -> IO () +createProcessWait_ s c = do + (_, _, _, p) <- createProcess_ s c + void $ waitForProcess p + -- TODO scanning should happen in main. We use withTempDir to setup a -- session, and then fire up brick again. add additional state -- element that is the user's chosen action. i.e. don't use diff --git a/sscan.cabal b/sscan.cabal index e95fa29..e290505 100644 --- a/sscan.cabal +++ b/sscan.cabal @@ -26,6 +26,7 @@ executable sscan , text >= 1.2.2.1 , vty >= 5.15 , temporary >= 1.2 - , process >= 1.6 + , process >= 1.4 + , time >=1.6 -- hs-source-dirs: default-language: Haskell2010 -- cgit v1.2.3