[ngrams] some refactoring of NgramsTable

Moved out smaller, helper components to a separate module.

src/Gargantext/Components/NgramsTable/Components.purs

+module Gargantext.Components.NgramsTable.Components where
+
+import Data.Lens ((^..), (^.), view)
+import Data.Lens.At (at)
+import Data.Lens.Fold (folded)
+import Data.Lens.Index (ix)
+import Data.List (null, toUnfoldable) as L
+import Data.Maybe (Maybe(..), maybe, isJust)
+import Data.Nullable (null, toMaybe)
+import Data.Set (Set)
+import Data.Set as Set
+import React.DOM (a, span, text)
+import React.DOM.Props as DOM
+import Effect (Effect)
+import FFI.Simple (delay)
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+import Gargantext.Prelude
+import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsElement, NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, Replace, _NgramsElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, singletonNgramsTablePatch)
+import Gargantext.Components.Table as Tbl
+import Gargantext.Types as T
+import Gargantext.Utils.Reactix as R2
+
+
+type SearchInputProps =
+  (
+    key :: String  -- to prevent refreshing & losing input
+  , onSearch :: String -> Effect Unit
+  , searchQuery :: String
+  )
+
+searchInput :: Record SearchInputProps -> R.Element
+searchInput props = R.createElement searchInputCpt props []
+
+searchInputCpt :: R.Component SearchInputProps
+searchInputCpt = R.hooksComponent "G.C.NT.searchInput" cpt
+  where
+    cpt { onSearch, searchQuery } _ = do
+      pure $ H.div { className: "input-group" } [
+        H.div { className: "input-group-addon" } [
+           H.span { className: "fa fa-search" } []
+         ]
+      , H.input { className: "form-control"
+                , defaultValue: searchQuery
+                , name: "search"
+                , on: { input: onSearch <<< R2.unsafeEventValue }
+                , placeholder: "Search"
+                , type: "value" }
+        ]
+
+
+type SelectionCheckboxProps =
+  (
+    allNgramsSelected :: Boolean
+  , dispatch          :: Dispatch
+  , ngramsSelection   :: Set NgramsTerm
+  )
+
+selectionCheckbox :: Record SelectionCheckboxProps -> R.Element
+selectionCheckbox props = R.createElement selectionCheckboxCpt props []
+
+selectionCheckboxCpt :: R.Component SelectionCheckboxProps
+selectionCheckboxCpt = R.hooksComponent "G.C.NT.selectionCheckbox" cpt
+  where
+    cpt { allNgramsSelected, dispatch, ngramsSelection } _ = do
+      ref <- R.useRef null
+
+      R.useEffect' $ delay unit $ \_ -> do
+        let mCb = toMaybe $ R.readRef ref
+        case mCb of
+          Nothing -> pure unit
+          Just cb -> do
+            _ <- if allNgramsSelected || (Set.isEmpty ngramsSelection) then
+              R2.setIndeterminateCheckbox cb false
+            else
+              R2.setIndeterminateCheckbox cb true
+            pure unit
+
+      pure $ H.input { checked: allNgramsSelected
+                     , className: "checkbox"
+                     , on: { change: const $ dispatch $ ToggleSelectAll }
+                     , ref
+                     , type: "checkbox" }
+
+
+type RenderNgramsTree =
+  ( ngrams      :: NgramsTerm
+  , ngramsClick :: NgramsClick
+  , ngramsEdit  :: NgramsClick
+  , ngramsStyle :: Array DOM.Props
+  , ngramsTable :: NgramsTable
+  )
+
+renderNgramsTree :: Record RenderNgramsTree -> R.Element
+renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
+
+renderNgramsTreeCpt :: R.Component RenderNgramsTree
+renderNgramsTreeCpt = R.hooksComponent "G.C.NT.renderNgramsTree" cpt
+  where
+    cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } _ =
+      pure $ H.ul {} [
+        H.span { className: "tree" } [
+          tree { ngramsClick
+                , ngramsDepth: {ngrams, depth: 0}
+                , ngramsEdit
+                , ngramsStyle
+                , ngramsTable
+                }
+        ]
+      ]
+
+
+type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
+type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
+
+type TreeProps =
+  (
+    ngramsClick :: NgramsClick
+  , ngramsDepth :: NgramsDepth
+  , ngramsEdit  :: NgramsClick
+  , ngramsStyle :: Array DOM.Props
+  , ngramsTable :: NgramsTable
+  )
+
+tree :: Record TreeProps -> R.Element
+tree p = R.createElement treeCpt p []
+
+treeCpt :: R.Component TreeProps
+treeCpt = R.hooksComponent "G.C.NT.tree" cpt
+  where
+    cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
+      pure $
+        H.li { style: {width : "100%"} }
+          ([ H.i { className, style } [] ]
+           <> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
+           <> maybe [] edit (ngramsEdit ngramsDepth)
+           <> [ forest cs ])
+      where
+        tag =
+          case ngramsClick ngramsDepth of
+            Just effect ->
+              a (ngramsStyle <> [DOM.onClick $ const effect])
+            Nothing ->
+              span ngramsStyle
+        edit effect = [ H.text " "
+                      , H.i { className: "glyphicon glyphicon-pencil"
+                            , on: { click: const effect } } []
+                      ]
+        leaf = L.null cs
+        className = "glyphicon glyphicon-chevron-" <> if open then "down" else "right"
+        style = if leaf then {color: "#adb5bd"} else {color: ""}
+        open = not leaf || false {- TODO -}
+        cs   = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsElement <<< _children <<< folded
+
+        forest =
+          let depth = ngramsDepth.depth + 1 in
+          H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
+
+
+type RenderNgramsItem =
+  ( dispatch :: Action -> Effect Unit
+  , ngrams :: NgramsTerm
+  , ngramsElement :: NgramsElement
+  , ngramsLocalPatch :: NgramsTablePatch
+  , ngramsParent :: Maybe NgramsTerm
+  , ngramsSelection :: Set NgramsTerm
+  , ngramsTable :: NgramsTable
+  )
+
+renderNgramsItem :: Record RenderNgramsItem -> R.Element
+renderNgramsItem p = R.createElement renderNgramsItemCpt p []
+
+renderNgramsItemCpt :: R.Component RenderNgramsItem
+renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
+  where
+    cpt { dispatch
+        , ngrams
+        , ngramsElement
+        , ngramsLocalPatch
+        , ngramsParent
+        , ngramsSelection
+        , ngramsTable } _ =
+      pure $ Tbl.makeRow [
+          selected
+        , checkbox T.GraphTerm
+        , checkbox T.StopTerm
+        , if ngramsParent == Nothing
+          then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
+          else
+            H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } } [
+                H.i { className: "glyphicon glyphicon-plus" } []
+              , (R2.buff $ span ngramsStyle [text $ " " <> ngramsTermText ngrams])
+            ]
+        , H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
+      ]
+      where
+        termList    = ngramsElement ^. _NgramsElement <<< _list
+        ngramsStyle = [termStyle termList ngramsOpacity]
+        ngramsEdit  = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
+        ngramsClick
+          = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
+          -- ^ This is the old behavior it is nicer to use since one can
+          --   rapidly change the ngram list without waiting for confirmation.
+          --   However this might expose bugs. One of them can be reproduced
+          --   by clicking a multiple times on the same ngram, sometimes it stays
+          --   transient.
+          -- | ngramsTransient = const Nothing
+          -- | otherwise       = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
+        selected    =
+          H.input { checked: Set.member ngrams ngramsSelection
+                  , className: "checkbox"
+                  , on: { change: const $ dispatch $ ToggleSelect ngrams }
+                  , type: "checkbox" }
+        checkbox termList' =
+          let chkd = termList == termList'
+              termList'' = if chkd then T.CandidateTerm else termList'
+          in
+          H.input { checked: chkd
+                  , className: "checkbox"
+                  , on: { change: const $ dispatch $
+                          setTermListA ngrams (replace termList termList'') }
+                  , readOnly: ngramsTransient
+                  , type: "checkbox" }
+        ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
+          -- ^ TODO here we do not look at ngramsNewElems, shall we?
+        ngramsOpacity
+          | ngramsTransient = 0.5
+          | otherwise       = 1.0
+
+        cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
+
+
+termStyle :: T.TermList -> Number -> DOM.Props
+termStyle T.GraphTerm     opacity = DOM.style { color: "green", opacity }
+termStyle T.StopTerm      opacity = DOM.style { color: "red",   opacity
+                                              , textDecoration: "line-through" }
+termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }
+
+setTermListA :: NgramsTerm -> Replace T.TermList -> Action
+setTermListA n patch_list =
+  CommitPatch $
+    singletonNgramsTablePatch n $
+    NgramsPatch { patch_list, patch_children: mempty }
+
+
+tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
+tablePatchHasNgrams ngramsTablePatch ngrams =
+  isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
+
+
+nextTermList :: T.TermList -> T.TermList
+nextTermList T.GraphTerm     = T.StopTerm
+nextTermList T.StopTerm      = T.CandidateTerm
+nextTermList T.CandidateTerm = T.GraphTerm

src/Gargantext/Components/NgramsTable/Core.purs

@@ -49,6 +49,8 @@ module Gargantext.Components.NgramsTable.Core
   , syncPatches
   , syncPatchesR
   , addNewNgram
+  , Action(..)
+  , Dispatch
   )
   where
 
@@ -735,3 +737,22 @@ convOrderBy (T.ASC  (T.ColumnName "Score")) = ScoreAsc
 convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
 convOrderBy (T.ASC  _) = TermAsc
 convOrderBy (T.DESC _) = TermDesc
+
+
+data Action
+  = CommitPatch NgramsTablePatch
+  | SetParentResetChildren (Maybe NgramsTerm)
+  -- ^ This sets `ngramsParent` and resets `ngramsChildren`.
+  | ToggleChild Boolean NgramsTerm
+  -- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
+  -- If the `Boolean` is `true` it means we want to add it if it is not here,
+  -- if it is `false` it is meant to be removed if not here.
+  | AddTermChildren
+  | Synchronize
+  | ToggleSelect NgramsTerm
+  -- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
+  | ToggleSelectAll
+  | ResetPatches
+
+
+type Dispatch = Action -> Effect Unit