{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | Cross reference

module Pdf.Core.XRef
(
  XRef(..),
  Entry(..),
  readXRef,
  lastXRef,
  prevXRef,
  trailer,
  lookupTableEntry,
  lookupStreamEntry,
  isTable,
  UnknownXRefStreamEntryType(..),
)
where

import Pdf.Core.Object
import Pdf.Core.Object.Util
import Pdf.Core.Parsers.XRef
import Pdf.Core.Stream
import Pdf.Core.Exception
import Pdf.Core.Util
import Pdf.Core.IO.Buffer (Buffer)
import qualified Pdf.Core.IO.Buffer as Buffer

import Data.Typeable
import Data.Int
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.Vector as Vector
import qualified Data.HashMap.Strict as HashMap
import Control.Monad
import Control.Exception hiding (throw)
import System.IO.Streams (InputStream)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.Attoparsec as Streams

-- | Entry in cross reference stream
data Entry =
  -- | Object number and generation
  EntryFree Int Int |
  -- | Object offset (in bytes from the beginning of file) and generation
  EntryUsed Int64 Int |
  -- | Object number of object stream and index within the object stream
  EntryCompressed Int Int
  deriving (Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
(Int -> Entry -> ShowS)
-> (Entry -> String) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show)

-- | Cross reference
data XRef =
  -- | Offset
  XRefTable Int64 |
  -- | Offset and stream
  XRefStream Int64 Stream
  deriving (XRef -> XRef -> Bool
(XRef -> XRef -> Bool) -> (XRef -> XRef -> Bool) -> Eq XRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XRef -> XRef -> Bool
$c/= :: XRef -> XRef -> Bool
== :: XRef -> XRef -> Bool
$c== :: XRef -> XRef -> Bool
Eq, Int -> XRef -> ShowS
[XRef] -> ShowS
XRef -> String
(Int -> XRef -> ShowS)
-> (XRef -> String) -> ([XRef] -> ShowS) -> Show XRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XRef] -> ShowS
$cshowList :: [XRef] -> ShowS
show :: XRef -> String
$cshow :: XRef -> String
showsPrec :: Int -> XRef -> ShowS
$cshowsPrec :: Int -> XRef -> ShowS
Show)

-- | Check whether the stream starts with \"xref\" keyword.
-- The keyword itself and newline after it are consumed
isTable :: InputStream ByteString -> IO Bool
isTable :: InputStream ByteString -> IO Bool
isTable InputStream ByteString
is = (Parser () -> InputStream ByteString -> IO ()
forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream Parser ()
tableXRef InputStream ByteString
is IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
  IO Bool -> (ParseException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
_) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Find the last cross reference
lastXRef :: Buffer -> IO XRef
lastXRef :: Buffer -> IO XRef
lastXRef Buffer
buf = do
  Int64
sz <- Buffer -> IO Int64
Buffer.size Buffer
buf
  Buffer -> Int64 -> IO ()
Buffer.seek Buffer
buf (Int64 -> IO ()) -> Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
0 (Int64
sz Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1024)
  (Parser Int64 -> InputStream ByteString -> IO Int64
forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream Parser Int64
startXRef (Buffer -> InputStream ByteString
Buffer.toInputStream Buffer
buf)
    IO Int64 -> (Int64 -> IO XRef) -> IO XRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Buffer -> Int64 -> IO XRef
readXRef Buffer
buf
    ) IO XRef -> (ParseException -> IO XRef) -> IO XRef
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
msg) ->
                  Corrupted -> IO XRef
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"lastXRef" [String
msg])

-- | Read XRef at specified offset
readXRef :: Buffer -> Int64 -> IO XRef
readXRef :: Buffer -> Int64 -> IO XRef
readXRef Buffer
buf Int64
off = do
  Buffer -> Int64 -> IO ()
Buffer.seek Buffer
buf Int64
off
  let is :: InputStream ByteString
is = Buffer -> InputStream ByteString
Buffer.toInputStream Buffer
buf
  Bool
