Commit 7ffa286c authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Improve renderLoop

parent 4e984ba2
Pipeline #7825 canceled with stages
...@@ -12,6 +12,7 @@ Portability : POSIX ...@@ -12,6 +12,7 @@ Portability : POSIX
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Gargantext.Core.NodeStory.Types module Gargantext.Core.NodeStory.Types
( HasNodeStory ( HasNodeStory
...@@ -203,19 +204,27 @@ data BuildForestError ...@@ -203,19 +204,27 @@ data BuildForestError
instance ToHumanFriendlyError BuildForestError where instance ToHumanFriendlyError BuildForestError where
mkHumanFriendly (BFE_loop_detected visited) mkHumanFriendly (BFE_loop_detected visited)
= "Loop detected in ngrams: " <> renderLoop visited = "Loop detected in terms: " <> renderLoop visited
renderLoop :: Set VisitedNode -> T.Text renderLoop :: Set VisitedNode -> T.Text
renderLoop = T.intercalate " -> " . map (unNgramsTerm . _vn_term) . Set.toAscList renderLoop (sortBy (comparing _vn_position) . Set.toList -> visited) = case visited of
[] -> mempty
(x : _) ->
let cycleWithoutRecursiveKnot = T.intercalate " -> " . map (unNgramsTerm . _vn_term) $ visited
-- Pretty print the first visited node last, so that the user can "see" the full recursive knot.
in cycleWithoutRecursiveKnot <> " -> " <> (unNgramsTerm . _vn_term $ x)
-- | Keeps track of the relative order in which visited a node, to be able to print cycles. -- | Keeps track of the relative order in which visited a node, to be able to print cycles.
data VisitedNode = data VisitedNode =
VN { _vn_position :: !Int, _vn_term :: !NgramsTerm } VN { _vn_position :: !Int, _vn_term :: !NgramsTerm }
deriving (Show) deriving (Show)
-- /NOTA BENE/: It's important to use this custom instance for the loop detector
-- to work correctly. If we stop comparing on the terms the loop detector .. will loop.
instance Eq VisitedNode where instance Eq VisitedNode where
(VN _ t1) == (VN _ t2) = t1 == t2 (VN _ t1) == (VN _ t2) = t1 == t2
-- /NOTA BENE/: Same proviso as for the 'Eq' instance.
instance Ord VisitedNode where instance Ord VisitedNode where
compare (VN _ t1) (VN _ t2) = t1 `compare` t2 compare (VN _ t1) (VN _ t2) = t1 `compare` t2
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment