Commit dbe8c256 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Some simplification of complex record with Record.Extra

parent ee36c672
...@@ -27,6 +27,7 @@ ...@@ -27,6 +27,7 @@
"random", "random",
"reactix", "reactix",
"read", "read",
"record-extra",
"routing", "routing",
"sequences", "sequences",
"smolder", "smolder",
......
...@@ -8,6 +8,11 @@ import Data.Tuple (Tuple(..), fst, snd) ...@@ -8,6 +8,11 @@ import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), CreateValue(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, createNode, deleteNode, loadNode, renameNode) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), CreateValue(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, createNode, deleteNode, loadNode, renameNode)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan) import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
...@@ -17,8 +22,6 @@ import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+) ...@@ -17,8 +22,6 @@ import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+)
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (OpenNodes, Session, mkNodeId) import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
type CommonProps = type CommonProps =
( (
...@@ -82,18 +85,19 @@ type ToHtmlProps = ...@@ -82,18 +85,19 @@ type ToHtmlProps =
) )
toHtml :: Record ToHtmlProps -> R.Element toHtml :: Record ToHtmlProps -> R.Element
toHtml { frontends toHtml p@{ frontends
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
, reload: reload@(_ /\ setReload) , reload: reload@(_ /\ setReload)
, session , session
, tasks: tasks@(asyncTasks /\ setAsyncTasks) , tasks: tasks@(asyncTasks /\ setAsyncTasks)
, tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} [] , tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
where where
el = R.hooksComponent "NodeView" cpt el = R.hooksComponent "NodeView" cpt
pAction = performAction {openNodes, reload, session, tasks, tree} commonProps = RecordE.pick p :: Record CommonProps
pAction = performAction (RecordE.pick p :: Record PerformActionProps)
cpt props _ = do cpt _ _ = do
let nodeId = mkNodeId session id let nodeId = mkNodeId session id
let folderIsOpen = Set.member nodeId (fst openNodes) let folderIsOpen = Set.member nodeId (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert let setFn = if folderIsOpen then Set.delete else Set.insert
...@@ -115,7 +119,9 @@ toHtml { frontends ...@@ -115,7 +119,9 @@ toHtml { frontends
, onAsyncTaskFinish , onAsyncTaskFinish
, session , session
} ] } ]
<> childNodes {children: ary, folderOpen, frontends, mCurrentRoute, openNodes, reload, session } <> childNodes (Record.merge commonProps
{ children: ary
, folderOpen })
) )
] ]
...@@ -137,9 +143,10 @@ type ChildNodesProps = ...@@ -137,9 +143,10 @@ type ChildNodesProps =
childNodes :: Record ChildNodesProps -> Array R.Element childNodes :: Record ChildNodesProps -> Array R.Element
childNodes { children: [] } = [] childNodes { children: [] } = []
childNodes { folderOpen: (false /\ _) } = [] childNodes { folderOpen: (false /\ _) } = []
childNodes { children, folderOpen: (true /\ _), frontends, mCurrentRoute, openNodes, reload, session } = childNodes props@{ children } =
map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted children map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted children
where where
commonProps = RecordE.pick props :: Record CommonProps
sorted :: Array FTree -> Array FTree sorted :: Array FTree -> Array FTree
sorted = A.sortWith (\(NTree (LNode {id}) _) -> id) sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
childNode :: Tree -> R.Element childNode :: Tree -> R.Element
...@@ -147,13 +154,18 @@ childNodes { children, folderOpen: (true /\ _), frontends, mCurrentRoute, openNo ...@@ -147,13 +154,18 @@ childNodes { children, folderOpen: (true /\ _), frontends, mCurrentRoute, openNo
el = R.hooksComponent "ChildNodeView" cpt el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, asyncTasks} _ = do cpt {tree, asyncTasks} _ = do
tasks <- R.useState' asyncTasks tasks <- R.useState' asyncTasks
pure $ toHtml { frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } pure $ toHtml (Record.merge commonProps
{ tasks, tree })
type PerformActionProps =
( openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
, tasks :: R.State (Array GT.AsyncTaskWithType)
, tree :: FTree
)
performAction :: { openNodes :: R.State OpenNodes performAction :: Record PerformActionProps
, reload :: R.State Reload
, session :: Session
, tasks :: R.State (Array GT.AsyncTaskWithType)
, tree :: FTree }
-> Action -> Action
-> Aff Unit -> Aff Unit
performAction { openNodes: (_ /\ setOpenNodes) performAction { openNodes: (_ /\ setOpenNodes)
......
...@@ -110,7 +110,7 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el ...@@ -110,7 +110,7 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
popOverIcon = popOverIcon =
H.a { className: "settings fa fa-cog" } [] H.a { className: "settings fa fa-cog" } []
mNodePopupView props@{asyncTasks, id, nodeType} onPopoverClose = mNodePopupView props@{id, nodeType} onPopoverClose =
nodePopupView { id nodePopupView { id
, dispatch , dispatch
, name: name' props , name: name' props
......
...@@ -34,12 +34,13 @@ import Math (log) ...@@ -34,12 +34,13 @@ import Math (log)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
import Record as Record
type GraphId = Int type GraphId = Int
type LayoutProps = type LayoutProps =
( graphId :: GraphId ( frontends :: Frontends
, frontends :: Frontends , graphId :: GraphId
, mCurrentRoute :: AppRoute , mCurrentRoute :: AppRoute
, session :: Session , session :: Session
, sessions :: Sessions , sessions :: Sessions
...@@ -69,19 +70,11 @@ explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element ...@@ -69,19 +70,11 @@ explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element
explorerLayoutView graphVersion p = R.createElement el p [] explorerLayoutView graphVersion p = R.createElement el p []
where where
el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt
cpt {frontends, graphId, mCurrentRoute, session, sessions, showLogin } _ = do cpt props@{graphId, session} _ = do
useLoader graphId (getNodes session graphVersion) handler useLoader graphId (getNodes session graphVersion) handler
where where
handler loaded = handler loaded =
explorer { frontends explorer (Record.merge props { graph, graphVersion, mMetaData })
, graph
, graphId
, graphVersion
, mCurrentRoute
, mMetaData
, session
, sessions
, showLogin }
where (Tuple mMetaData graph) = convert loaded where (Tuple mMetaData graph) = convert loaded
-------------------------------------------------------------- --------------------------------------------------------------
...@@ -91,7 +84,7 @@ explorer props = R.createElement explorerCpt props [] ...@@ -91,7 +84,7 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where where
cpt {frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin } _ = do cpt props@{frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin } _ = do
dataRef <- R.useRef graph dataRef <- R.useRef graph
graphRef <- R.useRef null graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion) graphVersionRef <- R.useRef (fst graphVersion)
...@@ -169,25 +162,21 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -169,25 +162,21 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
RH.div {className: "col-md-2 graph-tree"} [forest {sessions, route, frontends, showLogin }] RH.div {className: "col-md-2 graph-tree"} [forest {sessions, route, frontends, showLogin }]
mSidebar :: Maybe GET.MetaData mSidebar :: Maybe GET.MetaData
-> { frontends :: Frontends -> Record MSidebarProps
, graph :: SigmaxT.SGraph
, graphVersion :: R.State Int
, removedNodeIds :: R.State SigmaxT.NodeIds
, showSidePanel :: GET.SidePanelState
, selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session }
-> R.Element -> R.Element
mSidebar Nothing _ = RH.div {} [] mSidebar Nothing _ = RH.div {} []
mSidebar (Just metaData) {frontends, graph, graphVersion, removedNodeIds, session, selectedNodeIds, showSidePanel} = mSidebar (Just metaData) props =
Sidebar.sidebar { frontends Sidebar.sidebar (Record.merge props { metaData })
, graph
, graphVersion type MSidebarProps =
, metaData ( frontends :: Frontends
, removedNodeIds , graph :: SigmaxT.SGraph
, session , graphVersion :: R.State Int
, selectedNodeIds , removedNodeIds :: R.State SigmaxT.NodeIds
, showSidePanel , showSidePanel :: GET.SidePanelState
} , selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session
)
type GraphProps = ( type GraphProps = (
controls :: Record Controls.Controls controls :: Record Controls.Controls
...@@ -255,18 +244,20 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges} ...@@ -255,18 +244,20 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_ gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_
nodesMap = SigmaxT.nodesMap nodes nodesMap = SigmaxT.nodesMap nodes
edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
edgeFn i (GET.Edge e) = Seq.singleton { id : e.id_ edgeFn i (GET.Edge e) =
, color Seq.singleton
, confluence : e.confluence { id : e.id_
, hidden : false , color
, size: 1.0 , confluence : e.confluence
, source : e.source , hidden : false
, sourceNode , size: 1.0
, target : e.target , source : e.source
, targetNode , sourceNode
, weight : e.weight , target : e.target
, weightIdx: i , targetNode
} , weight : e.weight
, weightIdx: i
}
where where
sourceNode = unsafePartial $ fromJust $ Map.lookup e.source nodesMap sourceNode = unsafePartial $ fromJust $ Map.lookup e.source nodesMap
targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap
......
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