Improve message produced by eitherResult for Partial

When a parser result is Partial, previously the eitherResult function
showed a generic error message that includes no useful information other
than a generic "incomplete input" message.

For example, if we let

    p = (,) <$> letter <*> digit <?> "thing"

then

    eitherResult (parse p "a") = Left "Result: incomplete input"

Attoparsec is already capable of generating more informative error
information for this example, as we can demonstrate by using parseOnly:

    parseOnly p "a" = "thing > digit: not enough input"

This change brings that same error message to eitherResult by simply
feeding `mempty` into the continuation. With this change, eitherResult
now gives the same output as parseOnly.

    eitherResult (parse p "a") = "thing > digit: not enough input"

Author: chris-martin

Data/Attoparsec/ByteString.hs

@@ -226,7 +226,8 @@ maybeResult _            = Nothing
 -- | Convert a 'Result' value to an 'Either' value. A 'T.Partial'
 -- result is treated as failure.
 eitherResult :: Result r -> Either String r
-eitherResult (T.Done _ r)        = Right r
-eitherResult (T.Fail _ [] msg)   = Left msg
-eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)
-eitherResult _                   = Left "Result: incomplete input"
+eitherResult result = case feed result B.empty of
+    T.Done _ r        -> Right r
+    T.Fail _ [] msg   -> Left msg
+    T.Fail _ ctxs msg -> Left (intercalate " > " ctxs ++ ": " ++ msg)
+    T.Partial _       -> error "eitherResult: Partial"

Data/Attoparsec/Text.hs

@@ -266,10 +266,11 @@ maybeResult _            = Nothing
 -- | Convert a 'Result' value to an 'Either' value. A 'Partial' result
 -- is treated as failure.
 eitherResult :: Result r -> Either String r
-eitherResult (T.Done _ r)        = Right r
-eitherResult (T.Fail _ [] msg)   = Left msg
-eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)
-eitherResult _                   = Left "Result: incomplete input"
+eitherResult result = case feed result T.empty of
+    T.Done _ r        -> Right r
+    T.Fail _ [] msg   -> Left msg
+    T.Fail _ ctxs msg -> Left (intercalate " > " ctxs ++ ": " ++ msg)
+    T.Partial _       -> error "eitherResult: Partial"
 
 -- | A predicate that matches either a carriage return @\'\\r\'@ or
 -- newline @\'\\n\'@ character.

tests/QC/ByteString.hs

@@ -182,6 +182,13 @@ nonmembers :: [Word8] -> [Word8] -> Property
 nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'
     where set = S.fromList s
 
+eitherResultPartialError :: Property
+eitherResultPartialError = P.eitherResult (P.parse p input) === Left msg
+  where
+    p = (,) <$> P8.letter_ascii <*> P8.digit P.<?> "thing"
+    input = "a"
+    msg = "thing > digit: not enough input"
+
 tests :: [TestTree]
 tests = [
       testProperty "anyWord8" anyWord8
@@ -211,4 +218,5 @@ tests = [
     , testProperty "word8" word8
     , testProperty "members" members
     , testProperty "nonmembers" nonmembers
+    , testProperty "eitherResultPartialError" eitherResultPartialError
   ]

tests/QC/Text.hs

@@ -170,6 +170,13 @@ nonmembers :: String -> String -> Property
 nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s'
     where set = S.fromList s
 
+eitherResultPartialError :: Property
+eitherResultPartialError = P.eitherResult (P.parse p input) === Left msg
+  where
+    input = "a"
+    p = (,) <$> P.letter <*> P.digit P.<?> "thing"
+    msg = "thing > digit: not enough input"
+
 tests :: [TestTree]
 tests = [
       testProperty "anyChar" anyChar
@@ -198,6 +205,7 @@ tests = [
     , testProperty "takeWhile1_empty" takeWhile1_empty
     , testProperty "members" members
     , testProperty "nonmembers" nonmembers
+    , testProperty "eitherResultPartialError" eitherResultPartialError
     , testGroup "FastSet" FastSet.tests
     , testGroup "Regressions" Regressions.tests
   ]