Merge branch 'dev' into dev-graphql

package.json

 {
     "name": "Gargantext",
-    "version": "0.0.4.4",
+    "version": "0.0.4.5",
     "scripts": {
         "generate-purs-packages-nix": "./nix/generate-purs-packages.nix",
         "generate-psc-packages-nix": "./nix/generate-packages-json.bash",

shell.nix

@@ -35,6 +35,14 @@ let
 
   '';
 
+  serve = pkgs.writeShellScriptBin "serve" ''
+    #!/usr/bin/env bash
+    set -e
+
+    yarn server
+
+  '';
+
   build-watch = pkgs.writeShellScriptBin "build-watch" ''
     #!/usr/bin/env bash
     set -e
@@ -110,6 +118,7 @@ pkgs.mkShell {
     pkgs.minify
     pkgs.nodejs
     repl
+    serve
     pkgs.pulp
     pkgs.spago
     pkgs.yarn

src/Gargantext/Components/GraphExplorer/Controls.purs

@@ -163,7 +163,7 @@ controlsCpt = here.component "controls" cpt
                  [ RH.ul { className: "navbar-nav mx-auto" }
                    [ -- change type button (?)
                      navItem [ centerButton sigmaRef ]
-                   , navItem [ resetForceAtlasButton { forceAtlasState, sigmaRef } [] ]
+                   -- , navItem [ resetForceAtlasButton { forceAtlasState, sigmaRef } [] ]
                    , navItem [ pauseForceAtlasButton { state: forceAtlasState } [] ]
                    , navItem [ edgesToggleButton { state: showEdges } [] ]
                    , navItem [ louvainToggleButton { state: showLouvain } [] ]

src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -8,6 +8,7 @@ import Control.Parallel (parTraverse)
 import Data.Array (head, last, concat)
 import Data.Array as A
 import Data.Either (Either(..))
+import Data.Foldable as F
 import Data.Int (fromString)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromJust)
@@ -33,6 +34,7 @@ import Gargantext.Sessions (Session)
 import Gargantext.Types (CTabNgramType, FrontendError(..), NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Toestand as T2
+import Math as Math
 import Partial.Unsafe (unsafePartial)
 import Reactix as R
 import Reactix.DOM.HTML as H
@@ -182,6 +184,10 @@ selectedNodesCpt = here.component "selectedNodes" cpt
       { selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
       selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
 
+      let badges' = neighbourBadges graph selectedNodeIds'
+          minSize = F.foldl Math.min 0.0 (Seq.map _.size (SigmaxT.graphNodes graph))
+          maxSize = F.foldl Math.max 0.0 (Seq.map _.size (SigmaxT.graphNodes graph))
+
       pure $ R2.row
         [ R2.col 12
           [ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
@@ -191,9 +197,7 @@ selectedNodesCpt = here.component "selectedNodes" cpt
               [ RH.div { className: "d-flex flex-wrap justify-content-center"
                        , role: "tabpanel" }
                 ( Seq.toUnfoldable
-                  $ ( Seq.map (badge selectedNodeIds)
-                      (badges graph selectedNodeIds')
-                    )
+                  $ ( Seq.map (\node -> badge { maxSize, minSize, node, selectedNodeIds }) badges')
                 )
               , H.br {}
               ]
@@ -225,15 +229,17 @@ neighborhoodCpt = here.component "neighborhood" cpt
       { selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
       selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
 
+      let badges' = neighbourBadges graph selectedNodeIds'
+          minSize = F.foldl Math.min 0.0 (Seq.map _.size (SigmaxT.graphNodes graph))
+          maxSize = F.foldl Math.max 0.0 (Seq.map _.size (SigmaxT.graphNodes graph))
+
       pure $ RH.div { className: "tab-content", id: "myTabContent" }
         [ RH.div { -- className: "flex-space-around d-flex justify-content-center"
              className: "d-flex flex-wrap flex-space-around"
              , id: "home"
              , role: "tabpanel"
              }
-          (Seq.toUnfoldable $ Seq.map (badge selectedNodeIds)
-           $ neighbourBadges graph selectedNodeIds'
-          )
+          (Seq.toUnfoldable $ Seq.map (\node -> badge { maxSize, minSize, node, selectedNodeIds }) badges')
         ]
 
 
@@ -284,12 +290,29 @@ updateTermButtonCpt = here.component "updateTermButton" cpt
           T.write_ SigmaxT.emptyNodeIds selectedNodeIds
 
 
+type BadgeProps =
+  ( maxSize         :: Number
+  , minSize         :: Number
+  , node            :: Record SigmaxT.Node
+  , selectedNodeIds :: T.Box SigmaxT.NodeIds )
+
+badge :: R2.Leaf BadgeProps
+badge props = R.createElement badgeCpt props []
+badgeCpt :: R.Component BadgeProps
+badgeCpt = here.component "badge" cpt where
+  cpt { maxSize, minSize, node: { id, label, size }, selectedNodeIds } _ = do
+    let minFontSize = 1.0  -- "em"
+    let maxFontSize = 3.0  -- "em"
+    let sizeScaled = (size - minSize) / (maxSize - minSize)  -- in [0; 1] range
+    let scale' = Math.log (sizeScaled + 1.0) / (Math.log 2.0)  -- in [0; 1] range
+    let scale = minFontSize + scale' * (maxFontSize - minFontSize)
+    let style = {
+          fontSize: show scale <> "em"
+          }
     
-badge :: T.Box SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
-badge selectedNodeIds {id, label} =
-  RH.a { className: "badge badge-pill badge-light"
+    pure $ RH.a { className: "badge badge-pill badge-light"
                 , on: { click: onClick }
-       } [ RH.h6 {} [ RH.text label ] ]
+                } [ RH.h6 { style } [ RH.text label ] ]
     where
       onClick _ = do
         T.write_ (Set.singleton id) selectedNodeIds

src/Gargantext/Components/NgramsTable.purs

@@ -83,7 +83,7 @@ setTermListSetA ngramsTable ns new_list =
     f n _unit = NgramsPatch { patch_list, patch_children: mempty }
       where
         cur_list = ngramsTable ^? at n <<< _Just <<< _NgramsRepoElement <<< _list
-        patch_list = maybe mempty (\c -> replace c new_list) cur_list
+        patch_list = maybe mempty (replace new_list) cur_list
     toMap :: forall a. Set a -> Map a Unit
     toMap = unsafeCoerce
     -- TODO https://github.com/purescript/purescript-ordered-collections/pull/21
@@ -213,7 +213,8 @@ tableContainerCpt { dispatch
                                           , ngramsEdit
                                           }
                    , H.button { className: "btn btn-primary"
-                              , on: {click: (const $ dispatch AddTermChildren)}
+                              , on: {click: (const $ do
+                                               dispatch AddTermChildren)}
                               } [H.text "Save"]
                    , H.button { className: "btn btn-primary"
                               , on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
@@ -314,8 +315,8 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
     path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
     params <- T.useFocused (_.params) (\a b -> b { params = a }) path
     params'@{ orderBy } <- T.useLive T.unequal params
-    searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
-    searchQuery' <- T.useLive T.unequal searchQuery
+    searchQueryFocused <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
+    searchQuery <- T.useLive T.unequal searchQueryFocused
 
     let ngramsTable = applyNgramsPatches state' initTable
         rowMap (Tuple ng nre) =
@@ -328,15 +329,18 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
           in
           addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)
         rows :: PreConversionRows
-        rows = ngramsTableOrderWith orderBy (
-                 Seq.mapMaybe rowMap $
-                   Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
-               )
+        rows = ngramsTableOrderWith orderBy (Seq.mapMaybe rowMap nres)
+        nres = Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
+        rootOfMatch (Tuple ng nre) =
+          if queryMatchesLabel searchQuery (ngramsTermText ng)
+          then Just (fromMaybe ng (nre ^. _NgramsRepoElement <<< _root))
+          else Nothing
+        rootsWithMatches = Set.fromFoldable (Seq.mapMaybe rootOfMatch nres)
         rowsFilter :: NgramsElement -> Maybe NgramsElement
         rowsFilter ngramsElement =
           if displayRow { ngramsElement
                         , ngramsParentRoot
-                        , searchQuery: searchQuery'
+                        , rootsWithMatches
                         , state: state'
                         , termListFilter
                         , termSizeFilter } then
@@ -471,23 +475,33 @@ mkDispatch { filteredRows
             s { ngramsSelection = Set.empty :: Set NgramsTerm }
           else
             s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
-    performAction AddTermChildren =
+    performAction AddTermChildren = do
       case ngramsParent of
         Nothing ->
           -- impossible but harmless
           pure unit
         Just parent -> do
+          here.log2 "[performAction] AddTermChildren, parent" parent
           let pc = patchSetFromMap ngramsChildren
               pe = NgramsPatch { patch_list: mempty, patch_children: pc }
               pt = singletonNgramsTablePatch parent pe
           T.modify_ (setParentResetChildren Nothing) state
-          commitPatch pt state
+          here.log2 "[performAction] pt" pt
+          let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildren) of
+                Nothing -> mempty
+                Just h  ->
+                  let pp = NgramsPatch { patch_list: mempty
+                                       , patch_children: patchSetFromMap $ Map.mapMaybe (\v -> Just $ not v) ngramsChildren }
+                  in
+                  singletonNgramsTablePatch h pp
+          here.log2 "[performAction] pt with patchSetFromMap" $ pt <> ppt
+          commitPatch (pt <> ppt) state
     performAction (CoreAction a) = coreDispatch path state a
 
 
 displayRow :: { ngramsElement    :: NgramsElement
               , ngramsParentRoot :: Maybe NgramsTerm
-              , searchQuery      :: SearchQuery
+              , rootsWithMatches :: Set NgramsTerm
               , state            :: State
               , termListFilter   :: Maybe TermList
               , termSizeFilter   :: Maybe TermSize } -> Boolean
@@ -496,14 +510,17 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
            , state: { ngramsChildren
                     , ngramsLocalPatch
                     , ngramsParent }
-           , searchQuery
+           , rootsWithMatches
            , termListFilter
            , termSizeFilter } =
-  (
-    -- isNothing root
-    -- ^ Display only nodes without parents
-    -- ^^ (?) allow child nodes to be searched (see #340)
-       maybe true (_ == list) termListFilter
+    -- See these issues about the evolution of this filtering.
+    -- * https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/340
+    -- * https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/87
+       isNothing root
+    -- ^ Display only nodes without parents.
+    && Set.member ngrams rootsWithMatches
+    -- ^ and which matches the search query.
+    && maybe true (_ == list) termListFilter
     -- ^ and which matches the ListType filter.
     && ngramsChildren ^. at ngrams /= Just true
     -- ^ and which are not scheduled to be added already
@@ -517,10 +534,6 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
     -- ^ unless they are scheduled to be removed.
     || NTC.tablePatchHasNgrams ngramsLocalPatch ngrams
     -- ^ unless they are being processed at the moment.
-  )
-    && queryMatchesLabel searchQuery (ngramsTermText ngrams)
-    -- ^ and which matches the search query.
-
 
 allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
 allNgramsSelectedOnFirstPage selected rows = selected == (selectNgramsOnFirstPage rows)