Commit 30b72cda authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[GraphExplorer] tree works now (as props)

parent a8ea25ac
......@@ -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 :: GET.GraphData -> Graph.Graph
convert (GET.GraphData 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 GET.GraphData
getNodes graphId = get $ Config.toUrl Config.Back Config.Graph $ Just graphId
getAuthData :: Effect (Maybe AuthData)
......
......@@ -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
......
......@@ -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
......
......@@ -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 GET.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
......@@ -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
......
......@@ -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.State
--, graphExplorerState :: Record GET.StateGlue
, showTree :: Boolean
}
initAppState :: Effect AppState
initAppState = do
loginState <- LN.initialState
pure
{ currentRoute : Just Home
, loginState
, showLogin : false
, showCorpus : false
--, graphExplorerState : GE.initialState
--, graphExplorerState : GET.initialStateGlue
, 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
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