{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}

-- | Flate decode filter

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

-- | Vary basic implementation. Only PNG-UP prediction is implemented
--
-- Nothing when zlib is disabled via cabal flag
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) []

-- | PGN-UP prediction
--
-- TODO: Hacky solution, rewrite it
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