diff --git a/Handler/Achievements.hs b/Handler/Achievements.hs index 117c1b9..7655fae 100644 --- a/Handler/Achievements.hs +++ b/Handler/Achievements.hs @@ -7,12 +7,26 @@ import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs) import Handler.TagUtils import Handler.Tables +import Handler.Shared import Data.Time.Clock import Data.Time.LocalTime +import Data.Text + import qualified Yesod.Table as Table +data AchievementInfo = AchievementInfo { + achievementInfoName :: Text, + achievementInfoDescription :: Maybe Text, + achievementInfoPoints :: Int, + achievementInfoDeadline :: UTCTime, + achievementInfoMaxWinners :: Maybe Int, + achievementInfoWorkingOn :: [Entity User], + achievementInfoCurrentUser :: Maybe (Entity User) } + + + getAchievementsR :: Handler Html getAchievementsR = do (formWidget, formEnctype) <- generateFormPost achievementForm @@ -42,6 +56,8 @@ postAchievementsR = do doAchievements mUser formWidget formEnctype = do achievements <- runDB $ selectList [] [Asc AchievementName] + mUser <- maybeAuth + achievementInfos <- runDB $ mapM (getAchievementInfo mUser) achievements tagsAvailableAsJSON <- runDB $ getAvailableTagsAsJSON @@ -49,13 +65,30 @@ doAchievements mUser formWidget formEnctype = do setTitle "Achievements" $(widgetFile "achievements") -achievementsTable :: Table.Table App (Entity Achievement) +getAchievementInfo mUser (Entity achievementId achievement) = do + es <- selectList [WorkingOnAchievement ==. achievementId] [] + let userIds = Import.map (workingOnUser . entityVal) es + users <- mapM get404 userIds + + return $ AchievementInfo { + achievementInfoName = achievementName achievement, + achievementInfoDescription = achievementDescription achievement, + achievementInfoPoints = achievementPoints achievement, + achievementInfoDeadline = achievementDeadline achievement, + achievementInfoMaxWinners = achievementMaxWinners achievement, + achievementInfoWorkingOn = Import.map (\(i,v) -> Entity i v) $ Import.zip userIds users, + achievementInfoCurrentUser = mUser } + +achievementsTable :: Table.Table App (AchievementInfo) achievementsTable = mempty - ++ Table.text "achievement" (\(Entity _ achievement) -> achievementName achievement) - ++ Table.text "description" (\(Entity _ achievement) -> (fromMaybe (""::Text) (achievementDescription achievement))) - ++ Table.int "points" (\(Entity _ achievement) -> achievementPoints achievement) - ++ timestampCell "deadline" (\(Entity _ achievement) -> achievementDeadline achievement) - ++ Table.string "max submitters" (\(Entity _ achievement) -> formatMaxSubmitters $ achievementMaxWinners achievement) + ++ Table.text "achievement" achievementInfoName + ++ Table.text "description" (fromMaybe (""::Text) . achievementInfoDescription) + ++ Table.int "points" achievementInfoPoints + ++ timestampCell "deadline" achievementInfoDeadline + ++ Table.string "max submitters" (formatMaxSubmitters . achievementInfoMaxWinners) + ++ Table.text "who's working on it?" (formatSubmitters . achievementInfoWorkingOn) + +formatSubmitters userEnts = Data.Text.intercalate ", " $ Import.map (formatSubmitter . entityVal) userEnts formatMaxSubmitters :: Maybe Int -> String formatMaxSubmitters Nothing = "no limit" diff --git a/config/models b/config/models index 5225269..1ce270e 100644 --- a/config/models +++ b/config/models @@ -95,4 +95,8 @@ AchievementTag achievement AchievementId tag TagId UniqueAchievementTag achievement tag +WorkingOn + achievement AchievementId + user UserId + UniqueWorkingOnAchievementUser achievement user -- By default this file is used in Model.hs (which is imported by Foundation.hs) diff --git a/templates/achievements.hamlet b/templates/achievements.hamlet index 0b0e65b..0dadfa5 100644 --- a/templates/achievements.hamlet +++ b/templates/achievements.hamlet @@ -1,6 +1,6 @@

Achievements -^{Table.buildBootstrap achievementsTable achievements} +^{Table.buildBootstrap achievementsTable achievementInfos}