score table usable now
This commit is contained in:
parent
b033d0c4b5
commit
ea217896be
@ -5,6 +5,8 @@ import Import
|
|||||||
import Handler.Shared
|
import Handler.Shared
|
||||||
import Handler.Tables
|
import Handler.Tables
|
||||||
|
|
||||||
|
import Control.Monad.Extra
|
||||||
|
|
||||||
import Handler.AchievementUtils
|
import Handler.AchievementUtils
|
||||||
|
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
@ -12,6 +14,8 @@ import Database.Esqueleto ((^.))
|
|||||||
|
|
||||||
import qualified Yesod.Table as Table
|
import qualified Yesod.Table as Table
|
||||||
|
|
||||||
|
import Data.Text as T
|
||||||
|
|
||||||
getMyScoreR :: Handler Html
|
getMyScoreR :: Handler Html
|
||||||
getMyScoreR = do
|
getMyScoreR = do
|
||||||
entUser <- requireAuth
|
entUser <- requireAuth
|
||||||
@ -22,12 +26,18 @@ getScoreR userId = do
|
|||||||
user <- runDB $ get404 userId
|
user <- runDB $ get404 userId
|
||||||
doScore (Entity userId user)
|
doScore (Entity userId user)
|
||||||
|
|
||||||
scoreTable :: Table.Table App (AchievementInfo, Entity Submission)
|
scoreTable :: Table.Table App (AchievementInfo, (Entity Submission, Bool))
|
||||||
scoreTable = mempty
|
scoreTable = mempty
|
||||||
++ Table.text "name" (achievementInfoName . fst)
|
++ Table.text "name" (achievementInfoName . fst)
|
||||||
++ achievementDescriptionCell fst
|
++ achievementDescriptionCell fst
|
||||||
++ timestampCell "deadline" (achievementInfoDeadline . 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 User -> Handler Html
|
||||||
doScore (Entity userId user) = do
|
doScore (Entity userId user) = do
|
||||||
@ -45,7 +55,20 @@ doScore (Entity userId user) = do
|
|||||||
setTitle "Score"
|
setTitle "Score"
|
||||||
$(widgetFile "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
|
processEntry entUser (entAchievement, entSubmission) = do
|
||||||
aInfo <- runDB $ getAchievementInfo (Just entUser) entAchievement
|
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
|
||||||
|
@ -139,6 +139,7 @@ library
|
|||||||
, pwstore-fast
|
, pwstore-fast
|
||||||
, nonce
|
, nonce
|
||||||
, esqueleto
|
, esqueleto
|
||||||
|
, extra
|
||||||
|
|
||||||
executable gonito
|
executable gonito
|
||||||
if flag(library-only)
|
if flag(library-only)
|
||||||
|
@ -42,3 +42,4 @@ AchievementTags: tags required for an achievement
|
|||||||
Achievements: achievements
|
Achievements: achievements
|
||||||
AchievementPoints: points
|
AchievementPoints: points
|
||||||
WantToBeAnonimised: I want to stay anonymous for other user of Gonito.net
|
WantToBeAnonimised: I want to stay anonymous for other user of Gonito.net
|
||||||
|
YourScore: your score
|
||||||
|
@ -5,5 +5,5 @@ flags:
|
|||||||
packages:
|
packages:
|
||||||
- '.'
|
- '.'
|
||||||
- '../geval'
|
- '../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
|
resolver: lts-6.24
|
||||||
|
@ -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>
|
<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">
|
<ul class="dropdown-menu">
|
||||||
<li><a href="@{YourAccountR}">_{MsgYourAccount}</a></li>
|
<li><a href="@{YourAccountR}">_{MsgYourAccount}</a></li>
|
||||||
|
<li><a href="@{MyScoreR}">_{MsgYourScore}</a></li>
|
||||||
<li><a href="@{AuthR LogoutR}">_{MsgLogOut}</a></li>
|
<li><a href="@{AuthR LogoutR}">_{MsgLogOut}</a></li>
|
||||||
$nothing
|
$nothing
|
||||||
<ul class="nav navbar-nav">
|
<ul class="nav navbar-nav">
|
||||||
|
Loading…
Reference in New Issue
Block a user