[MERGE] fix conflicts.

src/Gargantext/Components/Annotation/AnnotatedField.purs

@@ -24,7 +24,7 @@ import Reactix.SyntheticEvent as E
 
 import Gargantext.Types (CTabNgramType(..), TermList)
 import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
-import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams)
+import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
 import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Selection as Sel
@@ -56,7 +56,7 @@ annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
             let x = E.clientX event
                 y = E.clientY event
                 setList t = do
-                  setTermList text' (Just list) t
+                  setTermList (normNgram CTabTerms text') (Just list) t
                   setMenu (const Nothing)
             setMenu (const $ Just {x, y, list: Just list, menuType: SetTermListItem, setList} )
 
@@ -78,9 +78,10 @@ maybeShowMenu setMenu setTermList ngrams event = do
         sel' -> do
           let x = E.clientX event
               y = E.clientY event
-              list = findNgramTermList CTabTerms ngrams sel'
+              n = normNgram CTabTerms sel'
+              list = findNgramTermList ngrams n
               setList t = do
-                setTermList sel' list t
+                setTermList n list t
                 setMenu (const Nothing)
           E.preventDefault event
           setMenu (const $ Just { x, y, list, menuType: NewNgram, setList })

src/Gargantext/Components/DocsTable.purs

@@ -391,7 +391,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
     pure $ T.table
       { rows: rows localCategories
       , container: T.defaultContainer { title: "Documents" }
-      , params, colNames, totalRecords }
+      , params, colNames, totalRecords, wrapColElts }
       where
         sid = sessionId session
         gi Favorite  = "glyphicon glyphicon-star"
@@ -402,6 +402,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
           | Just cid <- corpusId = Routes.CorpusDocument sid cid listId
           | otherwise = Routes.Document sid listId
         colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"]
+        wrapColElts = const identity
         getCategory (localCategories /\ _) {_id, category} = maybe category identity (localCategories ^. at _id)
         rows localCategories = row <$> documents
           where

src/Gargantext/Components/FacetsTable.purs

@@ -277,11 +277,12 @@ pageCpt :: R.Component PageProps
 pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
   where
     cpt {totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
-      T.table { rows, container, colNames, totalRecords, params }
+      T.table { rows, container, colNames, totalRecords, params, wrapColElts }
       where
         setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
         params = (fst path).params /\ setParams
         colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ]
+        wrapColElts = const identity
         -- TODO: how to interprete other scores?
         gi Favorite = "glyphicon glyphicon-star-empty"
         gi _ = "glyphicon glyphicon-star"

src/Gargantext/Components/NgramsTable.purs

@@ -7,8 +7,10 @@ import Prelude
   ( class Show, Unit, bind, const, discard, identity, map, mempty, not
   , pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<)
   , (==), (||) )
+import Control.Monad (unless)
 import Data.Array as A
-import Data.Lens (Lens', to, view, (%~), (.~), (^.), (^..))
+import Data.FunctorWithIndex (mapWithIndex)
+import Data.Lens (Lens', to, view, (%~), (.~), (^.), (^..), (^?))
 import Data.Lens.Common (_Just)
 import Data.Lens.At (at)
 import Data.Lens.Index (ix)
@@ -17,9 +19,11 @@ import Data.Lens.Record (prop)
 import Data.List as List
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..), maybe, fromJust)
 import Data.Monoid.Additive (Additive(..))
 import Data.Ord.Down (Down(..))
+import Data.Set (Set)
+import Data.Set as Set
 import Data.Symbol (SProxy(..))
 import Data.Tuple (Tuple(..), snd)
 import Data.Tuple.Nested ((/\))
@@ -37,17 +41,20 @@ import Gargantext.Types
   , readTermSize, termLists, termSizes)
 import Gargantext.Components.AutoUpdate (autoUpdateElt)
 import Gargantext.Components.NgramsTable.Core
-  ( CoreState, NgramsElement(..), NgramsPatch(..)
-  , NgramsTable, NgramsTerm, PageParams, Replace(..), Versioned(..)
+  ( CoreState, NgramsElement(..), NgramsPatch(..), NgramsTablePatch
+  , NgramsTable, NgramsTerm, PageParams, Replace, Versioned(..)
   , VersionedNgramsTable, _NgramsElement, _NgramsTable, _children
   , _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsTablePatch
   , applyPatchSet, commitPatch, convOrderBy, initialPageParams, loadNgramsTable
-  , patchSetFromMap, replace, singletonNgramsTablePatch )
+  , patchSetFromMap, replace, singletonNgramsTablePatch, isEmptyNgramsTablePatch
+  , normNgram, ngramsTermText, fromNgramsPatches, PatchMap(..), rootsOf )
 import Gargantext.Components.Loader (loader)
 import Gargantext.Components.Table as T
 import Gargantext.Sessions (Session)
 import Gargantext.Utils.Reactix as R2
 
