Merge branch 'dev-ngrams-refactoring' of...

Merge branch 'dev-ngrams-refactoring' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-ngrams-refactoring

src/Gargantext/Components/App.purs

@@ -7,7 +7,6 @@ import Data.Foldable (intercalate)
 import Data.Maybe (Maybe(..), maybe')
 import Data.Tuple (fst, snd)
 import Data.Tuple.Nested ((/\))
-import Effect (Effect)
 import Effect.Aff (launchAff_)
 import Effect.Class (liftEffect)
 import Reactix as R

src/Gargantext/Components/DocsTable.purs

@@ -390,9 +390,13 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
   cpt { layout: {frontends, session, nodeId, corpusId, listId, totalRecords}, documents, params } _ = do
     localCategories <- R.useState' (mempty :: LocalCategories)
     pure $ T.table
-      { rows: rows localCategories
+      { colNames
       , container: T.defaultContainer { title: "Documents" }
-      , params, colNames, totalRecords, wrapColElts }
+      , params
+      , rows: rows localCategories
+      , totalRecords
+      , wrapColElts
+      }
       where
         sid = sessionId session
         gi Favorite  = "glyphicon glyphicon-star"
@@ -409,7 +413,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
           where
             row (DocumentsView r) =
               { row:
-                [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
+                T.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
                  caroussel session nodeId setLocalCategories r cat
                 --, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
                 -- TODO show date: Year-Month-Day only

src/Gargantext/Components/FacetsTable.purs

@@ -335,15 +335,16 @@ pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt
         rows = row <$> filter (not <<< isDeleted) documents
         row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
           { row:
-            [ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
+            T.makeRow [
+              H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
               -- TODO show date: Year-Month-Day only
-            , maybeStricken delete [ H.text $ publicationDate dv ]
-            , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
-            , maybeStricken delete [ H.text source ]
-            , maybeStricken delete [ H.text authors ]
-              -- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
-            , H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } }
-            ]
+              , maybeStricken delete [ H.text $ publicationDate dv ]
+              , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
+              , maybeStricken delete [ H.text source ]
+              , maybeStricken delete [ H.text authors ]
+                -- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
+              , H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } }
+              ]
           , delete: true }
           where
             markClick _ = markCategory session nodeId category [id]

src/Gargantext/Components/NgramsTable/Core.purs

@@ -84,6 +84,7 @@ import Data.Traversable (class Traversable, for, sequence, traverse, traverse_)
 import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff)
+import Effect.Exception.Unsafe (unsafeThrow)
 import Foreign.Object as FO
 import Gargantext.Components.Table as T
 import Gargantext.Routes (SessionRoute(..))
@@ -179,14 +180,14 @@ _list = prop (SProxy :: SProxy "list")
 
 derive instance newtypeNgramsElement :: Newtype NgramsElement _
 
-_NgramsElement    :: Iso' NgramsElement {
-      children    :: Set NgramsTerm
-    , list        :: TermList
-    , ngrams      :: NgramsTerm
-    , occurrences :: Int
-    , parent      :: Maybe NgramsTerm
-    , root        :: Maybe NgramsTerm
-    }
+_NgramsElement  :: Iso' NgramsElement {
+    children    :: Set NgramsTerm
+  , list        :: TermList
+  , ngrams      :: NgramsTerm
+  , occurrences :: Int
+  , parent      :: Maybe NgramsTerm
+  , root        :: Maybe NgramsTerm
+  }
 _NgramsElement = _Newtype
 
 instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
@@ -336,14 +337,15 @@ replace old new
   | old == new = Keep
   | otherwise  = Replace { old, new }
 
-instance semigroupReplace :: Semigroup (Replace a) where
+derive instance eqReplace :: Eq a => Eq (Replace a)
+
+instance semigroupReplace :: Eq a => Semigroup (Replace a) where
   append Keep p = p
   append p Keep = p
