{-# 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)