add a parameter

Handler/EditSubmission.hs

@@ -12,18 +12,40 @@ import Handler.MakePublic
 
 import Data.Text as T
 
+postAddVariantParamR :: SubmissionId -> VariantId -> Handler Html
+postAddVariantParamR submissionId variantId = do
+  ((result, _), _) <- runFormPost addVariantParamForm
+  let FormSuccess (pName, pValue) = result
+  _ <- runDB $ insert $ Parameter {
+    parameterVariant = variantId,
+    parameterName = pName,
+    parameterValue = pValue }
+  getEditSubmissionAndVariantR submissionId variantId
+
 getEditSubmissionR :: SubmissionId -> Handler Html
-getEditSubmissionR submissionId = do
+getEditSubmissionR submissionId = getEditSubmissionG submissionId Nothing
+
+getEditSubmissionAndVariantR :: SubmissionId -> VariantId -> Handler Html
+getEditSubmissionAndVariantR submissionId variantId = getEditSubmissionG submissionId (Just variantId)
+
+getEditSubmissionG :: SubmissionId -> (Maybe VariantId) -> Handler Html
+getEditSubmissionG submissionId mVariantId = do
   submission <- runDB $ get404 submissionId
   tags <- runDB $ getTags submissionId
   let mTagsAsText = case tags of
         [] -> Nothing
         _ -> Just $ T.intercalate ", " $ Import.map (tagName . entityVal . fst) tags
   (formWidget, formEnctype) <- generateFormPost $ editSubmissionForm (submissionDescription submission) mTagsAsText
-  doEditSubmission formWidget formEnctype submissionId
+  doEditSubmission formWidget formEnctype submissionId mVariantId
 
 postEditSubmissionR :: SubmissionId -> Handler Html
-postEditSubmissionR submissionId = do
+postEditSubmissionR submissionId = postEditSubmissionG submissionId Nothing
+
+postEditSubmissionAndVariantR :: SubmissionId -> VariantId -> Handler Html
+postEditSubmissionAndVariantR submissionId variantId = postEditSubmissionG submissionId (Just variantId)
+
+postEditSubmissionG :: SubmissionId -> (Maybe VariantId) -> Handler Html
+postEditSubmissionG submissionId mVariantId = do
   submission <- runDB $ get404 submissionId
   ((result, _), _) <- runFormPost $ editSubmissionForm (submissionDescription submission) Nothing
   let FormSuccess (description, tags) = result
@@ -43,7 +65,7 @@ postEditSubmissionR submissionId = do
      do
       setMessage $ toHtml ("Only owner can edit a submission!!!" :: Text)
       return ()
-  getEditSubmissionR submissionId
+  getEditSubmissionG submissionId mVariantId
 
 
 getPossibleAchievements :: (BaseBackend backend ~ SqlBackend, PersistUniqueRead backend, PersistQueryRead backend, MonadIO m) => Key User -> Key Submission -> ReaderT backend m [(Entity Achievement, Key WorkingOn)]
@@ -55,7 +77,7 @@ getPossibleAchievements userId submissionId = do
   let rets = Import.zip achievements workingOns
   return $ Import.map (\(a, (Just w)) -> (a, entityKey w)) $ Import.filter (\(_, mw) -> isJust mw) $ rets
 
-doEditSubmission formWidget formEnctype submissionId = do
+doEditSubmission formWidget formEnctype submissionId mVariantId = do
   submission <- runDB $ get404 submissionId
   submissionFull <- getFullInfo (Entity submissionId submission)
   let view = queryResult submissionFull
@@ -66,6 +88,12 @@ doEditSubmission formWidget formEnctype submissionId = do
 
   achievements <- runDB $ getPossibleAchievements userId submissionId
 
+  variantParams <- case mVariantId of
+    Just variantId -> runDB $ selectList [ParameterVariant ==. variantId] [Asc ParameterName]
+    Nothing -> return []
+
+  (addVariantParamWidget, formEnctype2) <- generateFormPost $ addVariantParamForm
+
   defaultLayout $ do
     setTitle "Edit a submission"
     $(widgetFile "edit-submission")
@@ -76,6 +104,12 @@ editSubmissionForm description mTags = renderBootstrap3 BootstrapBasicForm $ (,)
     <*> aopt textField (tagsfs MsgSubmissionTags) (Just mTags)
 
 
+addVariantParamForm :: Form (Text, Text)
+addVariantParamForm = renderBootstrap3 BootstrapBasicForm $ (,)
+    <$> areq textField (bfs MsgParameterName) Nothing
+    <*> areq textField (bfs MsgParameterValue) Nothing
+
+
 getHideSubmissionR :: SubmissionId -> Handler Html
 getHideSubmissionR submissionId = changeSubmissionVisibility False submissionId
 

Handler/Tables.hs

@@ -53,7 +53,7 @@ submissionsTable mauthId challengeName repoScheme challengeRepo tests = mempty
   ++ timestampCell "when" (submissionStamp . (\(TableEntry (Entity _ s) _ _ _ _ _) -> s))
   ++ descriptionCell
   ++ mconcat (map (\(Entity k t) -> resultCell t (extractScore k)) tests)
