gonito/Handler/Presentation.hs

116 lines
3.9 KiB
Haskell
Raw Permalink Normal View History

{-# LANGUAGE ScopedTypeVariables #-}
2016-05-16 23:44:28 +02:00
module Handler.Presentation where
import Import
2019-09-23 23:16:46 +02:00
import GEval.MetricsMeta
2016-05-16 23:44:28 +02:00
import Handler.ShowChallenge
import Handler.Tables
import qualified Yesod.Table as Table
import Text.Hamlet (hamletFile)
sampleChallengeName :: Text
2019-09-23 23:16:46 +02:00
sampleChallengeName = "petite-difference-challenge2"
2016-05-16 23:44:28 +02:00
2016-05-17 14:55:03 +02:00
sampleChallengeName' :: Text
2019-09-23 23:16:46 +02:00
sampleChallengeName' = "retroc2"
2016-05-17 14:55:03 +02:00
2017-05-30 14:20:22 +02:00
retrocChallengeName :: Text
2019-09-23 23:16:46 +02:00
retrocChallengeName = "retroc2"
2017-05-30 14:20:22 +02:00
retroc2ChallengeName :: Text
retroc2ChallengeName = "retroc2"
2016-05-17 14:55:03 +02:00
sampleUserIdent :: Text
sampleUserIdent = "ptlen@ceti.pl"
2016-05-16 23:44:28 +02:00
getPresentation4RealR :: Handler Html
getPresentation4RealR = do
readme <- challengeReadme sampleChallengeName
2018-07-28 21:53:13 +02:00
(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName sampleChallengeName
2016-05-17 14:55:03 +02:00
(Just (Entity sampleUserId _)) <- runDB $ getBy $ UniqueUser sampleUserIdent
let condition = (\(Entity _ submission) -> (submissionSubmitter submission == sampleUserId))
(evaluationMaps', tests) <- runDB $ getChallengeSubmissionInfos 1 condition (const True) onlyTheBestVariant challengeId
2016-05-17 14:55:03 +02:00
let evaluationMaps = take 10 evaluationMaps'
sampleLeaderboard <- getSampleLeaderboard sampleChallengeName
sampleLeaderboard' <- getSampleLeaderboard sampleChallengeName'
app <- getYesod
let scheme = appRepoScheme $ appSettings app
challengeRepo <- runDB $ get404 $ challengePublicRepo challenge
2016-05-17 14:55:03 +02:00
presentationLayout $(widgetFile "presentation-4real")
2019-09-23 23:16:46 +02:00
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
2019-09-23 23:16:46 +02:00
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")
2017-05-27 08:59:10 +02:00
getPresentationDATeCH2017R = do
2017-05-30 14:20:22 +02:00
readme <- challengeReadme retrocChallengeName
retrocLeaderboard <- getSampleLeaderboard retrocChallengeName
retroc2Leaderboard <- getSampleLeaderboard retroc2ChallengeName
2017-05-27 08:59:10 +02:00
presentationLayout $(widgetFile "presentation-datech-2017")
2016-05-17 14:55:03 +02:00
getSampleLeaderboard :: Text -> HandlerFor App (WidgetFor App ())
2019-12-16 17:07:38 +01:00
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
2018-07-28 21:53:13 +02:00
(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name
2016-05-17 14:55:03 +02:00
2019-12-16 17:07:38 +01:00
(leaderboard, (_, tests)) <- getLeaderboardEntries maxPriority method challengeId
2016-05-17 14:55:03 +02:00
let leaderboardWithRanks = zip [1..] (take 10 leaderboard)
2016-05-16 23:44:28 +02:00
app <- getYesod
let scheme = appRepoScheme $ appSettings app
challengeRepo <- runDB $ get404 $ challengePublicRepo challenge
2019-12-16 17:07:38 +01:00
return $ Table.buildBootstrap (table Nothing
(challengeName challenge)
scheme challengeRepo tests)
2018-07-28 21:53:13 +02:00
leaderboardWithRanks
2016-05-16 23:44:28 +02:00
2019-12-16 17:07:38 +01:00
2016-05-16 23:44:28 +02:00
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")