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:
parent
3d994862b4
commit
266032950e
3 changed files with 20 additions and 35 deletions
|
@ -26,7 +26,6 @@ executable reveal
|
||||||
, containers
|
, containers
|
||||||
, mtl
|
, mtl
|
||||||
, Hufflepdf >= 0.2.0
|
, Hufflepdf >= 0.2.0
|
||||||
, zlib
|
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
50
src/Main.hs
50
src/Main.hs
|
@ -1,60 +1,46 @@
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Codec.Compression.Zlib (compress, decompress)
|
|
||||||
import Control.Monad.State (execState, execStateT)
|
import Control.Monad.State (execState, execStateT)
|
||||||
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 qualified Data.ByteString.Lazy.Char8 as Lazy (
|
|
||||||
fromStrict, intercalate, split, toStrict, writeFile
|
|
||||||
)
|
|
||||||
import qualified Data.Map as Map (insert, lookup)
|
|
||||||
import PDF (Layers(..), Document(..), UnifiedLayers(..), parseDocument, render)
|
import PDF (Layers(..), Document(..), UnifiedLayers(..), parseDocument, render)
|
||||||
import PDF.Box (I(..), at, atAll, edit)
|
import PDF.Box (Index(..), Maybe_(..), at, atAll, edit)
|
||||||
import PDF.Layer (Objects(..))
|
import PDF.Layer (Layer, Objects(..))
|
||||||
import PDF.Object (DirectObject(..), Object(..), Name(..), Number(..))
|
import PDF.Object.Navigation (StreamContent(..))
|
||||||
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 =
|
|
||||||
Lazy.toStrict . compress . revealText . decompress . Lazy.fromStrict
|
|
||||||
where
|
|
||||||
lines = Lazy.split '\n'
|
|
||||||
unlines = Lazy.intercalate "\n"
|
|
||||||
revealText = unlines . fmap fill . lines
|
revealText = unlines . fmap fill . lines
|
||||||
|
where
|
||||||
|
lines = BS.split '\n'
|
||||||
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 (Maybe_ StreamContent) $
|
||||||
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
|
|
||||||
|
|
||||||
reveal :: Document -> Document
|
reveal :: Document -> Document
|
||||||
reveal = execState $
|
reveal = execState $
|
||||||
edit .at UnifiedLayers .atAll Objects $ return . revealObject
|
edit .at UnifiedLayers $ revealLayer
|
||||||
|
|
||||||
revealFirst :: Document -> Document
|
revealFirst :: Document -> Document
|
||||||
revealFirst document = maybe document id $ execStateT (
|
revealFirst document = maybe document id $ execStateT (
|
||||||
edit .at Layers .at(I 0) .atAll Objects $ return . revealObject
|
edit .at Layers .at(Index 0) $ revealLayer
|
||||||
) document
|
) document
|
||||||
|
|
||||||
deepReveal :: Document -> Document
|
deepReveal :: Document -> Document
|
||||||
deepReveal = execState $
|
deepReveal = execState $
|
||||||
edit .atAll Layers .atAll Objects $ return . revealObject
|
edit .atAll Layers $ revealLayer
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
Loading…
Reference in a new issue