module Handler.Tags where import Import import Handler.Common (checkIfAdmin) import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs) import qualified Yesod.Table as Table import Handler.TagUtils getTagsR :: Handler Html getTagsR = do (formWidget, formEnctype) <- generateFormPost tagForm doTags formWidget formEnctype postTagsR :: Handler Html postTagsR = do ((result, formWidget), formEnctype) <- runFormPost tagForm canTagsBeAdded <- canAddTags when canTagsBeAdded $ do case result of FormSuccess (t, d) -> do _ <- runDB $ insert $ Tag t d return () _ -> do return () doTags formWidget formEnctype canAddTags :: Handler Bool canAddTags = do mUser <- maybeAuth app <- getYesod let tagPermissions = appTagPermissions $ appSettings app case tagPermissions of OnlyAdminCanAddNewTags -> return $ checkIfAdmin mUser EverybodyCanAddNewTags -> return $ isJust mUser doTags formWidget formEnctype = do tags <- runDB $ selectList [] [Asc TagName] canTagsBeAdded <- canAddTags defaultLayout $ do setTitle "Tags" $(widgetFile "tags") tagsTable :: Table.Table App (Entity Tag) tagsTable = mempty ++ Table.text "tag" (\(Entity _ tag) -> tagName tag) ++ Table.text "description" (\(Entity _ tag) -> (fromMaybe (""::Text) (tagDescription tag))) tagForm :: Form (Text, Maybe Text) tagForm = renderBootstrap3 BootstrapBasicForm $ (,) <$> areq textField (bfs MsgTagName) Nothing <*> aopt textField (bfs MsgTagDescription) Nothing getToggleSubmissionTagR :: SubmissionTagId -> Handler RepPlain getToggleSubmissionTagR submissionTagId = do mUser <- maybeAuth if (checkIfAdmin mUser) then do submissionTag <- runDB $ get404 submissionTagId let newState = toggleTag $ submissionTagAccepted submissionTag runDB $ update submissionTagId [SubmissionTagAccepted =. newState] return $ RepPlain $ toContent $ tagClass newState else do return $ RepPlain $ toContent ("BLOCKED" :: Text)