table <- InputStream ByteString -> IO Bool
isTable InputStream ByteString
is
  if Bool
table
    then XRef -> IO XRef
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> XRef
XRefTable Int64
off)
    else do
      Stream
s <- InputStream ByteString -> Int64 -> IO Stream
readStream InputStream ByteString
is Int64
off
      XRef -> IO XRef
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Stream -> XRef
XRefStream Int64
off Stream
s)

-- | Find prev cross reference
prevXRef :: Buffer -> XRef -> IO (Maybe XRef)
prevXRef :: Buffer -> XRef -> IO (Maybe XRef)
prevXRef Buffer
buf XRef
xref = String -> IO (Maybe XRef) -> IO (Maybe XRef)
forall a. String -> IO a -> IO a
message String
"prevXRef" (IO (Maybe XRef) -> IO (Maybe XRef))
-> IO (Maybe XRef) -> IO (Maybe XRef)
forall a b. (a -> b) -> a -> b
$ do
  Dict
tr <- Buffer -> XRef -> IO Dict
trailer Buffer
buf XRef
xref
  case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Prev" Dict
tr of
    Just Object
prev -> do
      Int
off <- Either String Int -> IO Int
forall a. Either String a -> IO a
sure (Either String Int -> IO Int) -> Either String Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Int
intValue Object
prev
        Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"Prev in trailer should be an integer"
      XRef -> Maybe XRef
forall a. a -> Maybe a
Just (XRef -> Maybe XRef) -> IO XRef -> IO (Maybe XRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Int64 -> IO XRef
readXRef Buffer
buf (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off)
    Maybe Object
_ -> Maybe XRef -> IO (Maybe XRef)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XRef
forall a. Maybe a
Nothing

-- | Read trailer for the xref
trailer :: Buffer -> XRef -> IO Dict
trailer :: Buffer -> XRef -> IO Dict
trailer Buffer
buf (XRefTable Int64
off) = do
  Buffer -> Int64 -> IO ()
Buffer.seek Buffer
buf Int64
off
  let is :: InputStream ByteString
is = Buffer -> InputStream ByteString
Buffer.toInputStream Buffer
buf
  Bool
table <- InputStream ByteString -> IO Bool
isTable InputStream ByteString
is
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
table (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Unexpected -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Unexpected
Unexpected String
"trailer" [String
"table not found"])
  ( InputStream ByteString -> IO ()
skipTable InputStream ByteString
is IO () -> IO Dict -> IO Dict
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser Dict -> InputStream ByteString -> IO Dict
forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream Parser Dict
parseTrailerAfterTable InputStream ByteString
is
    ) IO Dict -> (ParseException -> IO Dict) -> IO Dict
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
msg) ->
                  Corrupted -> IO Dict
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"trailer" [String
msg])
trailer Buffer
_ (XRefStream Int64
_ (S Dict
dict Int64
_)) = Dict -> IO Dict
forall (m :: * -> *) a. Monad m => a -> m a
return Dict
dict

