push for seeg

src/Gargantext/Components/GraphExplorer.purs

+module Gargantext.Components.GraphExplorer where
+
+import Effect.Unsafe (unsafePerformEffect)
+import Gargantext.Prelude hiding (max,min)
+
+import Control.Monad.Cont.Trans (lift)
+import Data.Array (fold, length, (!!), null)
+import Data.FoldableWithIndex (foldMapWithIndex)
+import Data.Foldable (foldMap)
+import Data.Int (toNumber)
+import Data.Int as Int
+import Data.Lens (Lens', over, (%~), (.~), (^.))
+import Data.Lens.Record (prop)
+import Data.Maybe (Maybe(..), fromJust)
+import Data.Newtype (class Newtype)
+import Data.Number as Num
+import Data.Sequence as Seq
+import Data.Set (Set)
+import Data.Set as Set
+import Data.Symbol (SProxy(..))
+import Data.Traversable (for_)
+import Data.Tuple.Nested ((/\))
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
+import Gargantext.Hooks.Sigmax.Types as Sigmax
+import Gargantext.Hooks.Sigmax.Sigmajs (CameraProps, SigmaNode, cameras, getCameraProps, goTo, pauseForceAtlas2, sigmaOnMouseMove)
+import Gargantext.Components.GraphExplorer.Types (Cluster(..), MetaData(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
+import Gargantext.Components.GraphExplorer.Controls as Controls
+import Gargantext.Components.GraphExplorer.Legend (legend)
+import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
+import Gargantext.Components.Login.Types (AuthData(..), TreeId)
+import Gargantext.Components.RandomText (words)
+import Gargantext.Components.Graph as Graph
+import Gargantext.Components.Tree as Tree
+import Gargantext.Config as Config
+import Gargantext.Config.REST (get)
+import Gargantext.Pages.Corpus.Graph.Tabs as GT
+import Gargantext.Types (class Optional)
+import Gargantext.Utils (toggleSet)
+import Gargantext.Utils.Reactix (scuff)
+import Partial.Unsafe (unsafePartial)
+import Unsafe.Coerce (unsafeCoerce)
+import Web.HTML (window)
+import Web.HTML.Window (localStorage)
+import Web.Storage.Storage (getItem)
+import Reactix as R
+import Reactix.DOM.HTML as RH
+
+type Props = ()
+
+explorer :: forall s fa2. Record (Props s fa2) -> R.Element
+explorer props = R.createElement explorerCpt props []
+
+explorerCpt :: forall s fa2. R.Component (Props s fa2)
+explorerCpt = R.hooksComponent "Explorer" cpt
+  where
+    cpt props _ = do
+      controls <- Controls.useGraphControls
+      pure $
+        outer
+        [ inner
+          [ row1
+            [ col [ pullLeft [ Toggle.treeTogglebutton controls.showTree ] ]
+            , col [ Toggle.controlsToggleButton controls.showControls ]
+            , col [ pullRight [ Toggle.sidePanelToggleButton controls.showSidePanel ] ]
+            ]
+          , row [ Controls.controls controls ]
+          , row [ graph controls, sidebar controls ]
+          , row [ ]
+          ]
+        ]
+    outer = RH.div { className: "col-md-9" }
+    inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } }
+    row1 = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } }
+    row = RH.div { className: "row" }
+    col = RH.div { className: "col-md-4" }
+    pullLeft = RH.div { className: "pull-left" }
+    pullRight = RH.div { className: "pull-right" }
+    sidebar _ = RH.div {} []
+    graph _ = RH.div {} []
+
+convert :: GraphData -> Graph.Graph
+convert (GraphData r) = Sigmax.Graph {nodes, edges}
+  where
+    nodes = foldMapWithIndex nodeFn r.nodes
+    nodeFn i (Node n) =
+      Seq.singleton
+        { id    : n.id_
+        , size  : toNumber n.size
+        , label : n.label
+        , x     : n.x -- cos (toNumber i)
+        , y     : n.y -- sin (toNumber i)
+        , color : intColor (cDef n.attributes)
+        }
+      where
+        cDef (Cluster {clustDefault}) = clustDefault
+    edges = foldMap edgeFn r.edges
+    edgeFn (Edge e) = Seq.singleton {id : e.id_, source : e.source, target : e.target}
+
+defaultPalette :: Array String
+defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#33c8f3","#739e9a","#caeca3","#f6f7e5","#f9bcca","#ccb069","#c9ffde","#c58683","#6c9eb0","#ffd3cf","#ccffc7","#52a1b0","#d2ecff","#99fffe","#9295ae","#5ea38b","#fff0b3","#d99e68"]
+
+-- clusterColor :: Cluster -> Color
+-- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `mod` length defaultPalette)
+
+
+intColor :: Int -> String
+intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaultPalette)
+
+
+
+
+
+getNodes :: Int -> Aff GraphData
+getNodes graphId = get $ Config.toUrl Config.Back Config.Graph $ Just graphId
+
+getAuthData :: Effect (Maybe AuthData)
+getAuthData = do
+  w  <- window
+  ls <- localStorage w
+  mto <- getItem "token" ls
+  mti <- getItem "tree_id" ls
+  pure do
+    token <- mto
+    tree_id <- Int.fromString =<< mti
+    pure $ AuthData {token, tree_id}
+

