]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/View/Display.hs
add some tracers and fix the temporal matching
[gargantext.git] / src / Gargantext / Viz / Phylo / View / Display.hs
1 {-|
2 Module : Gargantext.Viz.Phylo.Tools
3 Description : Phylomemy Tools to build/manage it
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10
11 -}
12
13 {-# LANGUAGE NoImplicitPrelude #-}
14 {-# LANGUAGE FlexibleContexts #-}
15 {-# LANGUAGE OverloadedStrings #-}
16
17 module Gargantext.Viz.Phylo.View.Display
18 where
19
20 import Control.Lens hiding (makeLenses, both, Level)
21 import Data.List (null,(++),sortOn)
22 import Gargantext.Prelude
23 import Gargantext.Viz.Phylo
24 import Gargantext.Viz.Phylo.Tools
25
26 -- | To transform a flat Phyloview into a nested Phyloview
27 toNestedView :: [PhyloNode] -> [PhyloNode] -> [PhyloNode]
28 toNestedView ns ns'
29 | null ns' = ns
30 | otherwise = toNestedView (filter (\n -> lvl' == getNodeLevel n) nested)
31 (filter (\n -> lvl' < getNodeLevel n) nested)
32 where
33 --------------------------------------
34 lvl' :: Level
35 lvl' = getNodeLevel $ head' "toNestedView" nested
36 --------------------------------------
37 nested :: [PhyloNode]
38 nested = foldl (\ns'' n -> let nIds' = getNodeParentsId n
39 in map (\n' -> if elem (getNodeId n') nIds'
40 then n' & pn_childs %~ (++ [n])
41 else n') ns'') ns' ns
42 --------------------------------------
43
44
45 -- | To process a DisplayMode to a PhyloView
46 processDisplay :: DisplayMode -> ExportMode -> PhyloView -> PhyloView
47 processDisplay d e v = case e of
48 Json -> case d of
49 Flat -> v
50 Nested -> let ns = sortOn getNodeLevel $ v ^. pv_nodes
51 lvl = getNodeLevel $ head' "processDisplay" ns
52 in v & pv_nodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns)
53 (filter (\n -> lvl < getNodeLevel n) ns)
54 _ -> v