Implement building discussion message tree from DB

src/Data/Tree/Local.hs

@@ -0,0 +1,28 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ 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
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Data.Tree.Local
+    ( sortForestOn
+    )
+where
+
+import Prelude
+
+import Data.List (sortOn)
+import Data.Tree
+
+sortForestOn :: Ord b => (a -> b) -> Forest a -> Forest a
+sortForestOn f =
+    sortOn (f . rootLabel) . map (\ (Node r s) -> Node r $ sortForestOn f s)

src/Vervis/Discussion.hs

@@ -0,0 +1,62 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ 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
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+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

src/Vervis/Model.hs

@@ -13,7 +13,7 @@
  - <http://creativecommons.org/publicdomain/zero/1.0/>.
  -}
 
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances  #-}
 
 module Vervis.Model where
 
@@ -21,6 +21,7 @@ import ClassyPrelude.Conduit
 import Yesod hiding (Header, parseTime)
 
 import Database.Persist.Quasi
+import Database.Persist.Sql (fromSqlKey)
 import Yesod.Auth.HashDB (HashDBUser (..))
 
 import Vervis.Model.Repo
@@ -34,3 +35,8 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"]
 instance HashDBUser Person where
     userPasswordHash = personHash
     setPasswordHash hash person = person { personHash = Just hash }
+
+-- "Vervis.Discussion" uses a 'HashMap' where the key type is 'MessageId'
+instance Hashable MessageId where
+    hashWithSalt salt = hashWithSalt salt . fromSqlKey
+    hash = hash . fromSqlKey

vervis.cabal

@@ -59,6 +59,7 @@ library
                        Data.Text.UTF8.Local
                        Data.Text.Lazy.UTF8.Local
                        Data.Time.Clock.Local
+                       Data.Tree.Local
                        Development.DarcsRev
                        Network.SSH.Local
                        Text.FilePath.Local
@@ -70,6 +71,7 @@ library
                        Vervis.Changes
                        Vervis.Content
                        Vervis.Darcs
+                       Vervis.Discussion
                        Vervis.Field.Key
                        Vervis.Field.Person
                        Vervis.Field.Project
@@ -163,6 +165,9 @@ library
                      , dlist
                      , esqueleto
                      , fast-logger
+                       -- for building a message tree using DFS in
+                       -- Vervis.Discussion, possibly also used by some git
+                       -- graph related code?
                      , fgl
                      , file-embed
                      , filepath