src/Gargantext/Components/GraphExplorer/Controls.purs

+module Gargantext.Components.GraphExplorer.Controls
+ ( Controls, useGraphControls, controls, controlsCpt
+ , getShowTree, setShowTree
+ , getShowControls, setShowControls
+ , getShowSidePanel, setShowSidePanel
+ , getShowEdges, setShowEdges
+ , getCursorSize, setCursorSize
+ , getLabelSize, setLabelSize
+ , getNodeSize, setNodeSize
+ , getMultiNodeSelect, setMultiNodeSelect
+ ) where
+
+import Reactix as R
+import Reactix.DOM.HTML as RH
+
+
+type Controls =
+  ( showTree :: R.State Boolean
+  , showControls :: R.State Boolean
+  , showSidePanel :: R.State Boolean
+  , showEdges :: R.State Boolean
+  , cursorSize :: R.State Number
+  , labelSize :: R.State Number
+  , nodeSize :: R.State Number
+  , multiNodeSelect :: R.Ref Boolean
+  )
+
+controls = Record Controls -> R.Element
+controls props = R.createElement controlsCpt props []
+
+controlsCpt :: R.Component Controls
+controlsCpt = R.hooksComponent "GraphControls" cpt
+  where
+    cpt props _ =
+      case getShowControls props of
+        false -> pure $ RH.div {} []
+        true -> do
+          RH.div { className: "col-md-12", style: { paddingBottom: "10px" } }
+          [ menu { id: "toolbar" }
+            [ RH.ul {}
+              [ -- change type button (?)
+                RH.li {} [ edgesToggleButton props.showEdges ]
+                -- change level
+                -- file upload
+                -- run demo
+                -- search button
+                -- search topics
+                -- cursor size: 0-100
+                -- labels size: 1-4
+                -- node size : 5-15
+                -- edge size : ??
+                -- zoom: 0 -100 - calculate ratio
+                -- toggle multi node selection
+                -- spatialization (pause ForceAtlas2)
+                -- save button
+              ]
+            ]
+          ]
+
+useGraphControls :: R.Hooks (Record Controls)
+useGraphControls = do
+  showTree <- R.useState' false
+  showControls <- R.useState' false
+  showSidePanel <- R.useState' false
+  showEdges <- R.useState' true
+  cursorSize <- R.useState' 10
+  labelSize <- R.useState' 3
+  nodeSize <- R.useState' 10
+  multiNodeSelect <- R.useRef false
+  pure { showTree, showControls, showSidePanel, showEdges, cursorSize, labelSize, nodeSize, multiNodeSelect }
+  
+getShowTree :: Controls -> Boolean
+getShowTree { showTree: ( should /\ _ ) } = should
+
+getShowControls :: Controls -> Boolean
+getShowControls { showControls: ( should /\ _ ) } = should
+
+getShowSidePanel :: Controls -> Boolean
+getShowSidePanel { showSidePanel: ( should /\ _ ) } = should
+
+getShowEdges :: Controls -> Boolean
+getShowEdges { showEdges: ( should /\ _ ) } = should 
+
+getCursorSize :: Controls -> Number
+getCursorSize { cursorSize: ( size /\ _ ) } = size
+
+getLabelSize :: Controls -> Number
+getLabelSize { labelSize: ( size /\ _ ) } = size
+
+getNodeSize :: Controls -> Number
+getNodeSize { nodeSize: ( size /\ _ ) } = size
+
+getMultiNodeSelect :: Controls -> Boolean
+getMultiNodeSelect { multiNodeSelect } = R.readRef multiNodeSelect
+
+setShowTree :: Controls -> Boolean -> Effect Unit
+setShowTree { showTree: ( _ /\ set ) } = set
+
+setShowControls :: Controls -> Boolean -> Effect Unit
+setShowControls { showControls: ( _ /\ set ) } = set
+
+setShowSidePanel :: Controls -> Boolean -> Effect Unit
+setShowSidePanel { showSidePanel: ( _ /\ set ) } = set
+
+setShowEdges :: Controls -> Boolean -> Effect Unit
+setShowEdges { showEdges: ( _ /\ set ) } = set
+
+setCursorSize :: Controls -> Number -> Effect Unit
+setCursorSize { cursorSize: ( _ /\ setSize ) } = setSize
+
+setLabelSize :: Controls -> Number -> Effect Unit
+setLabelSize { labelSize: ( _ /\ setSize) } = setSize
+
+setNodeSize :: Controls -> Number -> Effect Unit
+setNodeSize { nodeSize: ( _ /\ setSize ) } = setSize
+
+setMultiNodeSelect :: Controls -> Boolean -> Effect Unit
+setMultiNodeSelect { multiNodeSelect } = R.setRef multiNodeSelect

