From cdfaec81f202e2feae2189012589f3ceca16f013 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Thu, 19 May 2016 15:49:39 +0000 Subject: [PATCH] Replace dummy discussion widget with a real one --- src/Vervis/Discussion.hs | 37 +++++++++++------- src/Vervis/Widget/Discussion.hs | 38 ++++++++++++++++++- .../widget/{tree.hamlet => message.hamlet} | 8 +++- templates/discussion/widget/tree.cassius | 17 +++++++++ 4 files changed, 83 insertions(+), 17 deletions(-) rename templates/discussion/widget/{tree.hamlet => message.hamlet} (70%) create mode 100644 templates/discussion/widget/tree.cassius diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs index e853b4b..6e7c522 100644 --- a/src/Vervis/Discussion.hs +++ b/src/Vervis/Discussion.hs @@ -20,12 +20,13 @@ where import Prelude +import Control.Arrow (second) import Data.Graph.Inductive.Graph (mkGraph, lab') import Data.Graph.Inductive.PatriciaTree (Gr) import Data.Graph.Inductive.Query.DFS (dffWith) import Data.Maybe (isNothing, mapMaybe) -import Data.Tree (Tree (..), Forest) -import Database.Persist (Entity (..), selectList, (==.)) +import Data.Tree (Forest) +import Database.Esqueleto hiding (isNothing) import Yesod.Persist.Core (runDB) import qualified Data.HashMap.Lazy as M (fromList, lookup) @@ -34,29 +35,37 @@ import Data.Tree.Local (sortForestOn) import Vervis.Foundation import Vervis.Model -getMessages :: DiscussionId -> Handler [Entity Message] -getMessages did = runDB $ selectList [MessageRoot ==. did] [] +getMessages :: DiscussionId -> Handler [(Entity Message, Sharer)] +getMessages did = fmap (map $ second entityVal) $ runDB $ + select $ from $ \ (message, person, sharer) -> do + where_ $ + message ^. MessageRoot ==. val did &&. + message ^. MessageAuthor ==. person ^. PersonId &&. + person ^. PersonIdent ==. sharer ^. SharerId + return (message, sharer) -discussionTree :: [Entity Message] -> Forest (Entity Message) -discussionTree messages = - let nodes = zip [1..] messages - nodeMap = M.fromList $ map (\ (n, Entity mid _m) -> (mid, n)) nodes - mkEdge n (Entity _ m) = +discussionTree :: [(Entity Message, Sharer)] -> Forest (Message, Sharer) +discussionTree mss = + let numbered = zip [1..] mss + mkEntry n ((Entity mid _m), _s) = (mid, n) + nodeMap = M.fromList $ map (uncurry mkEntry) numbered + mkEdge n (m, _s) = case messageParent m of Nothing -> Nothing Just mid -> case M.lookup mid nodeMap of Nothing -> error "message parent not in discussion" Just p -> Just (p, n, ()) + nodes = map (\ (n, (Entity _ m, s)) -> (n, (m, s))) numbered edges = mapMaybe (uncurry mkEdge) nodes - graph = mkGraph nodes edges :: Gr (Entity Message) () - roots = [n | (n, Entity _ m) <- nodes, isNothing $ messageParent m] + graph = mkGraph nodes edges :: Gr (Message, Sharer) () + roots = [n | (n, (m, _s)) <- nodes, isNothing $ messageParent m] in dffWith lab' roots graph -sortByTime :: Forest (Entity Message) -> Forest (Entity Message) -sortByTime = sortForestOn $ messageCreated . entityVal +sortByTime :: Forest (Message, Sharer) -> Forest (Message, Sharer) +sortByTime = sortForestOn $ messageCreated . fst -- | Get the tree of messages in a given discussion, with siblings sorted from -- old to new. -getDiscussion :: DiscussionId -> Handler (Forest (Entity Message)) +getDiscussion :: DiscussionId -> Handler (Forest (Message, Sharer)) getDiscussion did = sortByTime . discussionTree <$> getMessages did diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs index 8267699..50331ba 100644 --- a/src/Vervis/Widget/Discussion.hs +++ b/src/Vervis/Widget/Discussion.hs @@ -20,10 +20,44 @@ where import Prelude +import Control.Monad.IO.Class (liftIO) +import Data.Foldable (traverse_) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) +import Data.Tree (Tree (..)) +import Text.Cassius (cassiusFile) +import Yesod.Core.Handler (newIdent) +import Yesod.Core.Widget (whamlet, toWidget, handlerToWidget) + +import Data.EventTime.Local (intervalToEventTime, showEventTime) +import Data.Time.Clock.Local () +import Vervis.Discussion (getDiscussion) import Vervis.Foundation -import Vervis.Model (DiscussionId) +import Vervis.MediaType (MediaType (Markdown)) +import Vervis.Model +import Vervis.Render (renderSourceT) import Vervis.Settings (widgetFile) +messageW :: Sharer -> UTCTime -> UTCTime -> Text -> Widget +messageW sharer created now content = + $(widgetFile "discussion/widget/message") + +messageTreeW :: Text -> UTCTime -> Tree (Message, Sharer) -> Widget +messageTreeW cReplies now t = go t + where + go (Node (message, sharer) trees) = do + messageW sharer (messageCreated message) now (messageContent message) + [whamlet| +
+ $forall tree <- trees + ^{go tree} + |] + discussionW :: DiscussionId -> Widget discussionW did = do - $(widgetFile "discussion/widget/tree") + forest <- handlerToWidget $ getDiscussion did + cReplies <- newIdent + now <- liftIO getCurrentTime + toWidget $(cassiusFile "templates/discussion/widget/tree.cassius") + traverse_ (messageTreeW cReplies now) forest diff --git a/templates/discussion/widget/tree.hamlet b/templates/discussion/widget/message.hamlet similarity index 70% rename from templates/discussion/widget/tree.hamlet rename to templates/discussion/widget/message.hamlet index 6285537..9075e82 100644 --- a/templates/discussion/widget/tree.hamlet +++ b/templates/discussion/widget/message.hamlet @@ -12,4 +12,10 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -[[[ [TODO] the discussion system is still being developed ]]] +
+ + #{fromMaybe (sharerIdent sharer) $ sharerName sharer} +
+ #{showEventTime $ intervalToEventTime $ diffUTCTime now created} +
+ ^{renderSourceT Markdown content} diff --git a/templates/discussion/widget/tree.cassius b/templates/discussion/widget/tree.cassius new file mode 100644 index 0000000..6b4f392 --- /dev/null +++ b/templates/discussion/widget/tree.cassius @@ -0,0 +1,17 @@ +/* This file is part of Vervis. + * + * Written in 2016 by fr33domlover . + * + * ♡ Copying is an act of love. Please copy, reuse and share. + * + * The author(s) have dedicated all copyright and related and neighboring + * rights to this software to the public domain worldwide. This software is + * distributed without any warranty. + * + * You should have received a copy of the CC0 Public Domain Dedication along + * with this software. If not, see + * . + */ + +.#{cReplies} + margin-left: 2em