We are no longer offering accounts on this server. Consider https://gitlab.freedesktop.org/ as a place to host projects.

Commit c32f54de authored by David L. L. Thomas's avatar David L. L. Thomas

Bugfix - tag id parsed as value, not looked up

Fixed SD-302
parent a19c7e7f
......@@ -166,11 +166,11 @@ instance Yesod App where
-- The page to be redirected to when authentication is required.
authRoute _ = Just $ AuthR LoginR
errorHandler (PermissionDenied _) = do
errorHandler (PermissionDenied s) = do
maybe_user <- maybeAuth
selectRep $
provideRep $ defaultLayout $ do
setTitle "Permission Denied"
setTitle $ "Permission Denied: " <> toHtml s
toWidget [hamlet|$newline never
<h1>Permission Denied
<p>
......
......@@ -221,8 +221,10 @@ checkboxesField' ioptlist = (multiSelectField ioptlist)
{ fieldView =
\theId name attrs value _ -> do
opts <- fmap olOptions $ handlerToWidget ioptlist
let optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
[whamlet|
<span ##{theId}>
$forall opt <- opts
......@@ -232,6 +234,7 @@ checkboxesField' ioptlist = (multiSelectField ioptlist)
|]
}
redirectParams :: (MonadHandler (HandlerT site m), MonadBaseControl IO m) => Route site -> [(Text, Text)] -> HandlerT site m a
redirectParams route params = getUrlRenderParams >>= \ render -> redirect $ render route params
......
......@@ -157,11 +157,22 @@ createCommentTagForm = renderBootstrap3 $ areq' textField "" Nothing
newCommentTagForm :: [Entity Tag] -> [Entity Tag] -> Form (Maybe [TagId], Maybe [TagId])
newCommentTagForm project_tags other_tags = renderBootstrap3 $ (,)
-- <$> fmap (\(Entity tag_id tag) -> aopt checkBoxField (tag_id) (tagName tag)) (project_tags <> other_tags)
<$> aopt (tagCloudField $ tags project_tags) "Tags used elsewhere in this project:" Nothing
<*> aopt (tagCloudField $ tags other_tags) "Tags used in other projects:" Nothing
<$> aopt (tagCloudFieldList project_tags) "Tags used elsewhere in this project:" Nothing
<*> aopt (tagCloudFieldList other_tags) "Tags used in other projects:" Nothing
-- <*> areq hiddenField "" (Just "apply")
where tags = fmap (\(Entity tag_id tag) -> (tagName tag, tag_id))
tagCloudField = checkboxesFieldList' $ (\(PersistInt64 a) -> show a) . unKey
where
tagCloudFieldList tags =
let toOption (Entity tag_id tag) = Option
{ optionDisplay = tagName tag
, optionInternalValue = tag_id
, optionExternalValue = (\ (Key (PersistInt64 i)) -> T.pack $ show i) tag_id
}
optlist = OptionList
{ olOptions = map toOption tags
, olReadExternal = Just . Key . PersistInt64 . read . T.unpack
}
in checkboxesField' (return optlist)
flagCommentForm :: Maybe (Maybe [FlagReason]) -> Maybe (Maybe Markdown) -> Form (Maybe [FlagReason], Maybe Markdown)
flagCommentForm def_reasons def_message = renderBootstrap3 $ (,) <$> flagReasonsForm <*> additionalCommentsForm
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment