Make cacheFonts slightly more useful by passing layer directly to it and run the ReaderT underneath

This commit is contained in:
Tissevert 2020-03-17 10:33:47 +01:00
parent d21e14f9a4
commit ba7dd6a690
3 changed files with 4 additions and 6 deletions

View File

@ -78,7 +78,6 @@ executable getText
, bytestring , bytestring
, containers , containers
, Hufflepdf , Hufflepdf
, mtl
, text , text
ghc-options: -Wall ghc-options: -Wall
default-language: Haskell2010 default-language: Haskell2010

View File

@ -1,7 +1,6 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
import Control.Monad ((>=>)) import Control.Monad ((>=>))
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (runReaderT)
import qualified Data.ByteString.Char8 as BS (readFile) import qualified Data.ByteString.Char8 as BS (readFile)
import Data.Id (Id(..), mapWithKey) import Data.Id (Id(..), mapWithKey)
import qualified Data.Map as Map (toList) import qualified Data.Map as Map (toList)
@ -34,11 +33,11 @@ displayPage n = withResources (
getAll :: Layer -> IO () getAll :: Layer -> IO ()
getAll layer = getAll layer =
Map.toList <$> r Pages layer Map.toList <$> r Pages layer
>>= flip runReaderT layer . cacheFonts . mapM_ (uncurry displayPage) >>= cacheFonts layer . mapM_ (uncurry displayPage)
get :: Int -> Layer -> IO () get :: Int -> Layer -> IO ()
get n layer = get n layer =
r (P n) layer >>= flip runReaderT layer . cacheFonts . displayPage n r (P n) layer >>= cacheFonts layer . displayPage n
onDoc :: FilePath -> (Layer -> IO ()) -> IO () onDoc :: FilePath -> (Layer -> IO ()) -> IO ()
onDoc inputFile f = do onDoc inputFile f = do

View File

@ -149,8 +149,8 @@ instance Monad m => Box m Contents Page (OrderedMap (Id Object) Content) where
r Contents = return . contents r Contents = return . contents
w _ contents page = return $ page {contents} w _ contents page = return $ page {contents}
cacheFonts :: Monad m => StateT CachedFonts m a -> m a cacheFonts :: Monad m => Layer -> FontCache m a -> m a
cacheFonts = flip evalStateT Map.empty cacheFonts layer = flip runReaderT layer . flip evalStateT Map.empty
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 =