src/Gargantext/Components/GraphExplorer/ControlsToggleButton.purs

+module Gargantext.Components.GraphExplorer.ControlsToggleButton
+  ( Props, controlsToggleButton, controlsToggleButtonCpt
+  ) where
+
+import Prelude (bind, pure, ($))
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+type Props = ( state :: R.State Boolean )
+
+controlsToggleButton :: Record Props -> R.Element
+controlsToggleButton props = R.createElement controlsToggleButtonCpt props []
+  
+controlsToggleButtonCpt :: R.Component Props
+controlsToggleButtonCpt = R.hooksComponent "GraphControlsToggleButton" cpt
+  where
+    cpt {state} _ = do
+      let (open /\ setOpen) = state
+      pure $
+        RH.button
+          { className: "btn btn-primary", on: {click: \_ -> setOpen not } }
+          [ RH.text (text open) ]
+    text true = "Hide Controls"
+    text false = "Show Controls"

src/Gargantext/Components/GraphExplorer/Legend.purs

+module Gargantext.Components.GraphExplorer.Legend
+  ( Props, legend, legendCpt
+  ) where
+
+import Data.Seq (Seq)
+import Data.Seq as Seq
+import Data.Traversable (foldMap)
+import Reactix as R
+import Reactix.DOM.HTML as RH
+import Gargantext.Components.GraphExplorer.Types (Cluster(..), MetaData(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData, intColor)
+
+type Props = ( items :: Seq Legend )
+
+legend :: Record Props -> R.Element
+legend props = R.createElement legendCpt props []
+
+legendCpt :: R.Component Props
+legendCpt = R.hooksComponent "Legend" cpt
+  where
+    cpt {items} _ = pure $ RH.div {} (foldMap entry items)
+
+entry :: Legend -> R.Element
+entry (Legend {id_, label}) =
+  RH.p {}
+  [ RH.span { style: { width: 10, height: 10, backgroundColor: intColor id_, display: "inline-block" } } []
+  , RH.text # " " <> label
+    

src/Gargantext/Components/GraphExplorer/ToggleButton.purs

+module Gargantext.Components.GraphExplorer.ToggleButton
+  ( Props, toggleButton, toggleButtonCpt
+  , treeToggleButton
+  , controlsToggleButton
+  , sidebarToggleButton
+  , edgesToggleButton
+  ) where
+
+import Prelude (bind, pure, ($))
+import Reactix as R
+import Reactix.HTML as H
+
+type Props = ( state :: R.State Boolean, onMessage :: String, offMessage :: String )
+
+toggleButton :: Record Props -> R.Element
+toggleButton props = R.createElement toggleButtonCpt props []
+  
+toggleButtonCpt :: R.Component Props
+toggleButtonCpt = R.hooksComponent "ToggleButton" cpt
+  where
+    cpt {state, onMessage, offMessage} _ = do
+      let (toggled /\ setToggled) = state
+      pure $
+        RH.button
+          { className: "btn btn-primary", on: {click: \_ -> setToggled not } }
+          [ RH.text (text onMessage offMessage toggled) ]
+    text on _off true = on
+    text _on off false = off
+
+treeToggleButton :: R.State Boolean -> R.Element
+treeToggleButton state =
+  toggleButton { state: state, onMessage: "Hide Tree", offMessage: "Show Tree" }
+
+controlsToggleButton :: R.State Boolean -> R.Element
+controlsToggleButton state =
+  toggleButton { state: state, onMessage: "Hide Controls", offMessage: "Show Controls" }
+
+sidebarToggleButton :: R.State Boolean -> R.Element
+sidebarToggleButton state =
+  toggleButton { state: state, onMessage: "Hide Sidebar", offMessage: "Show Sidebar" }
+
+edgesToggleButton :: R.State Boolean -> R.Element
+edgesToggleButton state =
+  toggleButton { state: state, onMessage: "Hide Edges", offMessage: "Show Edges" }
+

src/Gargantext/Components/GraphExplorer/Types.purs

@@ -136,3 +136,14 @@ getLegendData (GraphData {nodes, edges, metaData}) = getLegend metaData
     getLegend Nothing  = []
 
 
+defaultPalette :: Array String
+defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#33c8f3","#739e9a","#caeca3","#f6f7e5","#f9bcca","#ccb069","#c9ffde","#c58683","#6c9eb0","#ffd3cf","#ccffc7","#52a1b0","#d2ecff","#99fffe","#9295ae","#5ea38b","#fff0b3","#d99e68"]
+
+-- clusterColor :: Cluster -> Color
+-- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `mod` length defaultPalette)
+
+
+intColor :: Int -> String
+intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaultPalette)
+
+  

