internetmarke 0.0.1 → 0.0.2
raw patch · 2 files changed
+61/−10 lines, 2 filesdep ~explicit-exception
Dependency ranges changed: explicit-exception
Files
- internetmarke.cabal +2/−2
- src/Main.hs +59/−8
internetmarke.cabal view
@@ -1,5 +1,5 @@ Name: internetmarke-Version: 0.0.1+Version: 0.0.2 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -47,7 +47,7 @@ Executable internetmarke Build-Depends:- explicit-exception >= 0.0.1 && < 0.1,+ explicit-exception >= 0.0.2 && < 0.1, mtl >= 1.1 && < 1.2, process >= 1.0 && < 1.1, parsec >= 2.1 && < 2.2,
src/Main.hs view
@@ -15,7 +15,8 @@ import System.Cmd (rawSystem, ) import System.Process (runInteractiveProcess, waitForProcess, )-import System.IO (hGetContents, )+import System.IO (withFile, hGetContents, hGetChar, IOMode(ReadMode), )+import System.IO.Error (ioeGetFileName, isDoesNotExistError, ) import Paths_internetmarke (getDataDir, ) import System.Console.GetOpt (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, )@@ -24,8 +25,9 @@ import Control.Monad (liftM, liftM2, liftM3, when, guard, ) import Control.Monad.Trans (lift, )+import Control.Monad.State (StateT, evalStateT, gets, modify, ) import qualified Control.Monad.Exception.Synchronous as Exc-import Control.Exception (try, )+import Control.Exception (try, ioErrors, ) data Picture = Picture {@@ -309,18 +311,67 @@ Exc.fromEitherT $ readJpegFile jpegPath -loadMatrixCode :: Int -> Exc.ExceptionalT String IO (JpegFile,JpegFile)-loadMatrixCode n =- liftM2 (,)- (loadPPMasJPEG $ matrixCodePathPrefix ++ "-" ++ showInt3 (3*n))- (loadPPMasJPEG $ matrixCodePathPrefix ++ "-" ++ showInt3 (3*n+1))+{- lazy hGetContents fails badly here, because the stream is closed before we can check its content+checkFilePrefix :: String -> FilePath -> IO Bool+checkFilePrefix prefix path =+ withFile path ReadMode (fmap (isPrefixOf prefix) . hGetContents)+-} +checkFilePrefix :: String -> FilePath -> Exc.ExceptionalT String IO Bool+checkFilePrefix prefix path =+ Exc.catchT+ (Exc.fromEitherT $ try $+ withFile path ReadMode $ \h ->+ fmap and $ mapM (\c -> fmap (c==) (hGetChar h)) prefix)+ (\e ->+ (case ioErrors e of+ Just ioe ->+ when (isDoesNotExistError ioe)+ (Exc.throwT $+ "file " ++ show (maybe "" id (ioeGetFileName ioe)) ++ " not found for opening.\n" +++ "This may indicate that there are no images with the expected sizes,\n" +++ "which in turn may mean, that the Post company changed the sizes of the Data Code Matrix.")+ _ -> return ()) >>+ Exc.throwT (show e)) +lazyMonadicAnd :: (Monad m) => m Bool -> m Bool -> m Bool+lazyMonadicAnd m0 m1 =+ m0 >>= \b ->+ if b+ then m1+ else return False++{- |+We identify the matrix code according to its size.+If the Post changes the sizes this will fail.+-}+loadMatrixCode :: StateT Int (Exc.ExceptionalT String IO) (JpegFile,JpegFile)+loadMatrixCode =+ do fn0 <- gets makeMatrixCodePath+ modify succ+ fn1 <- gets makeMatrixCodePath++ b <- lift $+ checkFilePrefix "P6\n30 156\n" (fn0++".ppm") `lazyMonadicAnd`+ checkFilePrefix "P6\n156 156\n" (fn1++".ppm")+ if b+ then+ do modify succ+ lift $ liftM2 (,)+ (loadPPMasJPEG fn0)+ (loadPPMasJPEG fn1)+ else+ loadMatrixCode++ -- * process shell arguments matrixCodePathPrefix :: FilePath matrixCodePathPrefix = "/tmp/internetmarke" +makeMatrixCodePath :: Int -> FilePath+makeMatrixCodePath n = matrixCodePathPrefix ++ "-" ++ showInt3 n+ logoFileName :: FilePath logoFileName = "Deutsche-Post-Logo.svg" @@ -402,7 +453,7 @@ exitCodeToException $ rawSystem "pdfimages" [pdfInput, matrixCodePathPrefix]- codeFiles <- mapM loadMatrixCode (zipWith const [0..] stamps)+ codeFiles <- evalStateT (mapM (const loadMatrixCode) stamps) 0 imageFile <- Traversable.mapM (Exc.fromEitherT . readJpegFile) $ optPicture flags