Use the new Box instance between Object and Bytestring that generalizes the code that had been written specificly for this demo tool, and get rid of zlib (directly in Hufflepdf now) and Lazy Bytestrings

This commit is contained in:
Tissevert 2020-02-27 17:24:23 +01:00
parent 3d994862b4
commit 266032950e
3 changed files with 20 additions and 35 deletions

View file

@ -26,7 +26,6 @@ executable reveal
, containers
, mtl
, Hufflepdf >= 0.2.0
, zlib
hs-source-dirs: src
ghc-options: -Wall
default-language: Haskell2010

View file

@ -1,60 +1,46 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
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 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 (I(..), at, atAll, edit)
import PDF.Layer (Objects(..))
import PDF.Object (DirectObject(..), Object(..), Name(..), Number(..))
import PDF.Box (Index(..), Maybe_(..), at, atAll, edit)
import PDF.Layer (Layer, Objects(..))
import PDF.Object.Navigation (StreamContent(..))
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
revealText :: ByteString -> ByteString
revealText = unlines . fmap fill . lines
where
lines = Lazy.split '\n'
unlines = Lazy.intercalate "\n"
revealText = unlines . fmap fill . lines
lines = BS.split '\n'
fill = update $ const Fill
unlines = BS.intercalate "\n"
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
revealLayer :: Monad m => Layer -> m Layer
revealLayer =
atAll Objects
.atAll (Maybe_ StreamContent) $
return . revealText
reveal :: Document -> Document
reveal = execState $
edit .at UnifiedLayers .atAll Objects $ return . revealObject
edit .at UnifiedLayers $ revealLayer
revealFirst :: Document -> Document
revealFirst document = maybe document id $ execStateT (
edit .at Layers .at(I 0) .atAll Objects $ return . revealObject
edit .at Layers .at(Index 0) $ revealLayer
) document
deepReveal :: Document -> Document
deepReveal = execState $
edit .atAll Layers .atAll Objects $ return . revealObject
edit .atAll Layers $ revealLayer
main :: IO ()
main = do

View file

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