print failed test input

cli/CLI/Submit.hs

@@ -14,6 +14,8 @@ import Core.Generator.Splitmix (SplitmixGenerator (SplitmixGenerator))
 import Core.Test.Loader (loadTestSuite)
 import Core.Test.Runner
   ( SolutionBatch (SolutionBatch, entryMain, python3Utilities, sbLang, sbTimeout, solution, utilities),
+    TestCaseResult (tcrIdx, tcrInput, tcrResult),
+    TestInput (TestInput),
     TestResult (Internal, Pass, RE, TLE, WA),
     runSuiteWithProgress,
   )
@@ -140,15 +142,18 @@ executeSubmit ui resolved = do
           Left exc ->
             failSubmitStep runningChecklist (classifySuiteException exc)
           Right results ->
-            case find (\(_, res) -> case res of Pass _ -> False; _ -> True) results of
-              Just (idx, verdict) ->
-                failSubmitStep runningChecklist $
-                  case verdict of
-                    Internal msg
-                      | isOracleExecutionMessage msg -> SubmitInternalWhileJudging (Just idx) (stripOracleExecutionPrefix msg)
-                      | otherwise -> SubmitJudgeInternal (Just idx) (stripOracleExecutionPrefix msg)
-                    _ -> SubmitVerdict idx verdict
-              Nothing -> pure (Right (sum [t | (_, Pass t) <- results]))
+            case find (\caseResult -> case tcrResult caseResult of Pass _ -> False; _ -> True) results of
+              Just failedCase ->
+                let idx = tcrIdx failedCase
+                    input = tcrInput failedCase
+                    verdict = tcrResult failedCase
+                 in failSubmitStep runningChecklist $
+                      case verdict of
+                        Internal msg
+                          | isOracleExecutionMessage msg -> SubmitInternalWhileJudging (Just idx) (Just input) (stripOracleExecutionPrefix msg)
+                          | otherwise -> SubmitJudgeInternal (Just idx) (Just input) (stripOracleExecutionPrefix msg)
+                        _ -> SubmitVerdict idx input verdict
+              Nothing -> pure (Right (sum [t | Pass t <- map tcrResult results]))
 
 loadRuntimeTemplates :: FilePath -> Language -> IO (Either SubmitFailure (Text, Text, Text))
 loadRuntimeTemplates root lang = do
@@ -311,26 +316,29 @@ renderSubmitFailure ui failure = case failure of
   SubmitBackendUnavailable backendUrl -> do
     renderErrorHeader ui "submit" ("Backend is not reachable: " ++ T.unpack backendUrl)
     emitDetail ui "submit" "Check `openleetcode config list` and your backend service"
-  SubmitJudgeInternal maybeIdx msg -> do
+  SubmitJudgeInternal maybeIdx maybeInput msg -> do
     renderErrorHeader ui "submit" $
       case maybeIdx of
         Just idx -> "Judge internal error on test #" ++ show idx
         Nothing -> "Judge internal error"
     emitDetail ui "submit" ("  " ++ T.unpack msg)
-  SubmitInternalWhileJudging maybeIdx msg -> do
+    renderMaybeVerdictInput ui "submit" maybeInput
+  SubmitInternalWhileJudging maybeIdx maybeInput msg -> do
     renderErrorHeader ui "submit" $
       case maybeIdx of
         Just idx -> "Internal error while judging test #" ++ show idx
         Nothing -> "Internal error while judging"
     emitDetail ui "submit" ("  " ++ T.unpack msg)
+    renderMaybeVerdictInput ui "submit" maybeInput
   SubmitInfraFailure msg ->
     renderErrorHeader ui "submit" ("Internal error: " ++ T.unpack msg)
-  SubmitVerdict idx verdict -> renderVerdict ui idx verdict
+  SubmitVerdict idx input verdict -> renderVerdict ui idx input verdict
 
-renderVerdict :: UI -> Int -> TestResult -> IO ()
-renderVerdict ui idx verdict = case verdict of
+renderVerdict :: UI -> Int -> TestInput -> TestResult -> IO ()
+renderVerdict ui idx input verdict = case verdict of
   WA expected got out -> do
     renderVerdictHeader ui "wa" ("Wrong answer on test #" ++ show idx)
+    renderVerdictInput ui "wa" input
     emitVerdictDetail ui "wa" ("  Output: " ++ T.unpack got)
     emitVerdictDetail ui "wa" ("  Expected: " ++ T.unpack (fromMaybe "Multiple valid outputs allowed" expected))
     if T.null out
