>>> continue

src/Gargantext/Components/PhyloExplorer/Draw.purs

 module Gargantext.Components.PhyloExplorer.Draw
   ( drawPhylo
   , highlightSource
+  , highlightSource'
   , unhide
   , setGlobalDependencies, setGlobalD3Reference
   ) where
 
 import Gargantext.Prelude
 
+import Control.Monad.Except (runExcept)
 import DOM.Simple (Window)
+import DOM.Simple.Console (log, log2)
+import Data.Either (Either(..))
 import Data.Foldable (for_)
 import Data.FoldableWithIndex (forWithIndex_)
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), maybe)
 import Effect (Effect)
+import Effect.Class (liftEffect)
+import Effect.Ref as Ref
 import Effect.Uncurried (EffectFn7, runEffectFn7)
-import FFI.Simple (applyTo, (..), (.=), (.?))
+import FFI.Simple (applyTo, getProperty, getProperty', setProperty, setProperty', (..), (...), (.=), (.?))
 import Gargantext.Components.PhyloExplorer.Types (AncestorLink, Branch, BranchLink, GlobalTerm(..), Group(..), Link, Period, PhyloDataSet(..))
 import Gargantext.Utils.Reactix (getElementById)
-import Graphics.D3.Base (D3)
+import Graphics.D3.Base (D3, D3Eff)
+import Graphics.D3.Selection as D3S
+import Graphics.D3.Util (ffi)
+import Unsafe.Coerce (unsafeCoerce)
 
 foreign import _drawPhylo :: EffectFn7
   (Array Branch)
@@ -41,6 +50,25 @@ drawPhylo = runEffectFn7 _drawPhylo
 
 -----------------------------------------------------------
 
+-- @XXX: FFI.Simple `(...)` throws error (JavaScript issue)
+--       need to decompose computation
+--
+--       (?) chained prototype property issue?
+applyTo_ :: forall src arg res. src -> String -> Array arg -> res
+applyTo_ src name args =
+  let fn = getProperty name src
+  in applyTo fn src args
+
+
+-- @WIP: DOM.Simple lack of "ClassList" module
+addClass :: forall el. el -> Array String -> Effect Unit
+addClass el args = pure $ applyTo_ (el .. "classList") "add" args
+
+removeClass :: forall el. el -> Array String -> Effect Unit
+removeClass el args = pure $ applyTo_ (el .. "classList") "remove" args
+
+-----------------------------------------------------------
+
 foreign import _highlightSource :: Effect Unit
 
 highlightSource :: Effect Unit
@@ -97,7 +125,7 @@ setGlobalDependencies w (PhyloDataSet o)
       new <- pure $ applyTo (terms .. "flat") terms []
       pure $ (w .= "terms") new
 
-
+-- @XXX: prevent PureScript from not injecting D3
 setGlobalD3Reference :: Window -> D3 -> Effect Unit
 setGlobalD3Reference window d3 = void $ pure $ (window .= "d3") d3
 
@@ -115,3 +143,98 @@ unhide name = pure unit
     setText id n   = getElementById id >>= \el -> pure $ (el .= "innerHTML") n
     turnVisible id = getElementById id >>= \el -> pure $ (el .= "visibility")
       "visible"
+
+-----------------------------------------------------------
+
+
+
+
+orDie :: forall err a. Maybe a -> err -> Either err a
+orDie (Just a) _   = Right a
+orDie Nothing  err = Left err
+
+-- @WIP: "Graphics.D3.Selection" lack of "filter" function
+-- @WIP: "Graphics.D3.Selection" lack of "nodes" function
+selectionFilter :: forall d. String -> D3S.Selection d -> D3Eff (D3S.Selection D3S.Void)
+selectionFilter = ffi ["query", "selection", ""] "selection.filter(query)"
+
+selectionNodes :: forall d el. D3S.Selection d -> D3Eff (Array el)
+selectionNodes = ffi ["selection", ""] "selection.nodes()"
+
+
+highlightSource' :: Window -> Effect Unit
+highlightSource' window =
+  let
+    hasHighlight = maybe false identity (window .? "highlighted")
+    hasLdView    = maybe false identity (window .? "ldView")
+    -- @WIP
+    value = "string"
+
+  in do
+
+    groups <- D3S.rootSelectAll ".group-inner"
+
+
+    if hasHighlight
+    then
+          selectionFilter ".source-focus" groups
+      >>= selectionNodes
+      >>= flip for_ (flip addClass [ "group-unfocus" ])
+    else
+      pure unit
+
+
+    -- unselected all the groups
+    _ <-  selectionNodes groups
+      >>= flip for_ (flip removeClass [ "source-focus" ])
+
+    if hasLdView
+    then
+          selectionNodes groups
+      >>= flip for_ (fill "#f5eee6")
+    else
+          selectionNodes groups
+      >>= flip for_ (fill "#fff")
+
+    _ <-  D3S.rootSelectAll ".peak"
+      >>= D3S.classed "peak-focus-source" false
+
+
+    -- select the relevant ones
+    if (value == "unselect")
+    then
+      pure unit
+    else
+          selectionFilter (".source-" <> value) groups
+      >>= selectionNodes
+      >>= flip for_ (selectNodeGroup)
+      -- @WIP drawWordCloud
+
+    pure unit
+
+
+
+
+  where
+
+    fill :: forall el. String -> el -> Effect Unit
+    fill hex el = do
+      style <- pure $ (el .. "style")
+      pure $ (style .= "fill") hex
+
+
+    selectNodeGroup :: forall el. el -> D3Eff Unit
+    selectNodeGroup el = do
+      removeClass el [ "group-unfocus" ]
+      addClass el [ "source-focus" ]
+      fill "#a6bddb" el
+
+      bid <- liftEffect $ applyTo_ el "getAttribute" [ "bId" ]
+
+      void $
+            D3S.rootSelect ("#peak-" <> bid)
+        >>= D3S.classed "peak-focus-source" true
+
+
+drawWordCloud groups = do
+  labels <- Ref.new ()

src/Gargantext/Components/PhyloExplorer/Layout.purs

@@ -6,7 +6,7 @@ import Gargantext.Prelude
 
 import DOM.Simple (window)
 import Data.Array as Array
-import Gargantext.Components.PhyloExplorer.Draw (drawPhylo, highlightSource, setGlobalD3Reference, setGlobalDependencies, unhide)
+import Gargantext.Components.PhyloExplorer.Draw (drawPhylo, highlightSource, highlightSource', setGlobalD3Reference, setGlobalDependencies, unhide)
 import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet(..))
 import Gargantext.Utils (nbsp)
 import Gargantext.Utils.Reactix as R2
@@ -94,7 +94,7 @@ layoutCpt = here.component "layout" cpt where
           { id: "checkSource"
           , className: "select-source"
           , defaultValue: ""
-          , on: { change: \_ -> highlightSource }
+          , on: { change: \_ -> highlightSource' window }
           } $
           [
             H.option