reveal/src/Main.hs

45 lines
1.4 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Main where
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 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
where
lines = BS.split '\n'
fill = update $ const Fill
unlines = BS.intercalate "\n"
revealLayer :: Monad m => Layer -> m Layer
revealLayer =
atAll Objects
.atAll (Either_ Clear) $
return . revealText
reveal :: Document -> IO Document
reveal = at UnifiedLayers $ revealLayer
revealFirst :: Document -> IO Document
revealFirst = at Layers .at(Index 0) $ revealLayer
deepReveal :: Document -> IO Document
deepReveal = atAll Layers $ revealLayer
main :: IO ()
main = do
[inputPath, outputPath] <- getArgs
result <- parseDocument <$> BS.readFile inputPath
case result of
Left parseError -> hPutStrLn stderr $ show parseError
Right doc -> Lazy.writeFile outputPath . render =<< reveal doc