achievement can be edited now

This commit is contained in:
Filip Gralinski 2017-10-20 09:24:36 +02:00
parent 39a4fd19f9
commit c1f8e2d83e
6 changed files with 89 additions and 19 deletions

View File

@ -120,6 +120,7 @@ instance Yesod App where
isAuthorized TagsR _ = return Authorized isAuthorized TagsR _ = return Authorized
isAuthorized AchievementsR _ = return Authorized isAuthorized AchievementsR _ = return Authorized
isAuthorized (EditAchievementR _) _ = isAdmin
isAuthorized (ShowChallengeR _) _ = return Authorized isAuthorized (ShowChallengeR _) _ = return Authorized
isAuthorized (ChallengeReadmeR _) _ = return Authorized isAuthorized (ChallengeReadmeR _) _ = return Authorized

View File

@ -20,13 +20,13 @@ import qualified Yesod.Table as Table
getAchievementsR :: Handler Html getAchievementsR :: Handler Html
getAchievementsR = do getAchievementsR = do
(formWidget, formEnctype) <- generateFormPost achievementForm (formWidget, formEnctype) <- generateFormPost (achievementForm Nothing Nothing)
mUser <- maybeAuth mUser <- maybeAuth
doAchievements mUser formWidget formEnctype doAchievements mUser formWidget formEnctype
postAchievementsR :: Handler Html postAchievementsR :: Handler Html
postAchievementsR = do postAchievementsR = do
((result, formWidget), formEnctype) <- runFormPost achievementForm ((result, formWidget), formEnctype) <- runFormPost (achievementForm Nothing Nothing)
mUser <- maybeAuth mUser <- maybeAuth
when (checkIfAdmin mUser) $ do when (checkIfAdmin mUser) $ do
case result of case result of
@ -54,9 +54,9 @@ doAchievements mUser formWidget formEnctype = do
setTitle "Achievements" setTitle "Achievements"
$(widgetFile "achievements") $(widgetFile "achievements")
achievementsTable :: Table.Table App (AchievementInfo) achievementsTable :: Bool -> Table.Table App (AchievementInfo)
achievementsTable = mempty achievementsTable canEdit = mempty
++ Table.text "achievement" achievementInfoName ++ achievementNameEntry canEdit
++ Table.text "course" (courseName . entityVal . achievementInfoCourse) ++ Table.text "course" (courseName . entityVal . achievementInfoCourse)
++ Table.linked "challenge" (challengeTitle . entityVal . achievementInfoChallenge) (ShowChallengeR . challengeName . entityVal . achievementInfoChallenge) ++ Table.linked "challenge" (challengeTitle . entityVal . achievementInfoChallenge) (ShowChallengeR . challengeName . entityVal . achievementInfoChallenge)
++ achievementDescriptionCell id ++ achievementDescriptionCell id
@ -65,6 +65,9 @@ achievementsTable = mempty
++ Table.string "max submitters" (formatMaxSubmitters . achievementInfoMaxWinners) ++ Table.string "max submitters" (formatMaxSubmitters . achievementInfoMaxWinners)
++ workingOnCell ++ workingOnCell
achievementNameEntry True = Table.linked "achievement" (achievementInfoName) (EditAchievementR . achievementInfoId)
achievementNameEntry False = Table.text "achievement" achievementInfoName
workingOnCell = Table.widget "who's working on it?" workingOnWidget workingOnCell = Table.widget "who's working on it?" workingOnWidget
workingOnWidget ainfo = [whamlet| workingOnWidget ainfo = [whamlet|
@ -161,27 +164,76 @@ formatMaxSubmitters :: Maybe Int -> String
formatMaxSubmitters Nothing = "no limit" formatMaxSubmitters Nothing = "no limit"
formatMaxSubmitters (Just m) = show m formatMaxSubmitters (Just m) = show m
achievementForm :: Form (Text, Maybe Text, Int, Day, TimeOfDay, Maybe Int, Maybe Text, ChallengeId, CourseId) achievementForm :: Maybe Achievement -> Maybe [Entity Tag] -> Form (Text, Maybe Text, Int, Day, TimeOfDay, Maybe Int, Maybe Text, ChallengeId, CourseId)
achievementForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,,,,) achievementForm mAchievement mTags = renderBootstrap3 BootstrapBasicForm $ (,,,,,,,,)
<$> areq textField (bfs MsgAchievementName) Nothing <$> areq textField (bfs MsgAchievementName) (achievementName <$> mAchievement)
<*> aopt textField (bfs MsgAchievementDescription) Nothing <*> aopt textField (bfs MsgAchievementDescription) (achievementDescription <$> mAchievement)
<*> areq intField (bfs MsgAchievementPoints) Nothing <*> areq intField (bfs MsgAchievementPoints) (achievementPoints <$> mAchievement)
<*> areq dayField (bfs MsgAchievementDeadlineDay) Nothing <*> areq dayField (bfs MsgAchievementDeadlineDay) (utctDay <$> achievementDeadline <$> mAchievement)
<*> areq timeFieldTypeTime (bfs MsgAchievementDeadlineTime) Nothing <*> areq timeFieldTypeTime (bfs MsgAchievementDeadlineTime) (timeToTimeOfDay <$> utctDayTime <$> achievementDeadline <$> mAchievement)
<*> aopt intField (bfs MsgAchievementMaxWinners) Nothing <*> aopt intField (bfs MsgAchievementMaxWinners) (achievementMaxWinners <$> mAchievement)
<*> aopt textField (tagsfs MsgAchievementTags) Nothing <*> aopt textField (tagsfs MsgAchievementTags) (tagsToText <$> mTags)
<*> challengesSelectFieldList <*> challengesSelectFieldList (achievementChallenge <$> mAchievement)
<*> coursesSelectFieldList <*> coursesSelectFieldList (achievementCourse <$> mAchievement)
challengesSelectFieldList = areq (selectField challenges) (bfs MsgChallenge) Nothing tagsToText [] = Nothing
tagsToText tags = Just $ Data.Text.intercalate ", " $ Import.map (tagName . entityVal) tags
challengesSelectFieldList mChallengeId = areq (selectField challenges) (bfs MsgChallenge) mChallengeId
where where
challenges = do challenges = do
challengeEnts <- runDB $ selectList [] [Asc ChallengeTitle] challengeEnts <- runDB $ selectList [] [Asc ChallengeTitle]
optionsPairs $ Import.map (\ch -> (challengeTitle $ entityVal ch, entityKey ch)) challengeEnts optionsPairs $ Import.map (\ch -> (challengeTitle $ entityVal ch, entityKey ch)) challengeEnts
coursesSelectFieldList = areq (selectField courses) (bfs MsgCourse) Nothing coursesSelectFieldList mCourseId = areq (selectField courses) (bfs MsgCourse) mCourseId
where where
courses = do courses = do
courseEnts <- runDB $ selectList [] [Asc CourseName] courseEnts <- runDB $ selectList [] [Asc CourseName]
optionsPairs $ Import.map (\ch -> (courseName $ entityVal ch, entityKey ch)) courseEnts optionsPairs $ Import.map (\ch -> (courseName $ entityVal ch, entityKey ch)) courseEnts
getEditAchievementR :: AchievementId -> Handler Html
getEditAchievementR achievementId = do
tagsAvailableAsJSON <- runDB $ getAvailableTagsAsJSON
achievement <- runDB $ get404 achievementId
tags <- runDB $ getAchievementTags achievementId
(formWidget, formEnctype) <- generateFormPost (achievementForm (Just achievement) (Just tags))
mUser <- maybeAuth
defaultLayout $ do
setTitle "Edit achievements"
$(widgetFile "edit-achievement")
postEditAchievementR :: AchievementId -> Handler Html
postEditAchievementR achievementId = do
tagsAvailableAsJSON <- runDB $ getAvailableTagsAsJSON
achievement <- runDB $ get404 achievementId
((result, formWidget), formEnctype) <- runFormPost (achievementForm Nothing Nothing)
mUser <- maybeAuth
when (checkIfAdmin mUser) $ do
case result of
FormSuccess (name, description, points, deadlineDay, deadlineTime, maxSubmitters, mTags, challengeId, courseId) -> do
runDB $ do
update achievementId [AchievementName =. name,
AchievementDescription =. description,
AchievementPoints =. points,
AchievementDeadline =. UTCTime { utctDay = deadlineDay,
utctDayTime = timeOfDayToTime deadlineTime },
AchievementMaxWinners =. maxSubmitters,
AchievementChallenge =. challengeId,
AchievementCourse =. courseId]
deleteWhere [AchievementTagAchievement ==. achievementId]
tids <- tagsAsTextToTagIds mTags
mapM (\tid -> insert $ AchievementTag achievementId tid) tids
setMessage $ toHtml ("OK! Achievement modified" :: Text)
return ()
_ -> do
return ()
defaultLayout $ do
setTitle "Edit achievements"
$(widgetFile "edit-achievement")

View File

@ -35,6 +35,7 @@
/tags TagsR GET POST /tags TagsR GET POST
/achievements AchievementsR GET POST /achievements AchievementsR GET POST
/edit-achievement/#AchievementId EditAchievementR GET POST
/start-working-on/#AchievementId StartWorkingOnR GET /start-working-on/#AchievementId StartWorkingOnR GET
/give-up-working-on/#AchievementId GiveUpWorkingOnR GET /give-up-working-on/#AchievementId GiveUpWorkingOnR GET
/submission-for-achievement/#SubmissionId/#WorkingOnId SubmissionForAchievementR GET /submission-for-achievement/#SubmissionId/#WorkingOnId SubmissionForAchievementR GET

View File

@ -1,6 +1,6 @@
<h1>Achievements <h1>Achievements
^{Table.buildBootstrap achievementsTable achievementInfos} ^{Table.buildBootstrap (achievementsTable (checkIfAdmin mUser)) achievementInfos}
<hr> <hr>

View File

@ -0,0 +1,4 @@
<form method=post action=@{EditAchievementR achievementId}#form enctype=#{formEnctype}>
^{formWidget}
<button .btn .btn-primary type="submit">
_{MsgSubmit} <span class="glyphicon glyphicon-upload"></span>

View File

@ -0,0 +1,12 @@
var input = document.querySelector('input[data-role=tagsinput]'),
tagify = new Tagify( input, {
whitelist: #{tagsAvailableAsJSON},
autocomplete: true,
enforeWhitelist: true});
input.style.display = 'none';
$(document).ready(function() {
$("table").DataTable({
'pageLength': 50,
'order': [[1, 'desc']]});
} );