Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
195
Issues
195
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
7ffa286c
Commit
7ffa286c
authored
Aug 25, 2025
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Improve renderLoop
parent
4e984ba2
Pipeline
#7825
canceled with stages
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
11 additions
and
2 deletions
+11
-2
Types.hs
src/Gargantext/Core/NodeStory/Types.hs
+11
-2
No files found.
src/Gargantext/Core/NodeStory/Types.hs
View file @
7ffa286c
...
@@ -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
ngra
ms: "
<>
renderLoop
visited
=
"Loop detected in
ter
ms: "
<>
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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment