>>> continue

src/Gargantext/Components/Nodes/Corpus/Phylo.purs

@@ -12,7 +12,7 @@ import Data.HTTP.Method (Method(..))
 import Data.Maybe (Maybe(..))
 import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
-import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet)
+import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet(..))
 import Gargantext.Components.PhyloExplorer.Layout (layout)
 import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet, parsePhyloJSONSet)
 import Gargantext.Sessions (Session)

src/Gargantext/Components/PhyloExplorer/Draw.purs

 module Gargantext.Components.PhyloExplorer.Draw where
+
+import Gargantext.Prelude
+
+import Data.Function.Uncurried (Fn7, runFn7)
+import Effect (Effect)
+import Gargantext.Components.PhyloExplorer.Types (AncestorLink, Branch, BranchLink, Group, Link, Period)
+
+foreign import _drawPhylo :: Fn7
+  (Array Branch)
+  (Array Period)
+  (Array Group)
+  (Array Link)
+  (Array AncestorLink)
+  (Array BranchLink)
+  (Array Number)
+  (Effect Unit)
+
+drawPhylo ::
+     Array Branch
+  -> Array Period
+  -> Array Group
+  -> Array Link
+  -> Array AncestorLink
+  -> Array BranchLink
+  -> Array Number
+  -> Effect Unit
+drawPhylo = runFn7 _drawPhylo

src/Gargantext/Components/PhyloExplorer/JSON.purs

@@ -134,31 +134,32 @@ type EdgeData =
   )
 
 data RawEdge
-  = GroupToGroup
+  = GroupToAncestor
     { _gvid         :: Int
-    , constraint    :: String
+    , arrowhead     :: String
     , edgeType      :: String
     , lbl           :: String
     , penwidth      :: String
+    , style         :: String
     | EdgeData
     }
-  | BranchToGroup
+  | GroupToGroup
     { _gvid         :: Int
-    , arrowhead     :: String
+    , constraint    :: String
     , edgeType      :: String
+    , lbl           :: String
+    , penwidth      :: String
     | EdgeData
     }
-  | BranchToBranch
+  | BranchToGroup
     { _gvid         :: Int
     , arrowhead     :: String
-    , style         :: String
+    , edgeType      :: String
     | EdgeData
     }
-  | GroupToAncestor
+  | BranchToBranch
     { _gvid         :: Int
     , arrowhead     :: String
-    , lbl           :: String
-    , penwidth      :: String
     , style         :: String
     | EdgeData
     }

src/Gargantext/Components/PhyloExplorer/Layout.purs

@@ -4,29 +4,16 @@ module Gargantext.Components.PhyloExplorer.Layout
 
 import Gargantext.Prelude
 
-import DOM.Simple (Window, window)
+import DOM.Simple (window)
 import DOM.Simple.Console (log2)
 import Data.Array as Array
-import Data.Date as Date
-import Data.FoldableWithIndex (forWithIndex_)
-import Data.Int as Int
-import Data.Maybe (Maybe(..), maybe)
-import Data.Number as Number
-import Data.String as String
-import Data.Symbol (SProxy(..))
-import Data.Traversable (for, for_)
-import Data.Tuple as Tuple
-import Data.Tuple.Nested ((/\))
-import Effect (Effect)
-import FFI.Simple (maybeGetProperty, (..), (...), (.=), (.?))
-import Gargantext.Components.PhyloExplorer.Types (GlobalTerm(..), Group(..), PhyloDataSet(..))
+import Gargantext.Components.PhyloExplorer.Draw (drawPhylo)
+import Gargantext.Components.PhyloExplorer.JSON (RawEdge(..))
+import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet(..), setGlobalDependencies)
 import Gargantext.Utils (nbsp)
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Reactix.DOM.HTML as H
-import Record (get)
-import Toestand as T
-import Type.Proxy (Proxy(..))
 
 here :: R2.Here
 here = R2.here "Gargantext.Components.PhyloExplorer"
@@ -46,6 +33,16 @@ layoutCpt = here.component "layout" cpt where
 
     R.useEffectOnce' $ do
       setGlobalDependencies window (PhyloDataSet o)
+      drawPhylo
+        o.branches
+        o.periods
+        o.groups
+        o.links
+        o.ancestorLinks
+        o.branchLinks
+        o.bb
+
+
 
     -- @hightlightSource
     let
