Challenges can be archived

This commit is contained in:
Filip Graliński 2019-03-20 16:31:08 +01:00
parent 34394c072d
commit 27efefeb13
9 changed files with 68 additions and 16 deletions

View File

@ -163,6 +163,10 @@ instance Yesod App where
isAuthorized CreateResetLinkR _ = isAdmin
isAuthorized (ScoreR _) _ = isAdmin
isAuthorized ListArchivedChallengesR _ = isAdmin
isAuthorized (ArchiveR _) _ = isAdmin
isAuthorized (UnarchiveR _) _ = isAdmin
isAuthorized MyScoreR _ = return Authorized
isAuthorized (ResetPasswordR _) _ = return Authorized

View File

@ -120,7 +120,8 @@ addChallenge name publicRepoId privateRepoId chan = do
challengeDescription=(T.pack $ description),
challengeStamp=time,
challengeImage=mImage,
challengeStarred=False}
challengeStarred=False,
challengeArchived=Just False}
updateTests challengeId chan
return ()

View File

@ -3,8 +3,13 @@ module Handler.ListChallenges where
import Import
getListChallengesR :: Handler Html
getListChallengesR = do
challenges <- runDB $ selectList [] [Desc ChallengeStarred, Desc ChallengeStamp]
getListChallengesR = generalListChallenges [ChallengeArchived !=. Just True]
getListArchivedChallengesR :: Handler Html
getListArchivedChallengesR = generalListChallenges [ChallengeArchived ==. Just True]
generalListChallenges filterExpr = do
challenges <- runDB $ selectList filterExpr [Desc ChallengeStarred, Desc ChallengeStamp]
defaultLayout $ do
setTitle "List challenges"
$(widgetFile "list-challenges")

View File