+import Unsafe.Coerce (unsafeCoerce)
+
 type State =
   CoreState
   ( ngramsParent     :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
@@ -56,33 +63,67 @@ type State =
                      --   This updates the children of `ngramsParent`,
                      --   ngrams set to `true` are to be added, and `false` to
                      --   be removed.
+  , ngramsSelection  :: Set NgramsTerm
+                     -- ^ The set of selected checkboxes of the first column.
+  , ngramsSelectAll  :: Boolean
+                     -- ^ The checkbox to select all the checkboxes of the first column.
   )
 
 _ngramsChildren :: forall row. Lens' { ngramsChildren :: Map NgramsTerm Boolean | row } (Map NgramsTerm Boolean)
 _ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")
 
+_ngramsSelectAll :: forall row. Lens' { ngramsSelectAll :: Boolean | row } Boolean
+_ngramsSelectAll = prop (SProxy :: SProxy "ngramsSelectAll")
+
+_ngramsSelection :: forall row. Lens' { ngramsSelection :: Set NgramsTerm | row } (Set NgramsTerm)
+_ngramsSelection = prop (SProxy :: SProxy "ngramsSelection")
+
 initialState :: VersionedNgramsTable -> State
 initialState (Versioned {version}) =
   { ngramsTablePatch: mempty
   , ngramsVersion:    version
   , ngramsParent:     Nothing
   , ngramsChildren:   mempty
+  , ngramsSelectAll:  false
+  , ngramsSelection:  mempty
   }
 
 data Action
-  = SetTermListItem NgramsTerm (Replace TermList)
+  = 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 -- NgramsTable
-  -- ^ The NgramsTable argument is here as a cache of `ngramsTablePatch`
-  -- applied to `initTable`.
-  -- TODO more docs
+  | AddTermChildren
   | Refresh
-  | AddNewNgram NgramsTerm
+  | ToggleSelect NgramsTerm
+  -- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
+  | ToggleSelectAll
+
+setTermListA :: NgramsTerm -> Replace TermList -> Action
+setTermListA n patch_list =
+  CommitPatch $
+    singletonNgramsTablePatch n $
+    NgramsPatch { patch_list, patch_children: mempty }
+
+setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
+setTermListSetA ngramsTable ns new_list =
+  CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
+  where
+    f :: NgramsTerm -> Unit -> NgramsPatch
+    f n unit = NgramsPatch { patch_list, patch_children: mempty }
+      where
+        cur_list = ngramsTable ^? at n <<< _Just <<< _NgramsElement <<< _list
+        patch_list = maybe mempty (\c -> replace c new_list) cur_list
+    toMap :: forall a. Set a -> Map a Unit
+    toMap = unsafeCoerce
+    -- TODO https://github.com/purescript/purescript-ordered-collections/pull/21
+    -- toMap = Map.fromFoldable
+
+addNewNgramA :: NgramsTerm -> Action
+addNewNgramA ngram = CommitPatch $ addNewNgram ngram CandidateTerm
 
 type Dispatch = Action -> Effect Unit
 
@@ -90,14 +131,18 @@ tableContainer :: { path           :: R.State PageParams
                   , dispatch        :: Dispatch
                   , ngramsParent    :: Maybe NgramsTerm
                   , ngramsChildren  :: Map NgramsTerm Boolean
+                  , ngramsSelection :: Set NgramsTerm
                   , ngramsTable     :: NgramsTable
+                  , tabNgramType    :: CTabNgramType
                   }
                -> Record T.TableContainerProps -> R.Element
 tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
                , dispatch
                , ngramsParent
                , ngramsChildren
+               , ngramsSelection
                , ngramsTable: ngramsTableCache
+               , tabNgramType
                } props =
   H.div {className: "container-fluid"}
   [ H.div {className: "jumbotron1"}
@@ -119,7 +164,8 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
               , H.div {} (
                    if A.null props.tableBody && searchQuery /= "" then [
                      H.button { className: "btn btn-primary"
-                              , on: {click: const $ dispatch $ AddNewNgram searchQuery}}
+                              , on: {click: const $ dispatch $ addNewNgramA $ normNgram tabNgramType searchQuery}
+                              }
                      [ H.text ("Add " <> searchQuery) ]
                      ] else [])]
             , H.div {className: "col-md-2", style: {marginTop : "6px"}}
