{- 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 - . -} module Vervis.Discussion ( getDiscussion ) where import Prelude 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 Yesod.Persist.Core (runDB) import qualified Data.HashMap.Lazy as M (fromList, lookup) import Data.Tree.Local (sortForestOn) import Vervis.Foundation import Vervis.Model getMessages :: DiscussionId -> Handler [Entity Message] getMessages did = runDB $ selectList [MessageRoot ==. did] [] 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) = 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, ()) edges = mapMaybe (uncurry mkEdge) nodes graph = mkGraph nodes edges :: Gr (Entity Message) () roots = [n | (n, Entity _ m) <- nodes, isNothing $ messageParent m] in dffWith lab' roots graph sortByTime :: Forest (Entity Message) -> Forest (Entity Message) sortByTime = sortForestOn $ messageCreated . entityVal -- | Get the tree of messages in a given discussion, with siblings sorted from -- old to new. getDiscussion :: DiscussionId -> Handler (Forest (Entity Message)) getDiscussion did = sortByTime . discussionTree <$> getMessages did