2019-05-24 10:22:43 +02:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2019-05-18 11:04:02 +02:00
|
|
|
module Main where
|
|
|
|
|
2019-05-23 16:27:29 +02:00
|
|
|
import Data.ByteString.Char8 (ByteString)
|
2020-02-27 17:24:23 +01:00
|
|
|
import qualified Data.ByteString.Char8 as BS (readFile, split, intercalate)
|
|
|
|
import qualified Data.ByteString.Lazy.Char8 as Lazy (writeFile)
|
2020-02-26 17:22:44 +01:00
|
|
|
import PDF (Layers(..), Document(..), UnifiedLayers(..), parseDocument, render)
|
2020-05-28 18:50:24 +02:00
|
|
|
import PDF.Box (Index(..), Either_(..), at, atAll)
|
2020-02-27 17:24:23 +01:00
|
|
|
import PDF.Layer (Layer, Objects(..))
|
|
|
|
import PDF.Object.Navigation (StreamContent(..))
|
2019-05-18 11:04:02 +02:00
|
|
|
import PDF.TextRendering (TextRendering(..), update)
|
2019-05-23 16:27:29 +02:00
|
|
|
import Prelude hiding (lines, unlines)
|
2019-05-18 11:04:02 +02:00
|
|
|
import System.Environment (getArgs)
|
|
|
|
import System.IO (hPutStrLn, stderr)
|
|
|
|
|
2020-02-27 17:24:23 +01:00
|
|
|
revealText :: ByteString -> ByteString
|
|
|
|
revealText = unlines . fmap fill . lines
|
2019-05-18 11:04:02 +02:00
|
|
|
where
|
2020-02-27 17:24:23 +01:00
|
|
|
lines = BS.split '\n'
|
2019-05-18 11:04:02 +02:00
|
|
|
fill = update $ const Fill
|
2020-02-27 17:24:23 +01:00
|
|
|
unlines = BS.intercalate "\n"
|
2019-05-18 11:04:02 +02:00
|
|
|
|
2020-02-27 17:24:23 +01:00
|
|
|
revealLayer :: Monad m => Layer -> m Layer
|
|
|
|
revealLayer =
|
|
|
|
atAll Objects
|
2020-05-28 18:50:24 +02:00
|
|
|
.atAll (Either_ Clear) $
|
2020-02-27 17:24:23 +01:00
|
|
|
return . revealText
|
2019-05-18 11:04:02 +02:00
|
|
|
|
2020-04-17 12:26:07 +02:00
|
|
|
reveal :: Document -> IO Document
|
|
|
|
reveal = at UnifiedLayers $ revealLayer
|
2019-05-18 11:04:02 +02:00
|
|
|
|
2020-04-17 12:26:07 +02:00
|
|
|
revealFirst :: Document -> IO Document
|
|
|
|
revealFirst = at Layers .at(Index 0) $ revealLayer
|
2020-02-25 17:39:18 +01:00
|
|
|
|
2020-04-17 12:26:07 +02:00
|
|
|
deepReveal :: Document -> IO Document
|
|
|
|
deepReveal = atAll Layers $ revealLayer
|
2020-02-25 17:39:18 +01:00
|
|
|
|
2019-05-18 11:04:02 +02:00
|
|
|
main :: IO ()
|
|
|
|
main = do
|
|
|
|
[inputPath, outputPath] <- getArgs
|
|
|
|
result <- parseDocument <$> BS.readFile inputPath
|
|
|
|
case result of
|
|
|
|
Left parseError -> hPutStrLn stderr $ show parseError
|
2020-04-17 12:26:07 +02:00
|
|
|
Right doc -> Lazy.writeFile outputPath . render =<< reveal doc
|