Merge branch 'feature/toestand-global-state' of...

Merge branch 'feature/toestand-global-state' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge

src/Gargantext/Components/Forest.purs

@@ -171,11 +171,10 @@ forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where
         , tasks } children = do
     handed' <- T.useLive T.unequal p.handed
 
-    pure $ R2.row $ reverseHanded
-      ([ H.div { className: "col-md-2 forest-layout-raw-tree" }
+    pure $ R2.row $ reverseHanded handed' $
+      [ H.div { className: "col-md-2 forest-layout-raw-tree" }
          [ forest' p.handed ]
-       ] <> children
-      ) handed'
+      ] <> children
       where
         forest' handed =
           forest { backend

src/Gargantext/Components/Forest/Tree/Node.purs

@@ -101,7 +101,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
       tasks' <- T.read tasks
 
       pure $ H.span (dropProps droppedFile isDragOver)
-        $ reverseHanded
+        $ reverseHanded handed
         [ folderIcon  { folderOpen, nodeType } []
         , chevronIcon { folderOpen, handed, isLeaf, nodeType } []
         , nodeLink { frontends, handed, folderOpen, id, isSelected
@@ -136,7 +136,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
                               , refresh: const $ dispatch RefreshTree
                               , session
                               } []
-                ] handed
+                ]
         where
           onTaskFinish id' t _ = do
             mT <- T.read tasks

src/Gargantext/Components/Forest/Tree/Node/Action.purs

@@ -58,8 +58,29 @@ setTreeOut (LinkNode  {nodeType, params:_}) p = LinkNode  {nodeType, params: p}
 setTreeOut (SharePublic {params:_}) p = SharePublic  {params: p}
 setTreeOut a   _             = a
 
-
-instance showShow :: Show Action where
+derive instance genericAction :: Generic Action _
+
+instance eqAction :: Eq Action where
+  eq (AddNode s1 nt1) (AddNode s2 nt2) = (eq s1 s2) && (eq nt1 nt2)
+  eq (DeleteNode nt1) (DeleteNode nt2) = eq nt1 nt2
+  eq (RenameNode s1) (RenameNode s2) = eq s1 s2
+  eq (UpdateNode un1) (UpdateNode un2) = eq un1 un2
+  eq (DoSearch at1) (DoSearch at2) = eq at1 at2
+  eq (UploadFile nt1 ft1 s1 _) (UploadFile nt2 ft2 s2 _) = (eq nt1 nt2) && (eq ft1 ft2) && (eq s1 s2)
+  eq (UploadArbitraryFile s1 _) (UploadArbitraryFile s2 _) = eq s1 s2
+  eq DownloadNode DownloadNode = true
+  eq RefreshTree RefreshTree = true
+  eq ClosePopover ClosePopover = true
+  eq (ShareTeam s1) (ShareTeam s2) = eq s1 s2
+  eq (AddContact ac1) (AddContact ac2) = eq ac1 ac2
+  eq (SharePublic p1) (SharePublic p2) = eq p1 p2
+  eq (MoveNode p1) (MoveNode p2) = eq p1 p2
+  eq (MergeNode p1) (MergeNode p2) = eq p1 p2
+  eq (LinkNode l1) (LinkNode l2) = eq l1 l2
+  eq NoAction NoAction = true
+  eq _ _ = false
+
+instance showAction :: Show Action where
   show (AddNode     _ _    )      = "AddNode"
   show (DeleteNode  _      )      = "DeleteNode"
   show (RenameNode  _      )      = "RenameNode"

src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs

@@ -8,6 +8,7 @@ import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Toestand as T
 
 import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
 import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
@@ -53,11 +54,11 @@ linkNodeCpt :: R.Component SubTreeParamsIn
 linkNodeCpt = here.component "linkNode" cpt
   where
     cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
+      action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing})
+      action' <- T.useLive T.unequal action
 
