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
knownFilters :: [StreamFilter]
knownFilters = [flateDecode]
rawStreamContent :: MonadIO m
=> RIS
-> Int
-> Stream Int64
-> PdfE m (Stream IS)
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
decodedStreamContent :: MonadIO m
=> RIS
-> [StreamFilter]
-> (IS -> IO IS)
-> Int
-> Stream Int64
-> PdfE m (Stream IS)
decodedStreamContent ris filters decryptor len s = rawStreamContent ris len s >>= decodeStream filters decryptor
readStream :: MonadIO m => RIS -> PdfE m (Stream Int64)
readStream ris = do
Stream dict _ <- inputStream ris >>= parse parseIndirectObject >>= toStream . snd
Stream dict `liftM` tell ris
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 ++ ")"