@@ -340,13 +348,15 @@ renderVerdict ui idx verdict = case verdict of
         emitVerdictDetail ui "wa" (T.unpack out)
   TLE out -> do
     renderVerdictHeader ui "tle" ("Time limit exceeded on test #" ++ show idx)
+    renderVerdictInput ui "tle" input
     if T.null out
       then pure ()
       else do
         emitVerdictDetail ui "tle" "  Stdout:"
         emitVerdictDetail ui "tle" (T.unpack out)
   RE err out -> do
     renderVerdictHeader ui "re" ("Runtime error on test #" ++ show idx)
+    renderVerdictInput ui "re" input
     emitVerdictDetail ui "re" ("  " ++ T.unpack err)
     if T.null out
       then pure ()
@@ -355,9 +365,31 @@ renderVerdict ui idx verdict = case verdict of
         emitVerdictDetail ui "re" (T.unpack out)
   Internal msg -> do
     renderErrorHeader ui "submit" ("Judge internal error on test #" ++ show idx)
+    renderVerdictInput ui "submit" input
     emitDetail ui "submit" ("  " ++ T.unpack (stripOracleExecutionPrefix msg))
   Pass _ -> pure ()
 
+renderMaybeVerdictInput :: UI -> String -> Maybe TestInput -> IO ()
+renderMaybeVerdictInput _ _ Nothing = pure ()
+renderMaybeVerdictInput ui verdictTag (Just input) = renderVerdictInput ui verdictTag input
+
+renderVerdictInput :: UI -> String -> TestInput -> IO ()
+renderVerdictInput ui verdictTag (TestInput vars) = do
+  emitVerdictDetail ui verdictTag "  Input:"
+  case vars of
+    [] -> emitVerdictDetail ui verdictTag "    <unsupported>"
+    _ -> mapM_ renderVar vars
+  where
+    renderVar (name, value) =
+      emitVerdictDetail ui verdictTag ("    " ++ T.unpack name ++ ": " ++ T.unpack (truncateInputValue value))
+
+truncateInputValue :: Text -> Text
+truncateInputValue value
+  | T.length value <= inputValuePreviewLimit = value
+  | otherwise = T.take inputValuePreviewLimit value <> "..."
+  where
+    inputValuePreviewLimit = 200
+
 renderErrorHeader :: UI -> String -> String -> IO ()
 renderErrorHeader ui scope msg = case uiMode ui of
   Rich -> putErrorLine ui (T.pack msg)
@@ -386,15 +418,15 @@ submitFailureExitCode failure = case failure of
   SubmitSuiteNotFoundById _ -> renderExitCode ExitInput
   SubmitSuiteNotFoundByTitle _ -> renderExitCode ExitInput
   SubmitBackendUnavailable _ -> renderExitCode ExitInfra
-  SubmitInternalWhileJudging _ _ -> renderExitCode ExitInfra
-  SubmitJudgeInternal _ _ -> renderExitCode ExitInfra
+  SubmitInternalWhileJudging _ _ _ -> renderExitCode ExitInfra
+  SubmitJudgeInternal _ _ _ -> renderExitCode ExitInfra
   SubmitInfraFailure _ -> renderExitCode ExitInfra
-  SubmitVerdict _ _ -> renderExitCode ExitVerdict
+  SubmitVerdict _ _ _ -> renderExitCode ExitVerdict
 
 classifySuiteException :: SomeException -> SubmitFailure
 classifySuiteException exc =
   if "Oracle execution error:" `isInfixOf` shown
-    then SubmitInternalWhileJudging Nothing (stripOracleExecutionPrefix (T.pack shown))
+    then SubmitInternalWhileJudging Nothing Nothing (stripOracleExecutionPrefix (T.pack shown))
     else SubmitInfraFailure (classifyException exc)
   where
     shown = show exc

cli/CLI/SubmitPipeline.hs

@@ -1,7 +1,7 @@
 module CLI.SubmitPipeline where
 
 import CLI.AppEnv (Config)
-import Core.Test.Runner (SolutionBatch, TestResult)
+import Core.Test.Runner (SolutionBatch, TestInput, TestResult)
 import Core.Test.Types (TestSuite)
 import Core.Types (Language)
 import Data.Text (Text)
@@ -20,8 +20,8 @@ data SubmitFailure
   | SubmitSuiteNotFoundById Int
   | SubmitSuiteNotFoundByTitle Text
   | SubmitBackendUnavailable Text
