diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index e2b77dd..7abd729 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -4,6 +4,10 @@ import Import import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, withSmallInput) +import Data.Monoid +import qualified Yesod.Table as Table +import Yesod.Table (Table) + import qualified Data.Text.Lazy as TL import Text.Markdown @@ -16,6 +20,9 @@ import Handler.Shared import GEval.Core import GEval.OptionsParser +import Data.Map (Map) +import qualified Data.Map as Map + import PersistSHA1 getShowChallengeR :: Text -> Handler Html @@ -189,7 +196,38 @@ submissionForm = renderBootstrap3 BootstrapBasicForm $ (,,) <*> areq textField (fieldSettingsLabel MsgSubmissionUrl) Nothing <*> areq textField (fieldSettingsLabel MsgSubmissionBranch) Nothing +getChallengeMySubmissionsR :: Text -> Handler Html +getChallengeMySubmissionsR = getChallengeMySubmissionsR +getChallengeAllSubmissionsR :: Text -> Handler Html +getChallengeAllSubmissionsR name = do + (Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name + submissions <- runDB $ selectList [SubmissionChallenge ==. challengeId] [Desc SubmissionStamp] + tests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] [] + evaluationMaps <- mapM getEvaluationMap submissions + challengeLayout True challenge (challengeAllSubmissionsWidget challenge evaluationMaps tests) + +getEvaluationMap :: Entity Submission -> Handler (Entity Submission, Map (Key Test) Evaluation) +getEvaluationMap s@(Entity submissionId submission) = do + outs <- runDB $ selectList [OutSubmission ==. submissionId] [] + maybeEvaluations <- runDB $ mapM (\(Entity _ o) -> getBy $ UniqueEvaluationTestChecksum (outTest o) (outChecksum o)) outs + let evaluations = catMaybes maybeEvaluations + let m = Map.fromList $ map (\(Entity _ e) -> (evaluationTest e, e)) evaluations + return (s, m) + +challengeAllSubmissionsWidget challenge submissions tests = $(widgetFile "challenge-all-submissions") + +submissionsTable :: [Entity Test] -> Table site (Entity Submission, Map (Key Test) Evaluation) +submissionsTable tests = mempty + ++ Table.string "when" (show . submissionStamp . \(Entity _ s, _) -> s) + ++ Table.text "description" (submissionDescription . \(Entity _ s, _) -> s) + ++ mconcat (map (\(Entity k t) -> Table.string (testName t) (submissionScore k)) tests) + +submissionScore :: Key Test -> (Entity Submission, Map (Key Test) Evaluation) -> String +submissionScore k (_, m) = fromMaybe "N/A" (presentScore <$> lookup k m) + +presentScore :: Evaluation -> String +presentScore evaluation = fromMaybe "???" (show <$> evaluationScore evaluation) challengeLayout withHeader challenge widget = do bc <- widgetToPageContent widget diff --git a/config/routes b/config/routes index 73a6367..8ad0eba 100644 --- a/config/routes +++ b/config/routes @@ -14,3 +14,5 @@ /challenge/#Text ShowChallengeR GET /challenge-readme/#Text ChallengeReadmeR GET /challenge-submission/#Text ChallengeSubmissionR GET POST +/challenge-my-submissions/#Text ChallengeMySubmissionsR GET +/challenge-all-submissions/#Text ChallengeAllSubmissionsR GET diff --git a/gonito.cabal b/gonito.cabal index d2b81b0..668ff9d 100644 --- a/gonito.cabal +++ b/gonito.cabal @@ -104,6 +104,7 @@ library , markdown , geval , filepath + , yesod-table executable gonito if flag(library-only) diff --git a/templates/challenge-all-submissions.hamlet b/templates/challenge-all-submissions.hamlet new file mode 100644 index 0000000..ac7b7c6 --- /dev/null +++ b/templates/challenge-all-submissions.hamlet @@ -0,0 +1 @@ +^{Table.buildBootstrap (submissionsTable tests) submissions} diff --git a/templates/challenge.hamlet b/templates/challenge.hamlet index 720fa96..7dcf8bc 100644 --- a/templates/challenge.hamlet +++ b/templates/challenge.hamlet @@ -5,8 +5,8 @@