@@ -141,7 +187,20 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
                 [ props.pageSizeDescription
                 , props.pageSizeControl
                 , H.text " items / "
-                , props.paginationLinks]]]]
+                , props.paginationLinks]]
+            , H.div {className: "col-md-1", style: {marginTop : "6px", marginBottom : "1px"}}
+              [ H.li {className: " list-group-item"}
+                [ H.button { className: "btn btn-primary"
+                           , on: {click: const $ setSelection GraphTerm }
+                           }
+                  [ H.text "Map" ]
+                , H.button { className: "btn btn-primary"
+                           , on: {click: const $ setSelection StopTerm }
+                           }
+                  [ H.text "Stop" ]
+                ]
+              ]
+            ]]
         , H.div {}
           (maybe [] (\ngrams ->
               let
@@ -156,9 +215,9 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
                 ngramsClick _ = Nothing
                 ngramsEdit _ = Nothing
               in
-              [ H.p {} [H.text $ "Editing " <> ngrams]
+              [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
               , R2.buff $ renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
-              , H.button {className: "btn btn-primary", on: {click: (const $ dispatch $ AddTermChildren)}} [H.text "Save"]
+              , H.button {className: "btn btn-primary", on: {click: (const $ dispatch AddTermChildren)}} [H.text "Save"]
               , H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"]
               ]) ngramsParent)
           , H.div {id: "terms_table", className: "panel-body"}
@@ -170,10 +229,11 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
     setSearchQuery    x = setPath $ _ { searchQuery = x }
     setTermListFilter x = setPath $ _ { termListFilter = x }
     setTermSizeFilter x = setPath $ _ { termSizeFilter = x }
+    setSelection = dispatch <<< setTermListSetA ngramsTableCache ngramsSelection
 
-toggleMap :: forall a. a -> Maybe a -> Maybe a
-toggleMap _ (Just _) = Nothing
-toggleMap b Nothing  = Just b
+toggleMaybe :: forall a. a -> Maybe a -> Maybe a
+toggleMaybe _ (Just _) = Nothing
+toggleMaybe b Nothing  = Just b
 
 -- NEXT
 data Action'
@@ -183,8 +243,7 @@ data Action'
 
 -- NEXT
 type Props =
-  ( tabNgramType :: CTabNgramType
-  , path         :: R.State PageParams
+  ( path         :: R.State PageParams
   , versioned    :: VersionedNgramsTable )
 
 -- NEXT
@@ -223,18 +282,32 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
     performAction (SetParentResetChildren p) _ _ =
       modifyState_ $ setParentResetChildren p
     performAction (ToggleChild b c) _ _ =
-      modifyState_ $ _ngramsChildren <<< at c %~ toggleMap b
+      modifyState_ $ _ngramsChildren <<< at c %~ toggleMaybe b
+    performAction (ToggleSelect c) _ _ =
+      modifyState_ $ _ngramsSelection <<< at c %~ toggleMaybe unit
+    performAction ToggleSelectAll _ { ngramsSelectAll: true } =
+      modifyState_ $ (_ngramsSelection .~ mempty)
+                 <<< (_ngramsSelectAll .~ false)
+    performAction ToggleSelectAll { versioned: Versioned { data: initTable } }
+                                  { ngramsTablePatch } =
+      let
+        ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable
+        roots = rootsOf ngramsTable
+      in
+      modifyState_ $ (_ngramsSelection .~ roots)
+                 <<< (_ngramsSelectAll .~ true)
     performAction Refresh {path: path /\ _} {ngramsVersion} = do
       commitPatch path (Versioned {version: ngramsVersion, data: mempty})
-    performAction (SetTermListItem n pl) {path: path /\ _, tabNgramType} {ngramsVersion} =
+      -- Here we purposedly send an empty patch as a way to synchronize with
+      -- the server.
+    performAction (CommitPatch pt) {path: path /\ _} {ngramsVersion} =
+      unless (isEmptyNgramsTablePatch pt) $
         commitPatch path (Versioned {version: ngramsVersion, data: pt})
-      where
-        pe = NgramsPatch { patch_list: pl, patch_children: mempty }
-        pt = singletonNgramsTablePatch tabNgramType n pe
+
     performAction AddTermChildren _ {ngramsParent: Nothing} =
         -- impossible but harmless
         pure unit
-    performAction AddTermChildren {path: path /\ _, tabNgramType}
+    performAction AddTermChildren {path: path /\ _}
                   { ngramsParent: Just parent
                   , ngramsChildren
                   , ngramsVersion
@@ -244,25 +317,35 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
       where
         pc = patchSetFromMap ngramsChildren
         pe = NgramsPatch { patch_list: mempty, patch_children: pc }
-        pt = singletonNgramsTablePatch tabNgramType parent pe
-    performAction (AddNewNgram ngram) {path: path /\ _, tabNgramType} {ngramsVersion} =
-        commitPatch path (Versioned {version: ngramsVersion, data: pt})
-      where
-        pt = addNewNgram tabNgramType ngram CandidateTerm
+        pt = singletonNgramsTablePatch parent pe
 
     render :: Thermite.Render State (Record LoadedNgramsTableProps) Action
-    render dispatch { path: path@({params} /\ setPath)
-                    , versioned: Versioned { data: initTable } }
-                    { ngramsTablePatch, ngramsParent, ngramsChildren }
+    render dispatch { path: path@({scoreType, params} /\ setPath)
+                    , versioned: Versioned { data: initTable }
+                    , tabNgramType }
+                    { ngramsTablePatch, ngramsParent, ngramsChildren,
+                      ngramsSelection, ngramsSelectAll }
                     _reactChildren =
       [ autoUpdateElt { duration: 3000, effect: dispatch Refresh }
       , R2.scuff $ T.table { params: params /\ setParams -- TODO-LENS
-                           , rows, container, colNames, totalRecords}
+                           , rows, container, colNames, wrapColElts, totalRecords
+                           }
       ]
       where
         totalRecords = 47361 -- TODO
-        colNames = T.ColumnName <$> ["Map", "Stop", "Terms", "Score (Occurrences)"] -- see convOrderBy
-        container = tableContainer {path, dispatch, ngramsParent, ngramsChildren, ngramsTable}
+        colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
+        selected =
+          input
+            [ _type "checkbox"
+            , className "checkbox"
+            , checked ngramsSelectAll
+            , onChange $ const $ dispatch $ ToggleSelectAll
+            ]
+        -- This is used to *decorate* the Select header with the checkbox.
+        wrapColElts (T.ColumnName "Select") = const [R2.buff selected]
+        wrapColElts (T.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
+        wrapColElts _                       = identity
+        container = tableContainer {path, dispatch, ngramsParent, ngramsChildren, ngramsSelection, ngramsTable, tabNgramType}
         setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
         ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable
         orderWith =
@@ -276,9 +359,9 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
           let Additive occurrences = sumOccurrences ngramsTable ngramsElement in
           Tuple ne (ngramsElement # _NgramsElement <<< _occurrences .~ occurrences)
 
-        ngramsParentRoot :: Maybe String
+        ngramsParentRoot :: Maybe NgramsTerm
         ngramsParentRoot =
-          (\np -> ngramsTable ^. at np <<< _Just <<< _NgramsElement <<< _root) =<< ngramsParent
+          (\np -> ngramsTable ^? at np <<< _Just <<< _NgramsElement <<< _root <<< _Just) =<< ngramsParent
 
         displayRow (NgramsElement {ngrams, root}) =
           root == Nothing
@@ -292,7 +375,9 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
           || -- Unless they are scheduled to be removed.
           ngramsChildren ^. at ngrams == Just false
         convertRow (Tuple ngrams ngramsElement) =
-          { row: R2.buff <$> renderNgramsItem { ngramsTable, ngrams, ngramsParent, ngramsElement, dispatch}
+          { row: R2.buff <$> renderNgramsItem { ngramsTable, ngrams,
+                                                ngramsParent, ngramsElement,
+                                                ngramsSelection, dispatch }
           , delete: false
           }
 
@@ -334,7 +419,7 @@ tree :: { ngramsTable :: NgramsTable
 tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd =
   li [ style {width : "100%"} ]
     ([ i icon []
-     , tag [text $ " " <> nd.ngrams]
+     , tag [text $ " " <> ngramsTermText nd.ngrams]
      ] <> maybe [] edit (ngramsEdit nd) <>
      [ forest cs
      ])
@@ -381,17 +466,20 @@ renderNgramsItem :: { ngrams :: NgramsTerm
                     , ngramsTable :: NgramsTable
                     , ngramsElement :: NgramsElement
                     , ngramsParent :: Maybe NgramsTerm
+                    , ngramsSelection :: Set NgramsTerm
                     , dispatch :: Action -> Effect Unit
                     } -> Array ReactElement
-renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch } =
-  [ checkbox GraphTerm
+renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent
+                 , ngramsSelection, dispatch } =
+  [ selected
+  , checkbox GraphTerm
   , checkbox StopTerm
   , if ngramsParent == Nothing
     then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
     else
       a [onClick $ const $ dispatch $ ToggleChild true ngrams]
         [ i [className "glyphicon glyphicon-plus"] []
-        , span ngramsStyle [text $ " " <> ngrams]
+        , span ngramsStyle [text $ " " <> ngramsTermText ngrams]
         ]
   , text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
   ]
@@ -399,7 +487,14 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch }
     termList    = ngramsElement ^. _NgramsElement <<< _list
     ngramsStyle = [termStyle termList]
     ngramsEdit  = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
-    ngramsClick = Just <<< cycleTermListItem <<< view _ngrams
+    ngramsClick = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
+    selected    =
+      input
+        [ _type "checkbox"
+        , className "checkbox"
+        , checked $ Set.member ngrams ngramsSelection
+        , onChange $ const $ dispatch $ ToggleSelect ngrams
+        ]
     checkbox termList' =
       let chkd = termList == termList'
           termList'' = if chkd then CandidateTerm else termList'
@@ -408,14 +503,11 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch }
         [ _type "checkbox"
         , className "checkbox"
         , checked chkd
-     -- , title "Mark as completed"
-        , onChange $ const $ setTermList (replace termList termList'') ngrams
+        , onChange $ const $ dispatch $
+            setTermListA ngrams (replace termList termList'')
         ]
 
-    setTermList Keep                    _ = pure unit
-    setTermList rep@(Replace {old,new}) n = dispatch $ SetTermListItem n rep
-
-    cycleTermListItem = setTermList (replace termList (nextTermList termList))
+    cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
 
 termStyle :: TermList -> DOM.Props
 termStyle GraphTerm     = style {color: "green"}

src/Gargantext/Components/NgramsTable/Core.purs

@@ -11,6 +11,7 @@ module Gargantext.Components.NgramsTable.Core
   , _NgramsTable
   , NgramsTerm
   , normNgram
+  , ngramsTermText
   , findNgramTermList
   , Version
   , Versioned(..)
@@ -27,9 +28,11 @@ module Gargantext.Components.NgramsTable.Core
   , patchSetFromMap
   , applyPatchSet
   , applyNgramsTablePatch
+  , rootsOf
   , singletonPatchMap
   , fromNgramsPatches
   , singletonNgramsTablePatch
+  , isEmptyNgramsTablePatch
   , _list
   , _occurrences
   , _children
@@ -48,6 +51,7 @@ import Data.Array (head)
 import Data.Array as A
 import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson
                      , jsonEmptyObject, (:=), (~>), (.:), (.??) )
+import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
 import Data.Foldable (class Foldable, foldMap, foldl, foldr)
 import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
@@ -63,7 +67,7 @@ import Data.Lens.Iso.Newtype (_Newtype)
 import Data.List ((:), List(Nil))
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..), maybe, isNothing)
 import Data.Traversable (class Traversable, traverse, traverse_, sequence)
 import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
 import Data.Set (Set)
