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) ...@@ -11,7 +11,7 @@ import Data.Int (toNumber)
import Data.Int as Int import Data.Int as Int
import Data.Lens (Lens', over, (%~), (.~), (^.)) import Data.Lens (Lens', over, (%~), (.~), (^.))
import Data.Lens.Record (prop) import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Number as Num import Data.Number as Num
import Data.Sequence as Seq import Data.Sequence as Seq
...@@ -25,22 +25,23 @@ import Effect.Aff (Aff) ...@@ -25,22 +25,23 @@ import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Hooks.Sigmax.Types as Sigmax import Gargantext.Hooks.Sigmax.Types as Sigmax
import Gargantext.Hooks.Sigmax.Sigmajs (CameraProps, SigmaNode, cameras, getCameraProps, goTo, pauseForceAtlas2, sigmaOnMouseMove) 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.Controls as Controls
import Gargantext.Components.GraphExplorer.Legend (legend) import Gargantext.Components.GraphExplorer.Legend (legend)
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.Graph as Graph
import Gargantext.Components.Login.Types (AuthData(..), TreeId) import Gargantext.Components.Login.Types (AuthData(..), TreeId)
import Gargantext.Components.RandomText (words) import Gargantext.Components.RandomText (words)
import Gargantext.Components.Graph as Graph
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Config as Config import Gargantext.Config as Config
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.Graph.Tabs as GT import Gargantext.Pages.Corpus.Graph.Tabs as GT
import Gargantext.Router (Routes(..))
import Gargantext.Types (class Optional) import Gargantext.Types (class Optional)
import Gargantext.Utils (toggleSet) import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Thermite (Spec) import Thermite (Render, Spec, simpleSpec, defaultPerformAction)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Web.HTML (window) import Web.HTML (window)
import Web.HTML.Window (localStorage) import Web.HTML.Window (localStorage)
...@@ -48,30 +49,49 @@ import Web.Storage.Storage (getItem) ...@@ -48,30 +49,49 @@ import Web.Storage.Storage (getItem)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH 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 pure $ explorer state props
spec = R2.elSpec $ explorerCpt
explorer :: forall s fa2. Record (Props s fa2) -> R.Element explorer :: Record GET.State -> Record Props -> R.Element
explorer props = R.createElement explorerCpt props [] explorer state props = R.createElement (explorerCpt state) props []
explorerCpt :: forall s fa2. R.Component (Props s fa2) --explorerCpt :: GET.State -> R.Component Props
explorerCpt = R.hooksComponent "GraphExplorer" cpt explorerCpt state = R.hooksComponent "GraphExplorer" cpt
where where
cpt props _ = do cpt {mCurrentRoute, treeId} _ = do
controls <- Controls.useGraphControls controls <- Controls.useGraphControls
pure $ pure $
outer row
[ inner [
[ row1 outer
[ col [ pullLeft [ Toggle.treeToggleButton controls.showTree ] ] [ inner
, col [ Toggle.controlsToggleButton controls.showControls ] [ row1
, col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ] [ col [ pullLeft [ Toggle.treeToggleButton controls.showTree ] ]
, col [ Toggle.controlsToggleButton controls.showControls ]
, col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ]
]
, row [ Controls.controls controls ]
, row [ tree {mCurrentRoute, treeId} controls, graph controls, sidebar controls ]
, row [ ]
] ]
, row [ Controls.controls controls ]
, row [ graph controls, sidebar controls ]
, row [ ]
] ]
] ]
outer = RH.div { className: "col-md-9" } outer = RH.div { className: "col-md-9" }
...@@ -81,14 +101,18 @@ explorerCpt = R.hooksComponent "GraphExplorer" cpt ...@@ -81,14 +101,18 @@ explorerCpt = R.hooksComponent "GraphExplorer" cpt
col = RH.div { className: "col-md-4" } col = RH.div { className: "col-md-4" }
pullLeft = RH.div { className: "pull-left" } pullLeft = RH.div { className: "pull-left" }
pullRight = RH.div { className: "pull-right" } 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 {} [] graph _ = RH.div {} []
sidebar _ = RH.div {} []
convert :: GraphData -> Graph.Graph convert :: GET.GraphData -> Graph.Graph
convert (GraphData r) = Sigmax.Graph {nodes, edges} convert (GET.GraphData r) = Sigmax.Graph {nodes, edges}
where where
nodes = foldMapWithIndex nodeFn r.nodes nodes = foldMapWithIndex nodeFn r.nodes
nodeFn i (Node n) = nodeFn i (GET.Node n) =
Seq.singleton Seq.singleton
{ id : n.id_ { id : n.id_
, size : toNumber n.size , size : toNumber n.size
...@@ -98,9 +122,9 @@ convert (GraphData r) = Sigmax.Graph {nodes, edges} ...@@ -98,9 +122,9 @@ convert (GraphData r) = Sigmax.Graph {nodes, edges}
, color : intColor (cDef n.attributes) , color : intColor (cDef n.attributes)
} }
where where
cDef (Cluster {clustDefault}) = clustDefault cDef (GET.Cluster {clustDefault}) = clustDefault
edges = foldMap edgeFn r.edges 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 :: 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"] 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 ...@@ -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 getNodes graphId = get $ Config.toUrl Config.Back Config.Graph $ Just graphId
getAuthData :: Effect (Maybe AuthData) getAuthData :: Effect (Maybe AuthData)
......
...@@ -7,6 +7,13 @@ import Data.Argonaut (class DecodeJson, decodeJson, (.?)) ...@@ -7,6 +7,13 @@ import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Array (concat, fromFoldable, group, sort, take, (!!), length) import Data.Array (concat, fromFoldable, group, sort, take, (!!), length)
import Data.Maybe (Maybe(..), maybe, fromJust) import Data.Maybe (Maybe(..), maybe, fromJust)
import Data.Newtype (class Newtype) 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 newtype Node = Node
{ id_ :: String { id_ :: String
...@@ -62,6 +69,84 @@ newtype MetaData = MetaData ...@@ -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 instance decodeJsonGraphData :: DecodeJson GraphData where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
......
...@@ -178,15 +178,21 @@ treeLoadView setReload p = R.createElement el p [] ...@@ -178,15 +178,21 @@ treeLoadView setReload p = R.createElement el p []
useLoader root loadNode $ \{loaded} -> useLoader root loadNode $ \{loaded} ->
loadedTreeView setReload {tree: loaded, mCurrentRoute} loadedTreeView setReload {tree: loaded, mCurrentRoute}
treeview :: Spec {} Props Void elTreeview :: Props -> R.Element
treeview = R2.elSpec $ R.hooksComponent "TreeView" cpt elTreeview props = R.createElement el props []
where where
cpt {root, mCurrentRoute} _children = do el = R.hooksComponent "TreeView" treeviewCpt
-- NOTE: this is a hack to reload the tree view on demand
setReload <- R.useState' 0
treeview :: Spec {} Props Void
treeview = R2.elSpec $ R.hooksComponent "TreeView" treeviewCpt
pure $ treeLoadView setReload {root, mCurrentRoute} 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 -- START toHtml
......
...@@ -9,10 +9,10 @@ import Effect.Class (liftEffect) ...@@ -9,10 +9,10 @@ import Effect.Class (liftEffect)
import Thermite (PerformAction, modifyState, modifyState_) import Thermite (PerformAction, modifyState, modifyState_)
import Routing.Hash (setHash) import Routing.Hash (setHash)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow) import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Pages.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Layout.States (AppState) import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Router (Routes) import Gargantext.Router (Routes)
...@@ -22,7 +22,7 @@ import Gargantext.Router (Routes) ...@@ -22,7 +22,7 @@ import Gargantext.Router (Routes)
data Action data Action
= LoginA LN.Action = LoginA LN.Action
| SetRoute Routes | SetRoute Routes
| GraphExplorerA GE.Action | GraphExplorerA GET.Action
| AnnuaireAction Annuaire.Action | AnnuaireAction Annuaire.Action
| ShowLogin | ShowLogin
| Logout | Logout
...@@ -76,8 +76,8 @@ _annuaireAction = prism AnnuaireAction \action -> ...@@ -76,8 +76,8 @@ _annuaireAction = prism AnnuaireAction \action ->
AnnuaireAction a -> Right a AnnuaireAction a -> Right a
_ -> Left action _ -> Left action
-- _graphExplorerAction :: Prism' Action GE.Action _graphExplorerAction :: Prism' Action GET.Action
-- _graphExplorerAction = prism GraphExplorerA \action -> _graphExplorerAction = prism GraphExplorerA \action ->
-- case action of case action of
-- GraphExplorerA caction -> Right caction GraphExplorerA caction -> Right caction
-- _-> Left action _-> Left action
...@@ -23,13 +23,12 @@ import Gargantext.Pages.Annuaire.User.Contacts as C ...@@ -23,13 +23,12 @@ import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Corpus as Corpus import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Document as Annotation import Gargantext.Pages.Corpus.Document as Annotation
import Gargantext.Pages.Corpus.Dashboard as Dsh import Gargantext.Pages.Corpus.Dashboard as Dsh
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Lists as Lists import Gargantext.Pages.Lists as Lists
import Gargantext.Pages.Texts as Texts import Gargantext.Pages.Texts as Texts
import Gargantext.Pages.Home as L 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.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.Router (Routes(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -61,8 +60,7 @@ pagesComponent s = case s.currentRoute of ...@@ -61,8 +60,7 @@ pagesComponent s = case s.currentRoute of
selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout 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 (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 (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) = graphSpec
selectSpec (PGraphExplorer i) = layout1 $ noState $ GE.spec
selectSpec (Texts i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Texts.layout selectSpec (Texts i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Texts.layout
selectSpec (Lists i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Lists.layout selectSpec (Lists i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Lists.layout
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
...@@ -70,6 +68,14 @@ pagesComponent s = case s.currentRoute of ...@@ -70,6 +68,14 @@ pagesComponent s = case s.currentRoute of
selectSpec (UserPage i) = layout0 $ cmapProps (const {nodeId: i}) $ noState C.layoutUser selectSpec (UserPage i) = layout0 $ cmapProps (const {nodeId: i}) $ noState C.layoutUser
selectSpec (ContactPage 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 -- selectSpec _ = simpleSpec defaultPerformAction defaultRender
routingSpec :: Spec AppState {} Action routingSpec :: Spec AppState {} Action
......
...@@ -3,11 +3,13 @@ module Gargantext.Pages.Layout.States where ...@@ -3,11 +3,13 @@ module Gargantext.Pages.Layout.States where
import Prelude hiding (div) import Prelude hiding (div)
import Data.Lens (Lens', lens) import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(Just)) import Data.Maybe (Maybe(..))
import Effect (Effect) 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(..)) import Gargantext.Router (Routes(..))
type AppState = type AppState =
...@@ -15,19 +17,20 @@ type AppState = ...@@ -15,19 +17,20 @@ type AppState =
, loginState :: LN.State , loginState :: LN.State
, showLogin :: Boolean , showLogin :: Boolean
, showCorpus :: Boolean , showCorpus :: Boolean
--, graphExplorerState :: GE.State --, graphExplorerState :: Record GET.StateGlue
, showTree :: Boolean , showTree :: Boolean
} }
initAppState :: Effect AppState initAppState :: Effect AppState
initAppState = do initAppState = do
loginState <- LN.initialState loginState <- LN.initialState
pure pure
{ currentRoute : Just Home { currentRoute : Just Home
, loginState , loginState
, showLogin : false , showLogin : false
, showCorpus : false , showCorpus : false
--, graphExplorerState : GE.initialState --, graphExplorerState : GET.initialStateGlue
, showTree : false , showTree : false
} }
...@@ -37,6 +40,13 @@ initAppState = do ...@@ -37,6 +40,13 @@ initAppState = do
_loginState :: Lens' AppState LN.State _loginState :: Lens' AppState LN.State
_loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss}) _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
-- _graphExplorerState :: Lens' AppState GE.State _graphExplorerState :: Lens' AppState (Record GET.StateGlue)
-- _graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss}) _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