-  append (Replace { old: _m, new }) (Replace { old, new: _m' }) =
-    -- assert _m == _m'
-    Replace { old, new }
+  append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
+  append (Replace { new }) (Replace { old }) = replace old new
 
-instance semigroupMonoid :: Monoid (Replace a) where
+instance semigroupMonoid :: Eq a => Monoid (Replace a) where
   mempty = Keep
 
 applyReplace :: forall a. Eq a => Replace a -> a -> a
@@ -419,6 +421,9 @@ newtype NgramsPatch = NgramsPatch
   , patch_list     :: Replace TermList
   }
 
+derive instance eqNgramsPatch  :: Eq NgramsPatch
+derive instance eqPatchSetNgramsTerm  :: Eq (PatchSet NgramsTerm)
+
 instance semigroupNgramsPatch :: Semigroup NgramsPatch where
   append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
     { patch_children: p.patch_children <> q.patch_children
@@ -455,13 +460,16 @@ applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
 
 newtype PatchMap k p = PatchMap (Map k p)
 
-instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where
-  append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q)
+instance semigroupPatchMap :: (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
+  append (PatchMap p) (PatchMap q) = PatchMap pMap
+    where
+      pMap = Map.filter (\v -> v /= mempty) $ Map.unionWith append p q
 
-instance monoidPatchMap :: (Ord k, Semigroup p) => Monoid (PatchMap k p) where
+instance monoidPatchMap :: (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
   mempty = PatchMap Map.empty
 
 derive instance newtypePatchMap :: Newtype (PatchMap k p) _
+derive instance eqPatchMap :: (Eq k, Eq p) => Eq (PatchMap k p)
 
 _PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
 _PatchMap = _Newtype

src/Gargantext/Components/Nodes/Annuaire.purs

@@ -114,7 +114,12 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
       pure $ T.table { rows, params, container, colNames, totalRecords, wrapColElts }
       where
         path = fst pagePath
-        rows = (\c -> {row: contactCells session frontends (fst pagePath).nodeId c, delete: false}) <$> docs
+        rows = (\c -> {
+                   row: contactCells { annuaireId: (fst pagePath).nodeId
+                                     , frontends
+                                     , contact: c
+                                     , session }
+                   , delete: false }) <$> docs
         container = T.defaultContainer { title: "Annuaire" } -- TODO
         colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
         wrapColElts = const identity
@@ -124,11 +129,26 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
 
 type AnnuaireId = Int
 
-contactCells :: Session -> Frontends -> AnnuaireId -> CT.Contact -> Array R.Element
-contactCells session frontends aId = render
+type ContactCellsProps =
+  (
+    annuaireId :: AnnuaireId
+  , contact    :: CT.Contact
+  , frontends  :: Frontends
+  , session   :: Session
+  )
+
+contactCells :: Record ContactCellsProps -> R.Element
+contactCells p = R.createElement contactCellsCpt p []
+
+contactCellsCpt :: R.Component ContactCellsProps
+contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt
   where
-    render (CT.Contact { id, hyperdata : (CT.HyperdataUser {shared: Nothing} )}) =
-        [ H.text ""
+    cpt { annuaireId
+        , contact: (CT.Contact { id, hyperdata: (CT.HyperdataUser {shared: Nothing}) })
+        , frontends
+        , session } _ =
+      pure $ T.makeRow [
+        H.text ""
         , H.span {} [ H.text "name" ]
         --, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
         , H.text "No ContactWhere"
@@ -136,26 +156,34 @@ contactCells session frontends aId = render
         , H.div {className: "nooverflow"}
           [ H.text "No ContactWhereRole" ]
         ]
-    render (CT.Contact { id, hyperdata : (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who: who, ou:ou}) } )}) =
-      --let nodepath = NodePath (sessionId session) NodeContact (Just id)
-      let nodepath = Routes.ContactPage (sessionId session) aId id
-          href = url frontends nodepath in
-      [ H.text ""
-      , H.a { href} [ H.text $ maybe "name" identity contact.title ]
-      --, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
-      , H.text $ maybe "No ContactWhere" contactWhereOrg  (head $ ou)
-      , H.text $ maybe "No ContactWhereDept" contactWhereDept (head $ ou)
-      , H.div {className: "nooverflow"}
-        [ H.text $ maybe "No ContactWhereRole" contactWhereRole (head $ ou) ] ]
-
-    contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
-    contactWhereOrg (CT.ContactWhere { organization: orga }) =
-      maybe "No orga (list)" identity (head orga)
-    contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
-    contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
-      maybe "No Dept (list)" identity (head dept)
-    contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
-    contactWhereRole (CT.ContactWhere { role: Just role }) = role
+    cpt { annuaireId
+        , contact: (CT.Contact { id
+                               , hyperdata: (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who, ou})}) })
+        , frontends
+        , session } _ =
+        pure $ T.makeRow [
+          H.text ""
+          , H.a { href } [ H.text $ maybe "name" identity contact.title ]
+            --, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
+          , H.text $ maybe "No ContactWhere" contactWhereOrg  (head $ ou)
+          , H.text $ maybe "No ContactWhereDept" contactWhereDept (head $ ou)
+          , H.div {className: "nooverflow"} [
+              H.text $ maybe "No ContactWhereRole" contactWhereRole (head $ ou)
+            ]
+          ]
+          where
+            --nodepath = NodePath (sessionId session) NodeContact (Just id)
+            nodepath = Routes.ContactPage (sessionId session) annuaireId id
+            href = url frontends nodepath
+
+            contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
+            contactWhereOrg (CT.ContactWhere { organization: orga }) =
+              maybe "No orga (list)" identity (head orga)
+            contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
+            contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
+              maybe "No Dept (list)" identity (head dept)
+            contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
+            contactWhereRole (CT.ContactWhere { role: Just role }) = role
 
 
 data HyperdataAnnuaire = HyperdataAnnuaire