@@ -76,17 +80,14 @@ import Data.Tuple (Tuple(..))
 -- import Debug.Trace
 import Effect.Aff (Aff)
 import Foreign.Object as FO
-import React (ReactElement)
-import React as React
 import Thermite (StateCoTransformer, modifyState_)
 import Partial (crashWith)
 import Partial.Unsafe (unsafePartial)
 
 import Gargantext.Components.Table as T
-import Gargantext.Ends (url)
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get, put, post)
-import Gargantext.Types (OrderBy(..), CTabNgramType(..), TabType, TermList(..), TermSize)
+import Gargantext.Types (OrderBy(..), CTabNgramType(..), TabType, TermList(..), TermSize, ScoreType(..))
 import Gargantext.Utils.KarpRabin (indicesOfAny)
 
 type CoreParams s =
@@ -104,6 +105,7 @@ type PageParams =
     , searchQuery    :: String
     , termListFilter :: Maybe TermList -- Nothing means all
     , termSizeFilter :: Maybe TermSize -- Nothing means all
+    , scoreType      :: ScoreType
     )
 
 initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams
@@ -115,10 +117,34 @@ initialPageParams session nodeId listIds tabType =
   , termSizeFilter: Nothing
   , termListFilter: Just GraphTerm
   , searchQuery: ""