-      action@(valAction /\ setAction) :: R.State Action <- R.useState' (LinkNode {nodeType:Nothing,params:Nothing})
-
-      let button = case valAction of
-              LinkNode {params} -> case params of
+      let button = case action' of
+              LinkNode { params } -> case params of
                 Just val -> submitButton (LinkNode {nodeType: Just nodeType, params: Just val}) dispatch
                 Nothing -> H.div {} []
               _                   -> H.div {} []
@@ -65,10 +66,10 @@ linkNodeCpt = here.component "linkNode" cpt
       pure $ panel [
           subTreeView { action
                       , dispatch
+                      , handed
                       , id
                       , nodeType
                       , session
                       , subTreeParams
-                      , handed
-                      }
+                      } []
               ] button

src/Gargantext/Components/Forest/Tree/Node/Action/Merge.purs

@@ -31,7 +31,8 @@ mergeNodeCpt :: R.Component SubTreeParamsIn
 mergeNodeCpt = here.component "mergeNode" cpt
   where
     cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
-      action@(action' /\ _) :: R.State Action <- R.useState' (MergeNode {params:Nothing})
+      action <- T.useBox (MergeNode { params: Nothing })
+      action' <- T.useLive T.unequal action
 
       merge   <- T.useBox false
       options <- T.useBox (Set.singleton GT.MapTerm)
@@ -45,12 +46,12 @@ mergeNodeCpt = here.component "mergeNode" cpt
       pure $ panel
         [ subTreeView { action
                       , dispatch
+                      , handed
                       , id
                       , nodeType
                       , session
                       , subTreeParams
-                      , handed
-                      }
+                      } []
                   , H.ul { className:"merge mx-auto list-group"}
                      ([ H.li { className: "list-group-item" }
                        [ H.h5 { className: "mb-1" } [ H.text "Merge which list?" ]

src/Gargantext/Components/Forest/Tree/Node/Action/Move.purs

@@ -5,6 +5,7 @@ import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Toestand as T
 
 import Gargantext.Prelude
 
@@ -30,10 +31,11 @@ moveNodeCpt :: R.Component SubTreeParamsIn
 moveNodeCpt = here.component "moveNode" cpt
   where
     cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do
-      action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params: Nothing})
+      action :: T.Box Action <- T.useBox (MoveNode {params: Nothing})
+      action' <- T.useLive T.unequal action
 
-      let button = case valAction of
-              MoveNode {params} -> case params of
+      let button = case action' of
+              MoveNode { params } -> case params of
                 Just val -> submitButton (MoveNode {params: Just val}) dispatch
                 Nothing -> H.div {} []
               _                   -> H.div {} []
@@ -45,5 +47,5 @@ moveNodeCpt = here.component "moveNode" cpt
                                  , nodeType
                                  , session
                                  , subTreeParams
-                                 }
+                                 } []
               ] button

src/Gargantext/Components/Forest/Tree/Node/Action/Share.purs

@@ -9,6 +9,7 @@ import Effect.Aff (Aff)
 import Prelude (($))
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Toestand as T
 
 import Gargantext.Components.Forest.Tree.Node.Action (Action)
 import Gargantext.Components.Forest.Tree.Node.Action as Action
@@ -63,21 +64,22 @@ shareNodeCpt :: R.Component SubTreeParamsIn
 shareNodeCpt = here.component "shareNode" cpt
   where
     cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
-      action@(valAction /\ setAction) :: R.State Action <- R.useState' (Action.SharePublic {params: Nothing})
+      action <- T.useBox (Action.SharePublic { params: Nothing })
+      action' <- T.useLive T.unequal action
 
-      let button = case valAction of
-              Action.SharePublic {params} -> case params of
+      let button = case action' of
+              Action.SharePublic { params } -> case params of
                 Just val -> Tools.submitButton (Action.SharePublic {params: Just val}) dispatch
                 Nothing -> H.div {} []
               _   -> H.div {} []
 
       pure $ Tools.panel [ subTreeView { action
                                        , dispatch
+                                       , handed
                                        , id
                                        , nodeType
                                        , session
                                        , subTreeParams
-                                       , handed
-                                       }
+                                       } []
               ] button
 

