list all submissions

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

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

gonito.cabal

@@ -104,6 +104,7 @@ library
                  , markdown
                  , geval
                  , filepath
+                 , yesod-table
 
 executable         gonito
     if flag(library-only)

templates/challenge-all-submissions.hamlet

@@ -0,0 +1 @@
+^{Table.buildBootstrap (submissionsTable tests) submissions}

templates/challenge.hamlet

@@ -5,8 +5,8 @@
      <li role="presentation" class="active"><a href="@{ShowChallengeR (challengeName challenge)}">Graph</a>
      <li role="presentation"><a href="@{ChallengeReadmeR (challengeName challenge)}">Readme</a>
      <li role="presentation"><a href="@{ChallengeSubmissionR (challengeName challenge)}">Submit</a>
-     <li role="presentation"><a href="#">My Submissions</a>
-     <li role="presentation"><a href="#">All Submissions</a>
+     <li role="presentation"><a href="@{ChallengeMySubmissionsR (challengeName challenge)}">My Submissions</a>
+     <li role="presentation"><a href="@{ChallengeAllSubmissionsR (challengeName challenge)}">All Submissions</a>
   <div .col-md-10 role="main">
     <div class="panel panel-default">
       <div class="panel-body">