gonito/Handler/Score.hs

75 lines
2.6 KiB
Haskell
Raw Normal View History

2017-05-15 13:55:56 +02:00
module Handler.Score where
import Import
import Handler.Shared
import Handler.Tables
2017-05-15 14:25:54 +02:00
import Control.Monad.Extra
2017-05-15 13:55:56 +02:00
import Handler.AchievementUtils
import qualified Database.Esqueleto as E
import Database.Esqueleto ((^.))
import qualified Yesod.Table as Table
2017-05-15 14:25:54 +02:00
import Data.Text as T
2017-05-15 13:55:56 +02:00
getMyScoreR :: Handler Html
getMyScoreR = do
entUser <- requireAuth
doScore entUser
getScoreR :: UserId -> Handler Html
getScoreR userId = do
user <- runDB $ get404 userId
doScore (Entity userId user)
2017-05-15 14:25:54 +02:00
scoreTable :: Table.Table App (AchievementInfo, (Entity Submission, Bool))
2017-05-15 13:55:56 +02:00
scoreTable = mempty
++ Table.text "name" (achievementInfoName . fst)
++ achievementDescriptionCell fst
++ timestampCell "deadline" (achievementInfoDeadline . fst)
2017-05-15 14:25:54 +02:00
++ 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
2017-05-15 13:55:56 +02:00
doScore :: Entity User -> Handler Html
doScore (Entity userId user) = do
entries <- runDB $ E.select
$ E.from $ \(working_on, achievement, submission) -> do
E.where_ (working_on ^. WorkingOnAchievement E.==. achievement ^. AchievementId
E.&&. E.just (submission ^. SubmissionId) E.==. working_on ^. WorkingOnFinalSubmission
E.&&. working_on ^. WorkingOnUser E.==. E.val userId)
E.orderBy [E.asc (submission ^. SubmissionStamp)]
return (achievement, submission)
entries' <- mapM (processEntry (Entity userId user)) entries
defaultLayout $ do
setTitle "Score"
$(widgetFile "score")
2017-05-15 14:25:54 +02:00
processEntry :: Entity User -> (Entity Achievement, Entity Submission) -> Handler (AchievementInfo, (Entity Submission, Bool))
2017-05-15 13:55:56 +02:00
processEntry entUser (entAchievement, entSubmission) = do
aInfo <- runDB $ getAchievementInfo (Just entUser) entAchievement
2017-05-15 14:25:54 +02:00
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