{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
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
data Entry =
EntryFree Int Int |
EntryUsed Int64 Int |
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)
data XRef =
XRefTable Int64 |
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)
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
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])
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)
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
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)
= 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))
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
lookupTableEntry :: Buffer
-> XRef
-> Ref
-> 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
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
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"]
lookupStreamEntry
:: Dict
-> InputStream ByteString
-> Ref
-> 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)
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