-- | Unclassified tools

module Pdf.Core.Util
( notice
, readObjectAtOffset
, readCompressedObject
)
where

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

import Data.Int
import Data.ByteString (ByteString)
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as Parser
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

-- | Add a message to 'Maybe'
notice :: Maybe a -> String -> Either String a
notice :: Maybe a -> String -> Either String a
notice Maybe a
Nothing = String -> Either String a
forall a b. a -> Either a b
Left
notice (Just a
a) = Either String a -> String -> Either String a
forall a b. a -> b -> a
const (a -> Either String a
forall a b. b -> Either a b
Right a
a)

-- | Read indirect object at the specified offset
--
-- Returns the object and the 'Ref'. The payload for stream
-- will be an offset of stream content
readObjectAtOffset :: Buffer
                   -> Int64   -- ^ object offset
                   -> IO (Ref, Object)
readObjectAtOffset :: Buffer -> Int64 -> IO (Ref, Object)
readObjectAtOffset Buffer
buf Int64
off = String -> IO (Ref, Object) -> IO (Ref, Object)
forall a. String -> IO a -> IO a
message String
"readObjectAtOffset" (IO (Ref, Object) -> IO (Ref, Object))
-> IO (Ref, Object) -> IO (Ref, Object)
forall a b. (a -> b) -> a -> b
$ do
  Buffer -> Int64 -> IO ()
Buffer.seek Buffer
buf Int64
off
  (Ref
ref, Object
o) <- Parser (Ref, Object) -> InputStream ByteString -> IO (Ref, Object)
forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream Parser (Ref, Object)
parseIndirectObject
    (Buffer -> InputStream ByteString
Buffer.toInputStream Buffer
buf)
      IO (Ref, Object)
-> (ParseException -> IO (Ref, Object)) -> IO (Ref, Object)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
msg) -> Corrupted -> IO (Ref, Object)
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
msg [])
  case Object
o of
    Stream (S Dict
dict Int64
_) -> do
      Int64
pos <- Buffer -> IO Int64
Buffer.tell Buffer
buf
      (Ref, Object) -> IO (Ref, Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref
ref, Stream -> Object
Stream (Dict -> Int64 -> Stream
S Dict
dict Int64
pos))
    Ref Ref
_ -> Corrupted -> IO (Ref, Object)
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO (Ref, Object)) -> Corrupted -> IO (Ref, Object)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
"Indirect object can't be a Ref" []
    Object
_ -> (Ref, Object) -> IO (Ref, Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref
ref, Object
o)

-- | Read object from object stream
--
-- Never returns 'Stream'
readCompressedObject :: InputStream ByteString
                     -- ^ decoded object stream
                     -> Int64
                     -- ^ an offset of the first object
                     -- (\"First\" key in dictionary)
                     -> Int
                     -- ^ object number to read
                     -> IO Object
readCompressedObject :: InputStream ByteString -> Int64 -> Int -> IO Object
readCompressedObject InputStream ByteString
is Int64
first Int
num = do
  (InputStream ByteString
is', IO Int64
counter) <- InputStream ByteString -> IO (InputStream ByteString, IO Int64)
Streams.countInput InputStream ByteString
is
  Int64
off <- do
    [(Int, Int64)]
res <- Parser [(Int, Int64)]
-> InputStream ByteString -> IO [(Int, Int64)]
forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream (Int -> Parser ByteString (Int, Int64) -> Parser [(Int, Int64)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Parser ByteString (Int, Int64)
headerP) InputStream ByteString
is'
      IO [(Int, Int64)]
-> (ParseException -> IO [(Int, Int64)]) -> IO [(Int, Int64)]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
msg) -> Corrupted -> IO [(Int, Int64)]
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO [(Int, Int64)]) -> Corrupted -> IO [(Int, Int64)]
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted
        String
"Object stream" [String
msg]
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Int, Int64)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int64)]
res) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> IO ()
forall a. HasCallStack => String -> a
error String
"readCompressedObject: imposible"
    case [(Int, Int64)] -> (Int, Int64)
forall a. [a] -> a
last [(Int, Int64)]
res of
      (Int
_, Int64
off) -> Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
off
  Int64
pos <- IO Int64
counter
  Int -> InputStream ByteString -> IO ()
Buffer.dropExactly (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64
first Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
off Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
pos) InputStream ByteString
is
  Parser Object -> InputStream ByteString -> IO Object
forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream Parser Object
parseObject InputStream ByteString
is
    IO Object -> (ParseException -> IO Object) -> IO Object
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
msg) -> Corrupted -> IO Object
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO Object) -> Corrupted -> IO Object
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted
      String
"Object in object stream" [String
msg]
  where
  headerP :: Parser (Int, Int64)
  headerP :: Parser ByteString (Int, Int64)
headerP = do
    Int
n <- Parser Int
forall a. Integral a => Parser a
Parser.decimal
    Parser ()
Parser.skipSpace
    Int64
off <- Parser Int64
forall a. Integral a => Parser a
Parser.decimal
    Parser ()
Parser.skipSpace
    (Int, Int64) -> Parser ByteString (Int, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, Int64
off)