Prompt ambiguous parses in corpus tests

Summary:
During ranking, due to how candidates are ordered, it is completely possible to have multiple correct candidates
have the exact same rank (equal range and exact equal score). In this case `analyze` returns all of them, which gets
misinterpreted as having multiple tokens in output rather than multiple solutions. Checks this case and gives the
correct prompt for ambiguous parses.

Reviewed By: patapizza

Differential Revision: D7489391

fbshipit-source-id: b66947e37bddb3ac6273843dd79b559aff9d0083

tests/Duckling/Testing/Asserts.hs

@@ -19,6 +19,7 @@ module Duckling.Testing.Asserts
   , withTargets
   ) where
 
+import Data.List (partition)
 import Data.String
 import Data.Text (Text)
 import Prelude
@@ -64,15 +65,20 @@ makeCorpusTest targets (context, options, xs) = testCase "Corpus Tests" $
     check :: Example -> IO ()
     check (input, predicate) =
       let tokens = analyze input context options dims in
-      case tokens of
-        [] -> assertFailure $ "empty result on " ++ show input
-        (_:_:_) -> assertFailure $
-          show (length tokens) ++ " tokens found for " ++ show input
-        (token:_) -> do
-          assertEqual ("don't fully match " ++ show input)
-            (Range 0 (Text.length input)) (range token)
-          assertBool ("don't pass predicate on " ++ show input) $
-            predicate context token
+      let inputRange = Range 0 $ Text.length input in
+      let (fullRangeTokens, restTokens) =
+            partition ((== inputRange) . range) tokens in
+      case fullRangeTokens of
+        [] -> case restTokens of
+          [] -> assertFailure $ "empty result on " ++ show input
+          (_:_:_) -> assertFailure $
+            show (length restTokens) ++ " tokens found for " ++ show input
+          _ -> assertFailure $ "don't fully match " ++ show input
+        [token] -> assertBool ("don't pass predicate on " ++ show input) $
+          predicate context token
+        _ -> assertFailure $ show (length fullRangeTokens)
+          ++ " different ambiguous parses"
+
 
 makeNegativeCorpusTest :: [Some Dimension] -> NegativeCorpus -> TestTree
 makeNegativeCorpusTest targets (context, options, xs) =