OpenAFP-Utils 1.2.1 → 1.3
raw patch · 14 files changed
+437/−92 lines, 14 filesdep +line2pdfdep ~OpenAFPdep ~basenew-component:exe:afp2line2pdf
Dependencies added: line2pdf
Dependency ranges changed: OpenAFP, base
Files
- LICENSE +1/−1
- OpenAFP-Utils.cabal +49/−43
- afp-dump.hs +0/−2
- afp-page.hs +0/−2
- afp-replace.hs +0/−1
- afp-scanudc.hs +3/−5
- afp-split-scb.hs +0/−2
- afp-split-tcb.hs +0/−2
- afp-split.hs +0/−2
- afp-type.hs +0/−2
- afp-udcfix.hs +0/−2
- afp-validate.hs +0/−2
- afp2line.hs +30/−26
- afp2line2pdf.hs +354/−0
LICENSE view
@@ -1,4 +1,4 @@-The "MIT" License+Copyright 2004-2008 by Audrey Tang Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
OpenAFP-Utils.cabal view
@@ -1,5 +1,5 @@ Name: OpenAFP-Utils-Version: 1.2.1+Version: 1.3 License: BSD3 License-file: LICENSE Author: Audrey Tang@@ -8,58 +8,64 @@ Description: Assorted utilities to work with AFP data streams Category: Data Build-type: Simple+Cabal-Version: >= 1.2 -Executable: afp-dump-Main-is: afp-dump.hs-Build-depends: OpenAFP, haskell98, base, bytestring, containers, uconv, xhtml-Extensions: DeriveDataTypeable, PatternGuards+Executable afp2line2pdf+ Main-is: afp2line2pdf.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base, line2pdf >= 0.0.7+ Extensions: StandaloneDeriving, GeneralizedNewtypeDeriving, ImplicitParams,+ ExistentialQuantification, PatternGuards -Executable: afp-page-Main-is: afp-page.hs-Build-depends: OpenAFP, haskell98, base+Executable afp-olndump+ Main-is: afp-olndump.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base, bytestring, containers, binary -Executable: afp-replace-Main-is: afp-replace.hs-Build-depends: OpenAFP, haskell98, base-Extensions: DeriveDataTypeable, FlexibleContexts, PatternGuards+Executable afp-dump+ Main-is: afp-dump.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base, bytestring, containers, uconv, xhtml+ Extensions: DeriveDataTypeable, PatternGuards -Executable: afp-scanudc-Main-is: afp-scanudc.hs-Build-depends: OpenAFP, haskell98, base, directory-Extensions: BangPatterns+Executable afp-page+ Main-is: afp-page.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base -Executable: afp-split-Main-is: afp-split.hs-Build-depends: OpenAFP, haskell98, base+Executable afp-replace+ Main-is: afp-replace.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base+ Extensions: DeriveDataTypeable, FlexibleContexts, PatternGuards -Executable: afp-split-scb-Main-is: afp-split-scb.hs-Build-depends: OpenAFP, haskell98, base+Executable afp-scanudc+ Main-is: afp-scanudc.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base>=3 && <4, directory+ Extensions: BangPatterns, PatternGuards -Executable: afp-split-tcb-Main-is: afp-split-tcb.hs-Build-depends: OpenAFP, haskell98, base, filepath-Extensions: ImplicitParams+Executable afp-split+ Main-is: afp-split.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base -Executable: afp-type-Main-is: afp-type.hs-Build-depends: OpenAFP, haskell98, base+Executable afp-split-scb+ Main-is: afp-split-scb.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base -Executable: afp-udcfix-Main-is: afp-udcfix.hs-Build-depends: OpenAFP, haskell98, base, regex-base, regex-posix-Extensions: DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts+Executable afp-split-tcb+ Main-is: afp-split-tcb.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base, filepath+ Extensions: ImplicitParams -Executable: afp-validate-Main-is: afp-validate.hs-Build-depends: OpenAFP, haskell98, base+Executable afp-type+ Main-is: afp-type.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base -Executable: afp2line-Main-is: afp2line.hs-Build-depends: OpenAFP, haskell98, base-Extensions: GeneralizedNewtypeDeriving +Executable afp-udcfix+ Main-is: afp-udcfix.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base, regex-base, regex-posix+ Extensions: DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, PatternGuards, RankNTypes -Executable: afp-olndump-Main-is: afp-olndump.hs-Build-depends: OpenAFP, haskell98, base, bytestring, containers, binary+Executable afp-validate+ Main-is: afp-validate.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base>=3 && <4 +Executable afp2line+ Main-is: afp2line.hs+ Build-depends: OpenAFP >= 1.2, haskell98, base+ Extensions: GeneralizedNewtypeDeriving
afp-dump.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -O -fglasgow-exts -funbox-strict-fields -fimplicit-params #-}- module Main where import Text.XHtml import Codec.Text.UConv
afp-page.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -O -fglasgow-exts #-}- module Main where import OpenAFP import System.Exit
afp-replace.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, PatternGuards #-} module Main where import OpenAFP import qualified Data.ByteString.Lazy as L
afp-scanudc.hs view
@@ -1,11 +1,9 @@-{-# OPTIONS -O -fglasgow-exts -funbox-strict-fields -fbang-patterns #-}- module Main where import OpenAFP import System.Mem import System.Directory import Control.Concurrent-import qualified Control.Exception as E (try, catch, throwIO)+import qualified Control.Exception as E (try, catch, throwIO, Exception(..)) import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B @@ -59,9 +57,9 @@ _ -> return False -- skip non-afp files where tryOpen = openBinaryFile file ReadMode `E.catch` tryErr- tryErr (IOException ioe) | isFullError ioe = threadDelay 200 >> tryOpen+ tryErr (E.IOException ioe) | isFullError ioe = threadDelay 200 >> tryOpen tryErr e = E.throwIO e- hdl (IOException ioe) | Just e <- cast ioe, isUserError e = return True+ hdl (E.IOException ioe) | Just e <- cast ioe, isUserError e = return True hdl _ = return False scanPTX :: PTX -> IO ()
afp-split-scb.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -O -fglasgow-exts #-}- module Main where import OpenAFP import System.Exit
afp-split-tcb.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -O -fglasgow-exts #-}- module Main where import OpenAFP import System.Exit
afp-split.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -O -fglasgow-exts #-}- module Main where import OpenAFP import System.Exit
afp-type.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -O -fglasgow-exts #-}- module Main where import OpenAFP
afp-udcfix.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -O -fglasgow-exts -funbox-strict-fields #-}- module Main where import OpenAFP import qualified Data.Map as Map
afp-validate.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -O -fglasgow-exts #-}- module Main where import OpenAFP import System.Exit
afp2line.hs view
@@ -1,25 +1,24 @@-{-# OPTIONS_GHC -O2 -fglasgow-exts #-}- module Main where import OpenAFP import Data.Monoid-import System.Posix.Resource import qualified Data.IntMap as IM import qualified Data.ByteString as S import qualified Data.ByteString.Unsafe as S import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Char8 as C--__1GB__ :: Integer-__1GB__ = 1024 * 1024 * 1024--mkLimit :: Integer -> ResourceLimits-mkLimit x = ResourceLimits (ResourceLimit x) (ResourceLimit x)-+--+-- import System.Posix.Resource+--+-- __1GB__ :: Integer+-- __1GB__ = 1024 * 1024 * 1024+--+-- mkLimit :: Integer -> ResourceLimits+-- mkLimit x = ResourceLimits (ResourceLimit x) (ResourceLimit x)+-- main :: IO () main = do- setResourceLimit ResourceTotalMemory (mkLimit __1GB__)- setResourceLimit ResourceCoreFileSize (mkLimit 0)+ -- setResourceLimit ResourceTotalMemory (mkLimit __1GB__)+ -- setResourceLimit ResourceCoreFileSize (mkLimit 0) hSetBinaryMode stdout True args <- getArgs@@ -155,22 +154,27 @@ ptxGroupDump :: [PTX_] -> IO () ptxGroupDump (scfl:cs) = do let scflId = ptx_scfl (decodeChunk scfl)+ curEncoding <- lookupFontEncoding scflId cs ..>- [ _PTX_TRN ... \trn -> case curEncoding of- Just CP37 -> let bstr = packAStr' (ptx_trn trn) in do- insertText bstr- modifyIORef _CurrentColumn (+ S.length bstr)- Just CP835 -> pack835 (ptx_trn trn) >>= \bstr -> do- insertText bstr- modifyIORef _CurrentColumn (+ S.length bstr)- Just CP939 -> pack939 (ptx_trn trn) >>= \bstr -> do- insertText bstr- modifyIORef _CurrentColumn (+ S.length bstr)- Just CP950 -> let bstr = packBuf (ptx_trn trn) in do- insertText bstr- modifyIORef _CurrentColumn (+ S.length bstr)- _ -> fail "TRN without SCFL?"+ [ _PTX_TRN ... \trn -> do+ when (ptx_scfl (decodeChunk scfl) == 2) $ do+ hPrint stderr (ptx_trn trn) + case curEncoding of+ Just CP37 -> let bstr = packAStr' (ptx_trn trn) in do+ insertText bstr+ modifyIORef _CurrentColumn (+ S.length bstr)+ Just CP835 -> pack835 (ptx_trn trn) >>= \bstr -> do+ insertText bstr+ modifyIORef _CurrentColumn (+ S.length bstr)+ Just CP939 -> pack939 (ptx_trn trn) >>= \bstr -> do+ C.hPut stderr bstr+ insertText bstr+ modifyIORef _CurrentColumn (+ S.length bstr)+ Just CP950 -> let bstr = packBuf (ptx_trn trn) in do+ insertText bstr+ modifyIORef _CurrentColumn (+ S.length bstr)+ _ -> fail "TRN without SCFL?" , _PTX_BLN ... \_ -> do writeIORef _CurrentColumn 0 modifyIORef _CurrentLine (+1)
+ afp2line2pdf.hs view
@@ -0,0 +1,354 @@+{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ImplicitParams, ExistentialQuantification, PatternGuards #-}++module Main where+import OpenAFP+import Control.Applicative+import System.Exit+import System.Environment+import Text.LineToPDF.Internals hiding (Encoding)+-- import System.Posix.Resource+import qualified Data.ByteString as S+import qualified Data.ByteString.Unsafe as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Char8 as C+import qualified Text.LineToPDF.Internals as PDF++deriving instance Eq Encoding+deriving instance Ord Encoding+deriving instance Ix Encoding+deriving instance Bounded Encoding++__1GB__ :: Integer+__1GB__ = 1024 * 1024 * 1024++-- mkLimit :: Integer -> ResourceLimits+-- mkLimit x = ResourceLimits (ResourceLimit x) (ResourceLimit x)++main :: IO ()+main = do+ -- setResourceLimit ResourceTotalMemory (mkLimit __1GB__)+ -- setResourceLimit ResourceCoreFileSize (mkLimit 0)++ hSetBinaryMode stdout True+ args <- getArgs+ when (null args) $ do+ putStrLn "Usage: afp2line2pdf input.afp > output.pdf"+ forM_ args $ \f -> do+ ft <- guessFileType f+ processFile ft f++data FileType = F_ASCII | F_EBCDIC | F_AFP | F_PDF | F_Unknown deriving Show++-- | Read the first byte to determine its file type:+-- +-- * '1' indicates ASCII Plain Text line data+-- +-- * '\xF1' indicates EBCDIC line data+-- +-- * 'Z' indicates AFP file+-- +-- * '%' indicates PDF file+-- +guessFileType :: FilePath -> IO FileType+guessFileType fn = do+ fh <- openBinaryFile fn ReadMode+ bs <- S.hGet fh 1+ hClose fh+ return $ if S.null bs then F_Unknown else case C.head bs of+ 'Z' -> F_AFP+ '%' -> F_PDF+ '1' -> F_ASCII+ '0' -> F_ASCII+ ' ' -> F_ASCII+ '\xF0' -> F_EBCDIC+ '\xF1' -> F_EBCDIC+ '@' -> F_EBCDIC+ _ -> F_Unknown++imageChunkTypes :: [ChunkType]+imageChunkTypes =+ [ chunkTypeOf _BII+ , chunkTypeOf _BIM+ , chunkTypeOf _MIO+ , chunkTypeOf _IRD+ , chunkTypeOf _IPD+ ]++_blanks :: [C.ByteString]+_blanks = map C.pack+ [ "BLANK"+ , "BLN"+ , "blank"+ , "bln"+ ]++isBlank :: [AFP_] -> Bool+isBlank cs = case find (~~ _BR) cs of+ Just c -> let str = S.drop 2 (packAStr $ br (decodeChunk c)) in+ any (`S.isPrefixOf` str) _blanks+ _ -> False++processFile :: FileType -> FilePath -> IO ()+processFile F_ASCII _ = do+ -- ...Look at each line's first byte to determine what to output...+ return ()+processFile F_AFP f = do+ cs <- readAFP f++ env <- getEnvironment+ case lookup "AFP2PDF2LINE_SKIP_IMAGE" env of+ Just "1" | not (isBlank cs), any ((`elem` imageChunkTypes) . chunkType) cs -> do+ -- We can't process image data, sorry.+ exitWith (ExitFailure 1)+ _ -> return ()++ hSetBinaryMode stdout True+ pr$ "%PDF-1.2\n" ++ "%\xE2\xE3\xCF\xD3\n"+ (info, root, tPages, resources) <- writeHeader [Latin, Big5, ShiftJIS] ++ forM_ (filter (~~ _PGD) cs) $ \c -> do+ let pgd = decodeChunk c+ xSize = toPt $ pgd_XPageSize pgd+ ySize = toPt $ pgd_YPageSize pgd+ modifyIORef __MAX_WIDTH__ (max xSize)+ modifyIORef __MAX_HEIGHT__ (max ySize)++ modifyIORef __MAX_WIDTH__ (+30)+ modifyIORef __MAX_HEIGHT__ (+30)++ forM_ (tail $ splitRecords _BPG cs) $ \pageChunks -> do+ -- Start page+ markObj $ \obj -> do+ modifyRef __PAGE__ (obj:)+ pr$ "/Type/Page"+ pr$ "/Parent " ++ show tPages ++ " 0 R"+ pr$ "/Resources " ++ show resources ++ " 0 R"+ pr$ "/Contents " ++ show (succ obj) ++ " 0 R"+ pr$ "/Rotate 0"++ obj <- incrObj+ markLocation obj+ pr$ show obj ++ " 0 obj" ++ "<<"+ pr$ "/Length " ++ show (succ obj) ++ " 0 R"+ pr$ ">>" ++ "stream\n"++ streamStart <- currentLocation+ pr$ "BT\n";++ pageChunks ..>+ [ _PTX ... ptxDump+ , _MCF ... mcfHandler+ , _MCF1 ... mcf1Handler+ ]++ -- End Page+ pr$ "ET\n"+ streamEnd <- currentLocation+ pr$ "endstream\n" ++ "endobj\n"++ obj' <- incrObj+ markLocation obj'++ pr$ show obj' ++ " 0 obj\n"+ ++ show (streamEnd - streamStart) ++ "\n"+ ++ "endobj\n"++ pageObjs <-reverse <$> readRef __PAGE__+ markLocation root+ writeObj root $ do+ pr$ "/Type/Catalog" ++ "/Pages "+ pr$ show tPages ++ " 0 R" ++ maxPageWidth <- readIORef __MAX_WIDTH__+ maxPageHeight <- readIORef __MAX_HEIGHT__++ markLocation tPages+ writeObj tPages $ do+ pr$ "/Type/Pages" ++ "/Count "+ pr$ show (length pageObjs)+ ++ "/MediaBox[0 0 "+ ++ show maxPageWidth ++ " " ++ show maxPageHeight+ pr$ "]" ++ "/Kids["+ pr$ concatMap ((++ " 0 R ") . show) pageObjs+ pr$ "]"++ xfer <- currentLocation++ objCount <- incrObj+ pr$ "xref\n" ++ "0 " ++ show objCount ++ "\n"+ ++ "0000000000 65535 f \r"++ writeLocations++ pr$ "trailer\n" ++ "<<" ++ "/Size "+ pr$ show objCount++ pr$ "/Root " ++ show root ++ " 0 R"+ pr$ "/Info " ++ show info ++ " 0 R"+ pr$ ">>\n" ++ "startxref\n"+ pr$ show xfer ++ "\n" ++ "%%EOF\n"++processFile t f = warn $ "Unknown file type: " ++ show t ++ " (" ++ f ++ ")"++{-# NOINLINE __MAX_WIDTH__ #-}+__MAX_WIDTH__ :: IORef Float+__MAX_WIDTH__ = unsafePerformIO $ newIORef 0++{-# NOINLINE __MAX_HEIGHT__ #-}+__MAX_HEIGHT__ :: IORef Float+__MAX_HEIGHT__ = unsafePerformIO $ newIORef 0++{-# NOINLINE _CurrentLine #-}+_CurrentLine :: IORef Float+_CurrentLine = unsafePerformIO $ newIORef 0++{-# NOINLINE _CurrentColumn #-}+_CurrentColumn :: IORef Float+_CurrentColumn = unsafePerformIO $ newIORef 0++{-# NOINLINE _MaxColumn #-}+_MaxColumn :: IORef Int+_MaxColumn = unsafePerformIO $ newIORef 0++{-# NOINLINE _MaxLine #-}+_MaxLine :: IORef Int+_MaxLine = unsafePerformIO $ newIORef 0++{-# NOINLINE _MaxEncoding #-}+_MaxEncoding :: IORef Encoding+_MaxEncoding = unsafePerformIO $ newIORef CP37++{-# NOINLINE _MinFontSize #-}+_MinFontSize :: IORef Size+_MinFontSize = unsafePerformIO $ newIORef 12++lookupFontEncoding :: N1 -> IO (Maybe Encoding)+lookupFontEncoding = hashLookup _FontToEncoding++insertFonts :: [(N1, ByteString)] -> IO ()+insertFonts = mapM_ $ \(i, f) -> do+ let (enc, sz) = fontInfoOf f+ modifyIORef _MinFontSize $ \szMin -> case szMin of+ 0 -> sz+ _ -> min szMin sz+ modifyIORef _MaxEncoding (max enc)+ hashInsert _FontToEncoding i enc++{-# NOINLINE _FontToEncoding #-}+_FontToEncoding :: HashTable N1 Encoding+_FontToEncoding = unsafePerformIO $ hashNew (==) fromIntegral++-- | Record font Id to Name mappings in MCF's RLI and FQN chunks.+mcfHandler :: MCF -> IO ()+mcfHandler r = do+ readChunks r ..>+ [ _MCF_T ... \mcf -> do+ let cs = readChunks mcf+ ids = [ t_rli (decodeChunk c) | c <- cs, c ~~ _T_RLI ]+ fonts = [ t_fqn (decodeChunk c) | c <- cs, c ~~ _T_FQN ]+ insertFonts (ids `zip` map packAStr fonts)+ ]++-- | Record font Id to Name mappings in MCF1's Data chunks.+mcf1Handler :: MCF1 -> IO ()+mcf1Handler r = do+ insertFonts+ [ (mcf1_CodedFontLocalId mcf1, packA8 $ mcf1_CodedFontName mcf1)+ | Record mcf1 <- readData r+ ]++ptxDump :: PTX -> IO ()+ptxDump ptx = mapM_ ptxGroupDump . splitRecords _PTX_SCFL $ readChunks ptx++convertEncoding :: Encoding -> PDF.Encoding+convertEncoding CP37 = Latin+convertEncoding CP835 = Big5+convertEncoding CP939 = ShiftJIS+convertEncoding CP950 = Big5++ptxGroupDump :: [PTX_] -> IO ()+ptxGroupDump (scfl:cs) | scfl ~~ _PTX_SCFL = do+ let scflId = ptx_scfl (decodeChunk scfl)++ rv <- lookupFontEncoding scflId+ case rv of+ Nothing -> return ()+ Just curEncoding -> do+ height <- readIORef __MAX_HEIGHT__+ curSize <- readIORef _MinFontSize+ let display (enc, getBStr) = do+ font <- case enc of+ Latin -> do+ (fontOf . convertEncoding) <$> readIORef _MaxEncoding+ _ -> return (fontOf enc)+ pr$ "/F" ++ font ++ " " ++ show curSize ++ " Tf\n"+ pr$ show curSize ++ " TL\n"+ col <- readIORef _CurrentColumn+ ln <- readIORef _CurrentLine+ pr$ "1 0 0 1 " ++ show (col + 25) ++ " " ++ show (height - ln - 25) ++ " Tm("+ let escape ch = C.intercalate (C.pack ['\\', ch]) . C.split ch+ escapeTxt = escape '(' . escape ')' . escape '\\'+ origBStr <- getBStr+ let origLen = S.length origBStr+ escapedLen = S.length escapedBStr+ escapedBStr = escapeTxt origBStr+ C.putStr escapedBStr+ modifyRef __POS__ (+ escapedLen)+ pr$ ")Tj\n"+ modifyIORef _CurrentColumn (+ (realToFrac (origLen * curSize) * 0.5))+ cs ..>+ [ _PTX_TRN ... \trn -> display $ case curEncoding of+ CP37 -> (Latin, return $ packAStr' (ptx_trn trn))+ CP835 -> (Big5, pack835 (ptx_trn trn))+ CP939 -> (ShiftJIS, pack939 (ptx_trn trn))+ CP950 -> (Big5, return $ packBuf (ptx_trn trn))+ , _PTX_BLN ... \_ -> do+ writeIORef _CurrentColumn 0 -- XXX+ modifyIORef _CurrentLine (+ realToFrac curSize)+ , _PTX_AMB ... \x -> do+ -- hPrint stderr ("AMB", fromEnum $ ptx_amb x)+ movePosition Absolute _CurrentLine . ptx_amb $ x+ , _PTX_RMB ... \x -> do+ -- hPrint stderr ("RMB", fromEnum $ ptx_rmb x)+ movePosition Relative _CurrentLine . ptx_rmb $ x+ , _PTX_AMI ... movePosition Absolute _CurrentColumn . ptx_ami+ , _PTX_RMI ... movePosition Relative _CurrentColumn . ptx_rmi+ ]+ptxGroupDump _ = return ()++data Position = Absolute | Relative ++movePosition :: Position -> IORef Float -> N2 -> IO ()+movePosition p ref n = do+ case p of+ Absolute -> writeIORef ref (toPt n)+ Relative -> modifyIORef ref (+ (toPt n))+++toPt :: Enum a => a -> Float+toPt x = realToFrac (fromEnum x) * 0.3++packAStr' :: AStr -> S.ByteString+packAStr' astr = S.map (ebc2ascIsPrintW8 !) (packBuf astr)++{-# INLINE pack835 #-}+{-# INLINE pack939 #-}+pack835, pack939 :: NStr -> IO S.ByteString+pack835 = packWith convert835to950+pack939 = packWith convert939to932++{-# INLINE packWith #-}+packWith :: (Int -> Int) -> NStr -> IO S.ByteString+packWith f nstr = S.unsafeUseAsCStringLen (packBuf nstr) $ \(src, len) -> S.create len $ \target -> do+ let s = castPtr src+ let t = castPtr target+ forM_ [0..(len `div` 2)-1] $ \i -> do+ hi <- peekByteOff s (i*2) :: IO Word8+ lo <- peekByteOff s (i*2+1) :: IO Word8+ let ch = f (fromEnum hi * 256 + fromEnum lo)+ (hi', lo') = ch `divMod` 256+ pokeByteOff t (i*2) (toEnum hi' :: Word8)+ pokeByteOff t (i*2+1) (toEnum lo' :: Word8)++-- Target size = AFP size / 3