[API] PostNodeAsync funs, before refactoring
[gargantext.git] / src / Gargantext / Viz / Phylo / View / Sort.hs
index b04a5f1cbb45020f0e6405dd191e0d1fd92fe5f1..942bde5148d1fb8deec35c6925050c0639f2a15b 100644 (file)
@@ -18,28 +18,16 @@ module Gargantext.Viz.Phylo.View.Sort
   where
 
 import Control.Lens     hiding (makeLenses, both, Level)
-
-import Data.List        (notElem,last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!),sortOn,sort,(\\))
-import Data.Map         (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys,insert)
-import Data.Maybe       (isNothing)
-import Data.Set         (Set)
-import Data.Text        (Text,unwords)
+import Data.List        (sortOn)
 import Data.Tuple       (fst, snd)
-import Data.Vector      (Vector)
-
-import Gargantext.Prelude             hiding (head)
+import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Tools
 
-import qualified Data.List   as List
-import qualified Data.Map    as Map
-import qualified Data.Set    as Set
-import qualified Data.Vector as Vector
-
 
 -- | To sort a PhyloView by Age
 sortBranchByAge :: Order -> PhyloView -> PhyloView
-sortBranchByAge o v = v & phylo_viewBranches %~ f
+sortBranchByAge o v = v & pv_branches %~ f
   where
     --------------------------------------
     f :: [PhyloBranch] -> [PhyloBranch] 
@@ -48,10 +36,22 @@ sortBranchByAge o v = v & phylo_viewBranches %~ f
            Desc -> reverse $ sortOn (getBranchMeta "age") xs
     --------------------------------------
 
+-- | To sort a PhyloView by Birth date of a branch
+sortBranchByBirth :: Order -> PhyloView -> PhyloView
+sortBranchByBirth o v = v & pv_branches %~ f
+  where
+    --------------------------------------
+    f :: [PhyloBranch] -> [PhyloBranch] 
+    f xs = case o of 
+           Asc  -> sortOn (getBranchMeta "birth") xs
+           Desc -> reverse $ sortOn (getBranchMeta "birth") xs
+    --------------------------------------    
+
 -- | To process a Sort to a PhyloView
 processSort :: Maybe (Sort,Order) -> Phylo -> PhyloView -> PhyloView 
-processSort s p v = case s of
+processSort s _p v = case s of
                     Nothing -> v
-                    Just s  -> case fst s of
-                               ByBranchAge -> sortBranchByAge (snd s) v
-                               _           -> panic "[ERR][Viz.Phylo.View.Sort.processSort] sort not found"
\ No newline at end of file
+                    Just s'  -> case fst s' of
+                               ByBranchAge   -> sortBranchByAge   (snd s') v
+                               ByBranchBirth -> sortBranchByBirth (snd s') v
+                               --_           -> panic "[ERR][Viz.Phylo.View.Sort.processSort] sort not found"