[GraphExplorer] Camera in separate module, fixes to updating and centering it

src/Gargantext/Components/GraphExplorer/GraphTypes.purs

+module Gargantext.Components.GraphExplorer.GraphTypes where
+
+import Gargantext.Prelude
+
+import Data.Eq.Generic (genericEq)
+import Data.Generic.Rep (class Generic)
+import Data.Maybe (Maybe(..), fromJust)
+import Data.Newtype (class Newtype)
+import Data.Ord.Generic (genericCompare)
+import Data.Show.Generic (genericShow)
+import Partial.Unsafe (unsafePartial)
+import Record as Record
+import Simple.JSON as JSON
+import Type.Proxy (Proxy(..))
+
+
+newtype Cluster = Cluster { clustDefault :: Int }
+
+derive instance Generic Cluster _
+derive instance Newtype Cluster _
+instance Eq Cluster where eq = genericEq
+instance JSON.ReadForeign Cluster where
+  readImpl f = do
+    inst <- JSON.readImpl f
+    pure $ Cluster $ Record.rename clust_defaultP clustDefaultP inst
+instance JSON.WriteForeign Cluster where
+  writeImpl (Cluster cl) = JSON.writeImpl $ Record.rename clustDefaultP clust_defaultP cl
+
+newtype ClusterCount = ClusterCount
+  { id    :: Int
+  , count :: Int
+  }
+derive instance Generic ClusterCount _
+derive instance Newtype ClusterCount _
+
+
+newtype Node = Node {
+    attributes :: Cluster
+  , children   :: Array String
+  , id_        :: String
+  , label      :: String
+  , size       :: Int
+  , type_      :: String
+  , x          :: Number
+  , y          :: Number
+  }
+
+x_coordP = Proxy :: Proxy "x_coord"
+xP = Proxy :: Proxy "x"
+y_coordP = Proxy :: Proxy "y_coord"
+yP = Proxy :: Proxy "y"
+clustDefaultP = Proxy :: Proxy "clustDefault"
+clust_defaultP = Proxy :: Proxy "clust_default"
+cameraP = Proxy :: Proxy "camera"
+mCameraP = Proxy :: Proxy "mCamera"
+idP = Proxy :: Proxy "id"
+id_P = Proxy :: Proxy "id_"
+typeP = Proxy :: Proxy "type"
+type_P = Proxy :: Proxy "type_"
+
+derive instance Generic Node _
+derive instance Newtype Node _
+instance Eq Node where eq = genericEq
+instance Ord Node where compare (Node n1) (Node n2) = compare n1.id_ n2.id_
+instance JSON.ReadForeign Node where
+  readImpl f = do
+    inst <- JSON.readImpl f
+    pure $ Node $
+      Record.rename idP id_P $
+      Record.rename typeP type_P $
+      Record.rename x_coordP xP $
+      Record.rename y_coordP yP $ inst
+instance JSON.WriteForeign Node where
+  writeImpl (Node nd) = JSON.writeImpl $
+                        Record.rename id_P idP $
+                        Record.rename type_P typeP $
+                        Record.rename xP x_coordP $
+                        Record.rename yP y_coordP nd
+
+
+newtype Edge = Edge {
+    confluence :: Number
+  , id_ :: String
+  , source :: String
+  , target :: String
+  , weight :: Number
+  }
+
+
+derive instance Generic Edge _
+derive instance Newtype Edge _
+instance Eq Edge where eq = genericEq
+instance Ord Edge where compare (Edge e1) (Edge e2) = compare e1.id_ e2.id_
+instance JSON.ReadForeign Edge where
+  readImpl f = do
+    inst <- JSON.readImpl f
+    pure $ Edge $ Record.rename idP id_P inst
+instance JSON.WriteForeign Edge where
+  writeImpl (Edge ed) = JSON.writeImpl $ Record.rename id_P idP ed

src/Gargantext/Components/GraphExplorer/Layout.purs

