66 lines
2.3 KiB
Haskell
66 lines
2.3 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import Codec.Compression.Zlib (compress, decompress)
|
|
import Control.Monad.State (execState, execStateT)
|
|
import Data.ByteString.Char8 (ByteString)
|
|
import qualified Data.ByteString.Char8 as BS (
|
|
length, readFile
|
|
)
|
|
import qualified Data.ByteString.Lazy.Char8 as Lazy (
|
|
fromStrict, intercalate, split, toStrict, writeFile
|
|
)
|
|
import qualified Data.Map as Map (insert, lookup)
|
|
import PDF (AllLayers(..), Document(..), UnifiedLayers(..), parseDocument, render)
|
|
import PDF.Box (I(..), (.@), edit, modifyAt)
|
|
import PDF.Layer (AllObjects(..))
|
|
import PDF.Object (DirectObject(..), Object(..), Name(..), Number(..))
|
|
import PDF.TextRendering (TextRendering(..), update)
|
|
import Prelude hiding (lines, unlines)
|
|
import System.Environment (getArgs)
|
|
import System.IO (hPutStrLn, stderr)
|
|
|
|
revealFlateEncodedText :: ByteString -> ByteString
|
|
revealFlateEncodedText =
|
|
Lazy.toStrict . compress . revealText . decompress . Lazy.fromStrict
|
|
where
|
|
lines = Lazy.split '\n'
|
|
unlines = Lazy.intercalate "\n"
|
|
revealText = unlines . fmap fill . lines
|
|
fill = update $ const Fill
|
|
|
|
revealObject :: Object -> Object
|
|
revealObject obj@(Stream {header, streamContent}) =
|
|
case Map.lookup (Name "Filter") header of
|
|
Just (NameObject (Name "FlateDecode")) ->
|
|
let newStreamContent = revealFlateEncodedText streamContent in
|
|
let newLength = Number . fromIntegral $ BS.length newStreamContent in
|
|
Stream {
|
|
header = Map.insert (Name "Length") (NumberObject newLength) header
|
|
, streamContent = newStreamContent
|
|
}
|
|
_ -> obj
|
|
revealObject obj = obj
|
|
|
|
reveal :: Document -> Document
|
|
reveal = execState $ do
|
|
modifyAt (UnifiedLayers .@ AllObjects) (return . fmap revealObject)
|
|
|
|
revealFirst :: Document -> Document
|
|
revealFirst document = maybe document id $ execStateT (do
|
|
modifyAt (AllLayers .@ I 0 .@ AllObjects) (return . fmap revealObject)
|
|
) document
|
|
|
|
deepReveal :: Document -> Document
|
|
deepReveal = execState $ do
|
|
modifyAt AllLayers (mapM . edit AllObjects $ return . fmap revealObject)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
[inputPath, outputPath] <- getArgs
|
|
result <- parseDocument <$> BS.readFile inputPath
|
|
case result of
|
|
Left parseError -> hPutStrLn stderr $ show parseError
|
|
Right doc -> Lazy.writeFile outputPath . render $ reveal doc
|