From f3b6f4b050c682e064fa3ed4fd315ffe91df9597 Mon Sep 17 00:00:00 2001 From: Filip Gralinski Date: Tue, 2 Jan 2018 18:55:35 +0100 Subject: [PATCH] add extra points --- Application.hs | 1 + Foundation.hs | 1 + Handler/ExtraPoints.hs | 49 +++++++++++++++++++++++++++++++++ config/models | 7 +++++ config/routes | 2 ++ gonito.cabal | 1 + messages/en.msg | 4 +++ templates/default-layout.hamlet | 1 + templates/extra-points.hamlet | 7 +++++ 9 files changed, 73 insertions(+) create mode 100644 Handler/ExtraPoints.hs create mode 100644 templates/extra-points.hamlet diff --git a/Application.hs b/Application.hs index ab57aa4..cdf1f20 100644 --- a/Application.hs +++ b/Application.hs @@ -51,6 +51,7 @@ import Handler.Tags import Handler.EditSubmission import Handler.Achievements import Handler.Score +import Handler.ExtraPoints -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the diff --git a/Foundation.hs b/Foundation.hs index f44c2eb..576ec58 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -121,6 +121,7 @@ instance Yesod App where isAuthorized TagsR _ = return Authorized isAuthorized AchievementsR _ = return Authorized isAuthorized (EditAchievementR _) _ = isAdmin + isAuthorized ExtraPointsR _ = isAdmin isAuthorized (ShowChallengeR _) _ = return Authorized isAuthorized (ChallengeReadmeR _) _ = return Authorized diff --git a/Handler/ExtraPoints.hs b/Handler/ExtraPoints.hs new file mode 100644 index 0000000..081e396 --- /dev/null +++ b/Handler/ExtraPoints.hs @@ -0,0 +1,49 @@ +module Handler.ExtraPoints where + +import Import +import Handler.Common (checkIfAdmin) +import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs) + +getExtraPointsR :: Handler Html +getExtraPointsR = do + (formWidget, formEnctype) <- generateFormPost extraPointsForm + defaultLayout $ do + $(widgetFile "extra-points") + +postExtraPointsR :: Handler Html +postExtraPointsR = do + ((result, formWidget), formEnctype) <- runFormPost extraPointsForm + mUser <- maybeAuth + when (checkIfAdmin mUser) $ do + case result of + FormSuccess (points, description, userId, courseId) -> do + now <- liftIO getCurrentTime + let (Just (Entity adderId _)) = mUser + _ <- runDB $ insert $ ExtraPoints points description userId courseId now adderId + return () + _ -> do + return () + defaultLayout $ do + $(widgetFile "extra-points") + +extraPointsForm :: Form (Int, Text, UserId, CourseId) +extraPointsForm = renderBootstrap3 BootstrapBasicForm $ (,,,) + <$> areq intField (bfs MsgExtraPointsPoints) Nothing + <*> areq textField (bfs MsgExtraPointsDescription) Nothing + <*> usersSelectFieldList + <*> coursesSelectFieldList + +usersSelectFieldList = areq (selectField users) (bfs MsgUser) Nothing + where + users = do + userEnts <- runDB $ selectList [] [Asc UserName] + optionsPairs $ Import.map (\ch -> (userInSelection $ entityVal ch, entityKey ch)) userEnts + +userInSelection :: User -> Text +userInSelection user = (fromMaybe "" $ userLocalId user) ++ " / " ++ (fromMaybe "" $ userName user) + +coursesSelectFieldList = areq (selectField courses) (bfs MsgCourse) Nothing + where + courses = do + courseEnts <- runDB $ selectList [] [Asc CourseName] + optionsPairs $ Import.map (\ch -> (courseName $ entityVal ch, entityKey ch)) courseEnts diff --git a/config/models b/config/models index 6992185..bb6190b 100644 --- a/config/models +++ b/config/models @@ -108,6 +108,13 @@ Course closed Bool UniqueCourseName name UniqueCourseCode code +ExtraPoints + points Int + description Text + user UserId + course CourseId + posted UTCTime default=now() + addedBy UserId Participant user UserId course CourseId diff --git a/config/routes b/config/routes index 7f62cd3..b640408 100644 --- a/config/routes +++ b/config/routes @@ -41,6 +41,8 @@ /submission-for-achievement/#SubmissionId/#WorkingOnId SubmissionForAchievementR GET /toggle-submission-tag/#SubmissionTagId ToggleSubmissionTagR GET +/extra-points ExtraPointsR GET POST + /score/#UserId ScoreR GET /my-score MyScoreR GET diff --git a/gonito.cabal b/gonito.cabal index d575e5a..44edd5d 100644 --- a/gonito.cabal +++ b/gonito.cabal @@ -50,6 +50,7 @@ library Handler.TagUtils Handler.Score Handler.AchievementUtils + Handler.ExtraPoints if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT diff --git a/messages/en.msg b/messages/en.msg index e200433..744fd84 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -51,3 +51,7 @@ SubmissionDescriptionTooltip: the first non-empty line of the commit message wil Challenge: challenge Course: course CourseOptional: course (optional) +AddExtraPoints: add points freely +ExtraPointsPoints: Points to be added +ExtraPointsDescription: Describe why they are added +User: User diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index fb7d56d..780c140 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -13,6 +13,7 @@ $if userIsAdmin $ entityVal user
  • _{MsgCreateChallenge}
  • _{MsgCreateResetLink} +
  • _{MsgAddExtraPoints}