@@ -17,6 +17,7 @@ import Effect (Effect)
 import Gargantext.Components.App.Store as AppStore
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.GraphExplorer.Frame.DocFocus (docFocus)
+import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
 import Gargantext.Components.GraphExplorer.Resources as Graph
 import Gargantext.Components.GraphExplorer.Sidebar as GES
 import Gargantext.Components.GraphExplorer.Store as GraphStore
@@ -289,7 +290,7 @@ convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph
 convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
   where
     nodes = foldMapWithIndex nodeFn r.nodes
-    nodeFn _i nn@(GET.Node n) =
+    nodeFn _i nn@(GEGT.Node n) =
       Seq.singleton {
           borderColor: color
         , children: n.children
@@ -307,12 +308,12 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
         , _original: nn
         }
       where
-        cDef (GET.Cluster {clustDefault}) = clustDefault
+        cDef (GEGT.Cluster {clustDefault}) = clustDefault
         color = GET.intColor (cDef n.attributes)
         gargType =  unsafePartial $ fromJust $ Types.modeFromString n.type_
     nodesMap = SigmaxT.nodesMap nodes
-    edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
-    edgeFn i ee@(GET.Edge e) =
+    edges = foldMapWithIndex edgeFn $ A.sortWith (\(GEGT.Edge {weight}) -> weight) r.edges
+    edgeFn i ee@(GEGT.Edge e) =
       Seq.singleton
         { id : e.id_
         , color

src/Gargantext/Components/GraphExplorer/Resources.purs

@@ -19,6 +19,7 @@ import Gargantext.Components.GraphExplorer.Types as GET
 import Gargantext.Components.Themes (darksterTheme)
 import Gargantext.Components.Themes as Themes
 import Gargantext.Hooks.Sigmax as Sigmax
+import Gargantext.Hooks.Sigmax.Camera as Camera
 import Gargantext.Hooks.Sigmax.Graphology as Graphology
 import Gargantext.Hooks.Sigmax.ForceAtlas2 as ForceAtlas2
 import Gargantext.Hooks.Sigmax.Sigma as Sigma
@@ -148,12 +149,12 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
                     Just fa2 -> ForceAtlas2.stop fa2
 
                 case mCamera of
-                  Just (GET.Camera { ratio, x, y }) -> do
-                    Sigma.updateCamera sig { ratio, x, y }
+                  Just cam -> do
+                    Camera.updateCamera (Camera.camera sig) cam
                   -- Default camera: slightly de-zoom the graph to avoid
                   -- nodes sticking to the container borders
                   Nothing ->
-                    Sigma.updateCamera sig { ratio: 1.1, x: 0.5, y: 0.5 }
+                    Camera.updateCamera (Camera.camera sig) Camera.defaultCamera
 
                 -- Reload Sigma on Theme changes
                 -- TODO

src/Gargantext/Components/GraphExplorer/Sidebar/Legend.purs

@@ -10,6 +10,7 @@ import Data.Sequence (Seq)
 import Data.Set as Set
 import Data.Traversable (foldMap, intercalate)
 import Gargantext.Components.Bootstrap as B
+import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
 import Gargantext.Components.GraphExplorer.Types as GET
 import Gargantext.Hooks.Sigmax.Types as ST
 import Gargantext.Utils (getter, nbsp, (?))
@@ -23,8 +24,8 @@ here = R2.here "Gargantext.Components.GraphExplorer.Sidebar.Legend"
 
 type Props =
   ( legendSeq             :: Seq GET.Legend
-  , extractedNodeList     :: Array GET.Node
-  , nodeCountList         :: Array GET.ClusterCount
+  , extractedNodeList     :: Array GEGT.Node
+  , nodeCountList         :: Array GEGT.ClusterCount
   , selectedNodeIds       :: T.Box ST.NodeIds
   )
 
@@ -76,7 +77,7 @@ legendCpt = here.component "legend" cpt where
           ]
       ]
 
