{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} import Control.Monad.Fail (MonadFail(..)) 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 Data.Id (Id(..)) import PDF (Document(..), parseDocument) import PDF.Box (Box(..)) import PDF.Layer (Layer(..), unify) import PDF.Object (Object(..)) import PDF.Object.Navigation ( Clear(..), Raw(..), (//), objectById, origin ) import PDF.Output (Output) import qualified PDF.Output as Output (render) import Prelude hiding (fail) import System.Environment (getArgs, getProgName) import System.Exit (die) import Text.Printf (printf) import Text.Read (readMaybe) newtype Error a = Error { runError :: Either String a } deriving (Functor, Applicative, Monad) instance MonadFail Error where fail = Error . Left decodedStream :: Object -> Object decodedStream object = maybe object id $ r Clear object >>= flip (w Raw) object 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 . Id 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)