Generalize register to all IdMap a b, since it's gonna be needed by Indexed Text too

This commit is contained in:
Tissevert 2020-03-17 08:39:29 +01:00
parent 5027b079eb
commit 25e2823c75
2 changed files with 13 additions and 10 deletions

View File

@ -1,4 +1,5 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.Id (
Id(..)
, IdMap
@ -13,15 +14,17 @@ module Data.Id (
, mapWithKey
, member
, minViewWithKey
, register
, singleton
, size
, union
) where
import Control.Monad.State (MonadState, modify, gets)
import Data.IntMap (IntMap, (!))
import qualified Data.IntMap as IntMap (
delete, empty, fromList, keysSet, insert, lookup, mapWithKey, member
, minViewWithKey, size, union
delete, empty, fromList, keysSet, insert, lookup, mapWithKey, maxViewWithKey
, member, minViewWithKey, size, union
)
import Data.IntSet (IntSet)
import Prelude hiding (lookup)
@ -75,3 +78,9 @@ fromList = IdMap . IntMap.fromList . fmap (\(key, b) -> (getId key, b))
keysSet :: IdMap a b -> IntSet
keysSet = IntMap.keysSet . intMap
register :: MonadState (IdMap a b) m => b -> m (Id a)
register b = do
newId <- gets (Id . maybe 0 ((+1) . fst . fst) . IntMap.maxViewWithKey . intMap)
modify (insert newId b)
return newId

View File

@ -16,10 +16,10 @@ module PDF.Content (
import Control.Applicative ((<|>))
import Control.Monad.Fail (MonadFail)
import Control.Monad.Reader (asks, runReader)
import Control.Monad.State (evalStateT, gets, modify)
import Control.Monad.State (evalStateT, modify)
import Data.Attoparsec.ByteString.Char8 (sepBy)
import Data.ByteString (ByteString)
import Data.Id (Id(..), Indexed, at, empty, insert, size)
import Data.Id (Id(..), Indexed, at, empty, register)
import PDF.Box (Box(..))
import PDF.Content.Operator (Instruction, operator)
import PDF.Object (blank, directObject)
@ -49,12 +49,6 @@ instance Monad m => Box m Instructions Content (Indexed Instruction) where
w Instructions indexedInstructions someContent =
return $ someContent {indexedInstructions}
register :: Instruction -> InstructionParser (Id Instruction)
register newInstruction = do
newInstructionID <- gets (Id . size)
modify (insert newInstructionID newInstruction)
return newInstructionID
parse :: MonadFail m => ByteString -> m Content
parse =
either fail (return . uncurry Content) . runParser contentUnits empty