Simplify Content abstracting over MonadParser for no reason and provide instead an parse that's in MonadFail to avoid having to handle Either outside

src/PDF/Content.hs

@@ -12,13 +12,13 @@ module PDF.Content (
     , Id(..)
     , Indexed
     , TextContext
-    , content
     , parse
   ) where
 
 import Control.Applicative ((<|>))
+import Control.Monad.Fail (MonadFail)
 import Control.Monad.Reader (asks, runReader)
-import Control.Monad.State (MonadState, evalStateT, gets, modify, runStateT)
+import Control.Monad.State (evalStateT, gets, modify)
 import Data.Attoparsec.ByteString.Char8 (sepBy)
 import Data.ByteString (ByteString)
 import Data.Map (Map, (!))
@@ -27,7 +27,7 @@ import PDF.Box (Box(..))
 import PDF.Content.Operator (Instruction, operator)
 import PDF.Object (blank, directObject)
 import PDF.Output (Output(..), line)
-import PDF.Parser (MonadParser, evalParser, string)
+import PDF.Parser (Parser, runParser, string)
 
 newtype Id a = Id Int deriving (Eq, Ord, Show)
 data Instructions = Instructions
@@ -47,27 +47,26 @@ data Content = Content {
     , indexedInstructions :: Indexed Instruction
   } deriving Show
 
-type InstructionParser m = (MonadParser m, MonadState (Indexed Instruction) m)
+type InstructionParser = Parser (Indexed Instruction)
 
 instance Monad m => Box m Instructions Content (Indexed Instruction) where
   r Instructions = return . indexedInstructions
   w Instructions indexedInstructions someContent =
     return $ someContent {indexedInstructions}
 
-register :: MonadState (Indexed Instruction) m => Instruction -> m (Id Instruction)
+register :: Instruction -> InstructionParser (Id Instruction)
 register newInstruction = do
   newInstructionID <- gets (Id . Map.size)
   modify (Map.insert newInstructionID newInstruction)
   return newInstructionID
 
-content :: MonadParser m => m Content
+parse :: MonadFail m => ByteString -> m Content
-content = do
+parse =
-  (contentUnits, indexedInstructions) <- runInstructionParser
+  either fail (return . uncurry Content) . runParser contentUnits Map.empty
-  return $ Content {contentUnits, indexedInstructions}
   where
-    runInstructionParser = runStateT (contentUnit `sepBy` blank) Map.empty
+    contentUnits = contentUnit `sepBy` blank
 
-contentUnit :: InstructionParser m => m ContentUnit
+contentUnit :: InstructionParser ContentUnit
 contentUnit =
     (GraphicContext <$> graphicContext)
   <|> (TextContext <$> textContext)
@@ -75,21 +74,18 @@ contentUnit =
     graphicContext =
       string "q" *> blank *> graphicContextUnit `sepBy` blank <* blank <* string "Q"
 
-graphicContextUnit :: InstructionParser m => m GraphicContextUnit
+graphicContextUnit :: InstructionParser GraphicContextUnit
 graphicContextUnit =
     (GraphicInstruction <$> instruction)
   <|> (ContentUnit <$> contentUnit)
 
-instruction :: InstructionParser m => m (Id Instruction)
+instruction :: InstructionParser (Id Instruction)
 instruction = evalStateT stackParser [] >>= register
   where
     stackParser = ((directObject <* blank) >>= push) <|> operator
     push arg = modify (arg:) *> stackParser
 
-parse :: ByteString -> Either String Content
+textContext :: InstructionParser TextContext
-parse = evalParser content ()
-
-textContext :: InstructionParser m => m TextContext
 textContext =
   string "BT" *> blank *> instruction `sepBy` blank <* blank <* string "ET"