-filterByCluster :: Int -> Array GET.Node -> Array GET.Node
+filterByCluster :: Int -> Array GEGT.Node -> Array GEGT.Node
 filterByCluster id
   =   A.filter
       (   getter _.attributes
@@ -84,7 +85,7 @@ filterByCluster id
       >>> eq id
       )
 
-getClusterNodeCount :: Array GET.ClusterCount -> Int -> Int
+getClusterNodeCount :: Array GEGT.ClusterCount -> Int -> Int
 getClusterNodeCount nodeCountList id
   =   nodeCountList
   #   A.find
@@ -98,7 +99,7 @@ getClusterNodeCount nodeCountList id
 ---------------------------------------------------------
 
 type SelectedNodesProps =
-  ( extractedNodeList     :: Array GET.Node
+  ( extractedNodeList     :: Array GEGT.Node
   , selectedNodeIds       :: T.Box ST.NodeIds
   , clusterId             :: Int
   , nodeCount             :: Int
@@ -146,7 +147,7 @@ selectedNodesCpt = here.component "selectedNodes" cpt where
       { className: "graph-legend-nodes" }
       [
         flip foldMap (filterByCluster clusterId extractedNodeList)
-        \(GET.Node { label: nodeLabel, id_: nodeId }) ->
+        \(GEGT.Node { label: nodeLabel, id_: nodeId }) ->
 
           H.li
           { className: "graph-legend-nodes__item" }

src/Gargantext/Components/GraphExplorer/Toolbar/Buttons.purs

@@ -32,6 +32,7 @@ import Gargantext.Components.GraphExplorer.Resources as Graph
 import Gargantext.Components.GraphExplorer.Types as GET
 import Gargantext.Components.GraphExplorer.Utils as GEU
 import Gargantext.Hooks.Sigmax as Sigmax
+import Gargantext.Hooks.Sigmax.Camera as Camera
 import Gargantext.Hooks.Sigmax.Graphology as Graphology
 import Gargantext.Hooks.Sigmax.Sigma as Sigma
 import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
@@ -54,7 +55,7 @@ centerButton sigmaRef = B.button
   , callback: \_ -> do
       let sigma = R.readRef sigmaRef
       Sigmax.dependOnSigma sigma "[centerButton] sigma: Nothing" $ \s ->
-        Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
+        Camera.updateCamera (Camera.camera s) Camera.defaultCamera
   }
   [ H.text "Center" ]
 
@@ -96,10 +97,7 @@ cameraButton { id
             nodes = Graphology.nodes graph
             graphData = GET.GraphData $ hyperdataGraph { edges = A.fromFoldable $ Seq.map GEU.stEdgeToGET edges
                                                        , nodes = A.fromFoldable $ GEU.normalizeNodes $ Seq.map GEU.stNodeToGET nodes }
-        let cameras = map Sigma.toCamera $ Sigma.cameras s
-        let camera = case cameras of
-              [c] -> GET.Camera { ratio: c.ratio, x: c.x, y: c.y }
-              _   -> GET.Camera { ratio: 1.0, x: 0.0, y: 0.0 }
+        let camera = Camera.toCamera $ Camera.camera s
         let hyperdataGraph' = GET.HyperdataGraph { graph: graphData, mCamera: Just camera }
         launchAff_ $ do
           eClonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session }

src/Gargantext/Components/GraphExplorer/Types.purs

@@ -12,91 +12,13 @@ import Data.Show.Generic (genericShow)
 import Partial.Unsafe (unsafePartial)
 import Record as Record
 import Simple.JSON as JSON
+import Gargantext.Components.GraphExplorer.GraphTypes
+import Gargantext.Hooks.Sigmax.Camera (Camera(..))
 import Type.Proxy (Proxy(..))
 
 type GraphId = Int
 
-newtype Node = Node {
-    attributes :: Cluster
-  , children   :: Array String
-  , id_        :: String
-  , label      :: String
-  , size       :: Int
-  , type_      :: String
-  , x          :: Number
-  , y          :: Number
-  }
-
-x_coordP = Proxy :: Proxy "x_coord"
-xP = Proxy :: Proxy "x"
-y_coordP = Proxy :: Proxy "y_coord"
-yP = Proxy :: Proxy "y"
-clustDefaultP = Proxy :: Proxy "clustDefault"
-clust_defaultP = Proxy :: Proxy "clust_default"
-cameraP = Proxy :: Proxy "camera"
-mCameraP = Proxy :: Proxy "mCamera"
-idP = Proxy :: Proxy "id"
-id_P = Proxy :: Proxy "id_"
-typeP = Proxy :: Proxy "type"
-type_P = Proxy :: Proxy "type_"
-
-derive instance Generic Node _
-derive instance Newtype Node _
-instance Eq Node where eq = genericEq
-instance Ord Node where compare (Node n1) (Node n2) = compare n1.id_ n2.id_
-instance JSON.ReadForeign Node where
-  readImpl f = do
-    inst <- JSON.readImpl f
-    pure $ Node $
-      Record.rename idP id_P $
-      Record.rename typeP type_P $
-      Record.rename x_coordP xP $
-      Record.rename y_coordP yP $ inst
-instance JSON.WriteForeign Node where
-  writeImpl (Node nd) = JSON.writeImpl $
-                        Record.rename id_P idP $
-                        Record.rename type_P typeP $
-                        Record.rename xP x_coordP $
-                        Record.rename yP y_coordP nd
-
-
-newtype Cluster = Cluster { clustDefault :: Int }
-
-derive instance Generic Cluster _
-derive instance Newtype Cluster _
-instance Eq Cluster where eq = genericEq
-instance JSON.ReadForeign Cluster where
-  readImpl f = do
-    inst <- JSON.readImpl f
-    pure $ Cluster $ Record.rename clust_defaultP clustDefaultP inst
-instance JSON.WriteForeign Cluster where
-  writeImpl (Cluster cl) = JSON.writeImpl $ Record.rename clustDefaultP clust_defaultP cl
-
-newtype ClusterCount = ClusterCount
-  { id    :: Int
-  , count :: Int
-  }
-derive instance Generic ClusterCount _
-derive instance Newtype ClusterCount _
-
-newtype Edge = Edge {
-    confluence :: Number
-  , id_ :: String
-  , source :: String
-  , target :: String
-  , weight :: Number
-  }
 
-derive instance Generic Edge _
-derive instance Newtype Edge _
-instance Eq Edge where eq = genericEq
-instance Ord Edge where compare (Edge e1) (Edge e2) = compare e1.id_ e2.id_
-instance JSON.ReadForeign Edge where
-  readImpl f = do
-    inst <- JSON.readImpl f
-    pure $ Edge $ Record.rename idP id_P inst
-instance JSON.WriteForeign Edge where
-  writeImpl (Edge ed) = JSON.writeImpl $ Record.rename id_P idP ed
 
 -- | A 'fully closed interval' in CS parlance
 type InclusiveRange t = { min :: t, max :: t }
@@ -246,18 +168,6 @@ instance Show SideTab where
   show SideTabData      = "Data"
   show SideTabCommunity = "Community"
 
-
-newtype Camera =
-  Camera { ratio :: Number
-         , x     :: Number
-         , y     :: Number
-         }
-derive instance Generic Camera _
-derive instance Newtype Camera _
-instance Eq Camera where eq = genericEq
-derive newtype instance JSON.ReadForeign Camera
-derive newtype instance JSON.WriteForeign Camera
-
 newtype HyperdataGraph = HyperdataGraph {
     graph   :: GraphData
   , mCamera :: Maybe Camera

src/Gargantext/Components/GraphExplorer/Utils.purs

@@ -11,16 +11,17 @@ import Data.Foldable (maximum, minimum)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (wrap)
 import Data.Sequence as Seq
+import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
 import Gargantext.Components.GraphExplorer.Types as GET
 import Gargantext.Hooks.Sigmax.Types as ST
 import Gargantext.Utils (getter)
 import Gargantext.Utils.Seq as GUS
 
-stEdgeToGET :: Record ST.Edge -> GET.Edge
+stEdgeToGET :: Record ST.Edge -> GEGT.Edge
 stEdgeToGET { _original } = _original
 
-stNodeToGET :: Record ST.Node -> GET.Node
-stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } } = GET.Node {
+stNodeToGET :: Record ST.Node -> GEGT.Node
+stNodeToGET { id, label, x, y, _original: GEGT.Node { attributes, size, type_ } } = GEGT.Node {
     attributes
   , children: []
   , id_: id
@@ -33,11 +34,11 @@ stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } }
 
 -----------------------------------------------------------------------
 
-normalizeNodes :: Seq.Seq GET.Node -> Seq.Seq GET.Node
+normalizeNodes :: Seq.Seq GEGT.Node -> Seq.Seq GEGT.Node
 normalizeNodes ns = Seq.map normalizeNode ns
   where
-    xs = map (\(GET.Node { x }) -> x) ns
-    ys = map (\(GET.Node { y }) -> y) ns
+    xs = map (\(GEGT.Node { x }) -> x) ns
+    ys = map (\(GEGT.Node { y }) -> y) ns
     mMinx = minimum xs
     mMaxx = maximum xs
     mMiny = minimum ys
@@ -56,12 +57,12 @@ normalizeNodes ns = Seq.map normalizeNode ns
     ydivisor = case mYrange of
       Nothing -> 1.0
       Just ydiv -> 1.0 / ydiv
-    normalizeNode (GET.Node n@{ x, y }) = GET.Node $ n { x = x * xdivisor
+    normalizeNode (GEGT.Node n@{ x, y }) = GEGT.Node $ n { x = x * xdivisor
                                                          , y = y * ydivisor }
 
 ------------------------------------------------------------------------
 
-takeGreatestNodeByCluster :: GET.HyperdataGraph -> Int -> Int -> Array GET.Node
+takeGreatestNodeByCluster :: GET.HyperdataGraph -> Int -> Int -> Array GEGT.Node
 takeGreatestNodeByCluster graphData take clusterId
   =   graphData
   #   getter _.graph
@@ -77,7 +78,7 @@ takeGreatestNodeByCluster graphData take clusterId
   >>> A.takeEnd take
   >>> A.reverse
 
-countNodeByCluster :: GET.HyperdataGraph -> Int -> GET.ClusterCount
+countNodeByCluster :: GET.HyperdataGraph -> Int -> GEGT.ClusterCount
 countNodeByCluster graphData clusterId
   =   graphData
   #   getter _.graph

src/Gargantext/Hooks/Sigmax/Camera.js

+'use strict';
+
+export function _setState(cam, state) {
+  return cam.setState(state);
+}

src/Gargantext/Hooks/Sigmax/Camera.purs

+module Gargantext.Hooks.Sigmax.Camera where
+
+import Gargantext.Prelude
+
+import Data.Eq.Generic (genericEq)
+import Data.Generic.Rep (class Generic)
+import Data.Newtype (class Newtype)
+import Effect (Effect)
+import Effect.Uncurried (EffectFn2, runEffectFn2)
+import FFI.Simple ((..))
+import Gargantext.Hooks.Sigmax.Sigma as Sigma
+import Simple.JSON as JSON
+
+
+foreign import data CameraInstance' :: Row Type
+type CameraInstance = { | CameraInstance' }
+
+type CameraRow =
+  ( angle :: Number
+  , ratio :: Number
+  , x     :: Number
+  , y     :: Number )
+
+newtype Camera =
+  Camera { |CameraRow }
+derive instance Generic Camera _
+derive instance Newtype Camera _
+instance Eq Camera where eq = genericEq
+derive newtype instance JSON.ReadForeign Camera
+derive newtype instance JSON.WriteForeign Camera
+
+defaultCamera :: Camera
+defaultCamera = Camera { angle: 0.0
+                       , ratio: 1.1
+                       , x: 0.5
+                       , y: 0.5 }
+
+
+camera :: Sigma.Sigma -> CameraInstance
+camera sig = sig .. "camera"
+
+toCamera :: CameraInstance -> Camera
+toCamera c = Camera { angle, ratio, x, y }
+  where
+    angle = c .. "angle" :: Number
+    ratio = c .. "ratio" :: Number
+    x = c .. "x" :: Number
+    y = c .. "y" :: Number
+
+updateCamera :: CameraInstance -> Camera -> Effect Unit
+updateCamera cam (Camera { angle, ratio, x, y }) = runEffectFn2 _setState cam { angle, ratio, x, y }
+
+foreign import _setState :: forall e. EffectFn2 CameraInstance {|CameraRow} Unit

src/Gargantext/Hooks/Sigmax/Sigma.purs

@@ -190,44 +190,19 @@ sigmaEasing =
   , cubicInOut : SigmaEasing "cubicInOut"
   }
 
-type CameraProps =
-  ( x :: Number
-  , y :: Number
-  , ratio :: Number
-  , angle :: Number
-  )
-
-foreign import data CameraInstance' :: Row Type
-type CameraInstance = { | CameraInstance' }
-
--- | Get an array of a sigma instance's `cameras`.
-cameras :: Sigma -> Array CameraInstance
-cameras s = Object.values cs
-  where
-    -- For some reason, `sigma.cameras` is an object with integer keys.
-    cs = s .. "cameras" :: Object.Object CameraInstance
-
-toCamera :: CameraInstance -> Record CameraProps
-toCamera c = { angle, ratio, x, y }
-  where
-    angle = c .. "angle" :: Number
-    ratio = c .. "ratio" :: Number
-    x = c .. "x" :: Number
-    y = c .. "y" :: Number
-
-updateCamera :: Sigma -> { ratio :: Number, x :: Number, y :: Number } -> Effect Unit
-updateCamera sig { ratio, x, y } = do
-  let camera = sig .. "camera"
-  _ <- pure $ (camera .= "ratio") ratio
-  _ <- pure $ (camera .= "x") x
-  _ <- pure $ (camera .= "y") y
-  pure unit
-
-goTo :: Record CameraProps -> CameraInstance -> Effect Unit
-goTo props cam = pure $ cam ... "goTo" $ [props]
-
-goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
-goToAllCameras s props = traverse_ (goTo props) $ cameras s
+-- DEPRECATED
+-- -- | Get an array of a sigma instance's `cameras`.
+-- cameras :: Sigma -> Array CameraInstance
+-- cameras s = Object.values cs
+--   where
+--     -- For some reason, `sigma.cameras` is an object with integer keys.
+--     cs = s .. "cameras" :: Object.Object CameraInstance
+
+-- goTo :: Record CameraProps -> CameraInstance -> Effect Unit
+-- goTo props cam = pure $ cam ... "goTo" $ [props]
+
+-- goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
+-- goToAllCameras s props = traverse_ (goTo props) $ cameras s
 
 takeScreenshot :: Sigma -> Effect String
 takeScreenshot =  runEffectFn1 _takeScreenshot

src/Gargantext/Hooks/Sigmax/Types.purs

@@ -13,7 +13,7 @@ import Data.Tuple (Tuple(..))
 import Partial.Unsafe (unsafePartial)
 import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod, not)
 
-import Gargantext.Components.GraphExplorer.Types as GET
+import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
 import Gargantext.Data.Louvain as Louvain
 import Gargantext.Types as GT
 
@@ -47,7 +47,7 @@ type Node = (
   , type        :: String  -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
   , x           :: Number
   , y           :: Number
-  , _original   :: GET.Node
+  , _original   :: GEGT.Node
   )
 
 type Edge = (
@@ -62,7 +62,7 @@ type Edge = (
   , targetNode :: Record Node
   , weight     :: Number
   , weightIdx  :: Int
-  , _original  :: GET.Edge
+  , _original  :: GEGT.Edge
   )
 
 type NodeIds = Set.Set NodeId