Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
139
Issues
139
List
Board
Labels
Milestones
Merge Requests
4
Merge Requests
4
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
2e3c679a
Commit
2e3c679a
authored
Aug 05, 2019
by
James Laver
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
push for seeg
parent
5e770fd1
Changes
8
Show whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
359 additions
and
90 deletions
+359
-90
GraphExplorer.purs
src/Gargantext/Components/GraphExplorer.purs
+128
-0
Controls.purs
src/Gargantext/Components/GraphExplorer/Controls.purs
+118
-0
ControlsToggleButton.purs
...antext/Components/GraphExplorer/ControlsToggleButton.purs
+24
-0
Legend.purs
src/Gargantext/Components/GraphExplorer/Legend.purs
+27
-0
ToggleButton.purs
src/Gargantext/Components/GraphExplorer/ToggleButton.purs
+45
-0
Types.purs
src/Gargantext/Components/GraphExplorer/Types.purs
+11
-0
Sigmax.purs
src/Gargantext/Hooks/Sigmax.purs
+1
-0
Graph.purs
src/Gargantext/Pages/Corpus/Graph.purs
+5
-90
No files found.
src/Gargantext/Components/GraphExplorer.purs
0 → 100644
View file @
2e3c679a
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
0 → 100644
View file @
2e3c679a
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
0 → 100644
View file @
2e3c679a
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
0 → 100644
View file @
2e3c679a
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
0 → 100644
View file @
2e3c679a
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
View file @
2e3c679a
...
...
@@ -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
View file @
2e3c679a
...
...
@@ -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
View file @
2e3c679a
...
...
@@ -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
]
...
...
@@ -315,7 +270,6 @@ specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
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"}]
[-- : MetaData {title}
case metaData of
Just( MetaData {title }) ->
...
...
@@ -323,28 +277,9 @@ 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"]
[
if (st.showControls) then
...
...
@@ -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}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment