packages feed

pdf-toolbox-core (empty) → 0.0.1.0

raw patch · 19 files changed

+1696/−0 lines, 19 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, containers, errors, io-streams, transformers, zlib-bindings

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Yuras Shumovich++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Yuras Shumovich nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lib/Pdf/Toolbox/Core.hs view
@@ -0,0 +1,26 @@++-- | Low level tools for processing PDF file++module Pdf.Toolbox.Core+(+  module Pdf.Toolbox.Core.Error,+  module Pdf.Toolbox.Core.IO,+  module Pdf.Toolbox.Core.Stream,+  module Pdf.Toolbox.Core.Object.Types,+  module Pdf.Toolbox.Core.Object.Builder,+  module Pdf.Toolbox.Core.Object.Util,+  module Pdf.Toolbox.Core.XRef,+  module Pdf.Toolbox.Core.Util,+  module Pdf.Toolbox.Core.Writer+)+where++import Pdf.Toolbox.Core.Error+import Pdf.Toolbox.Core.IO+import Pdf.Toolbox.Core.Stream+import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Object.Builder+import Pdf.Toolbox.Core.Object.Util+import Pdf.Toolbox.Core.XRef+import Pdf.Toolbox.Core.Util+import Pdf.Toolbox.Core.Writer
+ lib/Pdf/Toolbox/Core/Error.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE  ScopedTypeVariables #-}++-- | Error used by API++module Pdf.Toolbox.Core.Error+(+  PdfError(..),+  PdfE,+  annotateError,+  annotatingError,+  tryPdfIO,+  module Control.Error+)+where++import Control.Error+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class++-- | Errors+data PdfError =+  -- | Parser error+  ParseError [String] String |+  IOError IOError |+  AnnotatedError String PdfError |+  -- | Something unexpected+  UnexpectedError String+  deriving Show++-- | API uses this for error handling+type PdfE m = EitherT PdfError m++-- | Wrap any 'PdfError' into 'AnnotatedError'+--+-- Usefull when you want to add high-level description to+-- error, returned by low-level function+annotateError :: Monad m => String -> PdfE m a -> PdfE m a+annotateError ann = fmapLT (AnnotatedError ann')+  where+  ann' = if length ann <= 50 then ann else take 47 ann ++ "..."++-- | 'annotateError' with fliped arguments+annotatingError :: Monad m => PdfE m a -> String -> PdfE m a+annotatingError = flip annotateError++-- | Catch exception if any and convert to 'IOError'+tryPdfIO :: MonadIO m => IO a -> PdfE m a+tryPdfIO action = do+  res <- liftIO $ Right `liftM` action+      `catch` (\(e :: IOError) -> return $ Left $ IOError e)+  case res of+    Right a -> return a+    Left e -> left e
+ lib/Pdf/Toolbox/Core/IO.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | Basic IO operations for PDF++module Pdf.Toolbox.Core.IO+(+  IS,+  RIS,+  RIS.fromHandle,+  RIS.fromHandle',+  MonadIO,+  liftIO,+  size,+  seek,+  tell,+  parse,+  inputStream,+  takeBytes,+  readExactly,+  dropExactly+)+where++import Data.Int+import Data.Functor+import Data.Attoparsec (Parser)+import Data.ByteString (ByteString)+import Control.Monad.IO.Class+import Control.Exception+import qualified System.IO.Streams as Streams+import qualified System.IO.Streams.Attoparsec as Streams++import Pdf.Toolbox.Core.Error+import qualified Pdf.Toolbox.Core.IO.RIS as RIS+import Pdf.Toolbox.Core.IO.RIS (RIS, IS)++-- | Total number of bytes in 'RIS'+size :: MonadIO m => RIS -> PdfE m Int64+size = tryPdfIO . RIS.size++-- | Change input position in 'RIS'+seek :: MonadIO m => RIS -> Int64 -> PdfE m ()+seek ris = tryPdfIO . RIS.seek ris++-- | Current input position+tell :: MonadIO m => RIS -> PdfE m Int64+tell = tryPdfIO . RIS.tell++-- | Parse from 'IS'+parse :: MonadIO m => Parser r -> IS -> PdfE m r+parse p is = do+  res <- liftIO $ (Right <$> Streams.parseFromStream p is)+    `catch` (\(Streams.ParseException str) -> return $ Left $ ParseError [] str)+    `catch` (\(e :: IOError) -> return $ Left $ IOError e)+  case res of+    Left e -> left e+    Right r -> return r++-- | Convert random access stream to sequential+inputStream :: MonadIO m => RIS -> PdfE m IS+inputStream = tryPdfIO . RIS.inputStream++-- | See 'Streams.takeBytes'+takeBytes :: MonadIO m => Int64 -> IS -> PdfE m IS+takeBytes n = tryPdfIO . Streams.takeBytes n++-- | See 'Streams.readExactly'+readExactly :: MonadIO m => Int -> IS -> PdfE m ByteString+readExactly n = tryPdfIO . Streams.readExactly n++-- | Same as 'readExactly', but ignores the result+dropExactly :: MonadIO m => Int -> IS -> PdfE m ()+dropExactly n is = readExactly n is >> return ()
+ lib/Pdf/Toolbox/Core/IO/RIS.hs view
@@ -0,0 +1,93 @@++-- | Input stream with random access++module Pdf.Toolbox.Core.IO.RIS+(+  IS,+  RIS(..),+  RIS'(..),+  seek,+  size,+  tell,+  inputStream,+  fromHandle,+  fromHandle'+)+where++import Data.Int (Int64)+import Data.Functor+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.IORef+import System.IO+import System.IO.Streams (InputStream)+import qualified System.IO.Streams as Streams++-- | Sequential input stream+type IS = InputStream ByteString++-- | Internal state of 'RIS'+data RIS' = RIS' {+  risSeek :: Int64 -> IO (IO (Maybe ByteString)),+  risInputStream :: IS,+  risPos :: IO Int64,+  risSize :: Int64+  }++-- | Random access Input Stream+newtype RIS = RIS (IORef RIS')++-- | Seek the stream+seek :: RIS -> Int64 -> IO ()+seek (RIS ref) pos = do+  ris <- readIORef ref+  source <- risSeek ris pos+  stream <- Streams.makeInputStream source+  (s, c) <- Streams.countInput stream+  writeIORef ref ris {+    risInputStream = s,+    risPos = (+ pos) <$> c+    }++-- | Create RIS from 'Handle' with the specified chunk size+fromHandle' :: Handle -> Int -> IO RIS+fromHandle' h buf = do+  sz <- hFileSize h+  posRef <- newIORef 0+  stream <- Streams.makeInputStream (f posRef)+  (s, c) <- Streams.countInput stream+  RIS <$> newIORef RIS' {+    risSeek = \pos -> do+      hSeek h AbsoluteSeek (fromIntegral pos)+      ref <- newIORef $ fromIntegral pos+      return $ f ref,+    risInputStream = s,+    risPos = c,+    risSize = fromIntegral sz+    }+  where+  f ref = do+    prevPos <- readIORef ref+    curtPos <- hTell h+    hSeek h AbsoluteSeek prevPos+    chunk <- BS.hGetSome h buf+    hSeek h AbsoluteSeek curtPos+    writeIORef ref $! prevPos + fromIntegral (BS.length chunk)+    return $! if BS.null chunk then Nothing else Just chunk++-- | Create RIS from 'Handle' with default chunk size+fromHandle :: Handle -> IO RIS+fromHandle h = fromHandle' h 32752++-- | Number of bytes in the stream+size :: RIS -> IO Int64+size (RIS ref) = risSize <$> readIORef ref++-- | Current position in bytes+tell :: RIS -> IO Int64+tell (RIS ref) = readIORef ref >>= risPos++-- | Get sequential input stream, that is valid until the next 'seek'+inputStream :: RIS -> IO IS+inputStream (RIS ref) = risInputStream <$> readIORef ref
+ lib/Pdf/Toolbox/Core/Object/Builder.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Render 'Object' to bytestring++module Pdf.Toolbox.Core.Object.Builder+(+  buildIndirectObject,+  buildObject,+  buildNumber,+  buildBoolean,+  buildName,+  buildDict,+  buildArray,+  buildStr,+  buildRef,+  buildStream+)+where++import Data.Monoid+import Data.Char+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import Data.ByteString.Lazy.Builder+import Data.ByteString.Lazy.Builder.ASCII+import Text.Printf++import Pdf.Toolbox.Core.Object.Types++-- | Build indirect object+buildIndirectObject :: Ref -> Object BSL.ByteString -> Builder+buildIndirectObject (Ref i g) object =+  char7 '\n' `mappend`+  intDec i `mappend`+  char7 ' ' `mappend`+  intDec g `mappend`+  byteString " obj\n" `mappend`+  build object `mappend`+  byteString "\nendobj\n"+  where+  build (OStream s) = buildStream s+  build o = buildObject o++-- | Render inline object (without \"obj/endobj\").+-- It is 'error' to supply 'Stream', because it could not+-- be inlined, but should always be an indirect object+buildObject :: Object a -> Builder+buildObject (ONumber n) = buildNumber n+buildObject (OBoolean b) = buildBoolean b+buildObject (OName n) = buildName n+buildObject (ODict d) = buildDict d+buildObject (OArray a) = buildArray a+buildObject (OStr s) = buildStr s+buildObject (ORef r) = buildRef r+buildObject (OStream _) = error "buildObject: please don't pass streams to me"+buildObject ONull = byteString "null"++buildStream :: Stream BSL.ByteString -> Builder+buildStream (Stream dict content) =+  buildDict dict `mappend`+  byteString "stream\n" `mappend`+  lazyByteString content `mappend`+  byteString "\nendstream"++buildNumber :: Number -> Builder+buildNumber (NumInt i) = intDec i+buildNumber (NumReal d) = string7 $ printf "%f" d++buildBoolean :: Boolean -> Builder+buildBoolean (Boolean True) = byteString "true"+buildBoolean (Boolean False) = byteString "false"++buildName :: Name -> Builder+buildName (Name n) = char7 '/' `mappend` byteString n++intercalate :: Builder -> [Builder] -> Builder+intercalate _ [] = mempty+intercalate sep (x:xs) = x `mappend` go xs+  where+  go [] = mempty+  go (y:ys) = sep `mappend` y `mappend` go ys++buildDict :: Dict -> Builder+buildDict (Dict xs) =+  byteString "<<" `mappend`+  intercalate (char7 ' ') (concatMap build xs) `mappend`+  byteString ">>"+  where+  build (key, val) = [buildName key, buildObject val]++buildArray :: Array -> Builder+buildArray (Array xs) =+  char7 '[' `mappend`+  intercalate (char7 ' ') (map buildObject xs) `mappend`+  char7 ']'++buildStr :: Str -> Builder+buildStr (Str s) =+  if BS8.all isPrint s+    then char7 '(' `mappend` (byteString . BS8.pack . concatMap escape . BS8.unpack $ s) `mappend` char7 ')'+    else char7 '<' `mappend` (byteString . BS.pack . concatMap toHex . BS.unpack $ s) `mappend` char7 '>'+  where+  toHex w = map (\a -> if a < 10 then a + 48 else a + 55) [w `div` 16, w `mod` 16]+  escape '(' = "\\("+  escape ')' = "\\)"+  escape '\\' = "\\\\"+  escape '\n' = "\\n"+  escape '\r' = "\\r"+  escape '\t' = "\\t"+  escape '\b' = "\\b"+  escape ch = [ch]++buildRef :: Ref -> Builder+buildRef (Ref i j) = intDec i `mappend` char7 ' ' `mappend` intDec j `mappend` byteString " R"
+ lib/Pdf/Toolbox/Core/Object/Types.hs view
@@ -0,0 +1,83 @@++-- | Module contains definitions of pdf objects+--+-- See PDF1.7:7.3++module Pdf.Toolbox.Core.Object.Types+(+  Object(..),+  Number(..),+  Boolean(..),+  Name(..),+  Dict(..),+  Array(..),+  Str(..),+  Stream(..),+  Ref(..)+)+where++import Data.String+import Data.ByteString (ByteString)++-- | Integer or real +data Number =+  NumInt Int |+  NumReal Double+  deriving (Eq, Show)++-- | \"true\" or \"false\"+newtype Boolean = Boolean Bool+  deriving (Eq, Show)++-- | Names usually are used as keys in dictionaries+--+-- They starts with \'/\', but we strip it out, see 'Text.Pdf.Parser.Object.parseName'+newtype Name = Name ByteString+  deriving (Eq, Show)++-- | Set of key/value pairs+newtype Dict = Dict [(Name, Object ())]+  deriving (Eq, Show)++-- | An array+newtype Array = Array [Object ()]+  deriving (Eq, Show)++-- | Sequence of zero or more bytes+--+-- Represents both the literal and hexadecimal strings+newtype Str = Str ByteString+  deriving (Eq, Show)++-- | Contains stream dictionary and a payload+--+-- The payload could be offset within pdf file, actual content,+-- content stream or nothing+data Stream a = Stream Dict a+  deriving (Eq, Show)++-- | Object reference, contains object index and generation+data Ref = Ref Int Int+  deriving (Eq, Show, Ord)++-- | Any pdf object+--+-- It is parameterized by 'Stream' content+data Object a =+  ONumber Number |+  OBoolean Boolean |+  OName Name |+  ODict Dict |+  OArray Array |+  OStr Str |+  OStream (Stream a) |+  ORef Ref |+  ONull+  deriving (Eq, Show)++instance IsString Name where+  fromString = Name . fromString++instance IsString Str where+  fromString = Str . fromString
+ lib/Pdf/Toolbox/Core/Object/Util.hs view
@@ -0,0 +1,130 @@++-- | Utils relayted to pdf objects++module Pdf.Toolbox.Core.Object.Util+(+  -- * Casting pdf objects+  FromObject(..),+  toNumber,+  toBoolean,+  toName,+  toDict,+  toArray,+  toStr,+  toRef,+  toStream,+  mapObject,+  -- * Dictionary+  lookupDict,+  lookupDict',+  setValueForKey,+  deleteValueForKey,+  -- * Number+  intValue,+  realValue+)+where++import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Error++lookupDict :: Monad m => Name -> Dict -> PdfE m (Object ())+lookupDict key (Dict d) =+  case lookup key d of+    Just o -> right o+    Nothing -> left $ UnexpectedError $ "Key not found: " ++ show key ++ " " ++ show d++lookupDict' :: Name -> Dict -> Maybe (Object ())+lookupDict' key (Dict d) = lookup key d++deleteValueForKey :: Name -> Dict -> Dict+deleteValueForKey key (Dict vals) = Dict $ go vals+  where+  go [] = []+  go (x@(k, _) : xs)+    | k == key = go xs+    | otherwise = x : go xs++setValueForKey :: Name -> Object () -> Dict -> Dict+setValueForKey key val dict = Dict $ (key, val) : vals+  where+  Dict vals = deleteValueForKey key dict++intValue :: Monad m => Number -> PdfE m Int+intValue (NumInt i) = right i+intValue (NumReal r) = left $ UnexpectedError $ "Integer expected, but real received: " ++ show r++realValue :: Monad m => Number -> PdfE m Double+realValue (NumReal r) = right r+realValue (NumInt i) = right $ fromIntegral i++toNumber :: (Show a, Monad m) => Object a -> PdfE m Number+toNumber (ONumber n) = right n+toNumber o = left $ UnexpectedError $ "Can't cast object to Number: " ++ show o++toBoolean :: (Show a, Monad m) => Object a -> PdfE m Boolean+toBoolean (OBoolean b) = right b+toBoolean o = left $ UnexpectedError $ "Can't cast object to Boolean: " ++ show o++toName :: (Show a, Monad m) => Object a -> PdfE m Name+toName (OName n) = right n+toName o = left $ UnexpectedError $ "Can't cast object to Name: " ++ show o++toDict :: (Show a, Monad m) => Object a -> PdfE m Dict+toDict (ODict d) = right d+toDict o = left $ UnexpectedError $ "Can't cast object to Dict: " ++ show o++toStr :: (Show a, Monad m) => Object a -> PdfE m Str+toStr (OStr s) = right s+toStr o = left $ UnexpectedError $ "Can't cast object to Str: " ++ show o++toRef :: (Show a, Monad m) => Object a -> PdfE m Ref+toRef (ORef r) = right r+toRef o = left $ UnexpectedError $ "Can't cast object to Ref: " ++ show o++toArray :: (Show a, Monad m) => Object a -> PdfE m Array+toArray (OArray a) = right a+toArray o = left $ UnexpectedError $ "Can't cast object to Array: " ++ show o++toStream :: (Show a, Monad m) => Object a -> PdfE m (Stream a)+toStream (OStream s) = right s+toStream o = left $ UnexpectedError $ "Can't cast object to Stream: " ++ show o++-- | Apply function to all stream contents+mapObject :: (a -> b) -> Object a -> Object b+mapObject f o =+  case o of+    ONumber n -> ONumber n+    OBoolean b -> OBoolean b+    OName n -> OName n+    ODict d -> ODict d+    OArray a -> OArray a+    OStr s -> OStr s+    OStream (Stream d a) -> OStream (Stream d $ f a)+    ORef r -> ORef r+    ONull -> ONull++-- | Allows you to cast 'Object' to specific type+class FromObject c where+  fromObject :: (Show a, Monad m) => Object a -> PdfE m c++instance FromObject Number where+  fromObject = toNumber++instance FromObject Boolean where+  fromObject = toBoolean++instance FromObject Name where+  fromObject = toName++instance FromObject Dict where+  fromObject = toDict++instance FromObject Str where+  fromObject = toStr++instance FromObject Ref where+  fromObject = toRef++instance FromObject Array where+  fromObject = toArray
+ lib/Pdf/Toolbox/Core/Parsers/Object.hs view
@@ -0,0 +1,229 @@+{-# LANGUAGE OverloadedStrings #-}++-- | This module contains parsers for pdf objects++module Pdf.Toolbox.Core.Parsers.Object+(+  -- * Parse any object+  parseObject,+  -- * Parse object of specific type+  parseDict,+  parseArray,+  parseName,+  parseStr,+  parseHexStr,+  parseRef,+  parseNumber,+  parseBoolean,+  -- * Other+  parseTillStreamData,+  parseIndirectObject,+  isRegularChar+)+where++import Data.Char+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Attoparsec (Parser)+import qualified Data.Attoparsec.ByteString.Char8 as P+import Control.Applicative++import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Parsers.Util++-- for doctest+-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.Attoparsec.ByteString.Char8++-- |+-- >>> parseOnly parseDict "<</Key1(some string)/Key2 123>>"+-- Right (Dict [(Name "Key1",OStr (Str "some string")),(Name "Key2",ONumber (NumInt 123))])+parseDict :: Parser Dict+parseDict = do+  _ <- P.string "<<"+  dict <- many parseKey+  P.skipSpace+  _ <- P.string ">>"+  return $ Dict dict++parseKey :: Parser (Name, Object ())+parseKey = do+  P.skipSpace+  key <- parseName+  val <- parseObject+  return (key, val)++-- |+-- >>> parseOnly parseArray "[1 (string) /Name []]"+-- Right (Array [ONumber (NumInt 1),OStr (Str "string"),OName (Name "Name"),OArray (Array [])])+parseArray :: Parser Array+parseArray = do+  _ <- P.char '['+  array <- many parseObject+  P.skipSpace+  _ <- P.char ']'+  return $ Array array++-- |+-- >>> parseOnly parseNumber "123"+-- Right (NumInt 123)+-- >>> parseOnly parseNumber "12.3"+-- Right (NumReal 12.3)+-- >>> parseOnly parseNumber ".01"+-- Right (NumReal 1.0e-2)+parseNumber :: Parser Number+parseNumber = P.choice [+  toNum <$> P.number,+  NumReal <$> (P.signed $ read . ("0."++) . BS8.unpack <$> (P.char '.' >> P.takeWhile1 isDigit))+  ]+  where+  toNum (P.I i) = NumInt $ fromIntegral i+  toNum (P.D d) = NumReal d++-- |+-- >>> parseOnly parseStr "(hello)"+-- Right (Str "hello")+parseStr :: Parser Str+parseStr = do+  _ <- P.char '('+  str <- takeStr 0 []+  return $ Str $ BS8.pack str+  where+  takeStr :: Int -> String -> Parser String+  takeStr lvl res = do+    ch <- P.anyChar+    case ch of+      '(' -> takeStr (lvl + 1) (ch : res)+      ')' -> if lvl == 0+               then return $ reverse res+               else takeStr (lvl - 1) (ch : res)+      '\\' -> do+        ch' <- P.anyChar+        if ch' `elem` "()\\"+          then takeStr lvl (ch' : res)+          else case ch' of+                 'r' -> takeStr lvl ('\r' : res)+                 'n' -> takeStr lvl ('\n' : res)+                 'f' -> takeStr lvl ('\f' : res)+                 'b' -> takeStr lvl ('\b' : res)+                 't' -> takeStr lvl ('\t' : res)+                 '\r' -> takeStr lvl res+                 _ -> do+                   ch1 <- P.anyChar+                   ch2 <- P.anyChar+                   takeStr lvl (toEnum (fromEnum ch' * 64 + fromEnum ch1 * 8 + fromEnum ch2) : res)+      _ -> takeStr lvl (ch : res)++-- |+-- >>> parseOnly parseHexStr "<68656C6C6F>"+-- Right (Str "hello")+parseHexStr :: Parser Str+parseHexStr = do+  _ <- P.char '<'+  str <- many takeHex+  _ <- P.char '>'+  return $ Str $ BS.pack str+  where+  takeHex = do+    ch1 <- P.satisfy isHexDigit+    ch2 <- P.satisfy isHexDigit+    return $ fromIntegral $ digitToInt ch1 * 16 + digitToInt ch2++-- |+-- >>> parseOnly parseRef "0 2 R"+-- Right (Ref 0 2)+parseRef :: Parser Ref+parseRef = do+  obj <- P.decimal+  P.skipSpace+  gen <- P.decimal+  P.skipSpace+  _ <- P.char 'R'+  return $ Ref obj gen++-- |+-- >>> parseOnly parseName "/Name"+-- Right (Name "Name")+parseName :: Parser Name+parseName = do+  _ <- P.char '/'+  Name <$> P.takeWhile1 isRegularChar++-- | Whether the character can appear in 'Name'+isRegularChar :: Char -> Bool+isRegularChar = (`notElem` "[]()/<>{}% \n\r")++-- |+-- >>> parseOnly parseBoolean "true"+-- Right (Boolean True)+-- >>> parseOnly parseBoolean "false"+-- Right (Boolean False)+parseBoolean :: Parser Boolean+parseBoolean = Boolean <$> P.choice [+  P.string "true" >> return True,+  P.string "false" >> return False+  ]++-- | Consumes input till stream's data+--+-- Use 'parseDict' then 'parseTillStreamData'+-- to determine whether the object is dictionary or stream.+-- If 'parseTillStreamData' fails, then it is a dictionary.+-- Otherwise it is stream, and current position in input data+-- will point to stream's data start+--+-- >>> parse (parseDict >>= \dict -> parseTillStreamData >> return dict) "<</Key 123>>\nstream\n1234\nendstream"+-- Done "1234\nendstream" Dict [(Name "Key",ONumber (NumInt 123))]+parseTillStreamData :: Parser ()+parseTillStreamData = do+  P.skipSpace+  _ <- P.string "stream"+  endOfLine++-- | It parses any 'Object' except 'Stream'+-- cos for 'Stream' we need offset of data in file+--+-- >>> parseOnly parseObject "/Name"+-- Right (OName (Name "Name"))+parseObject :: Parser (Object ())+parseObject = do+  P.skipSpace+  P.choice [+    const ONull <$> P.string "null",+    OName <$> parseName,+    OBoolean <$> parseBoolean,+    ODict <$> parseDict,+    OArray <$> parseArray,+    OStr <$> parseStr,+    OStr <$> parseHexStr,+    ORef <$> parseRef,+    ONumber <$> parseNumber+    ]++-- | Parse object. Input position should point+-- to offset defined in XRef+--+-- >>> parseOnly parseIndirectObject "1 2 obj\n12"+-- Right (Ref 1 2,ONumber (NumInt 12))+parseIndirectObject :: Parser (Ref, Object ())+parseIndirectObject = do+  P.skipSpace+  index <- P.decimal :: Parser Int+  P.skipSpace+  gen <- P.decimal :: Parser Int+  P.skipSpace+  _ <- P.string "obj"+  P.skipSpace+  obj <- parseObject+  let ref = Ref index gen+  case obj of+    ODict d -> P.choice [+      parseTillStreamData >> return (ref, OStream $ Stream d ()),+      return (ref, ODict d)+      ]+    _ -> return (ref, obj)++-- |+-- More tests
+ lib/Pdf/Toolbox/Core/Parsers/Util.hs view
@@ -0,0 +1,23 @@++-- | Utils++module Pdf.Toolbox.Core.Parsers.Util+(+  endOfLine+)+where++import Data.Attoparsec (Parser)+import qualified Data.Attoparsec.ByteString.Char8 as P+import Control.Applicative (many)++-- | In pdf file EOL could be \"\\n\", \"\\r\" or \"\\n\\r\"+--+-- Also space (0x20) is usually ok before EOL+endOfLine :: Parser ()+endOfLine = do+  _ <- many $ P.char ' '+  P.choice [+    P.endOfLine, -- it already handles both the \n and \n\r+    P.char '\r' >>= const (return ())+    ]
+ lib/Pdf/Toolbox/Core/Parsers/XRef.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Parsers for XRef++module Pdf.Toolbox.Core.Parsers.XRef+(+  startXRef,+  tableXRef,+  parseSubsectionHeader,+  parseTrailerAfterTable,+  parseTableEntry+)+where++import Data.Int+import Data.Attoparsec (Parser)+import qualified Data.Attoparsec.ByteString.Char8 as P+import Control.Applicative (many)++import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Parsers.Object+import Pdf.Toolbox.Core.Parsers.Util++-- for doctest+-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.Attoparsec.ByteString.Char8++-- | Offset of the very last xref table+--+-- Before calling it, make sure your are currently somewhere near+-- the end of pdf file. Otherwice it can eat all the memory.+-- E.g. examine only the last 1KB+--+-- >>> parseOnly startXRef "anything...startxref\n222\n%%EOF...blah\nstartxref\n123\n%%EOF"+-- Right 123+startXRef :: Parser Int64+startXRef = do+  res <- many $ do+    _ <- P.manyTill P.anyChar $ P.string "startxref"+    P.skipSpace+    offset <- P.decimal+    P.skipSpace+    _ <- P.string "%%EOF"+    return offset+  case res of+    [] -> fail "Trailer not found"+    xs -> return $ last xs++-- | When current input position points to xref stream+-- (or doesn't point to xref at all), the parser will fail.+-- When it points to xref table, the parser will succeed+-- and input position will point to the first xref subsection+--+-- >>> parseOnly tableXRef "xref\n"+-- Right ()+-- >>> parseOnly tableXRef "not xref"+-- Left "Failed reading: takeWith"+tableXRef :: Parser ()+tableXRef = do+  _ <- P.string "xref"+  endOfLine++-- | Parse subsection header, return (the first object index, number of object)+--+-- Input position will point to the first object+parseSubsectionHeader :: Parser (Int, Int)+parseSubsectionHeader = do+  start <- P.decimal+  P.skipSpace+  count <- P.decimal+  endOfLine+  return (start, count)++-- | Parse trailer located after XRef table+--+-- Input position should point to the \"trailer\" keyword+parseTrailerAfterTable :: Parser Dict+parseTrailerAfterTable = do+  _ <- P.string "trailer"+  endOfLine+  parseDict++-- | Parse XRef table entry. Returns offset, generation and whether the object is free.+parseTableEntry :: Parser (Int64, Int, Bool)+parseTableEntry = do+  offset <- P.decimal+  P.skipSpace+  generation <- P.decimal+  P.skipSpace+  c <- P.anyChar+  case c of+    'n' -> return (offset, generation, False)+    'f' -> return (offset, generation, True)+    _ -> fail $ "error parsing XRef table entry: unknown char: " ++ [c]
+ lib/Pdf/Toolbox/Core/Stream.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE  OverloadedStrings #-}++-- | Stream related tools++module Pdf.Toolbox.Core.Stream+(+  StreamFilter,+  knownFilters,+  rawStreamContent,+  decodedStreamContent,+  readStream,+  decodeStream+)+where++import Data.Int+import Control.Monad++import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Object.Util+import Pdf.Toolbox.Core.IO+import Pdf.Toolbox.Core.Parsers.Object+import Pdf.Toolbox.Core.Stream.Filter.Type+import Pdf.Toolbox.Core.Stream.Filter.FlateDecode+import Pdf.Toolbox.Core.Error++-- | All stream filters implemented by the toolbox+--+-- Right now it contains only FlateDecode filter+knownFilters :: [StreamFilter]+knownFilters = [flateDecode]++-- | Raw content of stream.+-- Filters are not applyed+--+-- The 'IS' is valid only until the next 'seek'+--+-- Note: \"Length\" could be an indirect object, but we don't want+-- to read indirect objects here. So we require length to be provided+rawStreamContent :: MonadIO m+                 => RIS                 -- ^ random access input stream to read from+                 -> Int                 -- ^ stream length+                 -> Stream Int64        -- ^ stream object to read content for.+                                        -- The payload is offset of stream data+                 -> PdfE m (Stream IS)  -- ^ resulting stream object+rawStreamContent ris len (Stream dict off) = annotateError ("reading raw stream content at offset: " ++ show off) $ do+  seek ris off+  is <- inputStream ris >>= takeBytes (fromIntegral len)+  return $ Stream dict is++-- | Decoded stream content+--+-- The 'IS' is valid only until the next 'seek'+--+-- Note: \"Length\" could be an indirect object, that is why+-- we cann't read it ourself+decodedStreamContent :: MonadIO m+                     => RIS                -- ^ random input stream to read from+                     -> [StreamFilter]     -- ^ stream filters+                     -> (IS -> IO IS)      -- ^ decryptor+                     -> Int                -- ^ stream length+                     -> Stream Int64       -- ^ stream with offset+                     -> PdfE m (Stream IS)+decodedStreamContent ris filters decryptor len s = rawStreamContent ris len s >>= decodeStream filters decryptor++-- | Read 'Stream' at the current position in the 'RIS'+readStream :: MonadIO m => RIS -> PdfE m (Stream Int64)+readStream ris = do+  Stream dict _ <- inputStream ris >>= parse parseIndirectObject >>= toStream . snd+  Stream dict `liftM` tell ris++-- | Decode stream content+--+-- The 'IS' is valid only until the next 'RIS' operation+decodeStream :: MonadIO m => [StreamFilter] -> (IS -> IO IS) -> Stream IS -> PdfE m (Stream IS)+decodeStream filters decryptor (Stream dict istream) = annotateError "Can't decode stream" $ do+  is <- liftIO $ decryptor istream+  list <- buildFilterList dict+  Stream dict `liftM` foldM decode is list+  where+  decode is (name, params) = do+    f <- findFilter name+    tryPdfIO $ filterDecode f params is+  findFilter name = tryHead (UnexpectedError $ "Filter not found: " ++ show name) $+    filter ((== name) . filterName) filters++buildFilterList :: Monad m => Dict -> PdfE m [(Name, Maybe Dict)]+buildFilterList dict = do+  f <- lookupDict "Filter" dict `catchT` (const $ right ONull)+  p <- lookupDict "DecodeParms" dict `catchT` (const $ right ONull)+  case (f, p) of+    (ONull, _) -> right []+    (OName fd, ONull) -> return [(fd, Nothing)]+    (OName fd, ODict pd) -> return [(fd, Just pd)]+    (OName fd, OArray (Array [ODict pd])) -> return [(fd, Just pd)]+    (OArray (Array fa), ONull) -> do+      fa' <- mapM fromObject fa+      return $ zip fa' (repeat Nothing)+    (OArray (Array fa), OArray (Array pa)) | length fa == length pa -> do+      fa' <- mapM fromObject fa+      pa' <- mapM fromObject pa+      return $ zip fa' (map Just pa')+    _ -> left $ UnexpectedError $ "Can't handle Filter and DecodeParams: (" ++ show f ++ ", " ++ show p ++ ")"
+ lib/Pdf/Toolbox/Core/Stream/Filter/FlateDecode.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Flate decode filter++module Pdf.Toolbox.Core.Stream.Filter.FlateDecode+(+  flateDecode+)+where++import Data.Word+import qualified Data.ByteString as BS+import Codec.Zlib+import Control.Error+import Control.Exception+import qualified System.IO.Streams as Streams++import Pdf.Toolbox.Core.IO+import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Object.Util+import Pdf.Toolbox.Core.Stream.Filter.Type++-- | Vary basic implementation. Only PNG-UP prediction is implemented+flateDecode :: StreamFilter+flateDecode = StreamFilter {+  filterName = "FlateDecode",+  filterDecode = \params is -> decode params is >>= catchZlibExceptions+  }++catchZlibExceptions :: IS -> IO IS+catchZlibExceptions is =+  Streams.makeInputStream $+    Streams.read is+    `catch` (\(e :: ZlibException) -> throwIO $ DecodeException $ toException e)++decode :: Maybe Dict -> IS -> IO IS+decode Nothing is = Streams.decompress is+decode (Just dict) is = do+  predictor <- runEitherT $ lookupDict "Predictor" dict+  case predictor of+    Left _ -> Streams.decompress is+    Right p -> do+      p' <- runEitherT $ fromObject p >>= intValue+      case p' of+        Left e -> fail $ "Malformed predictor: " ++ show e+        Right val -> Streams.decompress is >>= unpredict dict val++unpredict :: Dict -> Int -> IS -> IO IS+unpredict _ 1 is = return is+unpredict dict 12 is = do+  c <- runEitherT $ lookupDict "Columns" dict >>= fromObject >>= intValue+  case c of+    Left e -> fail $ "flateDecode: malformed Columns value: " ++ show e+    Right cols -> unpredict12 (cols + 1) is+unpredict _ p _ = fail $ "Unsupported predictor: " ++ show p++-- | PGN-UP prediction+--+-- TODO: Hacky solution, rewrite it+unpredict12 :: Int -> IS -> IO IS+unpredict12 cols is = Streams.toList is >>= Streams.fromList . return . BS.pack . step (replicate cols 0) [] . concatMap BS.unpack+  where+  step :: [Word8] -> [Word8] -> [Word8] -> [Word8]+  step _ _ [] = []+  step (c:cs) [] (_:xs) = step cs [c] xs+  step (c:cs) (p:ps) (x:xs) = (x + p) : step cs (c:(x + p):ps) xs+  step [] ps xs = step (reverse ps) [] xs
+ lib/Pdf/Toolbox/Core/Stream/Filter/Type.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | Stream filter++module Pdf.Toolbox.Core.Stream.Filter.Type+(+  StreamFilter(..),+  DecodeException(..)+)+where++import Data.Typeable+import Control.Exception++import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.IO++-- | Stream filter+data StreamFilter = StreamFilter {+  filterName :: Name,      -- ^ as \"Filter\" key value in stream dictionary+  filterDecode :: Maybe Dict -> IS -> IO IS    -- ^ decode params -> content -> decoded content+}++-- | Exception that should be thrown by the decoder in case of any error+-- User code could catch it when reading from decoded stream content+data DecodeException = DecodeException (SomeException)+  deriving (Show, Typeable)++instance Exception DecodeException
+ lib/Pdf/Toolbox/Core/Util.hs view
@@ -0,0 +1,61 @@++-- | Unclassified tools++module Pdf.Toolbox.Core.Util+(+  readObjectAtOffset,+  readCompressedObject+)+where++import Data.Int+import qualified Data.Attoparsec.ByteString.Char8 as Parser+import Control.Monad+import qualified System.IO.Streams as Streams++import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Parsers.Object+import Pdf.Toolbox.Core.Error+import Pdf.Toolbox.Core.IO++-- | Read indirect object at the specified offset+readObjectAtOffset :: MonadIO m+                   => RIS              -- ^ input stream to read from+                   -> Int64            -- ^ object offset+                   -> Int              -- ^ object generation+                   -> PdfE m (Object Int64)+readObjectAtOffset ris off gen = do+  seek ris off+  (Ref _ gen', o) <- inputStream ris >>= parse parseIndirectObject+  unless (gen == gen') $ left $ UnexpectedError $ "Generation mismatch, expected: " ++ show gen ++ ", found: " ++ show gen'+  case o of+    ONumber val -> return $ ONumber val+    OBoolean val -> return $ OBoolean val+    OName val -> return $ OName val+    ODict val -> return $ ODict val+    OArray val -> return $ OArray val+    OStr val -> return $ OStr val+    OStream (Stream dict _) -> (OStream . Stream dict) `liftM` tell ris+    ORef _ -> left $ UnexpectedError "Indirect object can't be ORef"+    ONull -> return ONull++-- | Read object from object stream+readCompressedObject :: MonadIO m+                     => IS         -- ^ input object stream decoded content+                     -> Int64      -- ^ an offset of the first object (\"First\" key in dictionary)+                     -> Int        -- ^ object number to read+                     -> PdfE m (Object ())+readCompressedObject is first num = do+  (is', countConsumed) <- liftIO $ Streams.countInput is+  res <- replicateM (num + 1) $ parse headerP is' :: MonadIO m => PdfE m [(Int, Int64)]+  (_, off) <- tryLast (UnexpectedError $ "readCompressedObject: tryLast: impossible") res+  pos <- liftIO $ countConsumed+  dropExactly (fromIntegral $ first + off - pos) is+  parse parseObject is+  where+  headerP = do+    n <- Parser.decimal+    Parser.skipSpace+    off <- Parser.decimal+    Parser.skipSpace+    return (n, off)
+ lib/Pdf/Toolbox/Core/Writer.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Write PDF files+--+-- It could be used to generate new PDF file+-- or to incrementally update the existent one+--+-- To generate new file, first call 'writePdfHeader',+-- then a number of 'writeObject' and finally 'writeXRefTable'+--+-- To incrementally update PDF file just ommit the+-- `writePdfHeader` and append the result to the existent file++module Pdf.Toolbox.Core.Writer+(+  PdfWriter,+  runPdfWriter,+  writePdfHeader,+  writeObject,+  deleteObject,+  writeXRefTable+)+where++import Data.Int+import Data.Set (Set)+import qualified Data.Set as Set+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BSL+import Data.ByteString.Lazy.Builder+import Data.ByteString.Lazy.Builder.ASCII+import Data.Function+import Data.Monoid+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.State+import Control.Monad.IO.Class+import System.IO.Streams (OutputStream)+import qualified System.IO.Streams as Streams++import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Object.Builder++-- | The monad+newtype PdfWriter m a = PdfWriter (StateT PdfState m a)+  deriving (Monad, MonadIO, MonadTrans)++-- | Execute writer action+runPdfWriter :: MonadIO m+             => OutputStream ByteString    -- ^ streams to write to+             -> PdfWriter m a              -- ^ action to run+             -> m a+runPdfWriter output (PdfWriter action) = do+  (out, count) <- liftIO $ Streams.countOutput output+  let emptyState = PdfState {+        stOutput = out,+        stObjects = Set.empty,+        stCount = count,+        stOffset = 0+        }+  evalStateT action emptyState++data Elem = Elem {+  elemIndex :: {-# UNPACK #-} !Int,+  elemGen :: {-# UNPACK #-} !Int,+  elemOffset :: {-# UNPACK #-} !Int64,+  elemFree :: !Bool+  }++instance Eq Elem where+  (==) = (==) `on` elemIndex++instance Ord Elem where+  compare = compare `on` elemIndex++data PdfState = PdfState {+  stOutput :: OutputStream ByteString,+  stObjects :: !(Set Elem),+  stCount :: IO Int64,+  stOffset :: {-# UNPACK #-} !Int64+  }++-- | Write PDF header. Used for generating new PDF files.+-- Should be the first call. Not used fo incremental updates+writePdfHeader :: MonadIO m => PdfWriter m ()+writePdfHeader = do+  output <- PdfWriter $ gets stOutput+  liftIO $ Streams.write (Just "%PDF-1.7\n") output++-- | Write object+writeObject :: MonadIO m => Ref -> Object BSL.ByteString -> PdfWriter m ()+writeObject ref@(Ref index gen) obj = do+  st <- PdfWriter get+  pos <- countWritten+  addElem $ Elem index gen pos False+  dumpObject (stOutput st) ref obj+  return ()++-- | Delete object+deleteObject :: MonadIO m => Ref -> Int64 -> PdfWriter m ()+deleteObject (Ref index gen) nextFree =+  addElem $ Elem index gen nextFree True++-- | Write xref table. Should be the last call.+-- Used for generating and incremental updates.+writeXRefTable :: MonadIO m+               => Int64           -- ^ size of the original PDF file. Should be 0 for new file+               -> Dict            -- ^ trailer+               -> PdfWriter m ()+writeXRefTable offset tr = do+  st <- PdfWriter get+  off <- (+ offset) `liftM` countWritten+  let elems = Set.mapMonotonic (\e -> e {elemOffset = elemOffset e + offset})  $ stObjects st+      content = byteString "xref\n" `mappend`+                buildXRefTable (Set.toAscList elems) `mappend`+                byteString "trailer\n" `mappend`+                buildDict tr `mappend`+                byteString "\nstartxref\n" `mappend`+                int64Dec off `mappend`+                byteString "\n%%EOF\n"+  liftIO $ Streams.writeLazyByteString (toLazyByteString content) (stOutput st)++countWritten :: MonadIO m => PdfWriter m Int64+countWritten = do+  st <- PdfWriter get+  c <- (stOffset st +) `liftM` liftIO (stCount st)+  PdfWriter $ put $ st {stOffset = c}+  return $! c++addElem :: Monad m => Elem -> PdfWriter m ()+addElem e = do+  st <- PdfWriter get+  when (Set.member e $ stObjects st) $ error $ "PdfWriter: attempt to write object with the same index: " ++ show (elemIndex e)+  PdfWriter $ put st {stObjects = Set.insert e $ stObjects st}++dumpObject :: MonadIO m => OutputStream ByteString -> Ref -> Object BSL.ByteString -> m ()+dumpObject out ref o = liftIO $ Streams.writeLazyByteString (toLazyByteString $ buildIndirectObject ref o) out++buildXRefTable :: [Elem] -> Builder+buildXRefTable entries =+  mconcat (map buildXRefSection $ sections entries)+  where+  sections :: [Elem] -> [[Elem]]+  sections [] = []+  sections xs = let (s, rest) = section xs in s : sections rest+  section [] = error "impossible"+  section (x:xs) = go (elemIndex x + 1) [x] xs+    where+    go _ res [] = (reverse res, [])+    go i res (y:ys) =+      if i == elemIndex y+        then go (i + 1) (y : res) ys+        else (reverse res, y:ys)++buildXRefSection :: [Elem] -> Builder+buildXRefSection [] = error "impossible"+buildXRefSection s@(e:_) =+  intDec (elemIndex e) `mappend`+  char7 ' ' `mappend`+  intDec (length s) `mappend`+  char7 '\n' `mappend`+  loop s+  where+  loop (x:xs) =+    buildFixed 10 '0' (elemOffset x) `mappend`+    char7 ' ' `mappend`+    buildFixed 5 '0' (elemGen x) `mappend`+    char7 ' ' `mappend`+    char7 (if elemFree x then 'f' else 'n') `mappend`+    string7 "\r\n" `mappend`+    loop xs+  loop [] = mempty++buildFixed :: Show a => Int -> Char -> a -> Builder+buildFixed len c i =+  let v = take len $ show i+      l = length v+  in string7 $ replicate (len - l) c ++ v++{-+-- At attempt to do it directly with Set.+-- Actually uses 2x memory...+buildXRefTable :: Set Elem -> Builder+buildXRefTable elems+  | Set.null elems = mempty+  | otherwise = buildXRefSection elems++buildXRefSection :: Set Elem -> Builder+buildXRefSection elems =+  intDec (elemIndex start) `mappend`+  char7 ' ' `mappend`+  intDec len `mappend`+  char7 '\n' `mappend`+  section `mappend`+  buildXRefTable rest+  where+  (start, len, rest) = sectionLength elems+  section = buildSection len elems++buildSection :: Int -> Set Elem -> Builder+buildSection 0 _ = mempty+buildSection l els =+  let (x, xs) = Set.deleteFindMin els+  in buildFixed 10 '0' (elemOffset x) `mappend`+     char7 ' ' `mappend`+     buildFixed 5 '0' (elemGen x) `mappend`+     char7 ' ' `mappend`+     char7 (if elemFree x then 'f' else 'n') `mappend`+     string7 "\r\n" `mappend`+     buildSection (l - 1) xs++sectionLength :: Set Elem -> (Elem, Int, Set Elem)+sectionLength els =+  let (x, xs) = Set.deleteFindMin els+      (count, rest) = go 1 (elemIndex x) xs+  in (x, count, rest)+  where+  go n val xs+    | Set.null xs = (n, xs)+    | otherwise = let (next, rest) = Set.deleteFindMin xs+                  in if elemIndex next == val + 1+                       then go (n + 1) (val + 1) rest+                       else (n, xs)+-}
+ lib/Pdf/Toolbox/Core/XRef.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Cross reference++module Pdf.Toolbox.Core.XRef+(+  XRef(..),+  XRefEntry(..),+  TableEntry(..),+  StreamEntry(..),+  lastXRef,+  prevXRef,+  trailer,+  lookupTableEntry,+  lookupStreamEntry,+  isTable+)+where++import Data.Int+import qualified Data.ByteString as BS+import Control.Monad++import Pdf.Toolbox.Core.Object.Types+import Pdf.Toolbox.Core.Object.Util+import Pdf.Toolbox.Core.IO+import Pdf.Toolbox.Core.Parsers.XRef+import Pdf.Toolbox.Core.Stream+import Pdf.Toolbox.Core.Error++-- | Entry in cross reference table+data TableEntry = TableEntry {+  teOffset :: Int64,+  teGen :: Int,+  teIsFree :: Bool+  } deriving Show++-- | Entry in cross reference stream+data StreamEntry =+  -- | Object number and generation+  StreamEntryFree Int Int |+  -- | Object offset (in bytes from the beginning of file) and generation+  StreamEntryUsed Int64 Int |+  -- | Object number of object stream and index within the object stream+  StreamEntryCompressed Int Int+  deriving Show++-- | Entry in cross reference+data XRefEntry =+  XRefTableEntry TableEntry |+  XRefStreamEntry StreamEntry+  deriving Show++-- | Cross reference+data XRef =+  -- | Offset+  XRefTable Int64 |+  -- | Offset and stream with content offset+  XRefStream Int64 (Stream Int64)+  deriving Show++-- | Find the last cross reference+lastXRef :: MonadIO m => RIS -> PdfE m XRef+lastXRef ris = annotateError "Can't find the last xref" $ do+  sz <- size ris+  seek ris $ max 0 (sz - 1024)+  off <- inputStream ris >>= parse startXRef+  readXRef ris off++readXRef :: MonadIO m => RIS -> Int64 -> PdfE m XRef+readXRef ris off = do+  seek ris off+  table <- inputStream ris >>= isTable+  if table+    then return $ XRefTable off+    else XRefStream off `liftM` readStream ris++-- | Check whether the stream starts with \"xref\" keyword.+-- The keyword iyself is consumed+isTable :: MonadIO m => IS -> PdfE m Bool+isTable is = do+  res <- runEitherT (parse tableXRef is)+  case res of+    Right _ -> return True+    Left _ -> return False++-- | Find prev cross reference+prevXRef :: MonadIO m => RIS -> XRef -> PdfE m (Maybe XRef)+prevXRef ris xref = annotateError "Can't find prev xref" $ do+  tr <- trailer ris xref+  prev <- runEitherT $ lookupDict "Prev" tr+  case prev of+    Right p -> do+      off <- fromObject p >>= intValue+      Just `liftM` readXRef ris (fromIntegral off)+    Left _ -> return Nothing++-- | Read trailer for the xref+trailer :: MonadIO m => RIS -> XRef -> PdfE m Dict+trailer ris (XRefTable off) = annotateError ("Reading trailer for xref table: " ++ show off) $ do+  seek ris off+  inputStream ris >>= \is -> do+    _ <- isTable is+    skipTable is+    parse parseTrailerAfterTable is+trailer _ (XRefStream _ (Stream dict _)) = return dict++skipTable :: MonadIO m => IS -> PdfE m ()+skipTable is =+  subsectionHeader is >>= go . snd+  where+  go count = nextSubsectionHeader is count >>= maybe (return ()) (go . snd)++subsectionHeader :: MonadIO m => IS -> PdfE m (Int, Int)+subsectionHeader = parse parseSubsectionHeader++nextSubsectionHeader :: MonadIO m => IS -> Int -> PdfE m (Maybe (Int, Int))+nextSubsectionHeader is count = do+  skipSubsection is count+  hush `liftM` (runEitherT $ subsectionHeader is)++skipSubsection :: MonadIO m => IS -> Int -> PdfE m ()+skipSubsection is count = dropExactly (count * 20) is++-- | Read xref entry for the indirect object from xref table+--+-- RIS position should point to the begining of the next+-- line after \"xref\" keyword+lookupTableEntry :: MonadIO m+               => RIS             -- ^ input stream to read from+               -> Ref             -- ^ indirect object to look for+               -> PdfE m (Maybe TableEntry)+lookupTableEntry ris (Ref index gen) = annotateError "Can't read entry from xref table" $+  inputStream ris >>= subsectionHeader >>= go+  where+  go (start, count) = do+    if index >= start && index < start + count+      then do+        tell ris >>= seek ris . (+ (fromIntegral $ index - start) * 20)+        (off, gen', free) <- inputStream ris >>= parse parseTableEntry+        unless (gen == gen') $ left $ UnexpectedError "Generation mismatch"+        return $ Just $ TableEntry off gen free+      else do+        is <- inputStream ris+        nextSubsectionHeader is count >>= maybe (return Nothing) go++-- | Read xref entry for the indirect object from xref stream+--+-- See pdf1.7 spec: 7.5.8 Cross-Reference Streams+lookupStreamEntry :: MonadIO m+                => Stream IS                -- ^ decoded xref stream content+                -> Ref                      -- ^ indirect object+                -> PdfE m (Maybe StreamEntry)+lookupStreamEntry (Stream dict is) (Ref objNumber _) = annotateError "Can't parse xref stream" $ do+  sz <- lookupDict "Size" dict >>= fromObject >>= intValue++  index <- do+    Array i <- (lookupDict "Index" dict >>= fromObject)+      `catchT`+      const (return $ Array [ONumber $ NumInt 0, ONumber $ NumInt sz])+    let convertIndex res [] = return $ reverse res+        convertIndex res (x1:x2:xs) = do+          from <- fromObject x1 >>= intValue+          count <- fromObject x2 >>= intValue+          convertIndex ((from, count) : res) xs+        convertIndex _ _ = left $ UnexpectedError $ "Malformed Index in xref stream: " ++ show i+    convertIndex [] i++  width <- do+    Array w <- lookupDict "W" dict >>= fromObject+    mapM (fromObject >=> intValue) w+  unless (length width == 3) $ left $ UnexpectedError $ "Malformed With array in xref stream: " ++ show width++  values <- do+    let position = loop 0 index+        totalWidth = sum width+        loop _ [] = Nothing+        loop pos ((from, count) : xs) =+          if objNumber < from || objNumber >= from + count+            then loop (pos + totalWidth * count) xs+            else Just (pos + totalWidth * (objNumber - from))+    case position of+      Nothing -> return Nothing+      Just p -> dropExactly p is >> (Just . BS.unpack) `liftM` readExactly totalWidth is++  case values of+    Nothing -> return Nothing+    Just vs -> do+      let [v1, v2, v3] = map conv $ collect [] width vs :: [Int64]+            where+            conv l = conv' (length l - 1) 0 l+            conv' _ res [] = res+            conv' power res (x:xs) = conv' (power-1) (res + (fromIntegral x * 256 ^ power)) xs+            collect res [] [] = reverse res+            collect res (x:xs) ys = collect (take x ys : res) xs (drop x ys)+            collect _ _ _ = error "readStreamEntry: collect: impossible"+      case v1 of+        0 -> return $ Just $ StreamEntryFree (fromIntegral v2) (fromIntegral v3)+        1 -> return $ Just $ StreamEntryUsed v2 (fromIntegral v3)+        2 -> return $ Just $ StreamEntryCompressed (fromIntegral v2) (fromIntegral v3)+        _ -> left $ UnexpectedError $ "Unexpected xret stream entry type: " ++ show v1
+ pdf-toolbox-core.cabal view
@@ -0,0 +1,56 @@+name:                pdf-toolbox-core+version:             0.0.1.0+synopsis:            A collection of tools for processing PDF files.+license:             BSD3+license-file:        LICENSE+author:              Yuras Shumovich+maintainer:          Yuras Shumovich <shumovichy@gmail.com>+copyright:           Copyright (c) Yuras Shumovich 2012-2013+category:            PDF+build-type:          Simple+cabal-version:       >=1.8+homepage:            https://github.com/Yuras/pdf-toolbox+description:+  Low level tools for processing PDF files.+  .+  Level of abstraction: cross reference, trailer, indirect object, object+  .+  The API is based on random access input streams, and is designed to be memory efficient.+  We don't need to parse the entire PDF file and store it in memory when you need just one page or two.+  Usually it is also leads to time efficiency, but we don't try optimize performance+  by e.g. maintaining xref or object cache. Higher level layers should take care of it.+  .+  The library is low level. It may mean that you need to be familiar with PDF file internals to+  actually use it.++source-repository head+  type:                git+  location:            git://github.com/Yuras/pdf-toolbox.git++library+  hs-source-dirs:      lib+  exposed-modules:     Pdf.Toolbox.Core+                       Pdf.Toolbox.Core.IO+                       Pdf.Toolbox.Core.IO.RIS+                       Pdf.Toolbox.Core.Object.Types+                       Pdf.Toolbox.Core.Object.Builder+                       Pdf.Toolbox.Core.Object.Util+                       Pdf.Toolbox.Core.Error+                       Pdf.Toolbox.Core.Parsers.Object+                       Pdf.Toolbox.Core.Parsers.XRef+                       Pdf.Toolbox.Core.Parsers.Util+                       Pdf.Toolbox.Core.Stream.Filter.Type+                       Pdf.Toolbox.Core.Stream.Filter.FlateDecode+                       Pdf.Toolbox.Core.Stream+                       Pdf.Toolbox.Core.XRef+                       Pdf.Toolbox.Core.Util+                       Pdf.Toolbox.Core.Writer+  -- other-modules:       +  build-depends:       base ==4.6.*,+                       bytestring,+                       io-streams,+                       attoparsec,+                       errors,+                       transformers,+                       containers,+                       zlib-bindings