Compare commits

...

8 commits

3 changed files with 27 additions and 41 deletions

View file

@ -24,7 +24,8 @@ executable reveal
build-depends: base >=4.9.1 && <4.13 build-depends: base >=4.9.1 && <4.13
, bytestring , bytestring
, containers , containers
, mtl
, Hufflepdf >= 0.2.0 , Hufflepdf >= 0.2.0
, zlib
hs-source-dirs: src hs-source-dirs: src
ghc-options: -Wall -rtsopts
default-language: Haskell2010 default-language: Haskell2010

View file

@ -1,54 +1,39 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import Codec.Compression.Zlib (compress, decompress)
import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS ( import qualified Data.ByteString.Char8 as BS (readFile, split, intercalate)
length, readFile import qualified Data.ByteString.Lazy.Char8 as Lazy (writeFile)
) import PDF (Layers(..), Document(..), UnifiedLayers(..), parseDocument, render)
import qualified Data.ByteString.Lazy.Char8 as Lazy ( import PDF.Box (Index(..), Either_(..), at, atAll)
fromStrict, intercalate, split, toStrict, writeFile import PDF.Layer (Layer, Objects(..))
) import PDF.Object.Navigation (StreamContent(..))
import qualified Data.Map as Map (insert, lookup)
import PDF (Document(..), parseDocument, render)
import PDF.Object (Content(..), DirectObject(..), Object(..), Name(..), Number(..))
import PDF.TextRendering (TextRendering(..), update) import PDF.TextRendering (TextRendering(..), update)
import Prelude hiding (lines, unlines) import Prelude hiding (lines, unlines)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr) import System.IO (hPutStrLn, stderr)
revealFlateEncodedText :: ByteString -> ByteString revealText :: ByteString -> ByteString
revealFlateEncodedText = revealText = unlines . fmap fill . lines
Lazy.toStrict . compress . revealText . decompress . Lazy.fromStrict
where where
lines = Lazy.split '\n' lines = BS.split '\n'
unlines = Lazy.intercalate "\n"
revealText = unlines . fmap fill . lines
fill = update $ const Fill fill = update $ const Fill
unlines = BS.intercalate "\n"
revealObject :: Object -> Object revealLayer :: Monad m => Layer -> m Layer
revealObject obj@(Stream {header, streamContent}) = revealLayer =
case Map.lookup (Name "Filter") header of atAll Objects
Just (NameObject (Name "FlateDecode")) -> .atAll (Either_ Clear) $
let newStreamContent = revealFlateEncodedText streamContent in return . revealText
let newLength = Number . fromIntegral $ BS.length newStreamContent in
Stream {
header = Map.insert (Name "Length") (NumberObject newLength) header
, streamContent = newStreamContent
}
_ -> obj
revealObject obj = obj
revealContent :: Content -> Content reveal :: Document -> IO Document
revealContent content = content { reveal = at UnifiedLayers $ revealLayer
objects = revealObject <$> (objects content)
}
reveal :: Document -> Document revealFirst :: Document -> IO Document
reveal document = document { revealFirst = at Layers .at(Index 0) $ revealLayer
updates = revealContent <$> (updates document)
} deepReveal :: Document -> IO Document
deepReveal = atAll Layers $ revealLayer
main :: IO () main :: IO ()
main = do main = do
@ -56,4 +41,4 @@ main = do
result <- parseDocument <$> BS.readFile inputPath result <- parseDocument <$> BS.readFile inputPath
case result of case result of
Left parseError -> hPutStrLn stderr $ show parseError Left parseError -> hPutStrLn stderr $ show parseError
Right doc -> Lazy.writeFile outputPath . render $ reveal doc Right doc -> Lazy.writeFile outputPath . render =<< reveal doc

View file

@ -4,8 +4,8 @@ module PDF.TextRendering (
, update , update
) where ) where
import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BS (intercalate, pack, readInt, split) import qualified Data.ByteString.Char8 as BS (intercalate, pack, readInt, split)
import Prelude hiding (unwords, words) import Prelude hiding (unwords, words)
data TextRendering = data TextRendering =