diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs index f3761e5..2e0cb35 100644 --- a/src/Vervis/Discussion.hs +++ b/src/Vervis/Discussion.hs @@ -27,6 +27,7 @@ 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.Text (Text) import Data.Tree (Forest) import Database.Esqueleto hiding (isNothing) import Yesod.Persist.Core (runDB) @@ -41,7 +42,7 @@ import Vervis.Model data MessageTreeNodeAuthor = MessageTreeNodeLocal LocalMessageId Sharer - | MessageTreeNodeRemote FedURI + | MessageTreeNodeRemote Text LocalURI LocalURI data MessageTreeNode = MessageTreeNode { mtnMessageId :: MessageId @@ -63,13 +64,18 @@ getMessages getdid = runDB $ do on $ rm ^. RemoteMessageAuthor ==. rs ^. RemoteActorId on $ rm ^. RemoteMessageRest ==. m ^. MessageId where_ $ m ^. MessageRoot ==. val did - return (m, i ^. InstanceHost, rs ^. RemoteActorIdent) + return + ( m + , i ^. InstanceHost + , rm ^. RemoteMessageIdent + , rs ^. RemoteActorIdent + ) return $ map mklocal l ++ map mkremote r where mklocal (Entity mid m, Value lmid, Entity _ s) = MessageTreeNode mid m $ MessageTreeNodeLocal lmid s - mkremote (Entity mid m, Value h, Value lu) = - MessageTreeNode mid m $ MessageTreeNodeRemote $ l2f h lu + mkremote (Entity mid m, Value h, Value luMsg, Value luAuthor) = + MessageTreeNode mid m $ MessageTreeNodeRemote h luMsg luAuthor discussionTree :: [MessageTreeNode] -> Forest MessageTreeNode discussionTree mss = diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index d570fbb..895f6d3 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -85,8 +85,11 @@ getNode getdid mid = do (Nothing, Just (Entity _rmid rm)) -> do rs <- getJust $ remoteMessageAuthor rm i <- getJust $ remoteActorInstance rs - return $ MessageTreeNodeRemote $ - l2f (instanceHost i) (remoteActorIdent rs) + return $ + MessageTreeNodeRemote + (instanceHost i) + (remoteMessageIdent rm) + (remoteActorIdent rs) return $ MessageTreeNode mid m author {- diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs index de40473..14dfdb7 100644 --- a/src/Vervis/Widget/Discussion.hs +++ b/src/Vervis/Widget/Discussion.hs @@ -33,9 +33,11 @@ import Yesod.Core.Widget import qualified Data.Text as T (filter) import Network.FedURI +import Yesod.Hashids import Data.EventTime.Local import Data.Time.Clock.Local () + import Vervis.Discussion import Vervis.Foundation import Vervis.MediaType (MediaType (Markdown)) @@ -48,18 +50,19 @@ import Vervis.Widget.Sharer (personLinkW) actorLinkW :: MessageTreeNodeAuthor -> Widget actorLinkW actor = $(widgetFile "widget/actor-link") where - shortURI (FedURI h p f) = h <> p <> f + shortURI h (LocalURI p f) = h <> p <> f messageW :: UTCTime -> MessageTreeNode -> (MessageId -> Route App) -> Widget -messageW now (MessageTreeNode msgid msg author) reply = +messageW now (MessageTreeNode msgid msg author) reply = do + encodeHid <- getEncodeKeyHashid let showTime = showEventTime . intervalToEventTime . FriendlyConvert . diffUTCTime now showContent = renderSourceT Markdown . T.filter (/= '\r') - in $(widgetFile "discussion/widget/message") + $(widgetFile "discussion/widget/message") messageTreeW :: (MessageId -> Route App) diff --git a/templates/discussion/widget/message.hamlet b/templates/discussion/widget/message.hamlet index 5a802b2..4493557 100644 --- a/templates/discussion/widget/message.hamlet +++ b/templates/discussion/widget/message.hamlet @@ -14,7 +14,13 @@ $# . ^{actorLinkW author}
- #{showTime $ messageCreated msg} + $case author + $of MessageTreeNodeLocal lmid s + + #{showTime $ messageCreated msg} + $of MessageTreeNodeRemote h luMsg _luAuthor + + #{showTime $ messageCreated msg}
^{showContent $ messageContent msg}
diff --git a/templates/widget/actor-link.hamlet b/templates/widget/actor-link.hamlet index a8f66aa..3b26a9c 100644 --- a/templates/widget/actor-link.hamlet +++ b/templates/widget/actor-link.hamlet @@ -21,8 +21,8 @@ $case actor #{shr2text $ sharerIdent s} ./s/#{shr2text $ sharerIdent s} - $of MessageTreeNodeRemote uAuthor - + $of MessageTreeNodeRemote h _luMsg luAuthor + (?) - #{shortURI uAuthor} + #{shortURI h luAuthor}