Tissevert
/
Hufflepdf
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Wait, CachedFonts are indexed by Id Object so it could be an IdMap actually

This commit is contained in:
Tissevert 2020-03-17 16:39:06 +01:00
parent 11640c8465
commit c8a5e2b191
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/PDF/Pages.hs
View File

@ -20,9 +20,10 @@ import Control.Monad.Reader (ReaderT, runReaderT)
import Control.Monad.State (StateT(..), evalStateT, execStateT, gets, modify)
import Control.Monad.Trans (lift)
import Data.ByteString.Lazy (toStrict)
import Data.Id (Id)
import Data.Id (Id, IdMap)
import qualified Data.Id as Id (empty, insert, lookup)
import Data.Map (Map)
import qualified Data.Map as Map (empty, fromList, insert, lookup, toList)
import qualified Data.Map as Map (empty, fromList, insert, toList)
import Data.OrderedMap (OrderedMap, build, mapi)
import PDF.Box (Box(..), at, edit)
import PDF.CMap (cMap)
@ -47,7 +48,7 @@ import Text.Printf (printf)
type Except m = (Alternative m, MonadFail m)
type InLayer m = ReaderT Layer m
type CachedFonts = Map (Id Object) Font
type CachedFonts = IdMap Object Font
type FontCache m = StateT CachedFonts (InLayer m)
data Page = Page {
contents :: OrderedMap (Id Object) Content
@ -70,11 +71,11 @@ getFontDictionary pageObj =
cache :: Except m => ((Id Object) -> FontCache m Font) -> (Id Object) -> FontCache m Font
cache loader objectId =
gets (Map.lookup objectId) >>= maybe load return
gets (Id.lookup objectId) >>= maybe load return
where
load = do
value <- loader objectId
modify $ Map.insert objectId value
modify $ Id.insert objectId value
return value
loadFont :: Except m => (Id Object) -> FontCache m Font
@ -150,7 +151,7 @@ instance Monad m => Box m Contents Page (OrderedMap (Id Object) Content) where
w _ contents page = return $ page {contents}
withFonts :: Monad m => (Layer -> FontCache m a) -> Layer -> m a
withFonts f layer = runReaderT (evalStateT (f layer) Map.empty) layer
withFonts f layer = runReaderT (evalStateT (f layer) Id.empty) layer
withResources :: Except m => (Page -> ReaderT FontSet m b) -> Page -> FontCache m b
withResources f p =