-  | SubmitInternalWhileJudging (Maybe Int) Text
-  | SubmitJudgeInternal (Maybe Int) Text
+  | SubmitInternalWhileJudging (Maybe Int) (Maybe TestInput) Text
+  | SubmitJudgeInternal (Maybe Int) (Maybe TestInput) Text
   | SubmitInfraFailure Text
-  | SubmitVerdict Int TestResult
+  | SubmitVerdict Int TestInput TestResult
   deriving (Eq, Show)

core/Core/Test/Runner.hs

@@ -25,6 +25,15 @@
 import Data.Text.Encoding qualified as TE
 import Data.Vector qualified as V
 
+newtype TestInput = TestInput [(Text, Text)] deriving (Show, Eq)
+
+data TestCaseResult = TestCaseResult
+  { tcrIdx :: Int,
+    tcrInput :: TestInput,
+    tcrResult :: TestResult
+  }
+  deriving (Show, Eq)
+
 data TestResult = Pass Int | WA (Maybe Text) Text Text | TLE Text | RE Text Text | Internal Text deriving (Show, Eq)
 
 data SolutionBatch = SolutionBatch {entryMain :: Text, sbLang :: Language, solution :: Text, utilities :: Text, python3Utilities :: Text, sbTimeout :: Int}
@@ -35,6 +44,7 @@
     pcExpected :: Maybe Text,
     pcPrelude :: [Text],
     pcJsonInputs :: M.Map Text Value,
+    pcInput :: TestInput,
     pcMainCall :: Text,
     pcOracleCall :: Maybe Text
   }
@@ -51,7 +61,7 @@
   g ->
   SolutionBatch ->
   Types.TestSuite ->
-  IO [(Int, TestResult)]
+  IO [TestCaseResult]
 runSuite exec gen batch suite = runSuiteWithProgress exec gen batch suite (\_ _ -> pure ())
 
 runSuiteWithProgress ::
@@ -61,12 +71,12 @@
   SolutionBatch ->
   Types.TestSuite ->
   (Int -> Int -> IO ()) ->
-  IO [(Int, TestResult)]
+  IO [TestCaseResult]
 runSuiteWithProgress exec gen batch suite onProgress = do
   let preparedCases = zipWith (prepareCase gen batch (Types.tsSeed suite) suite) [1 ..] (Types.tsCases suite)
-  mainOutputsOrExc <- try (runMainBatch exec batch suite preparedCases) :: IO (Either SomeException (Either (Int, TestResult) (M.Map Int MainCaseOutput)))
+  mainOutputsOrExc <- try (runMainBatch exec batch suite preparedCases) :: IO (Either SomeException (Either TestCaseResult (M.Map Int MainCaseOutput)))
   case mainOutputsOrExc of
-    Left exc -> pure [(1, Internal (T.pack (displayException exc)))]
+    Left exc -> pure [caseResultForIdx preparedCases 1 (Internal (T.pack (displayException exc)))]
     Right (Left failed) -> pure [failed]
     Right (Right mainOutputs) -> do
       oracleOutputsOrExc <- try (runOracleBatch exec gen batch suite preparedCases mainOutputs) :: IO (Either SomeException (M.Map Int Bool))
@@ -77,7 +87,7 @@
       results <- mapM (evaluateCase timeLimit oracleFailure oracleOutputs mainOutputs) preparedCases
       mapM_ (`onProgress` total) [1 .. total]
       pure $
-        case Data.List.find (\(_, res) -> case res of Pass _ -> False; _ -> True) results of
+        case Data.List.find (\result -> case tcrResult result of Pass _ -> False; _ -> True) results of
           Just failed -> [failed]
           Nothing -> results
 
@@ -130,6 +140,7 @@
               cases
       mainCall = foldl (\acc (var, _) -> T.replace ("{" <> var <> "}") (jsonVarName idx var) acc) callStr (M.toList entryParams)
       jsonInputs = buildJsonInputs gen seed entryParams test
+      input = buildTestInput test jsonInputs
       prelude = buildParamPrelude lang idx entryParams
       oracleCall =
         case Types.tcOut test of
@@ -147,6 +158,7 @@
             Nothing -> Nothing,
           pcPrelude = prelude,
           pcJsonInputs = jsonInputs,
+          pcInput = input,
           pcMainCall = mainCall,
           pcOracleCall = oracleCall
         }
@@ -157,7 +169,7 @@
   SolutionBatch ->
   Types.TestSuite ->
   [PreparedCase] ->
-  IO (Either (Int, TestResult) (M.Map Int MainCaseOutput))
+  IO (Either TestCaseResult (M.Map Int MainCaseOutput))
 runMainBatch exec batch suite cases = do
   response <-
     C.execute
