{-# LANGUAGE NamedFieldPuns #-}
module Main where

import Codec.Compression.Zlib (compress, decompress)
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BS (
    length, lines, readFile, unlines, writeFile
  )
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 System.Environment (getArgs)
import System.IO (hPutStrLn, stderr)

revealFlateEncodedText :: ByteString -> ByteString
revealFlateEncodedText = compress . revealText . decompress
  where
    revealText = BS.unlines . fmap fill . BS.lines
    fill = update $ const Fill

revealObject :: Object -> Object
revealObject obj@(Stream {header, streamContent}) =
  case Map.lookup (Name "Filter") header of
    Just (NameObject (Name "FlateDecode")) ->
      let newStreamContent = revealFlateEncodedText streamContent in
      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
revealContent content = content {
    objects = revealObject <$> (objects content)
  }

reveal :: Document -> Document
reveal document = document {
    contents = revealContent <$> (contents document)
  }

main :: IO ()
main = do
  [inputPath, outputPath] <- getArgs
  result <- parseDocument <$> BS.readFile inputPath
  case result of
    Left parseError -> hPutStrLn stderr $ show parseError
    Right doc -> BS.writeFile outputPath . render $ reveal doc