some fix
[gargantext.git] / src / Gargantext / Viz / Phylo / View / Metrics.hs
index dcbe5222a2881a8909723fa764bfa0c99055802c..d14be825a2dbc05a6b225e92d41f5e34e84015a1 100644 (file)
@@ -18,40 +18,29 @@ module Gargantext.Viz.Phylo.View.Metrics
   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        (last,groupBy,sortOn)
+import Data.Map         (insert)
+import Data.Text        (Text)
 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 add a new meta Metric to a PhyloBranch
-addBranchMeta :: PhyloBranchId -> Text -> Double -> PhyloView -> PhyloView
-addBranchMeta id lbl val v = over (phylo_viewBranches
-                                  . traverse) 
-                                  (\b -> if getBranchId b == id
-                                         then b & phylo_branchMeta %~ insert lbl val 
-                                         else b) v
+addBranchMetrics :: PhyloBranchId -> Text -> Double -> PhyloView -> PhyloView
+addBranchMetrics id lbl val v = over (pv_branches
+                                     . traverse)
+                                    (\b -> if getBranchId b == id
+                                           then b & pb_metrics %~ insert lbl [val]
+                                           else b) v
 
 
 -- | To get the age (in year) of all the branches of a PhyloView
 branchAge :: PhyloView -> PhyloView
-branchAge v = foldl (\v' b -> let bId = (fst . head) b
+branchAge v = foldl (\v' b -> let bId = (fst . (head' "branchAge")) b
                                   prds = sortOn fst $ map snd b
-                              in addBranchMeta bId "age" ((abs . fromIntegral) 
-                                                          $ ((snd . last) prds) - ((fst . head) prds)) v') v
+                              in addBranchMetrics bId "age" ((abs . fromIntegral) $ ((snd . last) prds) - (fst $ head' "branchAge" prds)) v') v
             $ groupBy ((==) `on` fst)
             $ sortOn fst
             $ map (\n -> (getNodeBranchId n, (fst . fst) $ getNodeId n))
@@ -60,8 +49,9 @@ branchAge v = foldl (\v' b -> let bId = (fst . head) b
 
 -- | To process a list of Metrics to a PhyloView
 processMetrics :: [Metric] -> Phylo -> PhyloView -> PhyloView
-processMetrics ms p v = foldl (\v' m -> case m of
+processMetrics ms _p v = foldl (\v' m -> case m of
                                         BranchAge -> branchAge v'
-                                        _         -> panic "[ERR][Viz.Phylo.Example.processMetrics] metric not found") v ms
+                                       -- _         -> panic "[ERR][Viz.Phylo.Example.processMetrics] metric not found"
+                                        ) v ms