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

Try replacing general monadic type constraint by a definite monad stack

This commit is contained in:
Tissevert 2020-03-11 22:35:19 +01:00
parent 5b8d951516
commit 5bf2b08fa9
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/PDF/Content/Text.hs
View File

@ -13,8 +13,8 @@ module PDF.Content.Text (
import Control.Monad (foldM)
import Control.Monad.Fail (MonadFail(..))
import Control.Monad.Reader (MonadReader(..), asks, runReaderT)
import Control.Monad.State (MonadState(..), evalStateT)
import Control.Monad.Reader (MonadReader(..), ReaderT, asks, runReaderT)
import Control.Monad.State (MonadState(..), StateT, evalStateT)
import Data.Map ((!))
import qualified Data.Map as Map (empty, fromList, singleton)
import Data.Text (Text, breakOn)
@ -36,10 +36,10 @@ data ROContext = ROContext {
, fontSet :: FontSet
}
type TextContent m = (MonadReader ROContext m, MonadFail m)
type FontContext m = (MonadState Font m, TextContent m)
type TextContent m = ReaderT ROContext m
type FontContext m = StateT Font (TextContent m)
decodeString :: FontContext m => StringObject -> m Text
decodeString :: MonadFail m => StringObject -> FontContext m Text
decodeString input = do
Font {decode} <- get
either fail return . decode $ toByteString input
@ -57,24 +57,24 @@ renderText fontSet (Content.Content {contentUnits, Content.indexedInstructions})
where
roContext = ROContext {indexedInstructions, fontSet}
renderContentUnit :: TextContent m => ContentUnit -> m (Indexed Text)
renderContentUnit :: MonadFail m => ContentUnit -> TextContent m (Indexed Text)
renderContentUnit (GraphicContext graphicContextUnits) =
mconcat <$> mapM renderGraphicContextUnit graphicContextUnits
renderContentUnit (TextContext instructionIds) =
evalStateT (mconcat <$> mapM renderInstructionId instructionIds) emptyFont
renderGraphicContextUnit :: TextContent m => GraphicContextUnit -> m (Indexed Text)
renderGraphicContextUnit :: MonadFail m => GraphicContextUnit -> TextContent m (Indexed Text)
renderGraphicContextUnit (GraphicInstruction _) = return Map.empty
renderGraphicContextUnit (ContentUnit contentUnit) =
renderContentUnit contentUnit
renderInstructionId :: FontContext m => Id Instruction -> m (Indexed Text)
renderInstructionId :: MonadFail m => Id Instruction -> FontContext m (Indexed Text)
renderInstructionId instructionId@(Id n) = toMap <$>
(asks ((! instructionId) . indexedInstructions) >>= renderInstruction)
where
toMap = maybe Map.empty (Map.singleton (Id n))
renderInstruction :: FontContext m => Instruction -> m (Maybe Text)
renderInstruction :: MonadFail m => Instruction -> FontContext m (Maybe Text)
renderInstruction (Text Tf, [NameObject fontName, _]) =
asks ((! fontName) . fontSet) >>= put >> return Nothing