src/Gargantext/Components/Forest/Tree/Node/Box.purs

@@ -184,7 +184,7 @@ panelActionCpt = here.component "panelAction" cpt
     cpt {action: Merge {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
       pure $ mergeNode {dispatch, id, nodeType, session, subTreeParams, handed} []
     cpt {action: Move {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
-      pure $ moveNode {dispatch, id, nodeType, session, subTreeParams, handed} []
+      pure $ moveNode { dispatch, id, nodeType, session, subTreeParams, handed } []
     cpt {action: Link {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
       pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed} []
     cpt {action : Share, dispatch, id, name } _ = do

src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree.purs

@@ -7,6 +7,7 @@ import Effect.Aff (Aff)
 import React.SyntheticEvent     as E
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Record as Record
 import Toestand as T
 
 import Gargantext.Prelude
@@ -25,19 +26,19 @@ here :: R2.Here
 here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree"
 
 type SubTreeParamsIn =
-  ( subTreeParams :: SubTreeParams
-  , handed    :: GT.Handed
+  ( handed        :: GT.Handed
+  , subTreeParams :: SubTreeParams
   | Props
   )
 
 ------------------------------------------------------------------------
 type SubTreeParamsProps =
-  ( action    :: R.State Action
+  ( action    :: T.Box Action
   | SubTreeParamsIn
   )
 
-subTreeView :: Record SubTreeParamsProps -> R.Element
-subTreeView props = R.createElement subTreeViewCpt props []
+subTreeView :: R2.Component SubTreeParamsProps
+subTreeView = R.createElement subTreeViewCpt
 
 subTreeViewCpt :: R.Component SubTreeParamsProps
 subTreeViewCpt = here.component "subTreeView" cpt
@@ -49,24 +50,23 @@ subTreeViewCpt = here.component "subTreeView" cpt
                , nodeType
                , session
                , subTreeParams
-               } _ =
-      do
-        let
-          SubTreeParams {showtypes} = subTreeParams
-        --  (valAction /\ setAction)  = action
-        -- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
-
-        useLoader session (loadSubTree showtypes) $
-          \tree ->
-            subTreeViewLoaded { action
-                              , dispatch
-                              , handed
-                              , id
-                              , nodeType
-                              , session
-                              , subTreeParams
-                              , tree
-                              }
+               } _ = do
+      let
+        SubTreeParams {showtypes} = subTreeParams
+      --  (valAction /\ setAction)  = action
+      -- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
+
+      useLoader session (loadSubTree showtypes) $
+        \tree ->
+          subTreeViewLoaded { action
+                            , dispatch
+                            , handed
+                            , id
+                            , nodeType
+                            , session
+                            , subTreeParams
+                            , tree
+                            } []
 
 loadSubTree :: Array GT.NodeType -> Session -> Aff FTree
 loadSubTree nodetypes session = getSubTree session treeId nodetypes
@@ -84,55 +84,68 @@ type CorpusTreeProps =
   | SubTreeParamsProps
   )
 
-subTreeViewLoaded :: Record CorpusTreeProps -> R.Element
-subTreeViewLoaded props = R.createElement subTreeViewLoadedCpt props []
+subTreeViewLoaded :: R2.Component CorpusTreeProps
+subTreeViewLoaded = R.createElement subTreeViewLoadedCpt
 
 subTreeViewLoadedCpt :: R.Component CorpusTreeProps
-subTreeViewLoadedCpt = here.component "subTreeViewLoadedCpt" cpt
+subTreeViewLoadedCpt = here.component "subTreeViewLoaded" cpt
   where
-    cpt p@{dispatch, id, nodeType, session, tree, handed} _ = do
+    cpt p@{ dispatch, handed, id, nodeType, session, tree } _ = do
+      let pRender = Record.merge { render: subTreeTreeView } p
+
       pure $ H.div {className:"tree"}
-                   [H.div { className: if handed == GT.RightHanded
-                                         then "righthanded"
-                                         else "lefthanded"
-                          }
-                          [ subTreeTreeView p ]
-                   ]
-
-subTreeTreeView :: Record CorpusTreeProps -> R.Element
-subTreeTreeView props = R.createElement subTreeTreeViewCpt props []
-
-subTreeTreeViewCpt :: R.Component CorpusTreeProps
-subTreeTreeViewCpt = here.component "subTreeTreeViewCpt" cpt where
-  cpt p@{ tree: NTree (LNode { id: targetId, name, nodeType }) ary
-        , id, subTreeParams, dispatch, action, handed } _ = do
-    pure $ H.div {} $ GT.reverseHanded
+        [ H.div { className: if handed == GT.RightHanded
+                             then "righthanded"
+                             else "lefthanded"
+                }
+          [ subTreeTreeView (CorpusTreeRenderProps pRender) [] ]
+        ]
+
+newtype CorpusTreeRenderProps = CorpusTreeRenderProps
+  { render :: CorpusTreeRenderProps -> Array R.Element -> R.Element
+  | CorpusTreeProps }
+
+subTreeTreeView :: CorpusTreeRenderProps -> Array R.Element -> R.Element
+subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt
+
+subTreeTreeViewCpt :: R2.NTComponent CorpusTreeRenderProps
+subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
+  cpt (CorpusTreeRenderProps p@{ action
+                               , dispatch
+                               , handed
+                               , id
+                               , render
+                               , subTreeParams
+                               , tree: NTree (LNode { id: targetId, name, nodeType }) ary }) _ = do
+    action' <- T.useLive T.unequal action
+
+    let click e = do
+          let action'' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
+          E.preventDefault  e
+          E.stopPropagation e
+          T.modify_ (\a -> setTreeOut a action'') action
+
+        children = (map (\ctree -> render (CorpusTreeRenderProps (p { tree = ctree })) []) sortedAry) :: Array R.Element
+
+    pure $ H.div {} $ GT.reverseHanded handed
       [ H.div { className: nodeClass validNodeType }
         [ H.span { className: "text"
                  , on: { click } }
           [ nodeText { handed
-                     , isSelected: isSelected targetId valAction
+                     , isSelected: isSelected targetId action'
                      , name: " " <> name } []
           , H.span { className: "children" } children
           ]
         ]
       ]
-      handed
     where
       nodeClass vnt = "node " <> GT.fldr nodeType true <> " " <> validNodeTypeClass where
         validNodeTypeClass = if vnt then "node-type-valid" else ""
       SubTreeParams { valitypes } = subTreeParams
       sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id')
         $ A.filter (\(NTree (LNode {id:id'}) _) -> id'/= id) ary
-      children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry
       validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
       clickable    = if validNodeType then "clickable" else ""
-      (valAction /\ setAction) = action
       isSelected n action' = case (subTreeOut action') of
         Nothing                   -> false
         (Just (SubTreeOut {out})) -> n == out
-      click e = do
-        let action' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
-        E.preventDefault  e
-        E.stopPropagation e
-        setAction $ const $ setTreeOut valAction action'

src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree/Types.purs

@@ -10,14 +10,20 @@ import Reactix as R
 data SubTreeOut = SubTreeOut { in  :: GT.ID
                              , out :: GT.ID
                              }
+derive instance genericSubTreeOut :: Generic SubTreeOut _
+instance eqSubTreOut      :: Eq SubTreeOut where
+  eq = genericEq
+instance showSubTreeOut           :: Show SubTreeOut where
+  show = genericShow
 
 ------------------------------------------------------------------------
 data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
                                    , valitypes :: Array GT.NodeType
                                    }
 
-derive instance eqSubTreeParams      :: Eq SubTreeParams
 derive instance genericSubTreeParams :: Generic SubTreeParams _
+instance eqSubTreeParams      :: Eq SubTreeParams where
+  eq = genericEq
 instance showSubTreeParams           :: Show SubTreeParams where
   show = genericShow
 ------------------------------------------------------------------------

src/Gargantext/Components/Nodes/Frame.purs

@@ -100,7 +100,10 @@ frameLayoutViewCpt :: R.Component ViewProps
 frameLayoutViewCpt = here.component "frameLayoutView" cpt
   where
     cpt { frame: (NodePoly { hyperdata: Hyperdata { base, frame_id }})
-        , nodeId, reload, session, nodeType } _ =
+        , nodeId
+        , nodeType
+        , reload
+        , session } _ =
       pure $ H.div { className : "frame"
                    , rows: "100%,*" }
         [ H.iframe { src: hframeUrl nodeType base frame_id

src/Gargantext/Components/TopBar.purs

@@ -29,19 +29,19 @@ topBarCpt = here.component "topBar" cpt
       pure $ H.div { className: "navbar navbar-expand-lg navbar-dark bg-dark fixed-top"
                    , id: "dafixedtop"
                    , role: "navigation"
-                   } $ reverseHanded [
+                   } $ reverseHanded handed' [
                       -- NOTE: first (and only) entry in the sorted array should have the "ml-auto class"
                       -- https://stackoverflow.com/questions/19733447/bootstrap-navbar-with-left-center-or-right-aligned-items
                       -- In practice: only apply "ml-auto" to the last element of this list, if handed == LeftHanded
                       logo
-                   , H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded [
+                   , H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded handed' [
                         divDropdownLeft {} []
                       , handButton handed'
                       , smiley
                       , H.li { className: "nav-item" } [ themeSwitcher { theme: defaultTheme
                                                                        , themes: allThemes } [] ]
-                      ] handed'
-                   ] handed'
+                      ]
+                   ]
           where
             handButton handed' = H.li { title: "If you are Left Handed you can change\n"
                                             <> "the interface by clicking on me. Click\n"

src/Gargantext/Types.purs

@@ -24,9 +24,9 @@ switchHanded :: forall a. a -> a -> Handed -> a
 switchHanded l _ LeftHanded = l
 switchHanded _ r RightHanded = r
 
-reverseHanded :: forall a. Array a -> Handed -> Array a
-reverseHanded a LeftHanded = A.reverse a
-reverseHanded a RightHanded = a
+reverseHanded :: forall a. Handed -> Array a -> Array a
+reverseHanded LeftHanded a = A.reverse a
+reverseHanded RightHanded a = a
 
 flipHanded :: R.Element -> R.Element -> Handed -> R.Element
 flipHanded l r LeftHanded  = R.fragment [r, l]

src/Gargantext/Utils/Reactix.purs

@@ -51,15 +51,17 @@ type Component p = Record p -> Array R.Element -> R.Element
 type Leaf p = Record p -> R.Element
 
 type Here =
-  { component :: forall p. String -> R.HooksComponent p -> R.Component p
-  , log       :: forall l. l -> Effect Unit
-  , log2      :: forall l. String -> l -> Effect Unit }
+  { component   :: forall p. String -> R.HooksComponent p -> R.Component p
+  , log         :: forall l. l -> Effect Unit
+  , log2        :: forall l. String -> l -> Effect Unit
+  , ntComponent :: forall p. String -> NTHooksComponent p -> NTComponent p }
 
 here :: Module -> Here
 here mod =
-  { component: R.hooksComponentWithModule mod
-  , log:       log2 ("[" <> mod <> "]")
-  , log2:      \msg -> log2 ("[" <> mod <> "] " <> msg) }
+  { component:   R.hooksComponentWithModule mod
+  , log:         log2 ("[" <> mod <> "]")
+  , log2:        \msg -> log2 ("[" <> mod <> "] " <> msg)
+  , ntComponent: ntHooksComponentWithModule mod }
 
 -- newtypes
 type NTHooksComponent props = props -> Array R.Element -> R.Hooks R.Element