src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs

@@ -4,13 +4,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
   , userLayout )
   where
 
-import Data.Array (head)
 import Data.Lens as L
-import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Tuple (Tuple(..), fst, snd)
-import Data.Tuple.Nested (Tuple3, (/\))
-import Data.Newtype (unwrap)
-import Data.String (joinWith)
+import Data.Tuple.Nested ((/\))
 import DOM.Simple.Console (log2)
 import Effect (Effect)
 import Effect.Class (liftEffect)
@@ -18,8 +15,8 @@ import Effect.Aff (Aff, launchAff_)
 import Reactix as R
 import Reactix.DOM.HTML as H
 
-import Gargantext.Prelude
-import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
+import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
+import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
 import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
 import Gargantext.Hooks.Loader (useLoader)
 import Gargantext.Routes as Routes

src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs

@@ -84,7 +84,7 @@ type NgramsViewTabsProps =
 ngramsView :: Record NgramsViewTabsProps -> R.Element
 ngramsView {session,mode, defaultListId, nodeId} =
   NT.mainNgramsTable
-  { nodeId, defaultListId, tabType, session, tabNgramType }
+  { nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate: false }
   where
     tabNgramType = modeTabType' mode
     tabType      = TabPairing $ TabNgramType $ modeTabType mode

src/Gargantext/Components/Nodes/Lists/Tabs.purs

@@ -46,7 +46,7 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
       R.fragment
         [ chart mode
         , NT.mainNgramsTable
-            {session, defaultListId, nodeId: corpusId, tabType, tabNgramType}
+            {session, defaultListId, nodeId: corpusId, tabType, tabNgramType, withAutoUpdate: false}
         ]
       where
         tabNgramType = modeTabType mode

src/Gargantext/Components/Table.purs

@@ -20,7 +20,7 @@ type TableContainerProps =
   , tableBody           :: Array R.Element
   )
 
-type Row = { row :: Array R.Element, delete :: Boolean }
+type Row = { row :: R.Element, delete :: Boolean }
 type Rows = Array Row
 
 type OrderBy = Maybe (OrderByDirection ColumnName)
@@ -64,6 +64,12 @@ type State =
   , orderBy  :: OrderBy
   }
 
+paramsState :: Params -> State
+paramsState {offset, limit, orderBy} = {pageSize, page, orderBy}
+  where
+    pageSize = int2PageSizes limit
+    page = offset / limit + 1
+
 stateParams :: State -> Params
 stateParams {pageSize, page, orderBy} = {offset, limit, orderBy}
   where
@@ -128,34 +134,32 @@ tableCpt :: R.Component Props
 tableCpt = R.hooksComponent "G.C.Table.table" cpt
   where
     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}
-        ps = pageSizes2Int pageSize'
+        state = paramsState $ fst params
+        ps = pageSizes2Int state.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))
+            lnk mc = effectLink $ snd params $ _ { orderBy = mc }
             cs :: Array R.Element
             cs =
               wrapColElts c $
-              case orderBy of
+              case state.orderBy of
                 Just (ASC d)  | c == d -> [lnk (Just (DESC c)) "ASC ", lnk Nothing (columnName c)]
                 Just (DESC d) | c == d -> [lnk (Just (ASC  c)) "DESC ",  lnk Nothing (columnName c)]
                 _ -> [lnk (Just (ASC c)) (columnName c)]
