internetmarke 0.0.2 → 0.0.3
raw patch · 2 files changed
+57/−64 lines, 2 filesdep +transformersdep +utility-htdep −mtldep ~basedep ~explicit-exceptiondep ~parsec
Dependencies added: transformers, utility-ht
Dependencies removed: mtl
Dependency ranges changed: base, explicit-exception, parsec, process
Files
- internetmarke.cabal +10/−9
- src/Main.hs +47/−55
internetmarke.cabal view
@@ -1,10 +1,10 @@ Name: internetmarke-Version: 0.0.2+Version: 0.0.3 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de> Maintainer: Henning Thielemann <haskell@henning-thielemann.de>-Homepage: http://code.haskell.org/~thielema/internetmarke+Homepage: http://code.haskell.org/~thielema/internetmarke/ Category: Console, Graphics Synopsis: Shell command for constructing custom stamps for German Post Description:@@ -47,18 +47,19 @@ Executable internetmarke Build-Depends:- explicit-exception >= 0.0.2 && < 0.1,- mtl >= 1.1 && < 1.2,- process >= 1.0 && < 1.1,- parsec >= 2.1 && < 2.2,- HPDF >= 1.4 && < 1.5+ explicit-exception >=0.1 && <0.2,+ transformers >=0.2 && <0.4,+ utility-ht >=0.0.1 && <0.1,+ process >=1.0 && <1.2,+ parsec >=2.1 && <3.2,+ HPDF >=1.4 && <1.5 If flag(splitBase) Build-Depends:- base >= 3+ base >=3 && <5 Else Build-Depends:- base >= 1.0 && < 2+ base >=1.0 && <2 GHC-Options: -Wall Hs-source-dirs: src
src/Main.hs view
@@ -9,25 +9,26 @@ import qualified Text.ParserCombinators.Parsec as Parser import qualified Text.ParserCombinators.Parsec.Pos as SourcePos import qualified Data.Traversable as Traversable+import qualified Control.Monad.HT as MonadHT import Data.List (isSuffixOf, )+import Data.List.HT (maybePrefixOf, sliceVertical, padLeft, ) import Data.Char (isSpace, ) import Data.Maybe (mapMaybe, ) import System.Cmd (rawSystem, ) import System.Process (runInteractiveProcess, waitForProcess, ) import System.IO (withFile, hGetContents, hGetChar, IOMode(ReadMode), )-import System.IO.Error (ioeGetFileName, isDoesNotExistError, )+import System.IO.Error (ioeGetFileName, isDoesNotExistError, try, ) import Paths_internetmarke (getDataDir, ) import System.Console.GetOpt (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, ) import System.Environment (getArgs, getProgName, ) import System.Exit (exitWith, ExitCode(..), ) -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, ioErrors, )+import Control.Monad.Trans.State (StateT, evalStateT, gets, modify, )+import Control.Monad.Trans.Class (lift, )+import Control.Monad (liftM, liftM2, liftM3, when, ) data Picture = Picture {@@ -138,12 +139,7 @@ drawWithPage page $ applyMatrix (scale pdfUnit pdfUnit) >> (sequence_ $ zipWith stampToDraw positions stamps)) .- sliceVert (length positions)---- Utility-sliceVert :: Int -> [a] -> [[a]]-sliceVert n =- map (take n) . takeWhile (not . null) . iterate (drop n)+ sliceVertical (length positions) makeLayout :: (Int,PDFFloat,PDFFloat) -> (Int,PDFFloat,PDFFloat) -> [Point] makeLayout (ny,sy,dy) (nx,sx,dx) =@@ -157,13 +153,7 @@ ("Zweckform-4737", makeLayout (9,252,29.6) (3,8,66)) : [] --- Utility-maybePrefixOf :: Eq a => [a] -> [a] -> Maybe [a]-maybePrefixOf (x:xs) (y:ys) = guard (x==y) >> maybePrefixOf xs ys-maybePrefixOf [] ys = Just ys-maybePrefixOf _ [] = Nothing - -- * parse PDF text parseSatisfyLine :: (Show tok) =>@@ -277,9 +267,7 @@ -- * load matrix codes showInt3 :: Int -> String-showInt3 n =- let str = show n- in replicate (3 - length str) '0' ++ str+showInt3 n = padLeft '0' 3 (show n) exitCodeToException :: IO ExitCode -> Exc.ExceptionalT String IO ()@@ -311,35 +299,31 @@ Exc.fromEitherT $ readJpegFile jpegPath ++elaborateOnNotFound :: [String] -> IO a -> Exc.ExceptionalT String IO a+elaborateOnNotFound msg action =+ Exc.catchT+ (Exc.fromEitherT $ try $ action)+ (\ioe ->+ when (isDoesNotExistError ioe)+ (Exc.throwT $ unlines $+ ("file " +++ maybe "with unknown filename" show (ioeGetFileName ioe) +++ " not found for opening.") :+ [] :+ msg) >>+ Exc.throwT (show ioe))+ {- 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 :: String -> FilePath -> 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+ withFile path ReadMode $ \h ->+ fmap and $ mapM (\c -> fmap (c==) (hGetChar h)) prefix {- | We identify the matrix code according to its size.@@ -350,10 +334,17 @@ do fn0 <- gets makeMatrixCodePath modify succ fn1 <- gets makeMatrixCodePath+ let notFoundMsg =+ "This may indicate that there are no images with the expected sizes," :+ "which in turn may mean, that the Post company changed the sizes of the Data Code Matrix." :+ []+ checkFile prefix fn =+ elaborateOnNotFound notFoundMsg (checkFilePrefix prefix fn) b <- lift $- checkFilePrefix "P6\n30 156\n" (fn0++".ppm") `lazyMonadicAnd`- checkFilePrefix "P6\n156 156\n" (fn1++".ppm")+ checkFile "P6\n30 156\n" (fn0++".ppm")+ `MonadHT.andLazy`+ checkFile "P6\n156 156\n" (fn1++".ppm") if b then do modify succ@@ -375,6 +366,10 @@ logoFileName :: FilePath logoFileName = "Deutsche-Post-Logo.svg" +logoURL :: String+logoURL =+ "http://upload.wikimedia.org/wikipedia/de/4/42/Deutsche_Post-Logo.svg"+ -- factor from 1/10 millimeters to PDF unit -- we need such a small unit, because Font sizes can only be set as integers pdfUnit :: Double@@ -461,17 +456,14 @@ let logoPath = dataDir ++ "/data/" ++ logoFileName logoDrawing <- liftM makeLogo $- Exc.catchT- (do content <- Exc.mapExceptionT show $- Exc.fromEitherT (try (readFile logoPath))- when (null content) (Exc.throwT "Deutsche Post logo uninitialized")- return content)- (\msg ->- Exc.throwT $- msg ++- "\n\nDownload Deutsche Post Logo with\n" ++- "wget -O " ++ logoPath ++- " http://upload.wikimedia.org/wikipedia/de/4/42/Deutsche_Post-Logo.svg")+ do content <-+ elaborateOnNotFound+ ("Download Deutsche Post logo with" :+ unwords ("wget" : "-O" : logoPath : logoURL : []) :+ [])+ (readFile logoPath)+ when (null content) (Exc.throwT "Deutsche Post logo uninitialized")+ return content let rect = PDFRect 0 0 (round $ a4width*pdfUnit) (round $ a4height*pdfUnit) lift $ runPdf pdfOutput