2016-05-16 23:44:28 +02:00
|
|
|
module Handler.Presentation where
|
|
|
|
|
|
|
|
import Import
|
|
|
|
|
|
|
|
import Handler.ShowChallenge
|
|
|
|
import Handler.Tables
|
|
|
|
|
|
|
|
import qualified Yesod.Table as Table
|
|
|
|
import Yesod.Table (Table)
|
|
|
|
|
|
|
|
import Text.Hamlet (hamletFile)
|
|
|
|
|
|
|
|
sampleChallengeName :: Text
|
|
|
|
sampleChallengeName = "petite-difference-challenge"
|
|
|
|
|
2016-05-17 14:55:03 +02:00
|
|
|
sampleChallengeName' :: Text
|
|
|
|
sampleChallengeName' = "retroc"
|
|
|
|
|
|
|
|
|
|
|
|
sampleUserIdent :: Text
|
|
|
|
sampleUserIdent = "ptlen@ceti.pl"
|
|
|
|
|
2016-05-16 23:44:28 +02:00
|
|
|
getPresentation4RealR :: Handler Html
|
|
|
|
getPresentation4RealR = do
|
|
|
|
readme <- challengeReadme sampleChallengeName
|
|
|
|
|
2016-05-17 14:55:03 +02:00
|
|
|
challengeEnt@(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName sampleChallengeName
|
|
|
|
|
|
|
|
(Just (Entity sampleUserId _)) <- runDB $ getBy $ UniqueUser sampleUserIdent
|
|
|
|
let condition = (\(Entity _ submission) -> (submissionSubmitter submission == sampleUserId))
|
|
|
|
(evaluationMaps', tests) <- getChallengeSubmissionInfos condition challengeId
|
|
|
|
let evaluationMaps = take 10 evaluationMaps'
|
|
|
|
|
|
|
|
sampleLeaderboard <- getSampleLeaderboard sampleChallengeName
|
|
|
|
sampleLeaderboard' <- getSampleLeaderboard sampleChallengeName'
|
|
|
|
|
|
|
|
presentationLayout $(widgetFile "presentation-4real")
|
|
|
|
|
2017-05-27 08:59:10 +02:00
|
|
|
getPresentationDATeCH2017R = do
|
2017-05-29 23:24:12 +02:00
|
|
|
readme <- challengeReadme sampleChallengeName
|
|
|
|
sampleLeaderboard <- getSampleLeaderboard sampleChallengeName'
|
2017-05-27 08:59:10 +02:00
|
|
|
presentationLayout $(widgetFile "presentation-datech-2017")
|
|
|
|
|
2016-05-17 14:55:03 +02:00
|
|
|
|
|
|
|
getSampleLeaderboard name = do
|
2016-05-27 08:48:26 +02:00
|
|
|
challengeEnt@(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name
|
2016-05-17 14:55:03 +02:00
|
|
|
|
2016-05-16 23:44:28 +02:00
|
|
|
Just repo <- runDB $ get $ challengePublicRepo challenge
|
|
|
|
(test, leaderboard) <- getLeaderboardEntries challengeId
|
2016-05-17 14:55:03 +02:00
|
|
|
let leaderboardWithRanks = zip [1..] (take 10 leaderboard)
|
2016-05-16 23:44:28 +02:00
|
|
|
|
2016-05-17 14:55:03 +02:00
|
|
|
return $ Table.buildBootstrap (leaderboardTable Nothing (challengeName challenge) test) leaderboardWithRanks
|
2016-05-16 23:44:28 +02:00
|
|
|
|
|
|
|
presentationLayout widget = do
|
|
|
|
master <- getYesod
|
|
|
|
mmsg <- getMessage
|
|
|
|
|
|
|
|
maybeUser <- maybeAuth
|
|
|
|
|
|
|
|
pc <- widgetToPageContent widget
|
|
|
|
withUrlRenderer $(hamletFile "templates/presentation-layout.hamlet")
|