]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/View/Display.hs
add the view maker system
[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
22 import Data.List (notElem,last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!),sortOn,sort,(\\))
23 import Data.Map (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys,insert)
24 import Data.Maybe (isNothing)
25 import Data.Set (Set)
26 import Data.Text (Text,unwords)
27 import Data.Tuple (fst, snd)
28 import Data.Vector (Vector)
29
30 import Gargantext.Prelude hiding (head)
31 import Gargantext.Viz.Phylo
32 import Gargantext.Viz.Phylo.Tools
33
34 import qualified Data.List as List
35 import qualified Data.Map as Map
36 import qualified Data.Set as Set
37 import qualified Data.Vector as Vector
38
39
40 -- | To transform a flat Phyloview into a nested Phyloview
41 toNestedView :: [PhyloNode] -> [PhyloNode] -> [PhyloNode]
42 toNestedView ns ns'
43 | null ns' = ns
44 | otherwise = toNestedView (filter (\n -> lvl' == getNodeLevel n) nested)
45 (filter (\n -> lvl' < getNodeLevel n) nested)
46 where
47 --------------------------------------
48 lvl' :: Level
49 lvl' = getNodeLevel $ head $ nested
50 --------------------------------------
51 nested :: [PhyloNode]
52 nested = foldl (\ns' n -> let nId' = getNodeParentId n
53 in map (\n' -> if getNodeId n' == nId'
54 then n' & phylo_nodeChilds %~ (++ [n])
55 else n') ns') ns' ns
56 --------------------------------------
57
58
59 -- | To process a DisplayMode to a PhyloView
60 processDisplay :: DisplayMode -> PhyloView -> PhyloView
61 processDisplay d v = case d of
62 Flat -> v
63 Nested -> let ns = sortOn getNodeLevel $ v ^. phylo_viewNodes
64 lvl = getNodeLevel $ head ns
65 in v & phylo_viewNodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns)
66 (filter (\n -> lvl < getNodeLevel n) ns)
67 _ -> panic "[ERR][Viz.Phylo.Example.processDisplay] display not found"