src/Gargantext/Hooks/Sigmax.purs

@@ -153,6 +153,7 @@ useForceAtlas2 sigma settings =
     effect _ = dependOnSigma sigma sigmaNotFoundMsg withSigma
     withSigma sig = do
       log startingMsg
+      log sigma
       Sigma.startForceAtlas2 sig settings
       cleanupFirst sigma (Sigma.killForceAtlas2 sig)
     startingMsg = "[Graph] Starting ForceAtlas2"

src/Gargantext/Pages/Corpus/Graph.purs

@@ -49,13 +49,8 @@ import Web.Storage.Storage (getItem)
 data Action
   = LoadGraph Int
   | SelectNode SelectedNode
-  | ShowSidePanel Boolean
-  | ToggleControls
-  | ToggleTree
   | ChangeLabelSize Number
   | ChangeNodeSize Number
-  | DisplayEdges
-  | ToggleMultiNodeSelection
   | ChangeCursorSize Number
 --  | Zoom Boolean
 
@@ -68,15 +63,6 @@ derive instance ordSelectedNode :: Ord SelectedNode
 instance showSelectedNode :: Show SelectedNode where
   show (SelectedNode node) = node.label
 
-_cursorSize :: forall s a. Lens' { cursorSize :: a | s } a
-_cursorSize = prop (SProxy :: SProxy "cursorSize")
-
-_multiNodeSelection :: forall s a. Lens' { multiNodeSelection :: a | s } a
-_multiNodeSelection = prop (SProxy :: SProxy "multiNodeSelection")
-
--- _sigmaSettings :: forall s t a b. Lens { settings :: a | s } { settings :: b | t } a b
-_sigmaSettings :: forall s a. Lens' { sigmaSettings :: a | s } a
-_sigmaSettings = prop (SProxy :: SProxy "sigmaSettings")
 
 _labelSizeRatio' :: forall s a. Lens' { labelSizeRatio :: a | s } a
 _labelSizeRatio' = prop (SProxy :: SProxy "labelSizeRatio")
@@ -96,12 +82,6 @@ _minNodeSize' = prop (SProxy :: SProxy "minNodeSize")
 _minNodeSize :: Lens' {|Graph.SigmaSettings} Number
 _minNodeSize f = unsafeCoerce $ _minNodeSize' f
 
-_drawEdges' :: forall s a. Lens' { drawEdges :: a | s} a
-_drawEdges' = prop (SProxy :: SProxy "drawEdges")
-
-_drawEdges :: Lens' {|Graph.SigmaSettings} Boolean
-_drawEdges f = unsafeCoerce $ _drawEdges' f
-
 numberTargetValue :: SyntheticUIEvent -> Number
 numberTargetValue e =
   unsafePartial (fromJust (Num.fromString ((unsafeCoerce (unsafePerformEffect (target e))).value)))
@@ -170,16 +150,6 @@ performAction (SelectNode selectedNode@(SelectedNode node)) _ (State state) =
                               (if s.multiNodeSelection then s.selectedNodes
                                                        else Set.empty) }
 