skipTable :: InputStream ByteString -> IO ()
skipTable :: InputStream ByteString -> IO ()
skipTable InputStream ByteString
is = String -> IO () -> IO ()
forall a. String -> IO a -> IO a
message String
"skipTable" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  (InputStream ByteString -> IO (Int, Int)
subsectionHeader InputStream ByteString
is
    IO (Int, Int) -> (ParseException -> IO (Int, Int)) -> IO (Int, Int)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
msg) ->
      Corrupted -> IO (Int, Int)
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
msg []))
    IO (Int, Int) -> ((Int, Int) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IO ()
go (Int -> IO ()) -> ((Int, Int) -> Int) -> (Int, Int) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd
  where
  go :: Int -> IO ()
go Int
count = InputStream ByteString -> Int -> IO (Maybe (Int, Int))
nextSubsectionHeader InputStream ByteString
is Int
count IO (Maybe (Int, Int)) -> (Maybe (Int, Int) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ((Int, Int) -> IO ()) -> Maybe (Int, Int) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Int -> IO ()
go (Int -> IO ()) -> ((Int, Int) -> Int) -> (Int, Int) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd)

subsectionHeader :: InputStream ByteString -> IO (Int, Int)
subsectionHeader :: InputStream ByteString -> IO (Int, Int)
subsectionHeader = Parser (Int, Int) -> InputStream ByteString -> IO (Int, Int)
forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream Parser (Int, Int)
parseSubsectionHeader

nextSubsectionHeader :: InputStream ByteString -> Int -> IO (Maybe (Int, Int))
nextSubsectionHeader :: InputStream ByteString -> Int -> IO (Maybe (Int, Int))
nextSubsectionHeader InputStream ByteString
is Int
count = String -> IO (Maybe (Int, Int)) -> IO (Maybe (Int, Int))
forall a. String -> IO a -> IO a
message String
"nextSubsectionHeader" (IO (Maybe (Int, Int)) -> IO (Maybe (Int, Int)))
-> IO (Maybe (Int, Int)) -> IO (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ do
  InputStream ByteString -> Int -> IO ()
skipSubsection InputStream ByteString
is Int
count
  ((Int, Int) -> Maybe (Int, Int))
-> IO (Int, Int) -> IO (Maybe (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (InputStream ByteString -> IO (Int, Int)
subsectionHeader InputStream ByteString
is)
    IO (Maybe (Int, Int))
-> (ParseException -> IO (Maybe (Int, Int)))
-> IO (Maybe (Int, Int))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
_) -> Maybe (Int, Int) -> IO (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
forall a. Maybe a
Nothing

skipSubsection :: InputStream ByteString -> Int -> IO ()
skipSubsection :: InputStream ByteString -> Int -> IO ()
skipSubsection InputStream ByteString
is Int
count = Int -> InputStream ByteString -> IO ()
Buffer.dropExactly (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
20) InputStream ByteString
is

-- | Read xref entry for the indirect object from xref table
lookupTableEntry :: Buffer
                 -> XRef  -- ^ should be xref table
                 -> Ref   -- ^ indirect object to look for
                 -> IO (Maybe Entry)
lookupTableEntry :: Buffer -> XRef -> Ref -> IO (Maybe Entry)
lookupTableEntry Buffer
buf (XRefTable Int64
tableOff) (R Int
index Int
gen)
  = String -> IO (Maybe Entry) -> IO (Maybe Entry)
forall a. String -> IO a -> IO a
message String
"lookupTableEntry" (IO (Maybe Entry) -> IO (Maybe Entry))
-> IO (Maybe Entry) -> IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ do
  Buffer -> Int64 -> IO ()
Buffer.seek Buffer
buf Int64
tableOff
  Bool
table <- InputStream ByteString -> IO Bool
isTable (Buffer -> InputStream ByteString
Buffer.toInputStream Buffer
buf)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
table (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Unexpected -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Unexpected -> IO ()) -> Unexpected -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Unexpected
Unexpected String
"Not a table" []
  (InputStream ByteString -> IO (Int, Int)
subsectionHeader (Buffer -> InputStream ByteString
Buffer.toInputStream Buffer
buf) IO (Int, Int)
-> ((Int, Int) -> IO (Maybe Entry)) -> IO (Maybe Entry)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> IO (Maybe Entry)
go)
    IO (Maybe Entry)
-> (ParseException -> IO (Maybe Entry)) -> IO (Maybe Entry)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
err) -> Corrupted -> IO (Maybe Entry)
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
err [])
  where
  go :: (Int, Int) -> IO (Maybe Entry)
go (Int
start, Int
count) = do
    if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
start Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count
      then do
        -- that is our section, lets seek to the row
        Buffer -> IO Int64
Buffer.tell Buffer
buf
          IO Int64 -> (Int64 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Buffer -> Int64 -> IO ()
Buffer.seek Buffer
buf (Int64 -> IO ()) -> (Int64 -> Int64) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
20)
        (Int64
off, Int
gen', Bool
free) <-
          Parser (Int64, Int, Bool)
-> InputStream ByteString -> IO (Int64, Int, Bool)
forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream Parser (Int64, Int, Bool)
parseTableEntry (Buffer -> InputStream ByteString
Buffer.toInputStream Buffer
buf)
            IO (Int64, Int, Bool)
-> (ParseException -> IO (Int64, Int, Bool))
-> IO (Int64, Int, Bool)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
msg) ->
              Corrupted -> IO (Int64, Int, Bool)
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"parseTableEntry failed" [String
msg])
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
free Bool -> Bool -> Bool
|| Int
gen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
gen') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (Int, Int, Int64, Int, Bool) -> IO ()
forall a. Show a => a -> IO ()
print (Int
index, Int
gen, Int64
off, Int
gen', Bool
free)
          Corrupted -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO ()) -> Corrupted -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
