Fixed vicious bug introduced by 6096a1a237 (since follow is now automatic for references, it's not called explicitely but should in case of 'several' Content, which is an array of references, each of which should be expended) — TODO: add a unit test for that

This commit is contained in:
Tissevert 2020-03-04 18:14:33 +01:00
parent d288ecf0ac
commit 7cef65d799
2 changed files with 12 additions and 10 deletions

View File

@ -12,6 +12,7 @@ module PDF.Object.Navigation (
, (//) , (//)
, (>./) , (>./)
, (>//) , (>//)
, castObject
, getDictionary , getDictionary
, objectById , objectById
, origin , origin
@ -68,10 +69,11 @@ objectById objectId = do
(./) :: PDFContent m => m Object -> Component -> m Object (./) :: PDFContent m => m Object -> Component -> m Object
(./) object key = (object >>= getDictionary >>= getField key >>= castObject) (./) object key = (object >>= getDictionary >>= getField key >>= castObject)
where
castObject (Reference (IndirectObjCoordinates {objectId})) = castObject :: PDFContent m => DirectObject -> m Object
objectById objectId castObject (Reference (IndirectObjCoordinates {objectId})) =
castObject directObject = return $ Direct directObject objectById objectId
castObject directObject = return $ Direct directObject
(//) :: PDFContent m => m Object -> [Component] -> m Object (//) :: PDFContent m => m Object -> [Component] -> m Object
(//) object [] = object (//) object [] = object

View File

@ -37,8 +37,8 @@ import PDF.Object (
, Name(..), Object(..) , Name(..), Object(..)
,) ,)
import PDF.Object.Navigation ( import PDF.Object.Navigation (
Error(..), PDFContent, StreamContent(..), (//), (>./), (>//), getDictionary, objectById Error(..), PDFContent, StreamContent(..), (./), (//), (>./), (>//)
, origin , castObject, getDictionary, objectById, origin
) )
import PDF.Output (ObjectId(..)) import PDF.Output (ObjectId(..))
import Prelude hiding (fail) import Prelude hiding (fail)
@ -88,9 +88,9 @@ loadFonts = foldM addFont Map.empty . Map.toList
flip (Map.insert name) output <$> cache loadFont objectId flip (Map.insert name) output <$> cache loadFont objectId
addFont output _ = return output addFont output _ = return output
several :: Object -> [Object] several :: PDFContent m => Object -> m [Object]
several (Direct (Array l)) = Direct <$> l several (Direct (Array l)) = mapM castObject l
several object = [object] several object = return [object]
pagesList :: PDFContent m => m [ObjectId] pagesList :: PDFContent m => m [ObjectId]
pagesList = do pagesList = do
@ -109,7 +109,7 @@ getReferences objects = do
extractText :: FontCache m => Object -> m [Text] extractText :: FontCache m => Object -> m [Text]
extractText pageObj = do extractText pageObj = do
fonts <- loadFonts =<< getFontDictionary pageObj fonts <- loadFonts =<< getFontDictionary pageObj
objects <- several <$> pageObj >./ "Contents" objects <- pageObj >./ "Contents" >>= several
concat <$> mapM (loadContent fonts) objects concat <$> mapM (loadContent fonts) objects
where where
loadContent fonts object = loadContent fonts object =