-performAction (ShowSidePanel b) _ (State state) = void do
-  modifyState $ \(State s) -> State s {showSidePanel = b }
-
-
-performAction (ToggleControls) _ (State state) = void do
-  modifyState $ \(State s) -> State s {showControls = not (state.showControls) }
-
-performAction (ToggleTree) _ (State state) = void do
-  modifyState $ \(State s) -> State s {showTree = not (state.showTree) }
-
 performAction (ChangeLabelSize size) _ _ =
   modifyState_ $ \(State s) ->
     State $ ((_sigmaSettings <<< _labelSizeRatio) .~ size) s
@@ -256,15 +226,6 @@ render d p (State {sigmaGraphData, settings, legendData}) c =
 
 
 
-defaultPalette :: Array String
-defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#33c8f3","#739e9a","#caeca3","#f6f7e5","#f9bcca","#ccb069","#c9ffde","#c58683","#6c9eb0","#ffd3cf","#ccffc7","#52a1b0","#d2ecff","#99fffe","#9295ae","#5ea38b","#fff0b3","#d99e68"]
-
--- clusterColor :: Cluster -> Color
--- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `mod` length defaultPalette)
-
-
-intColor :: Int -> String
-intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaultPalette)
 
 -- modCamera0 :: forall o. Optional o CameraProps =>
 --               (Record CameraProps -> Record o) -> Effect Unit
@@ -273,12 +234,6 @@ intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaul
 --   for_ (cameras s !! 0) $ \cam ->
 --     void $ goTo cam (f $ getCameraProps cam)
 
-dispLegend :: Array Legend -> ReactElement
-dispLegend ary = div [] $ map dl ary
-  where
-    dl (Legend {id_, color, label}) =
-      p []
-      [ span [style {width : 10, height : 10, backgroundColor : intColor id_ , display: "inline-block"}] []
       , text $ " " <> label
       ]
 
@@ -314,8 +269,7 @@ specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
     render' :: Render State {} Action
     render' d _ (State st@{sigmaSettings, graphData: GraphData {sides,metaData  }}) _ =
       [ div [className "container-fluid", style {paddingTop : "90px" }]
-      [ {-div [ className "row"]
-        [ h2 [ style {textAlign : "center", position : "relative", top: "-1px"}]
+        [ {-div [ className "row"]
           [-- :  MetaData {title}
             case metaData of
               Just( MetaData {title }) ->
@@ -323,30 +277,11 @@ specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
               Nothing ->
                 text "Title"
           ]
-        ]
-        , -} div [className "row", style {paddingBottom : "10px", marginTop : "-24px"}]
-      [
-           div [className "col-md-4"]
-           [
-            ]
-          , div [className "col-md-4"]
-           [
-             button [className "btn btn-primary center-block"
-             , onClick \_ -> d ToggleControls
-             ]
-             [text $ if st.showControls then "Hide Controls" else "Show Controls"]
 
-            ]
-          , div [className "col-md-4"]
-          [ div [className "pull-right"]
-            [ button [className "btn btn-primary"
-               ,onClick \_ -> d $ ShowSidePanel $ not st.showSidePanel
-               ] [text $ if st.showSidePanel then "Hide Side Panel" else "Show Side Panel"]
-            ]
-          ]
-      ],
-      div [className "row"]
-      [
+]
+        , -}
+          div [className "row"]
+          [
            if (st.showControls) then
               div [className "col-md-12", style {"padding-bottom" : "10px"}]
             [ menu [_id "toolbar"]
@@ -354,13 +289,6 @@ specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
                 [
                 --  li' [ button [className "btn btn-success btn-sm"] [text "Change Type"] ]
                 -- ,
-                  li'
-                  [ button [
-                         className "btn btn-primary btn-sm"
-                       , onClick \_ -> d DisplayEdges
-                           ]
-                    [text "Toggle Edges"]
-                  ]
                 -- , li' [ button [className "btn btn-primary btn-sm"] [text "Change Level"] ]
                 {- ,li [style {display : "inline-block"}]
                   [ form'
@@ -601,16 +529,3 @@ specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
          ]
       ]
 
-getNodes :: Int -> Aff GraphData
-getNodes graphId = get $ Config.toUrl Config.Back Config.Graph $ Just graphId
-
-getAuthData :: Effect (Maybe AuthData)
-getAuthData = do
-  w  <- window
-  ls <- localStorage w
-  mto <- getItem "token" ls
-  mti <- getItem "tree_id" ls
-  pure do
-    token <- mto
-    tree_id <- Int.fromString =<< mti
-    pure $ AuthData {token, tree_id}