+  , scoreType: Occurrences
   , session
   }
 
-type NgramsTerm = String
+newtype NgramsTerm = NormNgramsTerm String
+
+derive instance eqNgramsTerm  :: Eq  NgramsTerm
+derive instance ordNgramsTerm :: Ord NgramsTerm
+
+instance encodeJsonNgramsTerm :: EncodeJson NgramsTerm where
+  encodeJson (NormNgramsTerm s) = encodeJson s
+
+-- TODO we assume that the ngrams are already normalized.
+instance decodeJsonNgramsTerm :: DecodeJson NgramsTerm where
+  decodeJson = map NormNgramsTerm <<< decodeJson
+
+ngramsTermText :: NgramsTerm -> String
+ngramsTermText (NormNgramsTerm t) = t
+
+-- TODO
+normNgramInternal :: CTabNgramType -> String -> String
+normNgramInternal CTabAuthors    = identity
+normNgramInternal CTabSources    = identity
+normNgramInternal CTabInstitutes = identity
+normNgramInternal CTabTerms      = S.toLower <<< R.replace wordBoundaryReg " "
+
+normNgram :: CTabNgramType -> String -> NgramsTerm
+normNgram tabType = NormNgramsTerm <<< normNgramInternal tabType
 
 -----------------------------------------------------------------------------------
 newtype NgramsElement = NgramsElement
@@ -194,10 +220,10 @@ derive instance newtypeNgramsTable :: Newtype NgramsTable _
 _NgramsTable :: Iso' NgramsTable (Map NgramsTerm NgramsElement)
 _NgramsTable = _Newtype
 
-instance indexNgramsTable :: Index NgramsTable String NgramsElement where
+instance indexNgramsTable :: Index NgramsTable NgramsTerm NgramsElement where
   ix k = _NgramsTable <<< ix k
 
-instance atNgramsTable :: At NgramsTable String NgramsElement where
+instance atNgramsTable :: At NgramsTable NgramsTerm NgramsElement where
   at k = _NgramsTable <<< at k
 
 instance decodeJsonNgramsTable :: DecodeJson NgramsTable where
@@ -239,7 +265,7 @@ highlightNgrams ntype (NgramsTable table) input0 =
     init x = S.take (S.length x - 1) x
     input = spR input0
     pats = A.fromFoldable (Map.keys table)
