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 CreateResetLinkR _ = isAdmin
isAuthorized (ScoreR _) _ = isAdmin isAuthorized (ScoreR _) _ = isAdmin
isAuthorized ListArchivedChallengesR _ = isAdmin
isAuthorized (ArchiveR _) _ = isAdmin
isAuthorized (UnarchiveR _) _ = isAdmin
isAuthorized MyScoreR _ = return Authorized isAuthorized MyScoreR _ = return Authorized
isAuthorized (ResetPasswordR _) _ = return Authorized isAuthorized (ResetPasswordR _) _ = return Authorized

View File

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

View File

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

View File

@ -18,6 +18,7 @@ import Handler.Tables
import Handler.TagUtils import Handler.TagUtils
import Handler.MakePublic import Handler.MakePublic
import Handler.Dashboard import Handler.Dashboard
import Handler.Common
import Gonito.ExtractMetadata (ExtractionOptions(..), import Gonito.ExtractMetadata (ExtractionOptions(..),
extractMetadataFromRepoDir, extractMetadataFromRepoDir,
@ -54,11 +55,10 @@ getShowChallengeR name = do
app <- getYesod app <- getYesod
let leaderboardStyle = appLeaderboardStyle $ appSettings app 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 Just repo <- runDB $ get $ challengePublicRepo challenge
(leaderboard, (entries, tests)) <- getLeaderboardEntries leaderboardStyle challengeId (leaderboard, (entries, tests)) <- getLeaderboardEntries leaderboardStyle challengeId
mauth <- maybeAuth mauth <- maybeAuth
let muserId = (\(Entity uid _) -> uid) <$> mauth
let params = getNumericalParams entries let params = getNumericalParams entries
@ -66,8 +66,9 @@ getShowChallengeR name = do
challengeRepo <- runDB $ get404 $ challengePublicRepo challenge challengeRepo <- runDB $ get404 $ challengePublicRepo challenge
challengeLayout True challenge (showChallengeWidget muserId challengeLayout True challenge (showChallengeWidget mauth
challenge scheme challengeEnt
scheme
challengeRepo challengeRepo
repo repo
leaderboard leaderboard
@ -89,8 +90,8 @@ challengeReadme name = do
contents <- liftIO $ System.IO.readFile readmeFilePath contents <- liftIO $ System.IO.readFile readmeFilePath
return $ markdown def $ TL.pack contents return $ markdown def $ TL.pack contents
showChallengeWidget :: Maybe UserId showChallengeWidget :: Maybe (Entity User)
-> Challenge -> Entity Challenge
-> RepoScheme -> RepoScheme
-> Repo -> Repo
-> Repo -> Repo
@ -98,8 +99,8 @@ showChallengeWidget :: Maybe UserId
-> [Text] -> [Text]
-> [Entity Test] -> [Entity Test]
-> WidgetFor App () -> WidgetFor App ()
showChallengeWidget muserId showChallengeWidget mUserEnt
challenge (Entity challengeId challenge)
scheme scheme
challengeRepo challengeRepo
repo repo
@ -111,6 +112,7 @@ showChallengeWidget muserId
maybeRepoLink = getRepoLink repo maybeRepoLink = getRepoLink repo
delta = Number 4 delta = Number 4
higherTheBetterArray = getIsHigherTheBetterArray $ map entityVal tests higherTheBetterArray = getIsHigherTheBetterArray $ map entityVal tests
mUserId = entityKey <$> mUserEnt
getRepoLink :: Repo -> Maybe Text getRepoLink :: Repo -> Maybe Text
getRepoLink repo getRepoLink repo
@ -180,6 +182,22 @@ challengeHowTo challenge settings repo shownId isIDSet isSSHUploaded mToken = $(
SelfHosted -> "master" :: Text SelfHosted -> "master" :: Text
_ -> "my-brilliant-branch" _ -> "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 :: Text -> Handler Html
getChallengeSubmissionR name = do getChallengeSubmissionR name = do
(Entity _ challenge) <- runDB $ getBy404 $ UniqueName name (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
@ -241,6 +259,12 @@ trigger userId challengeName url mBranch mGitAnnexRemote = do
doCreateSubmission :: UserId -> Key Challenge -> Maybe Text -> Maybe Text -> RepoSpec -> Channel -> Handler () doCreateSubmission :: UserId -> Key Challenge -> Maybe Text -> Maybe Text -> RepoSpec -> Channel -> Handler ()
doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do
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 maybeRepoKey <- getSubmissionRepo userId challengeId repoSpec chan
case maybeRepoKey of case maybeRepoKey of
Just repoId -> do Just repoId -> do

View File

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

View File

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

View File

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

View File

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

View File

@ -3,9 +3,20 @@ $maybe repoLink <- maybeRepoLink
(Browse at <tt><a href="#{repoLink}">#{repoLink}</a></tt>) (Browse at <tt><a href="#{repoLink}">#{repoLink}</a></tt>)
$nothing $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 <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"> <div id="graph-container">