Replace 'cacheFonts' by more versatile 'withFonts' inspired by 'withResources' that avoid having to declare an inline function to capture the 'layer' argument and pass it twice

This commit is contained in:
Tissevert 2020-03-17 16:29:46 +01:00
parent e94a09b3ec
commit 11640c8465
2 changed files with 8 additions and 10 deletions

View File

@ -3,7 +3,7 @@ import Control.Monad ((>=>))
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Char8 as BS (readFile)
import Data.Id (Id(..), mapWithKey)
import qualified Data.Map as Map (toList)
import qualified Data.Map as Map (mapWithKey)
import Data.OrderedMap (mapi)
import qualified Data.Text as Text (unpack)
import PDF (UnifiedLayers(..), parseDocument)
@ -11,7 +11,8 @@ import PDF.Box (Box(..))
import PDF.Content.Text (Chunks(..))
import PDF.Layer (Layer)
import PDF.Pages (
Contents(..), FontCache, Page(..), PageNumber(..), Pages(..), cacheFonts, withResources
Contents(..), FontCache, Page(..), PageNumber(..), Pages(..), withFonts
, withResources
)
import System.Environment (getArgs)
import System.Exit (die)
@ -31,13 +32,10 @@ displayPage n = withResources (
printf "p#%d obj#%d instr#%d: %s" n (getId a) (getId b) (Text.unpack v)
getAll :: Layer -> IO ()
getAll layer =
Map.toList <$> r Pages layer
>>= cacheFonts layer . mapM_ (uncurry displayPage)
getAll = withFonts $ r Pages >=> sequence_ . Map.mapWithKey displayPage
get :: Int -> Layer -> IO ()
get n layer =
r (P n) layer >>= cacheFonts layer . displayPage n
get n = withFonts $ r (P n) >=> displayPage n
onDoc :: FilePath -> (Layer -> IO ()) -> IO ()
onDoc inputFile f = do

View File

@ -9,7 +9,7 @@ module PDF.Pages (
, Page(..)
, PageNumber(..)
, Pages(..)
, cacheFonts
, withFonts
, withResources
) where
@ -149,8 +149,8 @@ instance Monad m => Box m Contents Page (OrderedMap (Id Object) Content) where
r Contents = return . contents
w _ contents page = return $ page {contents}
cacheFonts :: Monad m => Layer -> FontCache m a -> m a
cacheFonts layer = flip runReaderT layer . flip evalStateT Map.empty
withFonts :: Monad m => (Layer -> FontCache m a) -> Layer -> m a
withFonts f layer = runReaderT (evalStateT (f layer) Map.empty) layer
withResources :: Except m => (Page -> ReaderT FontSet m b) -> Page -> FontCache m b
withResources f p =