Compare commits
8 commits
main
...
big-Huffle
Author | SHA1 | Date | |
---|---|---|---|
84eafcf826 | |||
f7f22953ea | |||
d4406b6aae | |||
a64224d119 | |||
266032950e | |||
3d994862b4 | |||
4fe8ab2252 | |||
308cfd4cbe |
3 changed files with 27 additions and 41 deletions
|
@ -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
|
||||||
|
|
61
src/Main.hs
61
src/Main.hs
|
@ -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
|
||||||
|
|
|
@ -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