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
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Grégoire Locqueville
purescript-gargantext
Commits
30b72cda
Commit
30b72cda
authored
Aug 08, 2019
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[GraphExplorer] tree works now (as props)
parent
a8ea25ac
Changes
6
Show whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
184 additions
and
53 deletions
+184
-53
GraphExplorer.purs
src/Gargantext/Components/GraphExplorer.purs
+52
-28
Types.purs
src/Gargantext/Components/GraphExplorer/Types.purs
+85
-0
Tree.purs
src/Gargantext/Components/Tree.purs
+12
-6
Actions.purs
src/Gargantext/Pages/Layout/Actions.purs
+7
-7
Specs.purs
src/Gargantext/Pages/Layout/Specs.purs
+11
-5
States.purs
src/Gargantext/Pages/Layout/States.purs
+17
-7
No files found.
src/Gargantext/Components/GraphExplorer.purs
View file @
30b72cda
...
...
@@ -11,7 +11,7 @@ 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.Maybe (Maybe(..), fromJust
, fromMaybe
)
import Data.Newtype (class Newtype)
import Data.Number as Num
import Data.Sequence as Seq
...
...
@@ -25,22 +25,23 @@ 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.Types
as GET
import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Legend (legend)
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.Graph as Graph
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.Router (Routes(..))
import Gargantext.Types (class Optional)
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial)
import Thermite (
Spec
)
import Thermite (
Render, Spec, simpleSpec, defaultPerformAction
)
import Unsafe.Coerce (unsafeCoerce)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
...
...
@@ -48,20 +49,38 @@ import Web.Storage.Storage (getItem)
import Reactix as R
import Reactix.DOM.HTML as RH
type Props s fa2 = ()
type Props = (
mCurrentRoute :: Maybe Routes
, treeId :: Maybe Int
)
spec :: Spec (Record GET.StateGlue) (Record Props) GET.Action
spec = simpleSpec GET.performAction render
where
render :: Render (Record GET.StateGlue) (Record Props) GET.Action
render dispatch props state _ =
[ R2.scuff $ specCpt dispatch state props ]
specCpt :: (GET.Action -> Effect Unit) -> Record GET.StateGlue -> Record Props -> R.Element
specCpt d stateGlue props = R.createElement el props []
where
el = R.hooksComponent "SpecCpt" cpt
cpt props _children = do
state <- GET.fromStateGlue stateGlue
spec :: forall s fa2. Spec {} (Record (Props s fa2)) Void
spec = R2.elSpec $ explorerCpt
pure $ explorer state props
explorer ::
forall s fa2. Record (Props s fa2)
-> R.Element
explorer
props = R.createElement explorerCpt
props []
explorer ::
Record GET.State -> Record Props
-> R.Element
explorer
state props = R.createElement (explorerCpt state)
props []
explorerCpt :: forall s fa2. R.Component (Props s fa2)
explorerCpt = R.hooksComponent "GraphExplorer" cpt
--explorerCpt :: GET.State -> R.Component Props
explorerCpt
state
= R.hooksComponent "GraphExplorer" cpt
where
cpt
props
_ = do
cpt
{mCurrentRoute, treeId}
_ = do
controls <- Controls.useGraphControls
pure $
row
[
outer
[ inner
[ row1
...
...
@@ -70,10 +89,11 @@ explorerCpt = R.hooksComponent "GraphExplorer" cpt
, col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ]
]
, row [ Controls.controls controls ]
, row [
graph controls, sidebar controls ]
, row [ tree {mCurrentRoute, treeId} controls,
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" } }
...
...
@@ -81,14 +101,18 @@ explorerCpt = R.hooksComponent "GraphExplorer" cpt
col = RH.div { className: "col-md-4" }
pullLeft = RH.div { className: "pull-left" }
pullRight = RH.div { className: "pull-right" }
sidebar _ = RH.div {} []
tree {treeId: Nothing} _ = RH.div {} []
tree _ {showTree: false /\ _} = RH.div {} []
tree {mCurrentRoute, treeId: Just treeId} _ = RH.div {} [ Tree.elTreeview {mCurrentRoute, root: treeId} ]
graph _ = RH.div {} []
sidebar _ = RH.div {} []
convert :: GraphData -> Graph.Graph
convert (GraphData r) = Sigmax.Graph {nodes, edges}
convert :: G
ET.G
raphData -> Graph.Graph
convert (G
ET.G
raphData r) = Sigmax.Graph {nodes, edges}
where
nodes = foldMapWithIndex nodeFn r.nodes
nodeFn i (Node n) =
nodeFn i (
GET.
Node n) =
Seq.singleton
{ id : n.id_
, size : toNumber n.size
...
...
@@ -98,9 +122,9 @@ convert (GraphData r) = Sigmax.Graph {nodes, edges}
, color : intColor (cDef n.attributes)
}
where
cDef (Cluster {clustDefault}) = clustDefault
cDef (
GET.
Cluster {clustDefault}) = clustDefault
edges = foldMap edgeFn r.edges
edgeFn (Edge e) = Seq.singleton {id : e.id_, source : e.source, target : e.target}
edgeFn (
GET.
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"]
...
...
@@ -116,7 +140,7 @@ intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaul
getNodes :: Int -> Aff GraphData
getNodes :: Int -> Aff G
ET.G
raphData
getNodes graphId = get $ Config.toUrl Config.Back Config.Graph $ Just graphId
getAuthData :: Effect (Maybe AuthData)
...
...
src/Gargantext/Components/GraphExplorer/Types.purs
View file @
30b72cda
...
...
@@ -7,6 +7,13 @@ import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Array (concat, fromFoldable, group, sort, take, (!!), length)
import Data.Maybe (Maybe(..), maybe, fromJust)
import Data.Newtype (class Newtype)
import Data.Set (Set)
import Data.Set as Set
import Reactix as R
import Thermite (PerformAction, Spec)
import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Components.Graph as Graph
newtype Node = Node
{ id_ :: String
...
...
@@ -62,6 +69,84 @@ newtype MetaData = MetaData
}
newtype SelectedNode = SelectedNode {id :: String, label :: String}
derive instance eqSelectedNode :: Eq SelectedNode
derive instance newtypeSelectedNode :: Newtype SelectedNode _
derive instance ordSelectedNode :: Ord SelectedNode
instance showSelectedNode :: Show SelectedNode where
show (SelectedNode node) = node.label
data Action = Dummy
performAction :: forall props. PerformAction (Record StateGlue) (Record props) Action
performAction Dummy _ _ = do
pure $ unit
type StateGlue = (
--treeId :: Maybe TreeId
)
initialStateGlue :: Record StateGlue
initialStateGlue = {
{- corpusId <- R.useState' 0
cursorSize <- R.useState' 0.0
filePath <- R.useState' ""
graphData <- R.useState' initialGraphData
legendData <- R.useState' []
multiNodeSelection <- R.useState' false
selectedNodes <- R.useState' Set.empty
showControls <- R.useState' false
showSidePanel <- R.useState' false
showTree <- R.useState' false
sigmaGraphData <- R.useState' (Nothing :: Maybe Graph.Graph)
sigmaSettings <- R.useState' Graph.sigmaSettings
treeId <- R.useState' (Nothing :: Maybe TreeId) -}
--treeId : Nothing
}
type State = (
-- corpusId :: R.State Int
--, cursorSize :: R.State Number
--, filePath :: R.State String
--, graphData :: R.State GraphData
--, legendData :: R.State (Array Legend)
--, multiNodeSelection :: R.State Boolean
--, selectedNodes :: R.State (Set SelectedNode)
--, showSidePanel :: R.State Boolean
--, showControls :: R.State Boolean
--, showTree :: R.State Boolean
--, sigmaGraphData :: R.State (Maybe Graph.Graph)
--, sigmaSettings :: R.State ({|Graph.SigmaSettings})
--treeId :: R.State (Maybe TreeId)
)
fromStateGlue :: Record StateGlue -> R.Hooks (Record State)
fromStateGlue {} = do
--treeIdS <- R.useState' treeId
pure {
--treeId: treeIdS
}
initialGraphData :: GraphData
initialGraphData = GraphData {
nodes: []
, edges: []
, sides: []
, metaData : Just $ MetaData {title : "", legend : [], corpusId : [], listId : 0}
}
initialState :: R.Hooks (Record State)
initialState = fromStateGlue initialStateGlue
instance decodeJsonGraphData :: DecodeJson GraphData where
decodeJson json = do
obj <- decodeJson json
...
...
src/Gargantext/Components/Tree.purs
View file @
30b72cda
...
...
@@ -178,16 +178,22 @@ treeLoadView setReload p = R.createElement el p []
useLoader root loadNode $ \{loaded} ->
loadedTreeView setReload {tree: loaded, mCurrentRoute}
treeview :: Spec {} Props Void
treeview = R2.elSpec $ R.hooksComponent "TreeView" cpt
elTreeview :: Props -> R.Element
elTreeview props = R.createElement el props []
where
cpt {root, mCurrentRoute} _children = do
el = R.hooksComponent "TreeView" treeviewCpt
treeview :: Spec {} Props Void
treeview = R2.elSpec $ R.hooksComponent "TreeView" treeviewCpt
treeviewCpt {root, mCurrentRoute} _children = do
-- NOTE: this is a hack to reload the tree view on demand
setReload <- R.useState' 0
pure $ treeLoadView setReload {root, mCurrentRoute}
-- START toHtml
toHtml :: R.State Int -> R.State State -> Maybe Router.Routes -> R.Element
...
...
src/Gargantext/Pages/Layout/Actions.purs
View file @
30b72cda
...
...
@@ -9,10 +9,10 @@ import Effect.Class (liftEffect)
import Thermite (PerformAction, modifyState, modifyState_)
import Routing.Hash (setHash)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Prelude
import Gargantext.Router (Routes)
...
...
@@ -22,7 +22,7 @@ import Gargantext.Router (Routes)
data Action
= LoginA LN.Action
| SetRoute Routes
| GraphExplorerA GE.Action
| GraphExplorerA GE
T
.Action
| AnnuaireAction Annuaire.Action
| ShowLogin
| Logout
...
...
@@ -76,8 +76,8 @@ _annuaireAction = prism AnnuaireAction \action ->
AnnuaireAction a -> Right a
_ -> Left action
-- _graphExplorerAction :: Prism' Action GE
.Action
--
_graphExplorerAction = prism GraphExplorerA \action ->
--
case action of
--
GraphExplorerA caction -> Right caction
--
_-> Left action
_graphExplorerAction :: Prism' Action GET
.Action
_graphExplorerAction = prism GraphExplorerA \action ->
case action of
GraphExplorerA caction -> Right caction
_-> Left action
src/Gargantext/Pages/Layout/Specs.purs
View file @
30b72cda
...
...
@@ -23,13 +23,12 @@ import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Document as Annotation
import Gargantext.Pages.Corpus.Dashboard as Dsh
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Lists as Lists
import Gargantext.Pages.Texts as Texts
import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _loginAction, performAction)
import Gargantext.Pages.Layout.Actions (Action(..), _
graphExplorerAction, _
loginAction, performAction)
import Gargantext.Pages.Layout.Specs.SearchBar as SB
import Gargantext.Pages.Layout.States (AppState, _loginState)
import Gargantext.Pages.Layout.States (AppState, _loginState
, _graphExplorerState
)
import Gargantext.Router (Routes(..))
import Gargantext.Utils.Reactix as R2
...
...
@@ -61,8 +60,7 @@ pagesComponent s = case s.currentRoute of
selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout
selectSpec (CorpusDocument c l i) = layout0 $ cmapProps (const {nodeId: i, listId: l, corpusId: Just c}) $ noState Annotation.layout
selectSpec (Document l i) = layout0 $ cmapProps (const {nodeId: i, listId: l, corpusId: Nothing}) $ noState Annotation.layout
-- selectSpec (PGraphExplorer i)= layout1 $ focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec (PGraphExplorer i) = layout1 $ noState $ GE.spec
selectSpec (PGraphExplorer i) = graphSpec
selectSpec (Texts i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Texts.layout
selectSpec (Lists i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Lists.layout
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
...
...
@@ -70,6 +68,14 @@ pagesComponent s = case s.currentRoute of
selectSpec (UserPage i) = layout0 $ cmapProps (const {nodeId: i}) $ noState C.layoutUser
selectSpec (ContactPage i) = layout0 $ cmapProps (const {nodeId: i}) $ noState C.layoutUser
graphSpec = layout1 $ withState \st ->
cmapProps (const {
mCurrentRoute: st.currentRoute
, treeId: case st.loginState.authData of
Nothing -> Nothing
Just (AuthData ad) -> Just ad.tree_id
}) $ focus _graphExplorerState _graphExplorerAction $ GE.spec
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender
routingSpec :: Spec AppState {} Action
...
...
src/Gargantext/Pages/Layout/States.purs
View file @
30b72cda
...
...
@@ -3,11 +3,13 @@ module Gargantext.Pages.Layout.States where
import Prelude hiding (div)
import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(
Just
))
import Data.Maybe (Maybe(
..
))
import Effect (Effect)
import Gargantext.Components.Login as LN
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Components.Login as LN
--import Gargantext.Components.Login.Types as LNT
--import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Router (Routes(..))
type AppState =
...
...
@@ -15,19 +17,20 @@ type AppState =
, loginState :: LN.State
, showLogin :: Boolean
, showCorpus :: Boolean
--, graphExplorerState ::
GE.Stat
e
--, graphExplorerState ::
Record GET.StateGlu
e
, showTree :: Boolean
}
initAppState :: Effect AppState
initAppState = do
loginState <- LN.initialState
pure
{ currentRoute : Just Home
, loginState
, showLogin : false
, showCorpus : false
--, graphExplorerState : GE
.initialStat
e
--, graphExplorerState : GE
T.initialStateGlu
e
, showTree : false
}
...
...
@@ -37,6 +40,13 @@ initAppState = do
_loginState :: Lens' AppState LN.State
_loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
-- _graphExplorerState :: Lens' AppState GE.State
-- _graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})
_graphExplorerState :: Lens' AppState (Record GET.StateGlue)
_graphExplorerState = lens getter setter
where
getter :: AppState -> Record GET.StateGlue
getter s = {
}
--setter s ss = s {graphExplorerState = ss}
setter :: AppState -> (Record GET.StateGlue) -> AppState
setter s ss = s
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