1:- module(bc_comment_tree, [
    2    bc_build_comment_tree/2 % +Comments, -Tree
    3]).

Builds comment tree from reply-to structure */

 bc_build_comment_tree(+Comments, -Tree) is det
Builds comments tree from the flat list of comments. Sublist of comments appears as the replies key.
   13bc_build_comment_tree(Comments, Tree):-
   14    comments_filter(Comments, none, Top),
   15    build_comment_tree(Top, Comments, Tree).
   16
   17build_comment_tree([Comment|Top], Comments, [Out|Tree]):-
   18    Comment.'$id' = TopId,
   19    comments_filter(Comments, option(TopId), Filtered),
   20    build_comment_tree(Filtered, Comments, Replies),
   21    put_dict(replies, Comment, Replies, Out),
   22    build_comment_tree(Top, Comments, Tree).
   23
   24build_comment_tree([], _, []).
   25
   26comments_filter([Comment|Comments], ReplyToOption, Filtered):-
   27    (   ReplyToOption = none
   28    ->  (   get_dict(reply_to, Comment, _)
   29        ->  Filtered = Rest
   30        ;   Filtered = [Comment|Rest])
   31    ;   ReplyToOption = option(CommentId),
   32        (   get_dict(reply_to, Comment, CommentId)
   33        ->  Filtered = [Comment|Rest]
   34        ;   Filtered = Rest)
   35    ),
   36    comments_filter(Comments, ReplyToOption, Rest).
   37
   38comments_filter([], _, [])