Skip to content

P
purescript-gargantext
Commit 646baddf authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[graph] cloning endpoint works now

parent 024d161d
Show whitespace changes
Inline Side-by-side
Showing with 207 additions and 43 deletions
src/Gargantext/Components/GraphExplorer.purs
View file @ 646baddf
......@@ -50,6 +50,7 @@ type LayoutProps =
type Props = (
graph :: SigmaxT.SGraph
, graphData :: GET.GraphData
, graphVersion :: R.State Int
, mMetaData :: Maybe GET.MetaData
| LayoutProps
......@@ -75,7 +76,7 @@ explorerLayoutView graphVersion p = R.createElement el p []
useLoader graphId (getNodes session graphVersion) handler
where
handler loaded =
explorer (Record.merge props { graph, graphVersion, mMetaData })
explorer (Record.merge props { graph, graphData: loaded, graphVersion, mMetaData })
where (Tuple mMetaData graph) = convert loaded
--------------------------------------------------------------
......@@ -87,6 +88,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where
cpt props@{ frontends
, graph
, graphData
, graphId
, graphVersion
, handed
......@@ -103,7 +105,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
dataRef <- R.useRef graph
graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion)
controls <- Controls.useGraphControls graph graphId session forceAtlasS
controls <- Controls.useGraphControls graph graphData graphId session forceAtlasS
multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
R.useEffect' $ do
......@@ -264,9 +266,9 @@ 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 (GET.Node n) =
Seq.singleton
{ borderColor: color
nodeFn _i nn@(GET.Node n) =
Seq.singleton {
borderColor: color
, color : color
, equilateral: { numPoints: 3 }
, gargType
......@@ -277,6 +279,7 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
, type : modeGraphType gargType
, x : n.x -- cos (toNumber i)
, y : n.y -- sin (toNumber i)
, _original: nn
}
where
cDef (GET.Cluster {clustDefault}) = clustDefault
......@@ -284,7 +287,7 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_
nodesMap = SigmaxT.nodesMap nodes
edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
edgeFn i (GET.Edge e) =
edgeFn i ee@(GET.Edge e) =
Seq.singleton
{ id : e.id_
, color
......@@ -297,6 +300,7 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
, targetNode
, weight : e.weight
, weightIdx: i
, _original: ee
}
where
sourceNode = unsafePartial $ fromJust $ Map.lookup e.source nodesMap
......
src/Gargantext/Components/GraphExplorer/API.purs
View file @ 646baddf
......@@ -2,6 +2,7 @@ module Gargantext.Components.GraphExplorer.API where
import Data.Maybe (Maybe)
import Effect.Aff (Aff)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Hooks.Sigmax.Types as SigmaxT
......@@ -80,3 +81,13 @@ type UpdateGraphVersionsParams =
updateGraphVersions :: Record UpdateGraphVersionsParams -> Aff GET.GraphData
updateGraphVersions { graphId, session } = post session (GR.GraphAPI graphId $ "versions") {}
type CloneGraphParams =
(
graphData :: GET.GraphData
, id :: Int
, session :: Session
)
cloneGraph :: Record CloneGraphParams -> Aff Int
cloneGraph { graphData, id, session } = post session (GR.GraphAPI id $ "clone") graphData
src/Gargantext/Components/GraphExplorer/Button.purs
View file @ 646baddf
......@@ -12,6 +12,7 @@ import Data.Maybe (Maybe(..))
import Data.DateTime as DDT
import Data.DateTime.Instant as DDI
import Data.String as DS
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Now as EN
......@@ -19,6 +20,9 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryDataURL)
import Gargantext.Components.GraphExplorer.API (cloneGraph)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Sessions (Session)
......@@ -53,8 +57,19 @@ centerButton sigmaRef = simpleButton {
}
cameraButton :: Session -> Int -> R.Ref Sigmax.Sigma -> R.Element
cameraButton session id sigmaRef = simpleButton {
type CameraButtonProps = (
id :: Int
, graphData :: GET.GraphData
, session :: Session
, sigmaRef :: R.Ref Sigmax.Sigma
)
cameraButton :: Record CameraButtonProps -> R.Element
cameraButton { id
, graphData: GET.GraphData graphData'
, session
, sigmaRef } = simpleButton {
onClick: \_ -> do
let sigma = R.readRef sigmaRef
Sigmax.dependOnSigma sigma "[cameraButton] sigma: Nothing" $ \s -> do
......@@ -69,7 +84,12 @@ cameraButton session id sigmaRef = simpleButton {
, show $ fromEnum $ DDT.hour nowt
, show $ fromEnum $ DDT.minute nowt
, show $ fromEnum $ DDT.second nowt ]
edges <- Sigmax.getEdges s
nodes <- Sigmax.getNodes s
let graphData = GET.GraphData $ graphData' { edges = map GEU.stEdgeToGET edges
, nodes = map GEU.stNodeToGET nodes }
launchAff_ $ do
_ <- cloneGraph { id, graphData, session }
uploadArbitraryDataURL session id (Just $ nowStr <> "-" <> "screenshot.png") screen
, text: "Screenshot"
}
src/Gargantext/Components/GraphExplorer/Controls.purs
View file @ 646baddf
......@@ -38,6 +38,7 @@ type Controls =
, edgeWeight :: R.State Range.NumberRange
, forceAtlasState :: R.State SigmaxT.ForceAtlasState
, graph :: SigmaxT.SGraph
, graphData :: GET.GraphData
, graphId :: GET.GraphId
, graphStage :: R.State Graph.Stage
, multiSelectEnabled :: R.State Boolean
......@@ -161,13 +162,21 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
, multiSelectEnabled: props.multiSelectEnabled
, selectedNodeIds: props.selectedNodeIds } ]
, RH.li {} [ mouseSelectorSizeButton props.sigmaRef localControls.mouseSelectorSize ]
, RH.li {} [ cameraButton props.session props.graphId props.sigmaRef ]
, RH.li {} [ cameraButton { id: props.graphId
, graphData: props.graphData
, session: props.session
, sigmaRef: props.sigmaRef } ]
]
]
]
useGraphControls :: SigmaxT.SGraph -> GET.GraphId -> Session -> SigmaxT.ForceAtlasState -> R.Hooks (Record Controls)
useGraphControls graph graphId session forceAtlasS = do
useGraphControls :: SigmaxT.SGraph
-> GET.GraphData
-> GET.GraphId
-> Session
-> SigmaxT.ForceAtlasState
-> R.Hooks (Record Controls)
useGraphControls graph graphData graphId session forceAtlasS = do
edgeConfluence <- R.useState' $ Range.Closed { min: 0.0, max: 1.0 }
edgeWeight <- R.useState' $ Range.Closed {
min: 0.0
......@@ -191,6 +200,7 @@ useGraphControls graph graphId session forceAtlasS = do
, edgeWeight
, forceAtlasState
, graph
, graphData
, graphId
, graphStage
, multiSelectEnabled
......
src/Gargantext/Components/GraphExplorer/Types.purs
View file @ 646baddf
module Gargantext.Components.GraphExplorer.Types where
import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), jsonEmptyObject, (~>), (:=))
import Data.Array ((!!), length)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Ord
import Partial.Unsafe (unsafePartial)
import Gargantext.Prelude
type GraphId = Int
newtype Node = Node
{ id_ :: String
newtype Node = Node {
attributes :: Cluster
, id_ :: String
, label :: String
, size :: Int
, type_ :: String
, label :: String
, x :: Number
, y :: Number
, attributes :: Cluster
}
derive instance genericNode :: Generic Node _
derive instance newtypeNode :: Newtype Node _
instance eqNode :: Eq Node where
eq = genericEq
instance ordNode :: Ord Node where
compare (Node n1) (Node n2) = compare n1.id_ n2.id_
newtype Cluster = Cluster { clustDefault :: Int }
derive instance genericCluster :: Generic Cluster _
derive instance newtypeCluster :: Newtype Cluster _
instance eqCluster :: Eq Cluster where
eq = genericEq
newtype Edge = Edge
{ confluence :: Number
newtype Edge = Edge {
confluence :: Number
, id_ :: String
, source :: String
, target :: String
, weight :: Number
}
derive instance genericEdge :: Generic Edge _
derive instance newtypeEdge :: Newtype Edge _
instance eqEdge :: Eq Edge where
eq = genericEq
instance ordEdge :: Ord Edge where
compare (Edge e1) (Edge e2) = compare e1.id_ e2.id_
-- | A 'fully closed interval' in CS parlance
type InclusiveRange t = { min :: t, max :: t }
......@@ -65,6 +82,7 @@ newtype MetaData = MetaData
, list :: { listId :: ListId
, version :: Version
}
, metric :: String -- dummy value
, startForceAtlas :: Boolean
, title :: String
}
......@@ -105,6 +123,7 @@ initialGraphData = GraphData {
corpusId : []
, legend : []
, list: { listId : 0, version : 0 }
, metric: "Order1"
, startForceAtlas: true
, title : ""
}
......@@ -125,6 +144,13 @@ instance decodeJsonGraphData :: DecodeJson GraphData where
let sides = side <$> corpusIds
pure $ GraphData { nodes, edges, sides, metaData }
instance encodeJsonGraphData :: EncodeJson GraphData where
encodeJson (GraphData gd) =
"nodes" := gd.nodes
~> "edges" := gd.edges
~> "metadata" := gd.metaData
~> jsonEmptyObject
instance decodeJsonNode :: DecodeJson Node where
decodeJson json = do
obj <- decodeJson json
......@@ -137,6 +163,17 @@ instance decodeJsonNode :: DecodeJson Node where
y <- obj .: "y_coord"
pure $ Node { id_, type_, size, label, attributes, x, y }
instance encodeJsonNode :: EncodeJson Node where
encodeJson (Node nd) =
"id" := nd.id_
~> "attributes" := nd.attributes
~> "label" := nd.label
~> "size" := nd.size
~> "type" := nd.type_
~> "x_coord" := nd.x
~> "y_coord" := nd.y
~> jsonEmptyObject
instance decodeJsonMetaData :: DecodeJson MetaData where
decodeJson json = do
......@@ -145,6 +182,7 @@ instance decodeJsonMetaData :: DecodeJson MetaData where
corpusId <- obj .: "corpusId"
list <- obj .: "list"
listId <- list .: "listId"
metric <- obj .: "metric"
startForceAtlas <- obj .: "startForceAtlas"
title <- obj .: "title"
version <- list .: "version"
......@@ -152,10 +190,20 @@ instance decodeJsonMetaData :: DecodeJson MetaData where
corpusId
, legend
, list: {listId, version}
, metric
, startForceAtlas
, title
}
instance encodeJsonMetaData :: EncodeJson MetaData where
encodeJson (MetaData md) =
"corpusId" := md.corpusId
~> "legend" := md.legend
~> "list" := md.list
~> "metric" := md.metric
~> "startForceAtlas" := md.startForceAtlas
~> "title" := md.title
~> jsonEmptyObject
instance decodeJsonLegend :: DecodeJson Legend where
decodeJson json = do
......@@ -165,6 +213,13 @@ instance decodeJsonLegend :: DecodeJson Legend where
label <- obj .: "label"
pure $ Legend { id_, color, label }
instance encodeJsonLegend :: EncodeJson Legend where
encodeJson (Legend lg) =
"id" := lg.id_
~> "color" := lg.color
~> "label" := lg.label
~> jsonEmptyObject
instance decodeJsonCluster :: DecodeJson Cluster where
decodeJson json = do
......@@ -172,6 +227,11 @@ instance decodeJsonCluster :: DecodeJson Cluster where
clustDefault <- obj .: "clust_default"
pure $ Cluster { clustDefault }
instance encodeJsonCluster :: EncodeJson Cluster where
encodeJson (Cluster cl) =
"clust_default" := cl.clustDefault
~> jsonEmptyObject
instance decodeJsonEdge :: DecodeJson Edge where
decodeJson json = do
obj <- decodeJson json
......@@ -182,6 +242,15 @@ instance decodeJsonEdge :: DecodeJson Edge where
confluence <- obj .: "confluence"
pure $ Edge { id_, source, target, weight, confluence }
instance jsonEncodeEdge :: EncodeJson Edge where
encodeJson (Edge ed) =
"id" := ed.id_
~> "confluence" := ed.confluence
~> "source" := ed.source
~> "target" := ed.target
~> "weight" := ed.weight
~> jsonEmptyObject
newtype Legend = Legend {id_ ::Int , color :: String, label :: String}
instance eqLegend :: Eq Legend where
......
src/Gargantext/Components/GraphExplorer/Utils.purs 0 → 100644
View file @ 646baddf
module Gargantext.Components.GraphExplorer.Utils
where
import Gargantext.Prelude
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as ST
stEdgeToGET :: Record ST.Edge -> GET.Edge
stEdgeToGET { _original } = _original
stNodeToGET :: Record ST.Node -> GET.Node
stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } } = GET.Node {
attributes
, id_: id
, label
, size
, type_
, x
, y
}
src/Gargantext/Hooks/Sigmax.purs
View file @ 646baddf
......@@ -21,10 +21,11 @@ import Effect (Effect)
import Effect.Class.Console (error)
import Effect.Timer (TimeoutId, clearTimeout)
import FFI.Simple ((.=))
import Reactix as R
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils.Reactix as R2
import Reactix as R
type Sigma =
{ sigma :: R.Ref (Maybe Sigma.Sigma)
......@@ -259,3 +260,9 @@ markSelectedNodes sigma selectedNodeIds graphNodes = do
_ <- pure $ (n .= "color") newColor
pure unit
Sigma.refresh sigma
getEdges :: Sigma.Sigma -> Effect (Array (Record ST.Edge))
getEdges sigma = Sigma.getEdges sigma
getNodes :: Sigma.Sigma -> Effect (Array (Record ST.Node))
getNodes sigma = Sigma.getNodes sigma
src/Gargantext/Hooks/Sigmax/Sigma.js
View file @ 646baddf
......@@ -42,7 +42,7 @@ sigma.canvas.nodes.selected = (node, context, settings) => {
node.type = 'def';
sigma.canvas.hovers.def(node, context, settings);
node.type = 'selected';
console.log('hovers, settings:', settings);
//console.log('hovers, settings:', settings);
};
CustomShapes.init();
......@@ -200,8 +200,18 @@ function takeScreenshot(sigma) {
return scene.toDataURL('image/png');
}
function getEdges(sigma) {
return sigma.graph.edges();
}
function getNodes(sigma) {
return sigma.graph.nodes();
}
exports._sigma = _sigma;
exports._addRenderer = addRenderer;
exports._bindMouseSelectorPlugin = bindMouseSelectorPlugin;
exports._bind = bind;
exports._takeScreenshot = takeScreenshot;
exports._getEdges = getEdges;
exports._getNodes = getNodes;
src/Gargantext/Hooks/Sigmax/Sigma.purs
View file @ 646baddf
......@@ -16,9 +16,10 @@ import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn1, runEffectFn3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Foreign.Object as Object
import Gargantext.Hooks.Sigmax.Types as Types
import Type.Row (class Union)
import Gargantext.Hooks.Sigmax.Types as Types
-- | Type representing a sigmajs instance
foreign import data Sigma :: Type
-- | Type representing `sigma.graph`
......@@ -294,6 +295,12 @@ goToAllCameras s props = traverse_ (goTo props) $ cameras s
takeScreenshot :: Sigma -> Effect String
takeScreenshot = runEffectFn1 _takeScreenshot
getEdges :: Sigma -> Effect (Array (Record Types.Edge))
getEdges = runEffectFn1 _getEdges
getNodes :: Sigma -> Effect (Array (Record Types.Node))
getNodes = runEffectFn1 _getNodes
-- | FFI
foreign import _sigma ::
forall a b opts err.
......@@ -316,3 +323,5 @@ foreign import _bindMouseSelectorPlugin
(Either err Unit)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
foreign import _takeScreenshot :: EffectFn1 Sigma String
foreign import _getEdges :: EffectFn1 Sigma (Array (Record Types.Edge))
foreign import _getNodes :: EffectFn1 Sigma (Array (Record Types.Node))
src/Gargantext/Hooks/Sigmax/Types.purs
View file @ 646baddf
......@@ -13,6 +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.Data.Louvain as Louvain
import Gargantext.Types as GT
......@@ -29,8 +30,8 @@ type Renderer = { "type" :: String, container :: Element }
type NodeId = String
type EdgeId = String
type Node =
( borderColor :: String
type Node = (
borderColor :: String
, color :: String
, equilateral :: { numPoints :: Int }
, gargType :: GT.Mode
......@@ -41,10 +42,11 @@ type Node =
, type :: String -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
, x :: Number
, y :: Number
, _original :: GET.Node
)
type Edge =
( color :: String
type Edge = (
color :: String
, confluence :: Number
, id :: EdgeId
, hidden :: Boolean
......@@ -55,6 +57,7 @@ type Edge =
, targetNode :: Record Node
, weight :: Number
, weightIdx :: Int
, _original :: GET.Edge
)
type NodeIds = Set.Set NodeId
......
src/Gargantext/Types.purs
View file @ 646baddf
......@@ -21,7 +21,6 @@ import URI.Query (Query)
data Handed = LeftHanded | RightHanded
derive instance genericHanded :: Generic Handed _
instance eqHanded :: Eq Handed where
eq = genericEq
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment