reveal.cabal

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

src/Main.hs

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

src/PDF/TextRendering.hs

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