{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
module Pdf.Core.Stream.Filter.FlateDecode
(
flateDecode
)
where
import Data.Word
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.HashMap.Strict as HashMap
import Control.Exception hiding (throw)
import System.IO.Streams (InputStream)
import qualified System.IO.Streams as Streams
import Pdf.Core.Exception
import Pdf.Core.Object
import Pdf.Core.Object.Util
import Pdf.Core.Stream.Filter.Type
flateDecode :: Maybe StreamFilter
flateDecode :: Maybe StreamFilter
flateDecode = StreamFilter -> Maybe StreamFilter
forall a. a -> Maybe a
Just StreamFilter :: Name
-> (Maybe Dict
-> InputStream ByteString -> IO (InputStream ByteString))
-> StreamFilter
StreamFilter
{ filterName :: Name
filterName = Name
"FlateDecode"
, filterDecode :: Maybe Dict -> InputStream ByteString -> IO (InputStream ByteString)
filterDecode = Maybe Dict -> InputStream ByteString -> IO (InputStream ByteString)
decode
}
decode :: Maybe Dict -> InputStream ByteString -> IO (InputStream ByteString)
decode :: Maybe Dict -> InputStream ByteString -> IO (InputStream ByteString)
decode Maybe Dict
Nothing InputStream ByteString
is = InputStream ByteString -> IO (InputStream ByteString)
Streams.decompress InputStream ByteString
is
decode (Just Dict
dict) InputStream ByteString
is =
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Predictor" Dict
dict of
Maybe Object
Nothing -> InputStream ByteString -> IO (InputStream ByteString)
Streams.decompress InputStream ByteString
is
Just Object
o | Just Int
val <- Object -> Maybe Int
intValue Object
o ->
InputStream ByteString -> IO (InputStream ByteString)
Streams.decompress InputStream ByteString
is IO (InputStream ByteString)
-> (InputStream ByteString -> IO (InputStream ByteString))
-> IO (InputStream ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dict
-> Int -> InputStream ByteString -> IO (InputStream ByteString)
unpredict Dict
dict Int
val
Maybe Object
_ -> Corrupted -> IO (InputStream ByteString)
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO (InputStream ByteString))
-> Corrupted -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
"Predictor should be an integer" []
unpredict :: Dict
-> Int
-> InputStream ByteString
-> IO (InputStream ByteString)
unpredict :: Dict
-> Int -> InputStream ByteString -> IO (InputStream ByteString)
unpredict Dict
_ Int
1 InputStream ByteString
is = InputStream ByteString -> IO (InputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream ByteString
is
unpredict Dict
dict Int
12 InputStream ByteString
is = String
-> IO (InputStream ByteString) -> IO (InputStream ByteString)
forall a. String -> IO a -> IO a
message String
"unpredict" (IO (InputStream ByteString) -> IO (InputStream ByteString))
-> IO (InputStream ByteString) -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Columns" Dict
dict of
Maybe Object
Nothing -> Corrupted -> IO (InputStream ByteString)
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO (InputStream ByteString))
-> Corrupted -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
"Column is missing" []
Just Object
o
| Just Int
cols <- Object -> Maybe Int
intValue Object
o
-> Int -> InputStream ByteString -> IO (InputStream ByteString)
unpredict12 (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) InputStream ByteString
is
Maybe Object
_ -> Corrupted -> IO (InputStream ByteString)
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO (InputStream ByteString))
-> Corrupted -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
"Column should be an integer" []
unpredict Dict
_ Int
p InputStream ByteString
_ = Unexpected -> IO (InputStream ByteString)
forall e a. Exception e => e -> IO a
throwIO (Unexpected -> IO (InputStream ByteString))
-> Unexpected -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Unexpected
Unexpected (String
"Unsupported predictor: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
p) []
unpredict12 :: Int -> InputStream ByteString -> IO (InputStream ByteString)
unpredict12 :: Int -> InputStream ByteString -> IO (InputStream ByteString)
unpredict12 Int
cols InputStream ByteString
is
= InputStream ByteString -> IO [ByteString]
forall a. InputStream a -> IO [a]
Streams.toList InputStream ByteString
is
IO [ByteString]
-> ([ByteString] -> IO (InputStream ByteString))
-> IO (InputStream ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList ([ByteString] -> IO (InputStream ByteString))
-> ([ByteString] -> [ByteString])
-> [ByteString]
-> IO (InputStream ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return
(ByteString -> [ByteString])
-> ([ByteString] -> ByteString) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
ByteString.pack
([Word8] -> ByteString)
-> ([ByteString] -> [Word8]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8] -> [Word8] -> [Word8]
step (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
cols Word8
0) []
([Word8] -> [Word8])
-> ([ByteString] -> [Word8]) -> [ByteString] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [Word8]) -> [ByteString] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ByteString -> [Word8]
ByteString.unpack
where
step :: [Word8] -> [Word8] -> [Word8] -> [Word8]
step :: [Word8] -> [Word8] -> [Word8] -> [Word8]
step [Word8]
_ [Word8]
_ [] = []
step (Word8
c:[Word8]
cs) [] (Word8
_:[Word8]
xs) = [Word8] -> [Word8] -> [Word8] -> [Word8]
step [Word8]
cs [Word8
c] [Word8]
xs
step (Word8
c:[Word8]
cs) (Word8
p:[Word8]
ps) (Word8
x:[Word8]
xs) = (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
p) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8] -> [Word8] -> [Word8] -> [Word8]
step [Word8]
cs (Word8
cWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:(Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
p)Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
ps) [Word8]
xs
step [] [Word8]
ps [Word8]
xs = [Word8] -> [Word8] -> [Word8] -> [Word8]
step ([Word8] -> [Word8]
forall a. [a] -> [a]
reverse [Word8]
ps) [] [Word8]
xs