-  ++ statusCell challengeName repoScheme challengeRepo (\(TableEntry (Entity submissionId submission) _ (Entity userId _) _ _ _) -> (submissionId, submission, userId, mauthId))
+  ++ statusCell challengeName repoScheme challengeRepo (\(TableEntry (Entity submissionId submission) (Entity variantId variant) (Entity userId _) _ _ _) -> (submissionId, submission, variantId, variant, userId, mauthId))
 
 descriptionCell :: Table site TableEntry
 descriptionCell = Table.widget "description" (
@@ -85,6 +85,8 @@ leaderboardTable mauthId challengeName repoScheme challengeRepo test = mempty
   ++ Table.int "×" (leaderboardNumberOfSubmissions . snd)
   ++ statusCell challengeName repoScheme challengeRepo (\(_, e) -> (leaderboardBestSubmissionId e,
                                        leaderboardBestSubmission e,
+                                       leaderboardBestVariantId e,
+                                       leaderboardBestVariant e,
                                        leaderboardUserId e,
                                        mauthId))
 
@@ -106,14 +108,14 @@ timestampCell :: Text -> (a -> UTCTime) -> Table site a
 timestampCell h timestampFun = hoverTextCell h (Data.Text.pack . shorterFormat . timestampFun) (Data.Text.pack . show . timestampFun)
    where shorterFormat = formatTime defaultTimeLocale "%Y-%m-%d %H:%M"
 
-statusCell :: Text -> RepoScheme -> Repo -> (a -> (SubmissionId, Submission, UserId, Maybe UserId)) -> Table App a
+statusCell :: Text -> RepoScheme -> Repo -> (a -> (SubmissionId, Submission, VariantId, Variant, UserId, Maybe UserId)) -> Table App a
 statusCell challengeName repoScheme challengeRepo fun = Table.widget "" (statusCellWidget challengeName repoScheme challengeRepo . fun)
 
 resultCell :: Test -> (a -> Maybe Evaluation) -> Table App a
 resultCell test fun = hoverTextCell (formatTest test) (formatTruncatedScore (testPrecision test) . fun) (formatFullScore . fun)
 
-statusCellWidget :: Eq a => Text -> RepoScheme -> Repo -> (SubmissionId, Submission, a, Maybe a) -> WidgetFor App ()
+statusCellWidget :: Eq a => Text -> RepoScheme -> Repo -> (SubmissionId, Submission, VariantId, Variant, a, Maybe a) -> WidgetFor App ()
-statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, userId, mauthId) = $(widgetFile "submission-status")
+statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, variantId, _, userId, mauthId) = $(widgetFile "submission-status")
     where commitHash = fromSHA1ToText $ submissionCommit submission
           isPublic = submissionIsPublic submission
           isOwner = (mauthId == Just userId)

config/routes

@@ -53,6 +53,8 @@
 /my-score MyScoreR GET
 
 /edit-submission/#SubmissionId EditSubmissionR GET POST
+/edit-submission-and-variant/#SubmissionId/#VariantId EditSubmissionAndVariantR GET POST
+/add-variant-param/#SubmissionId/#VariantId AddVariantParamR POST
 
 /presentation/4real Presentation4RealR GET
 /presentation/datech-2017 PresentationDATeCH2017R GET

messages/en.msg

@@ -62,3 +62,5 @@ GitAnnexRemote: git-annex remote (if needed)
 SubmissionGitAnnexRemote: git-annex remote specification (if needed)
 RemoveSubmission: remove submission
 RestoreSubmission: restore submission
+ParameterName: parameter name
+ParameterValue: parameter value

templates/edit-submission.hamlet

@@ -11,7 +11,19 @@
  $forall (achievement, workingOnId) <- achievements
   <li><a href=@{SubmissionForAchievementR submissionId workingOnId}>send to review for #{achievementName $ entityVal achievement} achievement
 
-<h4>
+$maybe variantId <- mVariantId
+  <h4>Variant parameters
+
+  $forall param <- variantParams
+       <p>#{parameterName $ entityVal param} = #{parameterValue $ entityVal param}
+
+  <h5>Add new parameter
+
+  <form method=post action=@{AddVariantParamR submissionId variantId}#form enctype=#{formEnctype2}>
+    ^{addVariantParamWidget}
+    <button .btn .btn-primary type="submit">
+      _{MsgSubmit} <span class="glyphicon glyphicon-upload"></span>
+  <hr>
 
 $if submissionIsHidden submission == Just True
   <p>Submission is hidden!

templates/submission-status.hamlet

@@ -1,5 +1,5 @@
 $if isOwner
-  <a href="@{EditSubmissionR submissionId}">
+  <a href="@{EditSubmissionAndVariantR submissionId variantId}">
     <span class="glyphicon glyphicon-pencil" title="click to edit the submission" aria-hidden="true">
 
   <a href="@{HideSubmissionR submissionId}">