-    ixs = indicesOfAny (sp <$> pats) (normNgram ntype input)
+    ixs = indicesOfAny (sp <<< ngramsTermText <$> pats) (normNgramInternal ntype input)
 
     consOnJustTail s xs@(Tuple _ (Just _) : _) =
       Tuple s Nothing : xs
@@ -264,7 +290,7 @@ highlightNgrams ntype (NgramsTable table) input0 =
             Nothing ->
               crashWith "highlightNgrams: out of bounds pattern"
             Just pat ->
-              let lpat = S.length (db pat) in
+              let lpat = S.length (db (ngramsTermText pat)) in
               case Map.lookup pat table of
                 Nothing ->
                   crashWith "highlightNgrams: pattern missing from table"
@@ -452,14 +478,16 @@ instance traversablePatchMap :: Traversable (PatchMap k) where
 instance traversableWithIndexPatchMap :: TraversableWithIndex k (PatchMap k) where
   traverseWithIndex f (PatchMap m) = PatchMap <$> traverseWithIndex f m
 
-instance encodeJsonPatchMap :: EncodeJson p => EncodeJson (PatchMap String p) where
+-- TODO generalize
+instance encodeJsonPatchMap :: EncodeJson p => EncodeJson (PatchMap NgramsTerm p) where
   encodeJson (PatchMap m) =
-    encodeJson $ FO.fromFoldable $ (Map.toUnfoldable m :: Array _)
+    encodeJson $ FO.fromFoldable $ map (lmap ngramsTermText) (Map.toUnfoldable m :: Array _)
 
-instance decodeJsonPatchMap :: DecodeJson p => DecodeJson (PatchMap String p) where
+instance decodeJsonPatchMap :: DecodeJson p => DecodeJson (PatchMap NgramsTerm p) where
   decodeJson json = do
     obj <- decodeJson json
-    pure $ PatchMap $ Map.fromFoldableWithIndex (obj :: FO.Object p)
+    pure $ PatchMap $ foldlWithIndex (\k m v -> Map.insert (NormNgramsTerm k) v m) mempty (obj :: FO.Object p)
+    -- TODO we assume that the ngrams are already normalized ^^^^^^^^^^^^^
 
 singletonPatchMap :: forall k p. k -> p -> PatchMap k p
 singletonPatchMap k p = PatchMap (Map.singleton k p)
@@ -484,21 +512,22 @@ type NgramsTablePatch =
   , ngramsPatches  :: NgramsPatches
   }
 
+isEmptyNgramsTablePatch :: NgramsTablePatch -> Boolean
+isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches
+
 fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
 fromNgramsPatches ngramsPatches = {ngramsNewElems: mempty, ngramsPatches}
 
-normNgram :: CTabNgramType -> String -> NgramsTerm
-normNgram CTabAuthors = identity
-normNgram CTabSources = identity
-normNgram CTabInstitutes = identity
-normNgram CTabTerms      = S.toLower <<< R.replace wordBoundaryReg " "
+findNgramTermList :: NgramsTable -> NgramsTerm -> Maybe TermList
+findNgramTermList (NgramsTable m) n = m ^? at n <<< _Just <<< _NgramsElement <<< _list
 
+singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
+singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p
 
-findNgramTermList :: CTabNgramType -> NgramsTable -> String -> Maybe TermList
-findNgramTermList ntype (NgramsTable m) s = m ^? at (normNgram ntype s) <<< _Just <<< _NgramsElement <<< _list
-
-singletonNgramsTablePatch :: CTabNgramType -> NgramsTerm -> NgramsPatch -> NgramsTablePatch
-singletonNgramsTablePatch m n p = fromNgramsPatches $ singletonPatchMap (normNgram m n) p
+rootsOf :: NgramsTable -> Set NgramsTerm
+rootsOf (NgramsTable m) = Map.keys $ Map.filter isRoot m
+  where
+    isRoot (NgramsElement {parent}) = isNothing parent
 
 type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
 
@@ -526,7 +555,7 @@ reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) =
   -- root_of_parent <- use (at parent <<< _Just <<< _NgramsElement <<< _root)
   -- ^ TODO this does not type checks, we do the following two lines instead:
   s <- use (at parent)
-  let root_of_parent = s ^. (_Just <<< _NgramsElement <<< _root)
+  let root_of_parent = s ^? (_Just <<< _NgramsElement <<< _root <<< _Just)
   let rp = { root: maybe parent identity root_of_parent, parent }
   traverse_ (reParent Nothing) rem
   traverse_ (reParent $ Just rp) add
@@ -572,9 +601,10 @@ postNewElems newElems params = void $ traverseWithIndex postNewElem newElems
   where
     postNewElem ngrams list = postNewNgrams [ngrams] (Just list) params
 
