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

Commit 89888009 authored by Mitchell Rosen's avatar Mitchell Rosen

added wiki page creation event

parent dd60738d
......@@ -383,6 +383,7 @@ messageEventHandler (ECommentPosted comment_id comment) = case commentParent com
, "*You can filter these messages by adjusting the settings in your profile.*"
]
runSDB $ insertMessage_ MessageReply Nothing Nothing (Just parent_user_id) content True
-- TODO(mitchell): send messages on other events, per preferences
messageEventHandler _ = return ()
-- | Handler in charge of inserting events (stripped down) into a separate table for each type.
......@@ -391,6 +392,7 @@ eventInserterHandler :: SnowdriftEvent -> Daemon ()
eventInserterHandler (ECommentPosted comment_id Comment{..}) = runDB (insert_ (EventCommentPosted comment_id (fromJust commentModeratedTs)))
eventInserterHandler (ECommentPending comment_id Comment{..}) = runDB (insert_ (EventCommentPending comment_id commentCreatedTs))
eventInserterHandler (EMessageSent message_id Message{..}) = runDB (insert_ (EventMessageSent message_id messageCreatedTs))
eventInserterHandler (EWikiPage wiki_page_id WikiPage{..}) = runDB (insert_ (EventWikiPage wiki_page_id wikiPageCreatedTs))
eventInserterHandler (EWikiEdit wiki_edit_id WikiEdit{..}) = runDB (insert_ (EventWikiEdit wiki_edit_id wikiEditTs))
renderRoute' :: Route App -> App -> Text
......
......@@ -438,6 +438,7 @@ getProjectFeedR project_handle = do
Entity project_id _ <- getBy404 (UniqueProjectHandle project_handle)
comment_posted_entities <- fetchProjectCommentsPostedOnWikiPagesBeforeDB project_id muser_id before
comment_pending_entities <- fetchProjectCommentsPendingBeforeDB project_id muser_id before
wiki_page_entities <- fetchProjectWikiPagesBeforeDB project_id before
wiki_edit_entities <- fetchProjectWikiEditsBeforeDB project_id before
-- Suplementary maps for displaying the data.
......@@ -457,6 +458,7 @@ getProjectFeedR project_handle = do
let events = sortBy snowdriftEventNewestToOldest . mconcat $
[ map (onEntity ECommentPosted) comment_posted_entities
, map (onEntity ECommentPending) comment_pending_entities
, map (onEntity EWikiPage) wiki_page_entities
, map (onEntity EWikiEdit) wiki_edit_entities
]
return (events, discussion_wiki_pages_map, wiki_pages_map, users_map)
......
......@@ -13,6 +13,7 @@ import Model.Permission
import Model.Project
import Model.Tag (getAllTagsMap)
import Model.User
import Model.WikiPage
import Widgets.Preview
import Widgets.Time
import View.Comment
......@@ -105,7 +106,7 @@ postWikiR project_handle target = do
defaultLayout $ previewWidget form action $
renderWiki 0 project_handle target False False $
WikiPage target project_id content (Key $ PersistInt64 (-1)) Normal
WikiPage now target project_id content (Key $ PersistInt64 (-1)) Normal
Just x | x == action -> do
runSYDB $ do
......@@ -406,15 +407,11 @@ postNewWikiR project_handle target = do
Just "preview" -> do
(form, _) <- generateFormPost $ newWikiForm (Just content)
defaultLayout $ do
let page = WikiPage target project_id content (Key $ PersistInt64 0) Normal
let page = WikiPage now target project_id content (Key $ PersistInt64 0) Normal
previewWidget form action $ renderWiki 0 project_handle target False False page
Just x | x == action -> do
_ <- runDB $ do
discussion <- insert (Discussion 0)
page_id <- insert $ WikiPage target project_id content discussion Normal
edit_id <- insert $ WikiEdit now user_id page_id content $ Just "Page created."
insert $ WikiLastEdit page_id edit_id
runSDB (createWikiPageDB target project_id content Normal user_id)
addAlert "success" "Created."
redirect $ WikiR project_handle target
......@@ -424,8 +421,6 @@ postNewWikiR project_handle target = do
FormMissing -> error "Form missing."
FormFailure msgs -> error $ "Error submitting form: " ++ T.unpack (T.concat msgs)
--------------------------------------------------------------------------------
-- /#target/perm
......@@ -483,5 +478,3 @@ postEditWikiPermissionsR project_handle target = do
-- almost certainly internal anyway)
getOldWikiEditR :: Text -> Text -> WikiEditId -> Handler Html
getOldWikiEditR project_handle target edit_id = redirect $ WikiEditR project_handle target edit_id
module Model.Discussion
( fetchDiscussionWikiPagesInDB
( createDiscussionDB
, fetchDiscussionWikiPagesInDB
) where
import Import
......@@ -12,3 +13,5 @@ fetchDiscussionWikiPagesInDB discussion_ids =
where_ (wp ^. WikiPageDiscussion `in_` valList discussion_ids)
return wp
createDiscussionDB :: DB DiscussionId
createDiscussionDB = insert (Discussion 0)
......@@ -5,6 +5,7 @@ module Model.Project
, fetchProjectCommentsPendingBeforeDB
, fetchProjectCommentsPostedOnWikiPagesBeforeDB
, fetchProjectWikiEditsBeforeDB
, fetchProjectWikiPagesBeforeDB
-- TODO(mitchell): rename all these... prefix fetch, suffix DB
, getGithubIssues
, getProjectPages
......@@ -171,6 +172,7 @@ fetchProjectCommentsPostedOnWikiPagesBeforeDB project_id muser_id before =
fetchProjectCommentIdsPostedOnWikiPagesDB :: ProjectId -> DB [CommentId]
fetchProjectCommentIdsPostedOnWikiPagesDB = fmap (map unValue) . select . querProjectCommentIdsPostedOnWikiPagesDB
-- | Fetch all pending Comments made on a Project before some time.
fetchProjectCommentsPendingBeforeDB :: ProjectId -> Maybe UserId -> UTCTime -> DB [Entity Comment]
fetchProjectCommentsPendingBeforeDB project_id muser_id before =
select $
......@@ -181,7 +183,18 @@ fetchProjectCommentsPendingBeforeDB project_id muser_id before =
exprPermissionFilter muser_id (val project_id) c
return c
-- | Fetch all WikiEdits made on some Project.
-- | Fetch all WikiPages made on some Project before some time.
fetchProjectWikiPagesBeforeDB :: ProjectId -> UTCTime -> DB [Entity WikiPage]
fetchProjectWikiPagesBeforeDB project_id before =
select $
from $ \(ewp `InnerJoin` wp) -> do
on_ (ewp ^. EventWikiPageWikiPage ==. wp ^. WikiPageId)
where_ $
ewp ^. EventWikiPageTs <=. val before &&.
exprWikiPageOnProject wp project_id
return wp
-- | Fetch all WikiEdits made on some Project before some time.
fetchProjectWikiEditsBeforeDB :: ProjectId -> UTCTime -> DB [Entity WikiEdit]
fetchProjectWikiEditsBeforeDB project_id before =
select $
......
......@@ -12,3 +12,4 @@ snowdriftEventTime (ECommentPosted _ Comment{..}) = fromMaybe commentCreatedTs
snowdriftEventTime (ECommentPending _ Comment{..}) = commentCreatedTs
snowdriftEventTime (EMessageSent _ Message{..}) = messageCreatedTs
snowdriftEventTime (EWikiEdit _ WikiEdit{..}) = wikiEditTs
snowdriftEventTime (EWikiPage _ WikiPage{..}) = wikiPageCreatedTs
......@@ -9,4 +9,5 @@ data SnowdriftEvent
= ECommentPosted CommentId Comment -- Comment approved.
| ECommentPending CommentId Comment -- Comment unapproved (pending approval).
| EMessageSent MessageId Message
| EWikiEdit WikiEditId WikiEdit
| EWikiEdit WikiEditId WikiEdit -- New WikiEdit made.
| EWikiPage WikiPageId WikiPage -- New WikiPage posted.
module Model.WikiPage
( getAllWikiComments
( createWikiPageDB
, getAllWikiComments
, fetchWikiPagesInDB
) where
import Import
import Model.Comment.Sql
import Model.Discussion
import Model.Permission
import Model.Project (getProjectPages)
import Control.Monad.Writer.Strict (tell)
createWikiPageDB :: Text -> ProjectId -> Markdown -> PermissionLevel -> UserId -> SDB ()
createWikiPageDB target project_id content permission_level user_id = do
now <- liftIO getCurrentTime
discussion_id <- lift createDiscussionDB
let wiki_page = WikiPage now target project_id content discussion_id Normal
wiki_page_id <- lift (insert wiki_page)
wiki_edit_id <- lift (insert (WikiEdit now user_id wiki_page_id content (Just "Page created.")))
lift $ insert_ (WikiLastEdit wiki_page_id wiki_edit_id)
tell [EWikiPage wiki_page_id wiki_page]
fetchWikiPagesInDB :: [WikiPageId] -> DB [Entity WikiPage]
fetchWikiPagesInDB wiki_page_ids =
select $
......
......@@ -26,6 +26,12 @@ renderCommentPendingEvent comment_id comment =
\ <a href=@{CommentDirectLinkR comment_id}>(permalink)
|]
renderWikiPageEvent :: WikiPageId -> WikiPage -> Widget
renderWikiPageEvent wiki_page_id wiki_page =
[whamlet|
<div>Wiki page: #{wikiPageTarget wiki_page}
|]
renderWikiEditEvent :: WikiEditId -> WikiEdit -> Entity WikiPage -> Widget
renderWikiEditEvent _ _ (Entity _ wiki_page) =
[whamlet|
......
......@@ -173,6 +173,7 @@ Message
deriving Eq
WikiPage
createdTs UTCTime default=now()
target Text
project ProjectId
content Markdown
......@@ -357,10 +358,17 @@ EventCommentPending
comment CommentId
ts UTCTime
-- Message sent event.
EventMessageSent
message MessageId
ts UTCTime
-- Wiki page created event.
EventWikiPage
wikiPage WikiPageId
ts UTCTime
-- Wiki edit made event.
EventWikiEdit
wikiEdit WikiEditId
ts UTCTime
ALTER TABLE "wiki_page" ADD COLUMN "created_ts" TIMESTAMP NOT NULL DEFAULT now();
CREATe TABLE "event_wiki_page"("id" SERIAL PRIMARY KEY UNIQUE,"wiki_page" INT8 NOT NULL,"ts" TIMESTAMP NOT NULL);
ALTER TABLE "event_wiki_page" ADD CONSTRAINT "event_wiki_page_wiki_page_fkey" FOREIGN KEY("wiki_page") REFERENCES "wiki_page"("id");
......@@ -24,6 +24,9 @@ $forall event <- events
$of ECommentPending comment_id comment
^{renderCommentPendingEvent comment_id comment}
$of EWikiPage wiki_page_id wiki_page
^{renderWikiPageEvent wiki_page_id wiki_page}
$of EWikiEdit wiki_edit_id wiki_edit
^{renderWikiEditEvent wiki_edit_id wiki_edit (Entity (wikiEditPage wiki_edit) (fromJust $ M.lookup (wikiEditPage wiki_edit) wiki_pages_map))}
......
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