Hufflepdf/examples/getObj.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.Reader (ReaderT, runReaderT)
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS (readFile)
import qualified Data.ByteString.Lazy.Char8 as Lazy (putStrLn)
import PDF (Document(..), parseDocument)
import PDF.Box (Box(..))
import PDF.Layer (Layer(..), unify)
import PDF.Object (Object(..))
import PDF.Object.Navigation (
    Error(..), StreamContent(..), (//), objectById, origin
  )
import PDF.Output (ObjectId(..), Output)
import qualified PDF.Output as Output (render)
import System.Environment (getArgs, getProgName)
import System.Exit (die)
import Text.Printf (printf)
import Text.Read (readMaybe)

decodedStream :: Object -> Object
decodedStream object =
  maybe object forceClear $ r StreamContent object
  where
    forceClear streamContent = object {streamContent}

display :: Output a => ReaderT Layer Error a -> Document -> Either String ByteString
display getter (Document {eolStyle, layers}) =
  Output.render eolStyle <$> runError (runReaderT getter (unify layers))

parse :: [String] -> IO (FilePath, Document -> Either String ByteString)
parse [inputFile] = return (inputFile, display origin)
parse [inputFile, key] =
  return (inputFile, clear . maybe (byPath key) byId $ readMaybe key)
  where
    byId = objectById . ObjectId
    byPath path = origin // (explode path)
    explode "" = []
    explode path =
      case break (== '.') path of
        (name, "") -> [name]
        (name, rest) -> name : explode (drop 1 rest)
    clear = display . fmap decodedStream
parse _ =
  die . printf "Syntax: %s inputFile [OBJECT_ID | PATH_TO_OBJ]\n" =<< getProgName

main :: IO ()
main = do
  (inputFile, getData) <- parse =<< getArgs
  input <- BS.readFile inputFile
  either die Lazy.putStrLn $ (parseDocument input >>= getData)