"Generation mismatch" []
        let entry :: Entry
entry = if Bool
free
              then Int -> Int -> Entry
EntryFree (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
off) Int
gen
              else Int64 -> Int -> Entry
EntryUsed Int64
off Int
gen
        Maybe Entry -> IO (Maybe Entry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> Maybe Entry
forall a. a -> Maybe a
Just Entry
entry)
      else
        -- go to the next section if any
        InputStream ByteString -> Int -> IO (Maybe (Int, Int))
nextSubsectionHeader (Buffer -> InputStream ByteString
Buffer.toInputStream Buffer
buf) Int
count
        IO (Maybe (Int, Int))
-> (Maybe (Int, Int) -> IO (Maybe Entry)) -> IO (Maybe Entry)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe Entry)
-> ((Int, Int) -> IO (Maybe Entry))
-> Maybe (Int, Int)
-> IO (Maybe Entry)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Entry -> IO (Maybe Entry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Entry
forall a. Maybe a
Nothing) (Int, Int) -> IO (Maybe Entry)
go
lookupTableEntry Buffer
_ XRefStream{} Ref
_ =
  Unexpected -> IO (Maybe Entry)
forall e a. Exception e => e -> IO a
throwIO (Unexpected -> IO (Maybe Entry)) -> Unexpected -> IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Unexpected
Unexpected String
"lookupTableEntry" [String
"Only xref table allowed"]

-- | Read xref entry for the indirect object from xref stream
--
-- See pdf1.7 spec: 7.5.8 Cross-Reference Streams.
-- May throw 'UnknownXRefStreamEntryType'
lookupStreamEntry
  :: Dict                    -- ^ xref stream dictionary
  -> InputStream ByteString  -- ^ decoded xref stream content
  -> Ref                     -- ^ indirect object
  -> IO (Maybe Entry)
lookupStreamEntry :: Dict -> InputStream ByteString -> Ref -> IO (Maybe Entry)
lookupStreamEntry Dict
dict InputStream ByteString
is (R Int
objNumber Int
_) =
  String -> IO (Maybe Entry) -> IO (Maybe Entry)
forall a. String -> IO a -> IO a
message String
"lookupStreamEntry" (IO (Maybe Entry) -> IO (Maybe Entry))
-> IO (Maybe Entry) -> IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ do

  [(Int, Int)]
