61 lines
2.0 KiB
Haskell
61 lines
2.0 KiB
Haskell
{-# 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)
|