reveal/src/Main.hs

52 lines
1.6 KiB
Haskell

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Main where
import Control.Monad.State (execState, execStateT)
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(..), 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)
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 (Maybe_ StreamContent) $
return . revealText
reveal :: Document -> Document
reveal = execState $
edit .at UnifiedLayers $ revealLayer
revealFirst :: Document -> Document
revealFirst document = maybe document id $ execStateT (
edit .at Layers .at(Index 0) $ revealLayer
) document
deepReveal :: Document -> Document
deepReveal = execState $
edit .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