forked from filipg/gonito
116 lines
3.9 KiB
Haskell
116 lines
3.9 KiB
Haskell
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Handler.Presentation where
|
|
|
|
import Import
|
|
|
|
import GEval.MetricsMeta
|
|
|
|
import Handler.ShowChallenge
|
|
import Handler.Tables
|
|
|
|
import qualified Yesod.Table as Table
|
|
|
|
import Text.Hamlet (hamletFile)
|
|
|
|
sampleChallengeName :: Text
|
|
sampleChallengeName = "petite-difference-challenge2"
|
|
|
|
sampleChallengeName' :: Text
|
|
sampleChallengeName' = "retroc2"
|
|
|
|
retrocChallengeName :: Text
|
|
retrocChallengeName = "retroc2"
|
|
|
|
retroc2ChallengeName :: Text
|
|
retroc2ChallengeName = "retroc2"
|
|
|
|
sampleUserIdent :: Text
|
|
sampleUserIdent = "ptlen@ceti.pl"
|
|
|
|
getPresentation4RealR :: Handler Html
|
|
getPresentation4RealR = do
|
|
readme <- challengeReadme sampleChallengeName
|
|
|
|
(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName sampleChallengeName
|
|
|
|
(Just (Entity sampleUserId _)) <- runDB $ getBy $ UniqueUser sampleUserIdent
|
|
let condition = (\(Entity _ submission) -> (submissionSubmitter submission == sampleUserId))
|
|
(evaluationMaps', tests) <- runDB $ getChallengeSubmissionInfos 1 condition (const True) onlyTheBestVariant challengeId
|
|
let evaluationMaps = take 10 evaluationMaps'
|
|
|
|
sampleLeaderboard <- getSampleLeaderboard sampleChallengeName
|
|
sampleLeaderboard' <- getSampleLeaderboard sampleChallengeName'
|
|
|
|
app <- getYesod
|
|
let scheme = appRepoScheme $ appSettings app
|
|
|
|
challengeRepo <- runDB $ get404 $ challengePublicRepo challenge
|
|
|
|
presentationLayout $(widgetFile "presentation-4real")
|
|
|
|
getPresentationPSNC2019R :: Handler Html
|
|
getPresentationPSNC2019R = do
|
|
readme <- challengeReadme sampleChallengeName
|
|
|
|
(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName sampleChallengeName
|
|
|
|
(Just (Entity sampleUserId _)) <- runDB $ getBy $ UniqueUser sampleUserIdent
|
|
let condition = (\(Entity _ submission) -> (submissionSubmitter submission == sampleUserId))
|
|
(evaluationMaps', tests) <- runDB $ getChallengeSubmissionInfos 1 condition (const True) onlyTheBestVariant challengeId
|
|
let evaluationMaps = take 10 evaluationMaps'
|
|
|
|
sampleLeaderboard <- getSampleLeaderboard sampleChallengeName
|
|
sampleLeaderboard' <- getSampleLeaderboard sampleChallengeName'
|
|
|
|
app <- getYesod
|
|
let scheme = appRepoScheme $ appSettings app
|
|
|
|
challengeRepo <- runDB $ get404 $ challengePublicRepo challenge
|
|
|
|
presentationLayout $(widgetFile "presentation-psnc-2019")
|
|
|
|
getPresentationDATeCH2017R = do
|
|
readme <- challengeReadme retrocChallengeName
|
|
retrocLeaderboard <- getSampleLeaderboard retrocChallengeName
|
|
retroc2Leaderboard <- getSampleLeaderboard retroc2ChallengeName
|
|
presentationLayout $(widgetFile "presentation-datech-2017")
|
|
|
|
|
|
getSampleLeaderboard :: Text -> HandlerFor App (WidgetFor App ())
|
|
getSampleLeaderboard name = getSampleLeaderboardGeneralized name 1 BySubmitter leaderboardTable
|
|
|
|
getSampleAltLeaderboard :: Text -> HandlerFor App (WidgetFor App ())
|
|
getSampleAltLeaderboard name = getSampleLeaderboardGeneralized name 2 ByTag altLeaderboardTable
|
|
|
|
getSampleLeaderboardGeneralized name maxPriority method table = do
|
|
(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name
|
|
|
|
(leaderboard, (_, tests)) <- getLeaderboardEntries maxPriority method challengeId
|
|
let leaderboardWithRanks = zip [1..] (take 10 leaderboard)
|
|
|
|
app <- getYesod
|
|
let scheme = appRepoScheme $ appSettings app
|
|
|
|
challengeRepo <- runDB $ get404 $ challengePublicRepo challenge
|
|
|
|
return $ Table.buildBootstrap (table Nothing
|
|
(challengeName challenge)
|
|
scheme challengeRepo tests)
|
|
leaderboardWithRanks
|
|
|
|
|
|
|
|
presentationLayout widget = do
|
|
pc <- widgetToPageContent widget
|
|
withUrlRenderer $(hamletFile "templates/presentation-layout.hamlet")
|
|
|
|
getWritingPapersWithGonitoR :: Handler Html
|
|
getWritingPapersWithGonitoR = do
|
|
app <- getYesod
|
|
let tab :: String = "\t"
|
|
let rootAddress = appRoot $ appSettings app
|
|
defaultLayout $ do
|
|
setTitle "Writing papers with Gonito"
|
|
$(widgetFile "writing-papers")
|