src/Gargantext/Core/Viz/Phylo/View/Display.hs

   1 {-|
   2 Module      : Gargantext.Core.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
  14 module Gargantext.Core.Viz.Phylo.View.Display
  15   where
  16
  17 import Control.Lens     hiding (makeLenses, both, Level)
  18 import Data.List        (null,(++),sortOn)
  19 import Gargantext.Prelude
  20 import Gargantext.Core.Viz.Phylo
  21 import Gargantext.Core.Viz.Phylo.Tools
  22
  23 -- | To transform a flat Phyloview into a nested Phyloview
  24 toNestedView :: [PhyloNode] -> [PhyloNode] -> [PhyloNode]
  25 toNestedView ns ns'
  26   | null ns'  = ns
  27   | otherwise = toNestedView (filter (\n -> lvl' == getNodeLevel n) nested)
  28                              (filter (\n -> lvl' <  getNodeLevel n) nested)
  29     where
  30       --------------------------------------
  31       lvl' :: Level
  32       lvl' = getNodeLevel $ head' "toNestedView" nested
  33       --------------------------------------
  34       nested :: [PhyloNode]
  35       nested = foldl (\ns'' n -> let nIds' = getNodeParentsId n
  36                                 in map (\n' -> if elem (getNodeId n') nIds'
  37                                                then n' & pn_childs %~ (++ [n])
  38                                                else n') ns'') ns' ns
  39       --------------------------------------
  40
  41
  42 -- | To process a DisplayMode to a PhyloView
  43 processDisplay :: DisplayMode -> ExportMode -> PhyloView -> PhyloView
  44 processDisplay d e v = case e of
  45                        Json -> case d of
  46                                Flat   -> v
  47                                Nested -> let ns  = sortOn getNodeLevel $ v ^. pv_nodes
  48                                              lvl = getNodeLevel $ head' "processDisplay" ns
  49                                          in v & pv_nodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns)
  50                                                                          (filter (\n -> lvl <  getNodeLevel n) ns)
  51                        _    -> v