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

Browse source
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.State (StateT(..), evalStateT, execStateT, gets, modify)
import Control.Monad.Trans (lift) import Control.Monad.Trans (lift)
import Data.ByteString.Lazy (toStrict) 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 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 Data.OrderedMap (OrderedMap, build, mapi)
import PDF.Box (Box(..), at, edit) import PDF.Box (Box(..), at, edit)
import PDF.CMap (cMap) import PDF.CMap (cMap)
@ -47,7 +48,7 @@ import Text.Printf (printf)
type Except m = (Alternative m, MonadFail m) type Except m = (Alternative m, MonadFail m)
type InLayer m = ReaderT Layer 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) type FontCache m = StateT CachedFonts (InLayer m)
data Page = Page { data Page = Page {
contents :: OrderedMap (Id Object) Content 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 :: Except m => ((Id Object) -> FontCache m Font) -> (Id Object) -> FontCache m Font
cache loader objectId = cache loader objectId =
gets (Map.lookup objectId) >>= maybe load return gets (Id.lookup objectId) >>= maybe load return
where where
load = do load = do
value <- loader objectId value <- loader objectId
modify $ Map.insert objectId value modify $ Id.insert objectId value
return value return value
loadFont :: Except m => (Id Object) -> FontCache m Font 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} w _ contents page = return $ page {contents}
withFonts :: Monad m => (Layer -> FontCache m a) -> Layer -> m a 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 :: Except m => (Page -> ReaderT FontSet m b) -> Page -> FontCache m b
withResources f p = withResources f p =