@@ -176,9 +188,9 @@
       inferMainBatchFailure idx status err stdout =
         let out = T.unlines (filter (not . T.isPrefixOf "SOL_CASE_") (T.lines stdout))
          in case status of
-              C.TLE -> (idx, TLE out)
-              C.RE -> (idx, RE (T.strip err) out)
-              C.Unknown _ -> (idx, Internal (renderExecError status err))
+              C.TLE -> caseResultForIdx cases idx (TLE out)
+              C.RE -> caseResultForIdx cases idx (RE (T.strip err) out)
+              C.Unknown _ -> caseResultForIdx cases idx (Internal (renderExecError status err))
   case response of
     C.ExecFail err stdout s ->
       pure (Left (inferMainBatchFailure (inferFailedCaseIndex stdout) s err stdout))
@@ -222,29 +234,46 @@
   M.Map Int Bool ->
   M.Map Int MainCaseOutput ->
   PreparedCase ->
-  IO (Int, TestResult)
+  IO TestCaseResult
 evaluateCase timeLimit oracleFailure oracleOutputs mainOutputs pc =
   let out = fromJust (M.lookup (pcIdx pc) mainOutputs)
    in if mcoTimeMs out > timeLimit
-        then pure (pcIdx pc, TLE (T.unlines (filter (not . T.isPrefixOf "SOL_CASE_") (T.lines (mcoStdout out)))))
+        then pure (caseResult pc (TLE (T.unlines (filter (not . T.isPrefixOf "SOL_CASE_") (T.lines (mcoStdout out))))))
         else case pcExpected pc of
           Just expected ->
             let res = judge (pcJudge pc) expected (mcoResult out)
              in pure $
                   case res of
-                    J.Pass -> (pcIdx pc, Pass (mcoTimeMs out))
-                    J.Fail _ -> (pcIdx pc, WA (Just expected) (mcoResult out) (T.unlines (filter (not . T.isPrefixOf "SOL_CASE_") (T.lines (mcoStdout out)))))
+                    J.Pass -> caseResult pc (Pass (mcoTimeMs out))
+                    J.Fail _ -> caseResult pc (WA (Just expected) (mcoResult out) (T.unlines (filter (not . T.isPrefixOf "SOL_CASE_") (T.lines (mcoStdout out)))))
           Nothing ->
             case oracleFailure of
-              Just msg -> pure (pcIdx pc, Internal msg)
+              Just msg -> pure (caseResult pc (Internal msg))
               Nothing ->
                 ( if fromJust (M.lookup (pcIdx pc) oracleOutputs)
                     then
-                      pure (pcIdx pc, Pass (mcoTimeMs out))
+                      pure (caseResult pc (Pass (mcoTimeMs out)))
                     else
-                      pure (pcIdx pc, WA Nothing (mcoResult out) (T.unlines (filter (not . T.isPrefixOf "SOL_CASE_") (T.lines (mcoStdout out)))))
+                      pure (caseResult pc (WA Nothing (mcoResult out) (T.unlines (filter (not . T.isPrefixOf "SOL_CASE_") (T.lines (mcoStdout out))))))
                 )
 
+caseResultForIdx :: [PreparedCase] -> Int -> TestResult -> TestCaseResult
+caseResultForIdx cases idx result =
+  case Data.List.find ((== idx) . pcIdx) cases of
+    Just pc -> caseResult pc result
+    Nothing -> TestCaseResult idx (TestInput []) result
+
+caseResult :: PreparedCase -> TestResult -> TestCaseResult
+caseResult pc = TestCaseResult (pcIdx pc) (pcInput pc)
+
+buildTestInput :: Types.TestCase -> M.Map Text Value -> TestInput
+buildTestInput test jsonInputs =
+  TestInput $ map buildInputVar (Types.tcIn test)
+  where
+    buildInputVar (name, _) =
+      let val = fromJust (M.lookup name jsonInputs)
+       in (name, TE.decodeUtf8 (BL.toStrict (encode val)))
+
 buildMainProgram :: SolutionBatch -> [PreparedCase] -> Text
 buildMainProgram batch cases =
   buildProgramTemplate (sbLang batch) (entryMain batch) (solution batch) (utilities batch) snippets
@@ -456,7 +485,7 @@
     parseMainSection _ section = do
       let rawLines = T.lines section
           revLines = reverse rawLines
           resultLine = head revLines
           timeLine = revLines !! 1
           stdoutLines = drop 2 revLines
           ms = read (T.unpack (T.strip timeLine)) :: Int