@ -18,6 +18,7 @@ import Handler.Tables
import Handler.TagUtils
import Handler.MakePublic
import Handler.Dashboard
import Handler.Common
import Gonito.ExtractMetadata (ExtractionOptions(..),
extractMetadataFromRepoDir,
@ -54,11 +55,10 @@ getShowChallengeR name = do
app <- getYesod
let leaderboardStyle = appLeaderboardStyle $ appSettings app
(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name
challengeEnt@(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name
Just repo <- runDB $ get $ challengePublicRepo challenge
(leaderboard, (entries, tests)) <- getLeaderboardEntries leaderboardStyle challengeId
mauth <- maybeAuth
let muserId = (\(Entity uid _) -> uid) <$> mauth
let params = getNumericalParams entries
@ -66,8 +66,9 @@ getShowChallengeR name = do
challengeRepo <- runDB $ get404 $ challengePublicRepo challenge
challengeLayout True challenge (showChallengeWidget muserId
challenge scheme
challengeLayout True challenge (showChallengeWidget mauth
challengeEnt
scheme
challengeRepo
repo
leaderboard
@ -89,8 +90,8 @@ challengeReadme name = do
contents <- liftIO $ System.IO.readFile readmeFilePath
return $ markdown def $ TL.pack contents
showChallengeWidget :: Maybe UserId
-> Challenge
showChallengeWidget :: Maybe (Entity User)
-> Entity Challenge
-> RepoScheme
-> Repo
-> Repo
@ -98,8 +99,8 @@ showChallengeWidget :: Maybe UserId
-> [Text]
-> [Entity Test]
-> WidgetFor App ()
showChallengeWidget muserId
challenge
showChallengeWidget mUserEnt
(Entity challengeId challenge)
scheme
challengeRepo
repo
@ -111,6 +112,7 @@ showChallengeWidget muserId
maybeRepoLink = getRepoLink repo
delta = Number 4
higherTheBetterArray = getIsHigherTheBetterArray $ map entityVal tests
mUserId = entityKey <$> mUserEnt
getRepoLink :: Repo -> Maybe Text
getRepoLink repo
@ -180,6 +182,22 @@ challengeHowTo challenge settings repo shownId isIDSet isSSHUploaded mToken = $(
SelfHosted -> "master" :: Text
_ -> "my-brilliant-branch"
postArchiveR :: ChallengeId -> Handler Html
postArchiveR challengeId = doSetArchive True challengeId
postUnarchiveR :: ChallengeId -> Handler Html
postUnarchiveR challengeId = doSetArchive False challengeId
doSetArchive :: Bool -> ChallengeId -> Handler Html
doSetArchive status challengeId = do
runDB $ update challengeId [ChallengeArchived =. Just status]
challenge <- runDB $ get404 challengeId
getShowChallengeR $ challengeName challenge
archiveForm :: ChallengeId -> Form ChallengeId
archiveForm challengeId = renderBootstrap3 BootstrapBasicForm $ areq hiddenField "" (Just challengeId)
getChallengeSubmissionR :: Text -> Handler Html
getChallengeSubmissionR name = do
(Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
@ -235,14 +253,20 @@ trigger userId challengeName url mBranch mGitAnnexRemote = do
Just (Entity challengeId _) -> runOpenViewProgress $ doCreateSubmission userId challengeId
Nothing Nothing
RepoSpec {repoSpecUrl=url,
repoSpecBranch=branch,
repoSpecGitAnnexRemote=mGitAnnexRemote}
repoSpecBranch=branch,
repoSpecGitAnnexRemote=mGitAnnexRemote}
Nothing -> return $ toTypedContent (("Unknown challenge `" ++ (Data.Text.unpack challengeName) ++ "`. Cannot be triggered, must be submitted manually at Gonito.net!\n") :: String)
doCreateSubmission :: UserId -> Key Challenge -> Maybe Text -> Maybe Text -> RepoSpec -> Channel -> Handler ()
doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do
maybeRepoKey <- getSubmissionRepo userId challengeId repoSpec chan
case maybeRepoKey of
challenge <- runDB $ get404 challengeId
doCreateSubmission' (challengeArchived challenge) userId challengeId mDescription mTags repoSpec chan
doCreateSubmission' :: Maybe Bool -> UserId -> Key Challenge -> Maybe Text -> Maybe Text -> RepoSpec -> Channel -> Handler ()
doCreateSubmission' (Just True) _ _ _ _ _ chan = msg chan "This challenge is archived, you cannot submit to it. Ask the site admin to unarchive it."
doCreateSubmission' _ userId challengeId mDescription mTags repoSpec chan = do
maybeRepoKey <- getSubmissionRepo userId challengeId repoSpec chan
case maybeRepoKey of
Just repoId -> do
challenge <- runDB $ get404 challengeId

View File

@ -39,6 +39,7 @@ Challenge
stamp UTCTime default=now()
image ByteString Maybe
starred Bool
archived Bool Maybe
Test
challenge ChallengeId
metric Metric

View File

@ -10,6 +10,7 @@
/view-progress/#Int ViewProgressR GET
/open-view-progress/#Int OpenViewProgressR GET
/list-challenges ListChallengesR GET
/list-archived-challenges ListArchivedChallengesR GET
/challenge-image/#ChallengeId ChallengeImageR GET
/challenge/#Text ShowChallengeR GET
@ -36,6 +37,9 @@
/hide-submission/#SubmissionId HideSubmissionR GET
/restore-submission/#SubmissionId RestoreSubmissionR GET
/challenge-archive/#ChallengeId ArchiveR POST
/challenge-unarchive/#ChallengeId UnarchiveR POST
/account YourAccountR GET POST
/avatar/#UserId AvatarR GET
/create-reset-link CreateResetLinkR GET POST

View File

@ -76,3 +76,4 @@ TargetValue: target value to be reached before the target date
Test: test
Dashboard: dashboard
TargetName: target name
ShowArchivedChallenges: show archived challenges

View File

@ -27,6 +27,7 @@
<li><a href="@{CreateChallengeR}">_{MsgCreateChallenge}</a>
<li><a href="@{CreateResetLinkR}">_{MsgCreateResetLink}</a>
<li><a href="@{ExtraPointsR}">_{MsgAddExtraPoints}</a>
<li><a href="@{ListArchivedChallengesR}">_{MsgShowArchivedChallenges}</a>
<ul class="nav navbar-nav navbar-collapse collapse navbar-right">
<li class="dropdown">

View File

@ -3,9 +3,20 @@ $maybe repoLink <- maybeRepoLink
(Browse at <tt><a href="#{repoLink}">#{repoLink}</a></tt>)
$nothing
$if (challengeArchived challenge == Just True)
<p><b>This challenge is archived!
$if (checkIfAdmin mUserEnt)
$if (challengeArchived challenge /= Just True)
<form method=post action=@{ArchiveR challengeId}#form enctype="text/plain">
<button>Archive
$if (challengeArchived challenge == Just True)
<form method=post action=@{UnarchiveR challengeId}#form enctype="text/plain">
<button>Unarchive
<h2>Leaderboard
^{Table.buildBootstrap (leaderboardTable muserId (challengeName challenge) scheme challengeRepo tests) leaderboardWithRanks}
^{Table.buildBootstrap (leaderboardTable mUserId (challengeName challenge) scheme challengeRepo tests) leaderboardWithRanks}
<div id="graph-container">