73 lines
2.5 KiB
Haskell
73 lines
2.5 KiB
Haskell
{-# LANGUAGE TupleSections, OverloadedStrings, RankNTypes #-}
|
|
|
|
module Handler.EditSubmission where
|
|
|
|
import Import
|
|
import Handler.Common (checkIfCanEdit)
|
|
import Handler.SubmissionView
|
|
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs)
|
|
|
|
import Handler.TagUtils
|
|
|
|
import Data.Text as T
|
|
|
|
getEditSubmissionR :: SubmissionId -> Handler Html
|
|
getEditSubmissionR submissionId = do
|
|
submission <- runDB $ get404 submissionId
|
|
tags <- runDB $ getTags submissionId
|
|
let mTagsAsText = case tags of
|
|
[] -> Nothing
|
|
_ -> Just $ T.intercalate ", " $ Import.map (tagName . entityVal) tags
|
|
(formWidget, formEnctype) <- generateFormPost $ editSubmissionForm (submissionDescription submission) mTagsAsText
|
|
doEditSubmission formWidget formEnctype submissionId
|
|
|
|
postEditSubmissionR :: SubmissionId -> Handler Html
|
|
postEditSubmissionR submissionId = do
|
|
submission <- runDB $ get404 submissionId
|
|
((result, _), _) <- runFormPost $ editSubmissionForm (submissionDescription submission) Nothing
|
|
let FormSuccess (description, tags) = result
|
|
isEditable <- checkIfCanEdit submissionId
|
|
if isEditable
|
|
then
|
|
runDB $ do
|
|
update submissionId [SubmissionDescription =. description]
|
|
|
|
sts <- selectList [SubmissionTagSubmission ==. submissionId] []
|
|
let currentTagIds = Import.map (submissionTagTag . entityVal) sts
|
|
|
|
addTags submissionId tags currentTagIds
|
|
|
|
return ()
|
|
else
|
|
do
|
|
setMessage $ toHtml ("Only owner can edit a submission!!!" :: Text)
|
|
return ()
|
|
getEditSubmissionR submissionId
|
|
|
|
|
|
addTags submissionId tagsAsText existingOnes = do
|
|
tids <- tagsAsTextToTagIds tagsAsText
|
|
|
|
deleteWhere [SubmissionTagSubmission ==. submissionId, SubmissionTagTag /<-. tids]
|
|
|
|
_ <- mapM (\tid -> insert $ SubmissionTag submissionId tid Nothing) (Import.filter (not . (`elem` existingOnes)) tids)
|
|
return ()
|
|
|
|
|
|
|
|
doEditSubmission formWidget formEnctype submissionId = do
|
|
submission <- runDB $ get404 submissionId
|
|
submissionFull <- getFullInfo (Entity submissionId submission)
|
|
let view = queryResult submissionFull
|
|
|
|
tagsAvailableAsJSON <- runDB $ getAvailableTagsAsJSON
|
|
|
|
defaultLayout $ do
|
|
setTitle "Edit a submission"
|
|
$(widgetFile "edit-submission")
|
|
|
|
editSubmissionForm :: Text -> Maybe Text -> Form (Text, Maybe Text)
|
|
editSubmissionForm description mTags = renderBootstrap3 BootstrapBasicForm $ (,)
|
|
<$> areq textField (bfs MsgSubmissionDescription) (Just description)
|
|
<*> aopt textField (tagsfs MsgSubmissionTags) (Just mTags)
|