Minor but strict improvement : remove the general implementation of <?> for Alternative

src/PDF/Body.hs

@@ -19,7 +19,7 @@ import PDF.Object (
     , blank, dictionary, directObject, integer, line
   )
 import PDF.Output (ObjectId(..), Offset(..))
-import PDF.Parser (Parser, (<?>), block, char, evalParser, on, takeAll)
+import PDF.Parser (Parser, block, char, evalParser, on, takeAll)
 
 data UserState = UserState {
       input :: ByteString
@@ -105,7 +105,7 @@ indirectObjCoordinates = do
 
 occurrence :: SParser Occurrence
 occurrence =
-  Comment <$> comment <|> Indirect <$> indirectObjCoordinates <?> "comment or object"
+  Comment <$> comment <|> Indirect <$> indirectObjCoordinates
 
 populate :: ByteString -> InputStructure -> Content
 populate input structure =

src/PDF/Content.hs

@@ -15,7 +15,7 @@ import Data.ByteString (ByteString)
 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 (MonadParser, evalParser, string)
 
 data GraphicContextUnit =
     GraphicInstruction Instruction
@@ -29,7 +29,7 @@ data ContentUnit =
 newtype Content = Content [ContentUnit] deriving Show
 
 content :: MonadParser m => m Content
-content = Content <$> contentUnit `sepBy` blank <?> "content"
+content = Content <$> contentUnit `sepBy` blank
 
 contentUnit :: MonadParser m => m ContentUnit
 contentUnit =

src/PDF/Object.hs

@@ -50,11 +50,11 @@ import PDF.Output (
     , byteString, getObjectId, getOffset, getOffsets, join, newLine
     , saveOffset
   )
-import PDF.Parser (MonadParser(..), Parser, (<?>), octDigit, oneOf)
+import PDF.Parser (MonadParser(..), Parser, octDigit, oneOf)
 import Text.Printf (printf)
 
 line :: MonadParser m => String -> m ()
-line l = (string (Char8.pack l) *> blank *> return ()) <?> printf "line «%s»" l
+line l = (string (Char8.pack l) *> blank *> return ())
 
 magicNumber :: ByteString
 magicNumber = "%PDF-"
@@ -75,7 +75,7 @@ regular :: Char -> Bool
 regular = not . (`elem` (EOL.charset ++ whiteSpaceCharset ++ delimiterCharset))
 
 integer :: (Read a, Num a, MonadParser m) => m a
-integer = read . Char8.unpack <$> decNumber <* blank <?> "decimal integer"
+integer = read . Char8.unpack <$> decNumber <* blank
 
 -------------------------------------
 --          OBJECTS
@@ -88,7 +88,7 @@ type IndexedObjects = Map ObjectId Object
 --
 boolean :: MonadParser m => m Bool
 boolean =
-  (string "true" *> return True) <|> (string "false" *> return False) <?> "boolean"
+  (string "true" *> return True) <|> (string "false" *> return False)
 
 --
 -- Number
@@ -104,7 +104,6 @@ instance Output Number where
 number :: MonadParser m => m Number
 number = Number . read . Char8.unpack <$>
   (mappend <$> sign <*> (integerPart <|> Char8.cons '0' <$> floatPart))
-  <?> "number"
   where
     sign = string "-" <|> option "" (char '+' >> return "")
     integerPart = mappend <$> decNumber <*> option "" floatPart
@@ -123,7 +122,6 @@ stringObject :: MonadParser m => m StringObject
 stringObject =
     Literal <$> (char '(' *> (BS.concat <$> literalString) <* char ')')
   <|> Hexadecimal <$> (char '<' *> hexNumber <* char '>')
-  <?> "string object (literal or hexadecimal)"
   where
     literalString = many literalStringBlock
     literalStringBlock = takeAll1 normalChar <|> matchingParenthesis <|> escapedChar
@@ -147,14 +145,14 @@ instance Output Name where
   output (Name n) = Output.string ('/':n)
 
 name :: MonadParser m => m Name
-name = Name . Char8.unpack <$> (char '/' *> takeAll regular) <?> "name"
+name = Name . Char8.unpack <$> (char '/' *> takeAll regular)
 
 --
 -- Array
 --
 array :: MonadParser m => m [DirectObject]
 array =
-  char '[' *> blank *> directObject `sepBy` blank <* blank <* char ']' <?> "array"
+  char '[' *> blank *> directObject `sepBy` blank <* blank <* char ']'
 
 --
 -- Dictionary
@@ -171,7 +169,7 @@ instance Output Dictionary where
 
 dictionary :: MonadParser m => m Dictionary
 dictionary =
-  string "<<" *> blank *> keyValPairs <* string ">>" <?> "dictionary"
+  string "<<" *> blank *> keyValPairs <* string ">>"
   where
     keyVal = (,) <$> name <* blank <*> directObject
     keyValPairs = Map.fromList <$> keyVal `sepBy` blank <* blank
@@ -180,7 +178,7 @@ dictionary =
 -- Null
 --
 nullObject :: MonadParser m => m ()
-nullObject = string "null" *> return () <?> "null object"
+nullObject = string "null" *> return ()
 
 --
 -- Reference
@@ -192,7 +190,7 @@ data IndirectObjCoordinates = IndirectObjCoordinates {
 
 reference :: MonadParser m => m IndirectObjCoordinates
 reference = IndirectObjCoordinates
-  <$> (fmap ObjectId integer) <*> integer <* char 'R' <?> "reference to an object"
+  <$> (fmap ObjectId integer) <*> integer <* char 'R'
 
 --
 -- DirectObject
@@ -220,7 +218,7 @@ instance Output DirectObject where
     Output.string (printf "%d %d R" (getObjectId objectId) versionNumber)
 
 directObject :: MonadParser m => m DirectObject
-directObject = (peek >>= dispatch) <?> "direct object"
+directObject = peek >>= dispatch
   where
     dispatch 't' = Boolean <$> boolean
     dispatch 'f' = Boolean <$> boolean
@@ -291,7 +289,7 @@ instance Output XRefEntry where
 entry :: Parser u XRefEntry
 entry = do
   (big, small) <- (,) <$> integer <*> integer
-  (inUse big small <|> free big small <?> "XRef entry") <* blank
+  (inUse big small <|> free big small) <* blank
   where
     inUse :: Int -> Int -> Parser u XRefEntry
     inUse big generation =
@@ -315,7 +313,7 @@ instance Output XRefSubSection where
 
 xRefSubSection :: Parser u XRefSubSection
 xRefSubSection = do
-  (firstId, entriesNumber) <- (,) <$> integer <*> integer <?> "XRef subsection"
+  (firstId, entriesNumber) <- (,) <$> integer <*> integer
   entries <- count entriesNumber entry
   return $ XRefSubSection {firstObjectId = ObjectId firstId, entries}
 

src/PDF/Parser.hs

@@ -4,14 +4,12 @@
 module PDF.Parser (
       MonadParser(..)
     , Parser
-    , (<?>)
     , octDigit
     , on
     , runParser
     , evalParser
   ) where
 
-import Control.Applicative (Alternative, (<|>))
 import Control.Monad (MonadPlus)
 import Control.Monad.Fail (MonadFail(..))
 import Control.Monad.State (StateT(..), evalStateT)
@@ -49,7 +47,7 @@ instance MonadParser Atto.Parser where
   hexNumber = B16Int <$> Atto.takeWhile1 (`Set.member` hexDigits)
   oneOf charSet = Atto.satisfy (`elem` charSet)
   peek = Atto.peekChar'
-  string s = Atto.string s <?> show s
+  string s = Atto.string s
   takeAll = Atto.takeWhile
   takeAll1 = Atto.takeWhile1
 
@@ -67,9 +65,6 @@ instance (MonadParser m, MonadTrans t, MonadDeps (t m)) => MonadParser (t m) whe
 
 type Parser s = StateT s Atto.Parser
 
-(<?>) :: (Alternative m, MonadFail m) => m a -> String -> m a
-(<?>) parser debugMessage = parser <|> fail debugMessage
-
 digits :: Set Char
 digits = Set.fromList ['0'..'9']