diff --git a/src/Data/Id.hs b/src/Data/Id.hs index 22d7d09..b96afb0 100644 --- a/src/Data/Id.hs +++ b/src/Data/Id.hs @@ -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 diff --git a/src/PDF/Content.hs b/src/PDF/Content.hs index c87bf5f..ccee24d 100644 --- a/src/PDF/Content.hs +++ b/src/PDF/Content.hs @@ -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