-addNewNgram :: CTabNgramType -> NgramsTerm -> TermList -> NgramsTablePatch
-addNewNgram ntype ngrams list = { ngramsPatches: mempty
-                          , ngramsNewElems: Map.singleton (normNgram ntype ngrams) list }
+addNewNgram :: NgramsTerm -> TermList -> NgramsTablePatch
+addNewNgram ngrams list =
+  { ngramsPatches: mempty
+  , ngramsNewElems: Map.singleton ngrams list }
 
 putNgramsPatches :: forall s. CoreParams s -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
 putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
@@ -594,16 +624,16 @@ commitPatch props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNe
 
 loadNgramsTable :: PageParams -> Aff VersionedNgramsTable
 loadNgramsTable
-  { nodeId, listIds, termListFilter, termSizeFilter, session
+  { nodeId, listIds, termListFilter, termSizeFilter, session, scoreType
   , searchQuery, tabType, params: {offset, limit, orderBy}}
   = get session query
   where query = GetNgrams { tabType, offset, limit, listIds
                           , orderBy: convOrderBy <$> orderBy
                           , termListFilter, termSizeFilter
-                          , searchQuery } (Just nodeId)
+                          , searchQuery, scoreType } (Just nodeId)
 
 convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy
-convOrderBy (T.ASC  (T.ColumnName "Score (Occurrences)")) = ScoreAsc
-convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
+convOrderBy (T.ASC  (T.ColumnName "Score")) = ScoreAsc
+convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
 convOrderBy (T.ASC  _) = TermAsc
 convOrderBy (T.DESC _) = TermDesc

src/Gargantext/Components/Nodes/Annuaire.purs

 module Gargantext.Components.Nodes.Annuaire where
 
-import Prelude (bind, identity, pure, ($), (<$>), (<>))
+import Prelude (bind, identity, pure, const, ($), (<$>), (<>))
 import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
 import Data.Array (head)
 import Data.Maybe (Maybe(..), maybe)
@@ -101,12 +101,13 @@ pageCpt = R.staticComponent "LoadedAnnuairePage" cpt
   where
     cpt { session, annuairePath, pagePath
         , table: (AnnuaireTable {annuaireTable}) } _ = do
-      T.table { rows, params, container, colNames, totalRecords }
+      T.table { rows, params, container, colNames, totalRecords, wrapColElts }
       where
         totalRecords = 4361 -- TODO
         rows = (\c -> {row: contactCells session c, delete: false}) <$> annuaireTable
         container = T.defaultContainer { title: "Annuaire" } -- TODO
         colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
+        wrapColElts = const identity
         setParams f = snd pagePath $ \{nodeId, params: ps} ->
           {params: f ps, nodeId: fst annuairePath}
         params = T.initialParams /\ setParams

src/Gargantext/Components/Nodes/Corpus/Document.purs

@@ -22,7 +22,7 @@ import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
 import Gargantext.Hooks.Loader (useLoader)
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get)
-import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList)
+import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList, ScoreType(..))
 import Gargantext.Utils.Reactix as R2
 
 type DocPath =
@@ -295,11 +295,11 @@ docViewSpec = simpleSpec performAction render
         commitPatch path (Versioned {version: ngramsVersion, data: pt})
       where
         pe = NgramsPatch { patch_list: pl, patch_children: mempty }
-        pt = singletonNgramsTablePatch CTabTerms n pe
+        pt = singletonNgramsTablePatch n pe
     performAction (AddNewNgram ngram termList) {path} {ngramsVersion} =
         commitPatch path (Versioned {version: ngramsVersion, data: pt})
       where
-        pt = addNewNgram CTabTerms ngram termList
+        pt = addNewNgram ngram termList
 
     render :: Render State Props Action
     render dispatch { loaded: { ngramsTable: Versioned { data: initTable }, document } }
@@ -380,8 +380,9 @@ loadData {session, nodeId, listIds, tabType} = do
     , listIds
     , params: { offset : 0, limit : 100, orderBy: Nothing}
     , tabType
-    , searchQuery : ""
-    , termListFilter : Nothing
-    , termSizeFilter : Nothing
+    , searchQuery: ""
+    , termListFilter: Nothing
+    , termSizeFilter: Nothing
+    , scoreType: Occurrences
     }
   pure {document, ngramsTable}

src/Gargantext/Components/Table.purs

@@ -12,6 +12,7 @@ import Effect (Effect)
 import Reactix as R
 import Reactix.DOM.HTML as H
 import Gargantext.Utils.Reactix as R2
