src/Gargantext/Viz/Phylo/View/Sort.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.Sort
  18   where
  19
  20 import Control.Lens     hiding (makeLenses, both, Level)
  21 import Data.List        (sortOn)
  22 import Data.Tuple       (fst, snd)
  23 import Gargantext.Prelude
  24 import Gargantext.Viz.Phylo
  25 import Gargantext.Viz.Phylo.Tools
  26
  27
  28 -- | To sort a PhyloView by Age
  29 sortBranchByAge :: Order -> PhyloView -> PhyloView
  30 sortBranchByAge o v = v & pv_branches %~ f
  31   where
  32     --------------------------------------
  33     f :: [PhyloBranch] -> [PhyloBranch]
  34     f xs = case o of
  35            Asc  -> sortOn (getBranchMeta "age") xs
  36            Desc -> reverse $ sortOn (getBranchMeta "age") xs
  37     --------------------------------------
  38
  39 -- | To sort a PhyloView by Birth date of a branch
  40 sortBranchByBirth :: Order -> PhyloView -> PhyloView
  41 sortBranchByBirth o v = v & pv_branches %~ f
  42   where
  43     --------------------------------------
  44     f :: [PhyloBranch] -> [PhyloBranch]
  45     f xs = case o of
  46            Asc  -> sortOn (getBranchMeta "birth") xs
  47            Desc -> reverse $ sortOn (getBranchMeta "birth") xs
  48     --------------------------------------
  49
  50 -- | To process a Sort to a PhyloView
  51 processSort :: Maybe (Sort,Order) -> Phylo -> PhyloView -> PhyloView
  52 processSort s _p v = case s of
  53                     Nothing -> v
  54                     Just s'  -> case fst s' of
  55                                ByBranchAge   -> sortBranchByAge   (snd s') v
  56                                ByBranchBirth -> sortBranchByBirth (snd s') v
  57                                --_           -> panic "[ERR][Viz.Phylo.View.Sort.processSort] sort not found"