-      R.useEffect2' params state do
-        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
+        { pageSizeControl: sizeDD params
+        , pageSizeDescription: textDescription state.page state.pageSize totalRecords
+        , paginationLinks: pagination params totalPages
         , tableHead: H.tr {} (colHeader <$> colNames)
-        , tableBody: map (H.tr {} <<< map (\c -> H.td {} [c]) <<< _.row) rows
+        , tableBody: map _.row rows
         }
 
+makeRow :: Array R.Element -> R.Element
+makeRow els = H.tr {} $ (\c -> H.td {} [c]) <$> els
+
 
 type FilterRowsParams =
   (
@@ -193,12 +197,13 @@ graphContainer {title} props =
    -- , props.pageSizeDescription
    -- , props.paginationLinks
 
-sizeDD :: R.State PageSizes -> R.Element
-sizeDD (ps /\ setPageSize) =
-  H.span {} [ R2.select { className, defaultValue: ps, on: {change} } sizes ]
+sizeDD :: R.State Params -> R.Element
+sizeDD (params /\ setParams) =
+  H.span {} [ R2.select { className, defaultValue: pageSize, on: {change} } sizes ]
   where
+    {pageSize} = paramsState params
     className = "form-control"
-    change e = setPageSize $ const (string2PageSize $ R2.unsafeEventValue e)
+    change e = setParams $ \p -> stateParams $ (paramsState p) { pageSize = string2PageSize $ R2.unsafeEventValue e }
     sizes = map option pageSizes
     option size = H.option {value} [H.text value]
       where value = show size
@@ -212,51 +217,53 @@ textDescription currPage pageSize totalRecords =
     end  = if end' > totalRecords then totalRecords else end'
     msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
 
-pagination :: (R2.Setter Int) -> Int -> Int -> R.Element
-pagination changePage tp cp =
+pagination :: R.State Params -> Int -> R.Element
+pagination (params /\ setParams) tp =
   H.span {} $
     [ H.text " ", prev, first, ldots]
     <>
     lnums
     <>
-    [H.b {} [H.text $ " " <> show cp <> " "]]
+    [H.b {} [H.text $ " " <> show page <> " "]]
     <>
     rnums
     <>
     [ rdots, last, next ]
     where
-      prev = if cp == 1 then
+      {page} = paramsState params
+      changePage page = setParams $ \p -> stateParams $ (paramsState p) { page = page }
+      prev = if page == 1 then
                H.text " Prev. "
              else
-               changePageLink (cp - 1) "Prev."
-      next = if cp == tp then
+               changePageLink (page - 1) "Prev."
+      next = if page == tp then
                H.text " Next "
              else
-               changePageLink (cp + 1) "Next"
-      first = if cp == 1 then
+               changePageLink (page + 1) "Next"
+      first = if page == 1 then
                 H.text ""
               else
                 changePageLink' 1
-      last = if cp == tp then
+      last = if page == tp then
                H.text ""
              else
                changePageLink' tp
-      ldots = if cp >= 5 then
+      ldots = if page >= 5 then
                 H.text " ... "
                 else
                 H.text ""
-      rdots = if cp + 3 < tp then
+      rdots = if page + 3 < tp then
                 H.text " ... "
                 else
                 H.text ""
-      lnums = map changePageLink' $ A.filter (1  < _) [cp - 2, cp - 1]
-      rnums = map changePageLink' $ A.filter (tp > _) [cp + 1, cp + 2]
+      lnums = map changePageLink' $ A.filter (1  < _) [page - 2, page - 1]
+      rnums = map changePageLink' $ A.filter (tp > _) [page + 1, page + 2]
 
       changePageLink :: Int -> String -> R.Element
       changePageLink i s =
         H.span {}
           [ H.text " "
-          , effectLink (changePage (const i)) s
+          , effectLink (changePage i) s
           , H.text " "
           ]
 
@@ -274,6 +281,9 @@ instance showPageSize :: Show PageSizes where
   show PS100 = "100"
   show PS200 = "200"
 
+int2PageSizes :: Int -> PageSizes
+int2PageSizes i = string2PageSize $ show i
+
 pageSizes2Int :: PageSizes -> Int
 pageSizes2Int PS10  = 10
 pageSizes2Int PS20  = 20