2019-09-20 22:42:17 +02:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
2020-02-15 10:25:09 +01:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
2020-03-14 16:55:05 +01:00
|
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
2019-09-20 22:42:17 +02:00
|
|
|
|
2020-03-14 16:55:05 +01:00
|
|
|
import Control.Monad.Fail (MonadFail(..))
|
2020-02-15 10:25:09 +01:00
|
|
|
import Control.Monad.Reader (ReaderT, runReaderT)
|
2019-09-20 22:42:17 +02:00
|
|
|
import Data.ByteString.Lazy.Char8 (ByteString)
|
|
|
|
import qualified Data.ByteString.Char8 as BS (readFile)
|
2020-02-15 10:25:09 +01:00
|
|
|
import qualified Data.ByteString.Lazy.Char8 as Lazy (putStrLn)
|
2020-03-14 22:30:28 +01:00
|
|
|
import Data.Id (Id(..))
|
2019-09-20 22:42:17 +02:00
|
|
|
import PDF (Document(..), parseDocument)
|
2020-02-26 22:13:29 +01:00
|
|
|
import PDF.Box (Box(..))
|
2020-02-17 15:29:59 +01:00
|
|
|
import PDF.Layer (Layer(..), unify)
|
|
|
|
import PDF.Object (Object(..))
|
2020-02-15 10:25:09 +01:00
|
|
|
import PDF.Object.Navigation (
|
2020-03-18 15:11:28 +01:00
|
|
|
Clear(..), Raw(..), (//), objectById, catalog
|
2020-02-15 10:25:09 +01:00
|
|
|
)
|
2020-03-14 22:30:28 +01:00
|
|
|
import PDF.Output (Output)
|
2019-09-20 22:42:17 +02:00
|
|
|
import qualified PDF.Output as Output (render)
|
2020-03-14 16:55:05 +01:00
|
|
|
import Prelude hiding (fail)
|
2019-11-29 11:53:08 +01:00
|
|
|
import System.Environment (getArgs, getProgName)
|
|
|
|
import System.Exit (die)
|
|
|
|
import Text.Printf (printf)
|
2020-02-15 10:25:09 +01:00
|
|
|
import Text.Read (readMaybe)
|
2019-09-20 22:42:17 +02:00
|
|
|
|
2020-03-14 16:55:05 +01:00
|
|
|
newtype Error a = Error {
|
|
|
|
runError :: Either String a
|
|
|
|
} deriving (Functor, Applicative, Monad)
|
|
|
|
instance MonadFail Error where
|
|
|
|
fail = Error . Left
|
|
|
|
|
2020-02-15 10:25:09 +01:00
|
|
|
decodedStream :: Object -> Object
|
|
|
|
decodedStream object =
|
2020-03-04 18:31:30 +01:00
|
|
|
maybe object id $ r Clear object >>= flip (w Raw) object
|
2020-02-15 10:25:09 +01:00
|
|
|
|
2020-02-17 15:29:59 +01:00
|
|
|
display :: Output a => ReaderT Layer Error a -> Document -> Either String ByteString
|
|
|
|
display getter (Document {eolStyle, layers}) =
|
|
|
|
Output.render eolStyle <$> runError (runReaderT getter (unify layers))
|
2019-09-20 22:42:17 +02:00
|
|
|
|
2020-02-15 10:25:09 +01:00
|
|
|
parse :: [String] -> IO (FilePath, Document -> Either String ByteString)
|
2020-03-18 15:11:28 +01:00
|
|
|
parse [inputFile] = return (inputFile, display catalog)
|
2020-02-15 10:25:09 +01:00
|
|
|
parse [inputFile, key] =
|
|
|
|
return (inputFile, clear . maybe (byPath key) byId $ readMaybe key)
|
2019-11-29 11:53:08 +01:00
|
|
|
where
|
2020-03-14 22:30:28 +01:00
|
|
|
byId = objectById . Id
|
2020-03-18 15:11:28 +01:00
|
|
|
byPath path = catalog // (explode path)
|
2020-02-15 10:25:09 +01:00
|
|
|
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
|
2019-11-29 11:53:08 +01:00
|
|
|
|
2019-09-20 22:42:17 +02:00
|
|
|
main :: IO ()
|
|
|
|
main = do
|
2019-11-29 11:53:08 +01:00
|
|
|
(inputFile, getData) <- parse =<< getArgs
|
|
|
|
input <- BS.readFile inputFile
|
2020-02-15 10:25:09 +01:00
|
|
|
either die Lazy.putStrLn $ (parseDocument input >>= getData)
|