Challenges can be archived
This commit is contained in:
Filip Graliński
parent
34394c072d
commit
27efefeb13
@ -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
|
||||
|
||||
@ -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 ()
|
||||
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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
|
||||
|
||||
@ -39,6 +39,7 @@ Challenge
|
||||
stamp UTCTime default=now()
|
||||
image ByteString Maybe
|
||||
starred Bool
|
||||
archived Bool Maybe
|
||||
Test
|
||||
challenge ChallengeId
|
||||
metric Metric
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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">
|
||||
|
||||
@ -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">
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user