+import Gargantext.Utils.Reactix (effectLink)
 
 type TableContainerProps =
   ( pageSizeControl     :: R.Element
@@ -51,6 +52,8 @@ derive instance eqOrderByDirection :: Eq a => Eq (OrderByDirection a)
 
 type Props =
   ( colNames     :: Array ColumnName
+  , wrapColElts  :: ColumnName -> Array R.Element -> Array R.Element
+                 -- ^ Use `const identity` as a default behavior.
   , totalRecords :: Int
   , params       :: R.State Params
   , rows         :: Rows
@@ -126,32 +129,33 @@ table props = R.createElement tableCpt props []
 tableCpt :: R.Component Props
 tableCpt = R.hooksComponent "G.C.Table.table" cpt
   where
-    cpt {container, colNames, totalRecords, rows, params} _ = do
+    cpt {container, colNames, wrapColElts, totalRecords, rows, params} _ = do
       pageSize@(pageSize' /\ setPageSize) <- R.useState' PS10
       (page /\ setPage) <- R.useState' 1
       (orderBy /\ setOrderBy) <- R.useState' Nothing
-      let state = {pageSize: pageSize', orderBy, page}
-      let ps = pageSizes2Int pageSize'
-      let totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
-      R.useEffect1' state $ when (fst params /= stateParams state) $ (snd params) (const $ stateParams state)
-      pure $ container
-        { pageSizeControl: sizeDD pageSize
-        , pageSizeDescription: textDescription page pageSize' totalRecords
-        , paginationLinks: pagination setPage totalPages page
-        , tableHead: H.tr {} (colHeader setOrderBy orderBy <$> colNames)
-        , tableBody: map (H.tr {} <<< map (\c -> H.td {} [c]) <<< _.row) rows
-        }
-        where
-          colHeader :: (R2.Setter OrderBy) -> OrderBy -> ColumnName -> R.Element
-          colHeader setOrderBy orderBy c = H.th {scope: "col"} [ H.b {} cs ]
+      let
+        state = {pageSize: pageSize', orderBy, page}
+        ps = pageSizes2Int pageSize'
+        totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
+        colHeader :: ColumnName -> R.Element
+        colHeader c = H.th {scope: "col"} [ H.b {} cs ]
           where
             lnk mc = effectLink (setOrderBy (const mc))
             cs :: Array R.Element
             cs =
+              wrapColElts c $
               case orderBy of
                 Just (ASC d)  | c == d -> [lnk (Just (DESC c)) "DESC ", lnk Nothing (columnName c)]
                 Just (DESC d) | c == d -> [lnk (Just (ASC  c)) "ASC ",  lnk Nothing (columnName c)]
                 _ -> [lnk (Just (ASC c)) (columnName c)]
+      R.useEffect1' state $ when (fst params /= stateParams state) $ (snd params) (const $ stateParams state)
+      pure $ container
+        { pageSizeControl: sizeDD pageSize
+        , pageSizeDescription: textDescription page pageSize' totalRecords
+        , paginationLinks: pagination setPage totalPages page
+        , tableHead: H.tr {} (colHeader <$> colNames)
+        , tableBody: map (H.tr {} <<< map (\c -> H.td {} [c]) <<< _.row) rows
+        }
 
 defaultContainer :: {title :: String} -> Record TableContainerProps -> R.Element
 defaultContainer {title} props = R.fragment
@@ -198,9 +202,6 @@ textDescription currPage pageSize totalRecords =
     end  = if end' > totalRecords then totalRecords else end'
     msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
 
-effectLink :: Effect Unit -> String -> R.Element
-effectLink eff msg = H.a {on: {click: const eff}} [H.text msg]
-
 pagination :: (R2.Setter Int) -> Int -> Int -> R.Element
 pagination changePage tp cp =
   H.span {} $

src/Gargantext/Ends.purs

@@ -127,6 +127,7 @@ sessionPath (R.GetNgrams opts i)    =
     <> foldMap (\x -> "&list=" <> show x) opts.listIds
     <> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
     <> foldMap termSizeFilter opts.termSizeFilter
+    <> "&scoreType=" <> show opts.scoreType
     <> search opts.searchQuery
   where
     base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i

src/Gargantext/Types.purs

@@ -267,6 +267,13 @@ nodeTypePath Team      = "team"
 
 type ListId = Int
 
+data ScoreType = Occurrences
+
+derive instance genericScoreType :: Generic ScoreType _
+
+instance showScoreType :: Show ScoreType where
+  show = genericShow
+
 type NgramsGetOpts =
   { tabType        :: TabType
   , offset         :: Offset
@@ -275,6 +282,7 @@ type NgramsGetOpts =
   , listIds        :: Array ListId
   , termListFilter :: Maybe TermList
   , termSizeFilter :: Maybe TermSize
+  , scoreType      :: ScoreType
   , searchQuery    :: String
   }
 

src/Gargantext/Utils/Reactix.purs

@@ -20,6 +20,7 @@ import FFI.Simple ((...), defineProperty, delay, args2, args3)
 import React (class ReactPropFields, Children, ReactClass, ReactElement)
 import React as React
 import Reactix as R
+import Reactix.DOM.HTML as H
 import Reactix.DOM.HTML (ElemFactory, createDOM, text)
 import Reactix.React (react)
 import Reactix.SyntheticEvent as RE
@@ -187,3 +188,6 @@ appendChildToParentId ps c = delay unit $ \_ -> do
   case parentEl of
     Nothing -> pure unit
     Just el -> appendChild el c
+
+effectLink :: Effect Unit -> String -> R.Element
+effectLink eff msg = H.a {on: {click: const eff}} [H.text msg]