@@ -259,59 +256,6 @@ layoutCpt = here.component "layout" cpt where
 
       ]
 
-
-
-setGlobalDependencies :: Window -> PhyloDataSet -> Effect Unit
-setGlobalDependencies w (PhyloDataSet o)
-  = do
-    _ <- pure $ (w .= "freq") {}
-    _ <- pure $ (w .= "nbBranches") o.nbBranches
-    _ <- pure $ (w .= "nbDocs") o.nbDocs
-    _ <- pure $ (w .= "nbFoundations") o.nbFoundations
-    _ <- pure $ (w .= "nbGroups") o.nbGroups
-    _ <- pure $ (w .= "nbPeriods") o.nbPeriods
-    _ <- pure $ (w .= "nbTerms") o.nbTerms
-    _ <- pure $ (w .= "sources") o.sources
-    _ <- pure $ (w .= "terms") []
-    _ <- pure $ (w .= "timeScale") o.timeScale
-    _ <- pure $ (w .= "weighted") o.weighted
-
-    (freq :: Array Int)         <- pure $ w .. "freq"
-    (terms :: Array GlobalTerm) <- pure $ w .. "terms"
-
-    for_ o.groups \(Group g) -> do
-
-      let
-        f = g.foundation
-        l = g.label
-
-      log2 "group" g
-
-      -- For each entries in group.foundation array,
-      -- increment consequently the global window.keys array
-      -- forWithIndex_ f \i _ ->
-      --   let i' = show i
-      --   in case (freq .? i') of
-      --     Nothing -> pure $ (freq .= i') 0
-      --     Just v  -> pure $ (freq .= i') (v +1)
-      for_ f \i ->
-        let i' = show i
-        in case (freq .? i') of
-          Nothing -> pure $ (freq .= i') 0
-          Just v  -> pure $ (freq .= i') (v +1)
-
-
-      -- For each entries in group.foundation array,
-      -- if the global window.terms does not have it in property,
-      -- append an item to the global window.terms
-      for_ f \i ->
-        let i' = show i
-        in case (terms .? i') of
-          Nothing -> pure unit
-          Just _  -> void <<< pure $ (terms .= i') $ GlobalTerm
-            { label: l .. i'
-            , fdt  : f .. i'
-            }
 --------------------------------------------------------
 
 type PhyloCorpusProps = ()

src/Gargantext/Components/PhyloExplorer/Types.js

@@ -49,32 +49,3 @@ function utcStringToDate(str) {
 exports.yearToDate      = yearToDate;
 exports.stringToDate    = stringToDate;
 exports.utcStringToDate = utcStringToDate;
-
-function draw(json) {
-
-
-  var links = json.edges.filter(edges => edges.edgeType == "link").map(function(l){
-    return {  lId : parseInt(l._gvid),
-              from : parseInt(l.tail) ,
-                to : parseInt(l.head) ,
-            label : l.label}
-  });
-
-  var aLinks = json.edges.filter(edges => edges.edgeType == "ancestorLink").map(function(l){
-    return {  lId : parseInt(l._gvid),
-              from : parseInt(l.tail) ,
-                to : parseInt(l.head) ,
-            label : l.label }
-  });
-
-  var bLinks = json.edges.filter(edges => edges.edgeType == "branchLink").map(function(l){
-    return { from : parseInt(l.tail) ,
-                to : parseInt(l.head) }
-  });
-
-  window.terms = Object.values(window.terms)
-
-  // draw the phylo
-
-  drawPhylo(branches,periods,groups,links,aLinks,bLinks,bb);
-}

src/Gargantext/Components/PhyloExplorer/Types.purs

 module Gargantext.Components.PhyloExplorer.Types
   ( PhyloDataSet(..)
   , Branch(..), Period(..), Group(..)
+  , Link(..), AncestorLink(..), BranchLink(..)
   , GlobalTerm(..)
   , parsePhyloJSONSet
+  , setGlobalDependencies
   ) where
 
 import Gargantext.Prelude
 
+import DOM.Simple (Window)
+import DOM.Simple.Console (log2)
 import Data.Array as Array
 import Data.Date as Date
+import Data.Foldable (for_)
+import Data.FoldableWithIndex (forWithIndex_)
 import Data.Generic.Rep (class Generic)
 import Data.Int as Int
 import Data.Maybe (Maybe(..), maybe)
@@ -17,19 +23,25 @@ import Data.Show.Generic (genericShow)
 import Data.String as String
 import Data.Tuple as Tuple
 import Data.Tuple.Nested ((/\))
-import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet(..), RawObject(..))
+import Effect (Effect)
+import FFI.Simple (applyTo, (..), (.=), (.?))
+import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet(..), RawEdge(..), RawObject(..))
+import Unsafe.Coerce (unsafeCoerce)
 
 
--- @WIP Date or foreign?
+-- @WIP PureScript Date or stick to JavaScript foreign?
 foreign import yearToDate       :: String -> Date.Date
 foreign import stringToDate     :: String -> Date.Date
 foreign import utcStringToDate  :: String -> Date.Date
 
 
 newtype PhyloDataSet = PhyloDataSet
-  { bb            :: Array Number
+  { ancestorLinks :: Array AncestorLink
+  , bb            :: Array Number
+  , branchLinks   :: Array BranchLink
   , branches      :: Array Branch
   , groups        :: Array Group
+  , links         :: Array Link
   , nbBranches    :: Int
   , nbDocs        :: Int
   , nbFoundations :: Int
@@ -48,9 +60,12 @@ instance Show PhyloDataSet where show = genericShow
 
 parsePhyloJSONSet :: PhyloJSONSet -> PhyloDataSet
 parsePhyloJSONSet (PhyloJSONSet o) = PhyloDataSet
-  { bb            : parseBB o.bb
+  { ancestorLinks
+  , bb            : parseBB o.bb
+  , branchLinks
   , branches
   , groups
+  , links
   , nbBranches    : parseInt o.phyloBranches
   , nbDocs        : parseInt o.phyloDocs
   , nbFoundations : parseInt o.phyloFoundations
@@ -64,10 +79,14 @@ parsePhyloJSONSet (PhyloJSONSet o) = PhyloDataSet
   }
 
   where
-    epochTS   = o.phyloTimeScale == "epoch"
-    branches  = parseBranches o.objects
-    groups    = parseGroups epochTS o.objects
-    periods   = parsePeriods epochTS o.objects
+    epochTS       = o.phyloTimeScale == "epoch"
+
+    ancestorLinks = parseAncestorLinks o.edges
+    branchLinks   = parseBranchLinks o.edges
+    branches      = parseBranches o.objects
+    groups        = parseGroups epochTS o.objects
+    links         = parseLinks o.edges
+    periods       = parsePeriods epochTS o.objects
 
 -----------------------------------------------------------
 
@@ -173,6 +192,107 @@ parseGroups epoch
 
 -----------------------------------------------------------
 
+data Link = Link
+  { from    :: Int
+  , lId     :: Int
+  , label   :: String -- @WIP: undefined in Mèmiescape v2, still needed?
+  , to      :: Int
+  }
+
+derive instance Generic Link _
+derive instance Eq Link
+instance Show Link where show = genericShow
+
+parseLinks :: Array RawEdge -> Array Link
+parseLinks
+  =   Array.filter filter
+  >>> map parse
+  >>> Array.catMaybes
+
+  where
+    -- @WIP: necessary?
+    --       bc. GroupToGroup as 1-1 relation with "edgeType=link"
+    filter :: RawEdge -> Boolean
+    filter (GroupToGroup o) = o.edgeType == "link"
+    filter _                = false
+
+    parse :: RawEdge -> Maybe Link
+    parse (GroupToGroup o) = Just $ Link
+      { from  : o.tail
+      , lId   : o._gvid
+      , label : ""
+      , to    : o.head
+      }
+    parse _               = Nothing
+
+-----------------------------------------------------------
+
+data AncestorLink = AncestorLink
+  { from    :: Int
+  , lId     :: Int
+  , label   :: String -- @WIP: undefined in Mèmiescape v2, still needed?
+  , to      :: Int
+  }
+
+derive instance Generic AncestorLink _
+derive instance Eq AncestorLink
+instance Show AncestorLink where show = genericShow
+
+parseAncestorLinks :: Array RawEdge -> Array AncestorLink
+parseAncestorLinks
+  =   Array.filter filter
+  >>> map parse
+  >>> Array.catMaybes
+
+  where
+    -- @WIP: necessary?
+    --       bc. GroupToAncestor as 1-1 relation with "edgeType=ancestorLink"
+    filter :: RawEdge -> Boolean
+    filter (GroupToAncestor o) = o.edgeType == "ancestorLink"
+    filter _                   = false
+
+    parse :: RawEdge -> Maybe AncestorLink
+    parse (GroupToAncestor o) = Just $ AncestorLink
+      { from  : o.tail
+      , lId   : o._gvid
+      , label : ""
+      , to    : o.head
+      }
+    parse _               = Nothing
+
+-----------------------------------------------------------
+
+data BranchLink = BranchLink
+  { from    :: Int
+  , to      :: Int
+  }
+
+derive instance Generic BranchLink _
+derive instance Eq BranchLink
+instance Show BranchLink where show = genericShow
+
+parseBranchLinks :: Array RawEdge -> Array BranchLink
+parseBranchLinks
+  =   Array.filter filter
+  >>> map parse
+  >>> Array.catMaybes
+
+  where
+    -- @WIP: necessary?
+    --       bc. BranchToGroup as 1-1 relation with "edgeType=branchLink"
+    filter :: RawEdge -> Boolean
+    filter (BranchToGroup o) = o.edgeType == "branchLink"
+    filter _                   = false
+
+    parse :: RawEdge -> Maybe BranchLink
+    parse (BranchToGroup o) = Just $ BranchLink
+      { from  : o.tail
+      , to    : o.head
+      }
+    parse _               = Nothing
+
+-----------------------------------------------------------
+
 data GlobalTerm = GlobalTerm
   { label :: String
   , fdt   :: String
@@ -182,6 +302,55 @@ derive instance Generic GlobalTerm _
 derive instance Eq GlobalTerm
 instance Show GlobalTerm where show = genericShow
 
+setGlobalDependencies :: Window -> PhyloDataSet -> Effect Unit
+setGlobalDependencies w (PhyloDataSet o)
+  = do
+    _ <- pure $ (w .= "freq") {}
+    _ <- pure $ (w .= "nbBranches") o.nbBranches
+    _ <- pure $ (w .= "nbDocs") o.nbDocs
+    _ <- pure $ (w .= "nbFoundations") o.nbFoundations
+    _ <- pure $ (w .= "nbGroups") o.nbGroups
+    _ <- pure $ (w .= "nbPeriods") o.nbPeriods
+    _ <- pure $ (w .= "nbTerms") o.nbTerms
+    _ <- pure $ (w .= "sources") o.sources
+    _ <- pure $ (w .= "terms") []
+    _ <- pure $ (w .= "timeScale") o.timeScale
+    _ <- pure $ (w .= "weighted") o.weighted
+
+    (freq :: Array Int)         <- pure $ w .. "freq"
+    (terms :: Array GlobalTerm) <- pure $ w .. "terms"
+
+    for_ o.groups \(Group g) -> do
+
+      let
+        f = g.foundation
+        l = g.label
+
+      forWithIndex_ f \idx val ->
+        let
+          idx' = show idx
+          val' = show val
+        -- For each entries in group.foundation array,
+        -- increment consequently the global window.keys array
+        in case (freq .? val') of
+          Nothing -> pure $ (freq .= val') 0
+          Just v  -> pure $ (freq .= val') (v +1)
+        -- For each entries in group.foundation array,
+        -- if the global window.terms does not have it in property,
+        -- append an item to the global window.terms
+        *> case (terms .? val') of
+          Just _  -> pure unit
+          Nothing -> void <<< pure $ (terms .= val') $ GlobalTerm
+            { label: l .. idx'
+            , fdt  : val'
+            }
+
+    -- @XXX: FFI.Simple `(...)` throws error (JavaScript issue)
+    --       need to decompose computation
+    void do
+      new <- pure $ applyTo (terms .. "flat") terms []
+      pure $ (w .= "terms") new
+
 -----------------------------------------------------------
 
 parseInt :: String -> Int

src/Main.purs

@@ -9,6 +9,7 @@ import Effect (Effect)
 import FFI.Simple ((...))
 import Gargantext.Components.App (app)
 import Gargantext.Utils.Reactix as R2
+import Graphics.D3.Base (D3, d3)
 import Prelude (Unit, ($))
 
 main :: Effect Unit
@@ -17,3 +18,7 @@ main = paint $ toMaybe (document ... "getElementById" $ [ "app" ])
 paint :: Maybe Element -> Effect Unit
 paint Nothing = log "[main] Container not found"
 paint (Just c) = R2.render (app {} []) c
+
+-- @WIP
+d3charge :: D3
+d3charge = d3