index <- Either String [(Int, Int)] -> IO [(Int, Int)]
forall a. Either String a -> IO a
sure (Either String [(Int, Int)] -> IO [(Int, Int)])
-> Either String [(Int, Int)] -> IO [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ do
    Int
sz <- (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Size" Dict
dict Maybe Object -> (Object -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Int
intValue)
      Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"Size should be an integer"
    [Object]
i <-
      case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Index" Dict
dict of
        Maybe Object
Nothing           -> [Object] -> Either String [Object]
forall a b. b -> Either a b
Right [Scientific -> Object
Number Scientific
0, Scientific -> Object
Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)]
        Just (Array Array
arr) -> [Object] -> Either String [Object]
forall a b. b -> Either a b
Right (Array -> [Object]
forall a. Vector a -> [a]
Vector.toList Array
arr)
        Maybe Object
_                 -> String -> Either String [Object]
forall a b. a -> Either a b
Left String
"Index should be an array"

    let convertIndex :: [(Int, Int)] -> [Object] -> Either String [(Int, Int)]
convertIndex [(Int, Int)]
res [] = [(Int, Int)] -> Either String [(Int, Int)]
forall a b. b -> Either a b
Right ([(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a]
reverse [(Int, Int)]
res)
        convertIndex [(Int, Int)]
res (Object
x1:Object
x2:[Object]
xs) = do
          Int
from <- Object -> Maybe Int
intValue Object
x1 Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"from index should be an integer"
          Int
count <- Object -> Maybe Int
intValue Object
x2 Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"count should be an integer"
          [(Int, Int)] -> [Object] -> Either String [(Int, Int)]
convertIndex ((Int
from, Int
count) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)]
res) [Object]
xs
        convertIndex [(Int, Int)]
_ [Object]
_ = String -> Either String [(Int, Int)]
forall a b. a -> Either a b
Left (String -> Either String [(Int, Int)])
-> String -> Either String [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ String
"Malformed Index in xref stream: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
i

    [(Int, Int)] -> [Object] -> Either String [(Int, Int)]
convertIndex [] [Object]
i

  [Int]
width <- Either String [Int] -> IO [Int]
forall a. Either String a -> IO a
sure (Either String [Int] -> IO [Int])
-> Either String [Int] -> IO [Int]
forall a b. (a -> b) -> a -> b
$ do
    [Object]
ws <-
      case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"W" Dict
dict of
        Just (Array Array
ws) -> [Object] -> Either String [Object]
forall a b. b -> Either a b
Right (Array -> [Object]
forall a. Vector a -> [a]
Vector.toList Array
ws)
        Maybe Object
_ -> String -> Either String [Object]
forall a b. a -> Either a b
Left String
"W should be an array"
    (Object -> Maybe Int) -> [Object] -> Maybe [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Object -> Maybe Int
intValue [Object]
ws
      Maybe [Int] -> String -> Either String [Int]
forall a. Maybe a -> String -> Either String a
`notice` String
"W should contains integers"

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
width Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Corrupted -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO ()) -> Corrupted -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted (String
"Malformed With array in xref stream: "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
width) []

  Maybe [Word8]
values <- do
    let position :: Maybe Int
position = Int -> [(Int, Int)] -> Maybe Int
loop Int
0 [(Int, Int)]
index
        totalWidth :: Int
totalWidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
width
        loop :: Int -> [(Int, Int)] -> Maybe Int
loop Int
_ [] = Maybe Int
forall a. Maybe a
Nothing
        loop Int
pos ((Int
from, Int
count) : [(Int, Int)]
xs) =
          if Int
objNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
from Bool -> Bool -> Bool
|| Int
objNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count
            then Int -> [(Int, Int)] -> Maybe Int
loop (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
totalWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
count) [(Int, Int)]
xs
            else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
totalWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
objNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
from))
    case Maybe Int
position of
      Maybe Int
Nothing -> Maybe [Word8] -> IO (Maybe [Word8])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Word8]
forall a. Maybe a
Nothing
      Just Int
p -> do
        Int -> InputStream ByteString -> IO ()
