gonito/Handler/EditSubmission.hs

136 lines
5.3 KiB
Haskell
Raw Normal View History

2017-02-19 22:26:01 +01:00
{-# LANGUAGE TupleSections, OverloadedStrings, RankNTypes #-}
module Handler.EditSubmission where
import Import
2017-02-25 19:13:55 +01:00
import Handler.Common (checkIfCanEdit)
import Handler.SubmissionView
2017-02-19 22:26:01 +01:00
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs)
2017-02-26 21:40:38 +01:00
import Handler.TagUtils
import Handler.MakePublic
2017-02-26 21:40:38 +01:00
import Gonito.ExtractMetadata (parseTags)
2017-02-25 19:13:55 +01:00
import Data.Text as T
2018-07-30 07:59:38 +02:00
postAddVariantParamR :: SubmissionId -> VariantId -> Handler Html
postAddVariantParamR submissionId variantId = do
((result, _), _) <- runFormPost addVariantParamForm
let FormSuccess (pName, pValue) = result
_ <- runDB $ insert $ Parameter {
parameterVariant = variantId,
parameterName = pName,
parameterValue = pValue }
getEditSubmissionAndVariantR submissionId variantId
2017-02-19 22:26:01 +01:00
getEditSubmissionR :: SubmissionId -> Handler Html
2018-07-30 07:59:38 +02:00
getEditSubmissionR submissionId = getEditSubmissionG submissionId Nothing
getEditSubmissionAndVariantR :: SubmissionId -> VariantId -> Handler Html
getEditSubmissionAndVariantR submissionId variantId = getEditSubmissionG submissionId (Just variantId)
getEditSubmissionG :: SubmissionId -> (Maybe VariantId) -> Handler Html
getEditSubmissionG submissionId mVariantId = do
2017-02-25 19:13:55 +01:00
submission <- runDB $ get404 submissionId
tags <- runDB $ getTags submissionId
let mTagsAsText = case tags of
[] -> Nothing
2017-05-27 22:31:53 +02:00
_ -> Just $ T.intercalate ", " $ Import.map (tagName . entityVal . fst) tags
2017-02-25 19:13:55 +01:00
(formWidget, formEnctype) <- generateFormPost $ editSubmissionForm (submissionDescription submission) mTagsAsText
2018-07-30 07:59:38 +02:00
doEditSubmission formWidget formEnctype submissionId mVariantId
2017-02-19 22:26:01 +01:00
postEditSubmissionR :: SubmissionId -> Handler Html
2018-07-30 07:59:38 +02:00
postEditSubmissionR submissionId = postEditSubmissionG submissionId Nothing
postEditSubmissionAndVariantR :: SubmissionId -> VariantId -> Handler Html
postEditSubmissionAndVariantR submissionId variantId = postEditSubmissionG submissionId (Just variantId)
postEditSubmissionG :: SubmissionId -> (Maybe VariantId) -> Handler Html
postEditSubmissionG submissionId mVariantId = do
2017-02-25 19:13:55 +01:00
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 (parseTags tags) currentTagIds
2017-02-25 19:13:55 +01:00
return ()
else
do
setMessage $ toHtml ("Only owner can edit a submission!!!" :: Text)
return ()
2018-07-30 07:59:38 +02:00
getEditSubmissionG submissionId mVariantId
2017-02-25 19:13:55 +01:00
getPossibleAchievements :: (BaseBackend backend ~ SqlBackend, PersistUniqueRead backend, PersistQueryRead backend, MonadIO m) => Key User -> Key Submission -> ReaderT backend m [(Entity Achievement, Key WorkingOn)]
2017-04-03 12:22:52 +02:00
getPossibleAchievements userId submissionId = do
(Just submission) <- get submissionId
let challengeId = submissionChallenge submission
achievements <- selectList [AchievementChallenge ==. challengeId] []
workingOns <- mapM (\a -> getBy $ UniqueWorkingOnAchievementUser (entityKey a) userId) achievements
let rets = Import.zip achievements workingOns
return $ Import.map (\(a, (Just w)) -> (a, entityKey w)) $ Import.filter (\(_, mw) -> isJust mw) $ rets
2018-07-30 07:59:38 +02:00
doEditSubmission formWidget formEnctype submissionId mVariantId = do
2017-02-19 22:26:01 +01:00
submission <- runDB $ get404 submissionId
2017-02-25 19:13:55 +01:00
submissionFull <- getFullInfo (Entity submissionId submission)
let view = queryResult submissionFull
2017-02-26 21:40:38 +01:00
tagsAvailableAsJSON <- runDB $ getAvailableTagsAsJSON
2017-02-25 19:13:55 +01:00
(Entity userId _) <- requireAuth
2017-04-03 12:22:52 +02:00
achievements <- runDB $ getPossibleAchievements userId submissionId
2018-07-30 07:59:38 +02:00
variantParams <- case mVariantId of
Just variantId -> runDB $ selectList [ParameterVariant ==. variantId] [Asc ParameterName]
Nothing -> return []
(addVariantParamWidget, formEnctype2) <- generateFormPost $ addVariantParamForm
2017-02-19 22:26:01 +01:00
defaultLayout $ do
setTitle "Edit a submission"
$(widgetFile "edit-submission")
2017-02-25 19:13:55 +01:00
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)
2018-07-30 07:59:38 +02:00
addVariantParamForm :: Form (Text, Text)
addVariantParamForm = renderBootstrap3 BootstrapBasicForm $ (,)
<$> areq textField (bfs MsgParameterName) Nothing
<*> areq textField (bfs MsgParameterValue) Nothing
getHideSubmissionR :: SubmissionId -> Handler Html
getHideSubmissionR submissionId = changeSubmissionVisibility False submissionId
getRestoreSubmissionR :: SubmissionId -> Handler Html
getRestoreSubmissionR submissionId = changeSubmissionVisibility True submissionId
changeSubmissionVisibility :: Bool -> SubmissionId -> Handler Html
changeSubmissionVisibility status submissionId =
do
isOwner <- checkWhetherUserRepo submissionId
if isOwner
then
do
runDB $ update submissionId [SubmissionIsHidden =. Just (not status)]
setMessage $ toHtml (("Submission " :: Text) ++ (verb status))
else
setMessage $ toHtml ("Only owner can edit a submission!!!" :: Text)
getEditSubmissionR submissionId
where verb True = "restored"
verb False = "removed"