{- This file is part of Vervis.
 -
 - Written in 2016, 2019 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
    ( getDiscussionTree
    )
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 (Forest)
import Database.Esqueleto hiding (isNothing)
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 :: AppDB DiscussionId -> Handler [(Entity Message, Sharer)]
getMessages getdid = fmap (map $ second entityVal) $ runDB $ do
    did <- getdid
    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, Sharer)] -> Forest (Entity Message, Sharer)
discussionTree mss =
    let nodes = zip [1..] mss
        mkEntry n ((Entity mid _m), _s) = (mid, n)
        nodeMap = M.fromList $ map (uncurry mkEntry) nodes
        mkEdge n (Entity _ 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, ())
        edges = mapMaybe (uncurry mkEdge) nodes
        graph = mkGraph nodes edges :: Gr (Entity Message, Sharer) ()
        roots = [n | (n, (Entity _ m, _s)) <- nodes, isNothing $ messageParent m]
    in  dffWith lab' roots graph

sortByTime :: Forest (Entity Message, Sharer) -> Forest (Entity Message, Sharer)
sortByTime = sortForestOn $ messageCreated . entityVal . fst

-- | Get the tree of messages in a given discussion, with siblings sorted from
-- old to new.
getDiscussionTree :: AppDB DiscussionId -> Handler (Forest (Entity Message, Sharer))
getDiscussionTree getdid = sortByTime . discussionTree <$> getMessages getdid