diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.0.7.1 + +* fix compilation on ghc 7.4, 7.6 and 7.8 +* fix xobject handling in text extraction + 0.0.7.0 * support xobjects in text extraction diff --git a/lib/Pdf/Toolbox/Document/FontDict.hs b/lib/Pdf/Toolbox/Document/FontDict.hs --- a/lib/Pdf/Toolbox/Document/FontDict.hs +++ b/lib/Pdf/Toolbox/Document/FontDict.hs @@ -48,7 +48,7 @@ fontDictLoadInfo fd@(FontDict fontDict) = do subtype <- fontDictSubtype fd case subtype of - FontType0 -> FontInfoComposite <$> loadFontInfoComposite fontDict + FontType0 -> FontInfoComposite `liftM` loadFontInfoComposite fontDict FontType3 -> do fi <- loadFontInfoSimple fontDict Array arr <- lookupDict "FontMatrix" fontDict >>= deref >>= fromObject @@ -66,7 +66,7 @@ return $ FontInfoSimple fi { fiSimpleFontMatrix = fontMatrix } - _ -> FontInfoSimple <$> loadFontInfoSimple fontDict + _ -> FontInfoSimple `liftM` loadFontInfoSimple fontDict loadFontInfoComposite :: (MonadPdf m, MonadIO m) => Dict -> PdfE m FIComposite loadFontInfoComposite fontDict = do @@ -151,7 +151,7 @@ case arr of [] -> return [] (ONumber n : rest) -> do - n' <- fromIntegral <$> intValue n + n' <- fromIntegral `liftM` intValue n go [] n' rest _ -> throwE $ UnexpectedError "Differences array: the first object should be a number" where @@ -159,7 +159,7 @@ go res n (o:rest) = case o of (ONumber n') -> do - n'' <- fromIntegral <$> intValue n' + n'' <- fromIntegral `liftM` intValue n' go res n'' rest (OName (Name bs)) -> go (((n, bs)) : res) (n + 1) rest _ -> throwE $ UnexpectedError $ "Differences array: unexpected object: " ++ show o @@ -174,7 +174,7 @@ case toUnicode of OStream s -> do Stream _ is <- streamContent ref s - content <- mconcat <$> liftIO (Streams.toList is) + content <- mconcat `liftM` liftIO (Streams.toList is) case parseUnicodeCMap content of Left e -> throwE $ UnexpectedError $ "can't parse cmap: " ++ show e Right cmap -> return $ Just cmap diff --git a/lib/Pdf/Toolbox/Document/Page.hs b/lib/Pdf/Toolbox/Document/Page.hs --- a/lib/Pdf/Toolbox/Document/Page.hs +++ b/lib/Pdf/Toolbox/Document/Page.hs @@ -15,13 +15,13 @@ ) where +import Data.Int import qualified Data.Traversable as Traversable import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString.Lazy as Lazy.ByteString import Data.Text (Text) import qualified Data.Text.Lazy as TextL import qualified Data.Text.Lazy.Builder as TextB -import Data.Map (Map) import qualified Data.Map as Map import Control.Monad import qualified System.IO.Streams as Streams @@ -110,26 +110,35 @@ resDict <- deref res >>= fromObject case lookupDict' "XObject" resDict of Nothing -> return [] - Just xo -> do - Dict xosDict <- deref xo >>= fromObject - forM xosDict $ \(name, o) -> do + Just xo' -> do + Dict xosDict <- deref xo' >>= fromObject + liftM catMaybes $ forM xosDict $ \(name, o) -> do ref <- fromObject o xo <- lookupObject ref >>= toStream - Stream xoDict is <- streamContent ref xo - cont <- liftIO $ Lazy.ByteString.fromChunks <$> Streams.toList is + let Stream xoDict _ = xo + case lookupDict' "Subtype" xoDict of + Just (OName "Form") -> do + xobject <- mkXObject xo ref + return $ Just (name, xobject) + _ -> return Nothing - fontDicts <- Map.fromList <$> pageFontDicts (Page undefined xoDict) +mkXObject :: (MonadPdf m, MonadIO m) => Stream Int64 -> Ref -> PdfE m XObject +mkXObject s ref = do + Stream dict is <- streamContent ref s + cont <- liftIO $ Lazy.ByteString.fromChunks <$> Streams.toList is - glyphDecoders <- Traversable.forM fontDicts $ \fontDict -> - fontInfoDecodeGlyphs <$> fontDictLoadInfo fontDict - let glyphDecoder fontName = \str -> - case Map.lookup fontName glyphDecoders of - Nothing -> [] - Just decode -> decode str + fontDicts <- Map.fromList `liftM` pageFontDicts (Page undefined dict) - return (name, XObject cont glyphDecoder) + glyphDecoders <- Traversable.forM fontDicts $ \fontDict -> + fontInfoDecodeGlyphs `liftM` fontDictLoadInfo fontDict + let glyphDecoder fontName = \str -> + case Map.lookup fontName glyphDecoders of + Nothing -> [] + Just decode -> decode str + return (XObject cont glyphDecoder) + -- | Extract text from the page -- -- It tries to add spaces between chars if they don't present @@ -137,15 +146,15 @@ pageExtractText :: (MonadPdf m, MonadIO m) => Page -> PdfE m Text pageExtractText page = do -- load fonts and create glyph decoder - fontDicts <- Map.fromList <$> pageFontDicts page + fontDicts <- Map.fromList `liftM` pageFontDicts page glyphDecoders <- Traversable.forM fontDicts $ \fontDict -> - fontInfoDecodeGlyphs <$> fontDictLoadInfo fontDict + fontInfoDecodeGlyphs `liftM` fontDictLoadInfo fontDict let glyphDecoder fontName = \str -> case Map.lookup fontName glyphDecoders of Nothing -> [] Just decode -> decode str - xobjects <- Map.fromList <$> pageXObjects page + xobjects <- Map.fromList `liftM` pageXObjects page -- prepare content streams contents <- pageContents page @@ -169,7 +178,7 @@ let loop s p = do next <- readNextOperator s case next of - Just op@(Op_Do, [OName xoName]) -> processDo xoName p >>= loop s + Just (Op_Do, [OName xoName]) -> processDo xoName p >>= loop s Just op -> processOp op p >>= loop s Nothing -> return p diff --git a/pdf-toolbox-document.cabal b/pdf-toolbox-document.cabal --- a/pdf-toolbox-document.cabal +++ b/pdf-toolbox-document.cabal @@ -1,11 +1,11 @@ name: pdf-toolbox-document -version: 0.0.7.0 +version: 0.0.7.1 synopsis: A collection of tools for processing PDF files. license: BSD3 license-file: LICENSE author: Yuras Shumovich maintainer: Yuras Shumovich -copyright: Copyright (c) Yuras Shumovich 2012-2014 +copyright: Copyright (c) Yuras Shumovich 2012-2016 category: PDF build-type: Simple cabal-version: >=1.8 @@ -37,7 +37,7 @@ Pdf.Toolbox.Document.Internal.Types Pdf.Toolbox.Document.Internal.Util other-modules: Prelude - build-depends: base >= 4.6 && < 5, + build-depends: base >= 4.5 && < 5, transformers, containers, text,