Buffer.dropExactly Int
p InputStream ByteString
is
        [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just ([Word8] -> Maybe [Word8])
-> (ByteString -> [Word8]) -> ByteString -> Maybe [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
ByteString.unpack (ByteString -> Maybe [Word8])
-> IO ByteString -> IO (Maybe [Word8])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> InputStream ByteString -> IO ByteString
Streams.readExactly Int
totalWidth InputStream ByteString
is

  case Maybe [Word8]
values of
    Maybe [Word8]
Nothing -> Maybe Entry -> IO (Maybe Entry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Entry
forall a. Maybe a
Nothing
    Just [Word8]
vs -> do
      let [Int64
v1, Int64
v2, Int64
v3] = ([Word8] -> Int64) -> [[Word8]] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> Int64
forall a t. (Integral a, Num t) => [a] -> t
conv ([[Word8]] -> [Int64]) -> [[Word8]] -> [Int64]
forall a b. (a -> b) -> a -> b
$ [[Word8]] -> [Int] -> [Word8] -> [[Word8]]
forall a. [[a]] -> [Int] -> [a] -> [[a]]
collect [] [Int]
width [Word8]
vs :: [Int64]
            where
            conv :: [a] -> t
conv [a]
l = Int -> t -> [a] -> t
forall a b t. (Integral a, Integral b, Num t) => b -> t -> [a] -> t
conv' ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) t
0 [a]
l
            conv' :: b -> t -> [a] -> t
conv' b
_ t
res [] = t
res
            conv' b
power t
res (a
x:[a]
xs) =
              b -> t -> [a] -> t
conv' (b
powerb -> b -> b
forall a. Num a => a -> a -> a
-b
1) (t
res t -> t -> t
forall a. Num a => a -> a -> a
+ (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x t -> t -> t
forall a. Num a => a -> a -> a
* t
256 t -> b -> t
forall a b. (Num a, Integral b) => a -> b -> a
^ b
power)) [a]
xs
            collect :: [[a]] -> [Int] -> [a] -> [[a]]
collect [[a]]
res [] [] = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
res
            collect [[a]]
res (Int
x:[Int]
xs) [a]
ys = [[a]] -> [Int] -> [a] -> [[a]]
collect (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
x [a]
ys [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
res) [Int]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
x [a]
ys)
            collect [[a]]
_ [Int]
_ [a]
_ = String -> [[a]]
forall a. HasCallStack => String -> a
error String
"readStreamEntry: collect: impossible"
      case Int64
v1 of
        Int64
0 -> Maybe Entry -> IO (Maybe Entry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Entry -> IO (Maybe Entry))
-> Maybe Entry -> IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry) -> Entry -> Maybe Entry
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Entry
EntryFree (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v2)
                                             (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v3)
        Int64
1 -> Maybe Entry -> IO (Maybe Entry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Entry -> IO (Maybe Entry))
-> Maybe Entry -> IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry) -> Entry -> Maybe Entry
forall a b. (a -> b) -> a -> b
$ Int64 -> Int -> Entry
EntryUsed Int64
v2 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v3)
        Int64
2 -> Maybe Entry -> IO (Maybe Entry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Entry -> IO (Maybe Entry))
-> Maybe Entry -> IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry) -> Entry -> Maybe Entry
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Entry
EntryCompressed (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v2)
                                                   (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v3)
        Int64
_ -> UnknownXRefStreamEntryType -> IO (Maybe Entry)
forall e a. Exception e => e -> IO a
throwIO (UnknownXRefStreamEntryType -> IO (Maybe Entry))
-> UnknownXRefStreamEntryType -> IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ Int -> UnknownXRefStreamEntryType
UnknownXRefStreamEntryType (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v1)

-- | Unknown entry type should be interpreted as reference to null object
data UnknownXRefStreamEntryType = UnknownXRefStreamEntryType Int
  deriving (Int -> UnknownXRefStreamEntryType -> ShowS
[UnknownXRefStreamEntryType] -> ShowS
UnknownXRefStreamEntryType -> String
(Int -> UnknownXRefStreamEntryType -> ShowS)
-> (UnknownXRefStreamEntryType -> String)
-> ([UnknownXRefStreamEntryType] -> ShowS)
-> Show UnknownXRefStreamEntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnknownXRefStreamEntryType] -> ShowS
$cshowList :: [UnknownXRefStreamEntryType] -> ShowS
show :: UnknownXRefStreamEntryType -> String
$cshow :: UnknownXRefStreamEntryType -> String
showsPrec :: Int -> UnknownXRefStreamEntryType -> ShowS
$cshowsPrec :: Int -> UnknownXRefStreamEntryType -> ShowS
Show, Typeable)

instance Exception UnknownXRefStreamEntryType