score table usable now

This commit is contained in:
Filip Gralinski 2017-05-15 14:25:54 +02:00
parent b033d0c4b5
commit ea217896be
5 changed files with 31 additions and 5 deletions

View File

@ -5,6 +5,8 @@ import Import
import Handler.Shared
import Handler.Tables
import Control.Monad.Extra
import Handler.AchievementUtils
import qualified Database.Esqueleto as E
@ -12,6 +14,8 @@ import Database.Esqueleto ((^.))
import qualified Yesod.Table as Table
import Data.Text as T
getMyScoreR :: Handler Html
getMyScoreR = do
entUser <- requireAuth
@ -22,12 +26,18 @@ getScoreR userId = do
user <- runDB $ get404 userId
doScore (Entity userId user)
scoreTable :: Table.Table App (AchievementInfo, Entity Submission)
scoreTable :: Table.Table App (AchievementInfo, (Entity Submission, Bool))
scoreTable = mempty
++ Table.text "name" (achievementInfoName . fst)
++ achievementDescriptionCell fst
++ timestampCell "deadline" (achievementInfoDeadline . fst)
++ Table.text "submission" (submissionDescription . entityVal . snd)
++ timestampCell "submitted" (submissionStamp . entityVal . fst . snd)
++ Table.linked "submission" (submissionDescription . entityVal . fst . snd) (EditSubmissionR . entityKey . fst . snd)
++ Table.text "status" getStatus
getStatus :: (AchievementInfo, (Entity Submission, Bool)) -> Text
getStatus (_, (_, False)) = ""
getStatus (aInfo, (_, True)) = T.pack $ show $ achievementInfoPoints aInfo
doScore :: Entity User -> Handler Html
doScore (Entity userId user) = do
@ -45,7 +55,20 @@ doScore (Entity userId user) = do
setTitle "Score"
$(widgetFile "score")
processEntry :: Entity User -> (Entity Achievement, Entity Submission) -> Handler (AchievementInfo, Entity Submission)
processEntry :: Entity User -> (Entity Achievement, Entity Submission) -> Handler (AchievementInfo, (Entity Submission, Bool))
processEntry entUser (entAchievement, entSubmission) = do
aInfo <- runDB $ getAchievementInfo (Just entUser) entAchievement
return (aInfo, entSubmission)
accepted <- allM (checkSubmissionTag entSubmission) (achievementInfoTags aInfo)
return (aInfo, (entSubmission, accepted))
checkSubmissionTag :: Entity Submission -> Entity Tag -> Handler Bool
checkSubmissionTag (Entity submissionId _) (Entity tagId _) = do
mSubmissionTag <- runDB $ getBy $ UniqueSubmissionTag submissionId tagId
return $ case mSubmissionTag of
Just (Entity _ submissionTag) -> case submissionTagAccepted submissionTag of
Just b -> b
Nothing -> False
Nothing -> False

View File

@ -139,6 +139,7 @@ library
, pwstore-fast
, nonce
, esqueleto
, extra
executable gonito
if flag(library-only)

View File

@ -42,3 +42,4 @@ AchievementTags: tags required for an achievement
Achievements: achievements
AchievementPoints: points
WantToBeAnonimised: I want to stay anonymous for other user of Gonito.net
YourScore: your score

View File

@ -5,5 +5,5 @@ flags:
packages:
- '.'
- '../geval'
extra-deps: [markdown-0.1.13.2,geval-0.3.2.0,cond-0.4.1.1,wai-handler-fastcgi-3.0.0.2,murmur3-1.0.3]
extra-deps: [markdown-0.1.13.2,geval-0.3.2.0,cond-0.4.1.1,wai-handler-fastcgi-3.0.0.2,murmur3-1.0.3,extra-1.4.10]
resolver: lts-6.24

View File

@ -19,6 +19,7 @@
<a href="@{AuthR LoginR}" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">#{userIdent $ entityVal user}<span class="caret"></span>
<ul class="dropdown-menu">
<li><a href="@{YourAccountR}">_{MsgYourAccount}</a></li>
<li><a href="@{MyScoreR}">_{MsgYourScore}</a></li>
<li><a href="@{AuthR LogoutR}">_{MsgLogOut}</a></li>
$nothing
<ul class="nav navbar-nav">