Commit 6ced4acc authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-merge' into dev

parents 0275f3db 1907214d
This diff is collapsed.
This diff is collapsed.
let upstream = let upstream =
./packages-0.13.8-20200822.dhall https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall
let overrides = let overrides =
{ thermite = { thermite =
......
...@@ -12,10 +12,10 @@ ...@@ -12,10 +12,10 @@
module Gargantext.Components.Annotation.AnnotatedField where module Gargantext.Components.Annotation.AnnotatedField where
import Prelude import Prelude
import Data.Maybe ( Maybe(..), maybe, isJust, isNothing ) import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( Tuple(..) ) import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) ) import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect ( Effect ) import Effect ( Effect )
import Reactix as R import Reactix as R
...@@ -27,7 +27,6 @@ import Gargantext.Components.Annotation.Utils ( termBootstrapClass ) ...@@ -27,7 +27,6 @@ import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram) import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) ) import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Utils.Selection as Sel import Gargantext.Utils.Selection as Sel
import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.Annotation.AnnotatedField" thisModule = "Gargantext.Components.Annotation.AnnotatedField"
...@@ -58,11 +57,11 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" ...@@ -58,11 +57,11 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField"
onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
onSelect text' Nothing event = do onSelect text' Nothing event = do
log2 "[onSelect] text'" text' --log2 "[onSelect] text'" text'
maybeShowMenu setMenu menuRef setTermList ngrams event maybeShowMenu setMenu menuRef setTermList ngrams event
onSelect text' (Just list) event = do onSelect text' (Just list) event = do
log2 "[onSelect] text'" text' --log2 "[onSelect] text'" text'
log2 "[onSelect] list" list --log2 "[onSelect] list" (show list)
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
setList t = do setList t = do
...@@ -77,8 +76,8 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" ...@@ -77,8 +76,8 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField"
, onClose: \_ -> R.setRef menuRef Nothing , onClose: \_ -> R.setRef menuRef Nothing
, setList , setList
} }
--setMenu (const $ menu)
R.setRef menuRef menu R.setRef menuRef menu
setMenu $ const menu
mapCompile (Tuple t l) = {text: t, list: l, onSelect} mapCompile (Tuple t l) = {text: t, list: l, onSelect}
compiled = map mapCompile $ compile ngrams text compiled = map mapCompile $ compile ngrams text
...@@ -105,8 +104,8 @@ addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt ...@@ -105,8 +104,8 @@ addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt
R.useEffect' $ do R.useEffect' $ do
let m = R.readRef menuRef let m = R.readRef menuRef
log2 "[addMenu] menuRef" m --log2 "[addMenu] menuRef" m
log2 "[addMenu] mMenu" mMenu --log2 "[addMenu] mMenu" mMenu
setmMenu $ const m setmMenu $ const m
pure $ case mMenu of pure $ case mMenu of
...@@ -116,7 +115,7 @@ addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt ...@@ -116,7 +115,7 @@ addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt
-- forall e. IsMouseEvent e => R.Setter (Maybe AnnotationMenu) -> R.Setter ? -> ? -> e -> Effect Unit -- forall e. IsMouseEvent e => R.Setter (Maybe AnnotationMenu) -> R.Setter ? -> ? -> e -> Effect Unit
maybeShowMenu setMenu menuRef setTermList ngrams event = do maybeShowMenu setMenu menuRef setTermList ngrams event = do
s <- Sel.getSelection s <- Sel.getSelection
log2 "[maybeShowMenu] s" s --log2 "[maybeShowMenu] s" s
case s of case s of
Just sel -> do Just sel -> do
case Sel.selectionToString sel of case Sel.selectionToString sel of
...@@ -128,11 +127,11 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do ...@@ -128,11 +127,11 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do
list = findNgramTermList ngrams n list = findNgramTermList ngrams n
setList t = do setList t = do
setTermList n list t setTermList n list t
--setMenu (const Nothing)
R.setRef menuRef Nothing R.setRef menuRef Nothing
--setMenu (const Nothing)
E.preventDefault event E.preventDefault event
range <- Sel.getRange sel 0 range <- Sel.getRange sel 0
log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range --log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range
let menu = Just { let menu = Just {
x x
, y , y
...@@ -141,8 +140,8 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do ...@@ -141,8 +140,8 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do
, onClose: \_ -> R.setRef menuRef Nothing , onClose: \_ -> R.setRef menuRef Nothing
, setList , setList
} }
--setMenu (const $ menu)
R.setRef menuRef menu R.setRef menuRef menu
setMenu $ const $ menu
Nothing -> pure unit Nothing -> pure unit
-- Nothing -> do -- Nothing -> do
-- R.setRef menuRef Nothing -- R.setRef menuRef Nothing
......
...@@ -10,7 +10,6 @@ import Reactix.DOM.HTML as H ...@@ -10,7 +10,6 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config (publicBackend)
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout) import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..)) import Gargantext.Components.Lang (LandingLang(..))
...@@ -25,7 +24,7 @@ import Gargantext.Components.Nodes.Frame (frameLayout) ...@@ -25,7 +24,7 @@ import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout) import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout) import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout) import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Config (defaultFrontends, defaultBackends) import Gargantext.Config (defaultFrontends, defaultBackends, publicBackend)
import Gargantext.Ends (Frontends, Backend) import Gargantext.Ends (Frontends, Backend)
import Gargantext.Hooks.Router (useHashRouter) import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.License (license) import Gargantext.License (license)
...@@ -36,6 +35,7 @@ import Gargantext.Sessions as Sessions ...@@ -36,6 +35,7 @@ import Gargantext.Sessions as Sessions
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.App" thisModule = "Gargantext.Components.App"
-- TODO (what does this mean?) -- TODO (what does this mean?)
......
-- TODO: this module should be replaced by FacetsTable -- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where module Gargantext.Components.DocsTable where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array as A import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens ((^.)) import Data.Lens ((^.))
import Data.Lens.At (at) import Data.Lens.At (at)
import Data.Lens.Record (prop) import Data.Lens.Record (prop)
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Ord.Down (Down(..)) import Data.Ord.Down (Down(..))
import Data.Sequence as Seq
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.String as Str import Data.String as Str
...@@ -22,25 +17,23 @@ import Data.Tuple (Tuple(..), fst) ...@@ -22,25 +17,23 @@ import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Category import Gargantext.Components.Category (Category(..), caroussel, decodeCategory)
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..)) import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Utils (sortWith)
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, get, delete, put) import Gargantext.Sessions (Session, sessionId, get, delete)
import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabSubType(..), TabType, showTabType') import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabSubType, TabType, showTabType')
import Gargantext.Utils (sortWith)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParamS, queryParam, queryParamS)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
...@@ -285,7 +278,7 @@ getPageHash :: Session -> PageParams -> Aff String ...@@ -285,7 +278,7 @@ getPageHash :: Session -> PageParams -> Aff String
getPageHash session { corpusId, listId, nodeId, query, tabType } = do getPageHash session { corpusId, listId, nodeId, query, tabType } = do
(get session $ tableHashRoute nodeId tabType) :: Aff String (get session $ tableHashRoute nodeId tabType) :: Aff String
convOrderBy :: Maybe (T.OrderByDirection T.ColumnName) -> Maybe OrderBy
convOrderBy (Just (T.ASC (T.ColumnName "Date"))) = Just DateAsc convOrderBy (Just (T.ASC (T.ColumnName "Date"))) = Just DateAsc
convOrderBy (Just (T.DESC (T.ColumnName "Date"))) = Just DateDesc convOrderBy (Just (T.DESC (T.ColumnName "Date"))) = Just DateDesc
convOrderBy (Just (T.ASC (T.ColumnName "Title"))) = Just TitleAsc convOrderBy (Just (T.ASC (T.ColumnName "Title"))) = Just TitleAsc
...@@ -332,8 +325,7 @@ pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where ...@@ -332,8 +325,7 @@ pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where
(NT.CacheOn /\ _) -> do (NT.CacheOn /\ _) -> do
let paint (Tuple count docs) = page params (props { totalRecords = count }) docs let paint (Tuple count docs) = page params (props { totalRecords = count }) docs
mkRequest :: PageParams -> GUC.Request mkRequest :: PageParams -> GUC.Request
mkRequest p@{ listId, nodeId, tabType } = mkRequest p = GUC.makeGetRequest session $ tableRoute p
GUC.makeGetRequest session $ tableRoute nodeId tabType listId
useLoaderWithCacheAPI { useLoaderWithCacheAPI {
cacheEndpoint: getPageHash session cacheEndpoint: getPageHash session
...@@ -345,8 +337,8 @@ pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where ...@@ -345,8 +337,8 @@ pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where
(NT.CacheOff /\ _) -> do (NT.CacheOff /\ _) -> do
localCategories <- R.useState' (mempty :: LocalCategories) localCategories <- R.useState' (mempty :: LocalCategories)
paramsS <- R.useState' params paramsS <- R.useState' params
let loader p@{ listId, nodeId, tabType } = do let loader p = do
res <- get session $ tableRouteWithPage { listId, nodeId, params: fst paramsS, query, tabType } res <- get session $ tableRouteWithPage (p { params = fst paramsS, query = query })
pure $ handleResponse res pure $ handleResponse res
render (Tuple count documents) = pagePaintRaw { documents render (Tuple count documents) = pagePaintRaw { documents
, layout: props { params = fst paramsS , layout: props { params = fst paramsS
...@@ -493,17 +485,19 @@ instance encodeJsonSQuery :: EncodeJson SearchQuery where ...@@ -493,17 +485,19 @@ instance encodeJsonSQuery :: EncodeJson SearchQuery where
documentsRoute :: Int -> SessionRoute documentsRoute :: Int -> SessionRoute
documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents" documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
tableRoute :: Int -> TabType -> Int -> SessionRoute tableRoute :: forall row. {nodeId :: Int, tabType :: TabType, listId :: Int | row} -> SessionRoute
tableRoute nodeId tabType listId = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId) tableRoute {nodeId, tabType, listId} = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId)
tableHashRoute :: Int -> TabType -> SessionRoute tableHashRoute :: Int -> TabType -> SessionRoute
tableHashRoute nodeId tabType = NodeAPI Node (Just nodeId) $ "table/hash" <> "?tabType=" <> (showTabType' tabType) tableHashRoute nodeId tabType = NodeAPI Node (Just nodeId) $ "table/hash" <> "?tabType=" <> (showTabType' tabType)
tableRouteWithPage :: { listId :: Int tableRouteWithPage :: forall row.
, nodeId :: Int { listId :: Int
, params :: T.Params , nodeId :: Int
, query :: Query , params :: T.Params
, tabType :: TabType } -> SessionRoute , query :: Query
, tabType :: TabType
| row } -> SessionRoute
tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchType }, query, tabType } = tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchType }, query, tabType } =
NodeAPI Node (Just nodeId) $ "table" <> joinQueryStrings [tt, lst, lmt, odb, ofs, st, q] NodeAPI Node (Just nodeId) $ "table" <> joinQueryStrings [tt, lst, lmt, odb, ofs, st, q]
where where
......
...@@ -16,18 +16,15 @@ import Data.Map as Map ...@@ -16,18 +16,15 @@ import Data.Map as Map
import Data.Maybe (Maybe(..), isNothing, maybe) import Data.Maybe (Maybe(..), isNothing, maybe)
import Data.Monoid.Additive (Additive(..)) import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..)) import Data.Ord.Down (Down(..))
import Data.Sequence as Seq import Data.Sequence (Seq, length) as Seq
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst) import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Reactix (Component, Element, State, createElement, fragment, hooksComponentWithModule, unsafeEventValue, useState') as R
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
...@@ -45,8 +42,9 @@ import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermL ...@@ -45,8 +42,9 @@ import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermL
import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith) import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Seq as Seq import Gargantext.Utils.Seq (mapMaybe) as Seq
thisModule :: String
thisModule = "Gargantext.Components.NgramsTable" thisModule = "Gargantext.Components.NgramsTable"
type State' = type State' =
...@@ -103,7 +101,7 @@ initialState (Versioned {version}) = { ...@@ -103,7 +101,7 @@ initialState (Versioned {version}) = {
setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
setTermListSetA ngramsTable ns new_list = setTermListSetA ngramsTable ns new_list =
CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns CoreAction $ CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
where where
f :: NgramsTerm -> Unit -> NgramsPatch f :: NgramsTerm -> Unit -> NgramsPatch
f n unit = NgramsPatch { patch_list, patch_children: mempty } f n unit = NgramsPatch { patch_list, patch_children: mempty }
...@@ -116,9 +114,6 @@ setTermListSetA ngramsTable ns new_list = ...@@ -116,9 +114,6 @@ setTermListSetA ngramsTable ns new_list =
-- https://github.com/purescript/purescript-ordered-collections/pull/31 -- https://github.com/purescript/purescript-ordered-collections/pull/31
-- toMap = Map.fromFoldable -- toMap = Map.fromFoldable
addNewNgramA :: NgramsTerm -> Action
addNewNgramA ngram = CommitPatch $ addNewNgram ngram CandidateTerm
type PreConversionRows = Seq.Seq NgramsElement type PreConversionRows = Seq.Seq NgramsElement
type TableContainerProps = type TableContainerProps =
...@@ -157,8 +152,10 @@ tableContainerCpt { dispatch ...@@ -157,8 +152,10 @@ tableContainerCpt { dispatch
H.li { className: "list-group-item" } [ H.li { className: "list-group-item" } [
H.button { className: "btn btn-primary" H.button { className: "btn btn-primary"
, on: { click: const $ dispatch , on: { click: const $ dispatch
$ CoreAction
$ addNewNgramA $ addNewNgramA
$ normNgram tabNgramType searchQuery (normNgram tabNgramType searchQuery)
CandidateTerm
} }
} }
[ H.text ("Add " <> searchQuery) ] [ H.text ("Add " <> searchQuery) ]
...@@ -303,8 +300,12 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" ...@@ -303,8 +300,12 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
, versioned: Versioned { data: initTable } , versioned: Versioned { data: initTable }
, withAutoUpdate } _ = do , withAutoUpdate } _ = do
let syncResetBtns = [syncResetButtons { afterSync, ngramsLocalPatch
, performAction: performAction <<< CoreAction
}]
pure $ R.fragment $ pure $ R.fragment $
autoUpdate <> [syncResetButtons { afterSync, ngramsLocalPatch, performAction }] <> [ autoUpdate <> syncResetBtns <> [
H.h4 {style: {textAlign : "center"}} [ H.h4 {style: {textAlign : "center"}} [
H.span {className: "glyphicon glyphicon-hand-down"} [] H.span {className: "glyphicon glyphicon-hand-down"} []
, H.text "Extracted Terms" , H.text "Extracted Terms"
...@@ -327,13 +328,13 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" ...@@ -327,13 +328,13 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
, ngramsSelection , ngramsSelection
} }
} }
] <> [syncResetButtons { afterSync, ngramsLocalPatch, performAction }] ] <> syncResetBtns
where where
autoUpdate :: Array R.Element autoUpdate :: Array R.Element
autoUpdate = if withAutoUpdate then autoUpdate = if withAutoUpdate then
[ R2.buff $ autoUpdateElt { [ R2.buff $ autoUpdateElt {
duration: 5000 duration: 5000
, effect: performAction $ Synchronize { afterSync } , effect: performAction $ CoreAction $ Synchronize { afterSync }
} ] } ]
else [] else []
...@@ -357,11 +358,6 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" ...@@ -357,11 +358,6 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
s { ngramsSelection = Set.empty :: Set NgramsTerm } s { ngramsSelection = Set.empty :: Set NgramsTerm }
else else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows } s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction (Synchronize { afterSync }) = syncPatches path' (state /\ setState) afterSync
performAction (CommitPatch pt) =
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction ResetPatches =
setState $ \s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }
performAction AddTermChildren = performAction AddTermChildren =
case ngramsParent of case ngramsParent of
Nothing -> Nothing ->
...@@ -373,6 +369,7 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" ...@@ -373,6 +369,7 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
pt = singletonNgramsTablePatch parent pe pt = singletonNgramsTablePatch parent pe
setState $ setParentResetChildren Nothing setState $ setParentResetChildren Nothing
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState) commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction (CoreAction a) = coreDispatch path' (state /\ setState) a
totalRecords = Seq.length rows totalRecords = Seq.length rows
filteredConvertedRows :: T.Rows filteredConvertedRows :: T.Rows
...@@ -444,41 +441,6 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" ...@@ -444,41 +441,6 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
setSearchQuery x = setPath $ _ { searchQuery = x } setSearchQuery x = setPath $ _ { searchQuery = x }
type SyncResetButtonsProps = (
afterSync :: Unit -> Aff Unit
, ngramsLocalPatch :: NgramsTablePatch
, performAction :: Action -> Effect Unit
)
syncResetButtons :: Record SyncResetButtonsProps -> R.Element
syncResetButtons p = R.createElement syncResetButtonsCpt p []
syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = R.hooksComponentWithModule thisModule "syncResetButtons" cpt
where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do
synchronizing@(s /\ _) <- R.useState' false
let hasChanges = ngramsLocalPatch /= mempty
pure $ H.div {} [
H.button { className: "btn btn-danger " <> if hasChanges then "" else " disabled"
, on: { click: \_ -> performAction ResetPatches }
} [ H.text "Reset" ]
, H.button { className: "btn btn-primary " <> (if s || (not hasChanges) then "disabled" else "")
, on: { click: synchronize synchronizing }
} [ H.text "Sync" ]
]
where
synchronize (_ /\ setSynchronizing) _ = delay unit $ \_ -> do
setSynchronizing $ const true
performAction $ Synchronize { afterSync: newAfterSync }
where
newAfterSync x = do
afterSync x
liftEffect $ setSynchronizing $ const false
displayRow :: State -> SearchQuery -> NgramsTable -> Maybe NgramsTerm -> Maybe TermList -> Maybe TermSize -> NgramsElement -> Boolean displayRow :: State -> SearchQuery -> NgramsTable -> Maybe NgramsTerm -> Maybe TermList -> Maybe TermSize -> NgramsElement -> Boolean
displayRow state@{ ngramsChildren displayRow state@{ ngramsChildren
, ngramsLocalPatch , ngramsLocalPatch
......
...@@ -17,7 +17,12 @@ import Reactix as R ...@@ -17,7 +17,12 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsElement, NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, Replace, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, singletonNgramsTablePatch) import Gargantext.Components.NgramsTable.Core ( Action(..), Dispatch, NgramsElement, NgramsPatch(..)
, NgramsTable, NgramsTablePatch, NgramsTerm, Replace
, _NgramsElement, _NgramsRepoElement, _PatchMap, _children
, _list, _ngrams, _occurrences, ngramsTermText, replace
, singletonNgramsTablePatch, setTermListA
)
import Gargantext.Components.Table as Tbl import Gargantext.Components.Table as Tbl
import Gargantext.Types as T import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -207,7 +212,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c ...@@ -207,7 +212,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c
ngramsStyle = [termStyle termList ngramsOpacity] ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsClick ngramsClick
= Just <<< dispatch <<< cycleTermListItem <<< view _ngrams = Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
-- ^ This is the old behavior it is nicer to use since one can -- ^ This is the old behavior it is nicer to use since one can
-- rapidly change the ngram list without waiting for confirmation. -- rapidly change the ngram list without waiting for confirmation.
-- However this might expose bugs. One of them can be reproduced -- However this might expose bugs. One of them can be reproduced
...@@ -226,7 +231,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c ...@@ -226,7 +231,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c
in in
H.input { checked: chkd H.input { checked: chkd
, className: "checkbox" , className: "checkbox"
, on: { change: const $ dispatch $ , on: { change: const $ dispatch $ CoreAction $
setTermListA ngrams (replace termList termList'') } setTermListA ngrams (replace termList termList'') }
, readOnly: ngramsTransient , readOnly: ngramsTransient
, type: "checkbox" } , type: "checkbox" }
...@@ -245,13 +250,6 @@ termStyle T.StopTerm opacity = DOM.style { color: "red", opacity ...@@ -245,13 +250,6 @@ termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" } , textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity } 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 -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams = tablePatchHasNgrams ngramsTablePatch ngrams =
isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
......
...@@ -15,6 +15,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -15,6 +15,7 @@ module Gargantext.Components.NgramsTable.Core
, NgramsTerm , NgramsTerm
, normNgram , normNgram
, ngramsTermText , ngramsTermText
, findNgramRoot
, findNgramTermList , findNgramTermList
, Version , Version
, Versioned(..) , Versioned(..)
...@@ -51,11 +52,20 @@ module Gargantext.Components.NgramsTable.Core ...@@ -51,11 +52,20 @@ module Gargantext.Components.NgramsTable.Core
, commitPatch , commitPatch
, putNgramsPatches , putNgramsPatches
, syncPatches , syncPatches
, addNewNgram , addNewNgramP
, addNewNgramA
, setTermListP
, setTermListA
, CoreAction(..)
, CoreDispatch
, Action(..) , Action(..)
, Dispatch , Dispatch
, coreDispatch
, isSingleNgramsTerm , isSingleNgramsTerm
, filterTermSize , filterTermSize
, SyncResetButtonsProps
, syncResetButtons
, syncResetButtonsCpt
) )
where where
...@@ -107,7 +117,9 @@ import Effect (Effect) ...@@ -107,7 +117,9 @@ import Effect (Effect)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception.Unsafe (unsafeThrow) import Effect.Exception.Unsafe (unsafeThrow)
import Foreign.Object as FO import Foreign.Object as FO
import Reactix (State) as R import FFI.Simple.Functions (delay)
import Reactix as R
import Reactix.DOM.HTML as H
import Partial (crashWith) import Partial (crashWith)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
...@@ -118,6 +130,9 @@ import Gargantext.Sessions (Session, get, put) ...@@ -118,6 +130,9 @@ import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..)) import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.KarpRabin (indicesOfAny) import Gargantext.Utils.KarpRabin (indicesOfAny)
thisModule :: String
thisModule = "Gargantext.Components.NgramsTable.Core"
type Endo a = a -> a type Endo a = a -> a
type CoreParams s = type CoreParams s =
...@@ -746,8 +761,14 @@ isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches ...@@ -746,8 +761,14 @@ isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches
fromNgramsPatches :: NgramsPatches -> NgramsTablePatch fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
fromNgramsPatches ngramsPatches = {ngramsPatches} fromNgramsPatches ngramsPatches = {ngramsPatches}
findNgramRoot :: NgramsTable -> NgramsTerm -> NgramsTerm
findNgramRoot (NgramsTable m) n =
fromMaybe n (m.ngrams_repo_elements ^? at n <<< _Just <<< _NgramsRepoElement <<< _root <<< _Just)
findNgramTermList :: NgramsTable -> NgramsTerm -> Maybe TermList findNgramTermList :: NgramsTable -> NgramsTerm -> Maybe TermList
findNgramTermList (NgramsTable m) n = m.ngrams_repo_elements ^? at n <<< _Just <<< _NgramsRepoElement <<< _list findNgramTermList (NgramsTable m) n = m.ngrams_repo_elements ^? at r <<< _Just <<< _NgramsRepoElement <<< _list
where
r = findNgramRoot (NgramsTable m) n
singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p
...@@ -864,10 +885,21 @@ newNgramPatch list = ...@@ -864,10 +885,21 @@ newNgramPatch list =
} }
} }
addNewNgram :: NgramsTerm -> TermList -> NgramsTablePatch addNewNgramP :: NgramsTerm -> TermList -> NgramsTablePatch
addNewNgram ngrams list = addNewNgramP ngrams list =
{ ngramsPatches: singletonPatchMap ngrams (newNgramPatch list) } { ngramsPatches: singletonPatchMap ngrams (newNgramPatch list) }
addNewNgramA :: NgramsTerm -> TermList -> CoreAction
addNewNgramA ngrams list = CommitPatch $ addNewNgramP ngrams list
setTermListP :: NgramsTerm -> Replace TermList -> NgramsTablePatch
setTermListP ngram patch_list = singletonNgramsTablePatch ngram pe
where
pe = NgramsPatch { patch_list, patch_children: mempty }
setTermListA :: NgramsTerm -> Replace TermList -> CoreAction
setTermListA ngram termList = CommitPatch $ setTermListP ngram termList
putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff VersionedNgramsPatches putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff VersionedNgramsPatches
putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId) where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
...@@ -949,9 +981,13 @@ convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc ...@@ -949,9 +981,13 @@ convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc convOrderBy (T.DESC _) = TermDesc
data CoreAction
= CommitPatch NgramsTablePatch
| Synchronize { afterSync :: Unit -> Aff Unit }
| ResetPatches
data Action data Action
= CommitPatch NgramsTablePatch = CoreAction CoreAction
| SetParentResetChildren (Maybe NgramsTerm) | SetParentResetChildren (Maybe NgramsTerm)
-- ^ This sets `ngramsParent` and resets `ngramsChildren`. -- ^ This sets `ngramsParent` and resets `ngramsChildren`.
| ToggleChild Boolean NgramsTerm | ToggleChild Boolean NgramsTerm
...@@ -959,15 +995,22 @@ data Action ...@@ -959,15 +995,22 @@ data Action
-- If the `Boolean` is `true` it means we want to add it if it is not here, -- 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. -- if it is `false` it is meant to be removed if not here.
| AddTermChildren | AddTermChildren
| Synchronize { afterSync :: Unit -> Aff Unit }
| ToggleSelect NgramsTerm | ToggleSelect NgramsTerm
-- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`. -- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
| ToggleSelectAll | ToggleSelectAll
| ResetPatches
type CoreDispatch = CoreAction -> Effect Unit
type Dispatch = Action -> Effect Unit type Dispatch = Action -> Effect Unit
coreDispatch :: forall p s. CoreParams p -> R.State (CoreState s) -> CoreDispatch
coreDispatch path state (Synchronize { afterSync }) =
syncPatches path state afterSync
coreDispatch _ state@({ngramsVersion} /\ _) (CommitPatch pt) =
commitPatch (Versioned {version: ngramsVersion, data: pt}) state
coreDispatch _ (_ /\ setState) ResetPatches =
setState $ \s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }
isSingleNgramsTerm :: NgramsTerm -> Boolean isSingleNgramsTerm :: NgramsTerm -> Boolean
isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt
where where
...@@ -980,3 +1023,38 @@ filterTermSize :: Maybe TermSize -> NgramsTerm -> Boolean ...@@ -980,3 +1023,38 @@ filterTermSize :: Maybe TermSize -> NgramsTerm -> Boolean
filterTermSize (Just MonoTerm) nt = isSingleNgramsTerm nt filterTermSize (Just MonoTerm) nt = isSingleNgramsTerm nt
filterTermSize (Just MultiTerm) nt = not $ isSingleNgramsTerm nt filterTermSize (Just MultiTerm) nt = not $ isSingleNgramsTerm nt
filterTermSize _ _ = true filterTermSize _ _ = true
type SyncResetButtonsProps =
( afterSync :: Unit -> Aff Unit
, ngramsLocalPatch :: NgramsTablePatch
, performAction :: CoreDispatch
)
syncResetButtons :: Record SyncResetButtonsProps -> R.Element
syncResetButtons p = R.createElement syncResetButtonsCpt p []
syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = R.hooksComponentWithModule thisModule "syncResetButtons" cpt
where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do
synchronizing@(s /\ setSynchronizing) <- R.useState' false
let
hasChanges = ngramsLocalPatch /= mempty
newAfterSync x = do
afterSync x
liftEffect $ setSynchronizing $ const false
synchronizeClick _ = delay unit $ \_ -> do
setSynchronizing $ const true
performAction $ Synchronize { afterSync: newAfterSync }
pure $ H.div {} [
H.button { className: "btn btn-danger " <> if hasChanges then "" else " disabled"
, on: { click: \_ -> performAction ResetPatches }
} [ H.text "Reset" ]
, H.button { className: "btn btn-primary " <> (if s || (not hasChanges) then "disabled" else "")
, on: { click: synchronizeClick }
} [ H.text "Sync" ]
]
\ No newline at end of file
...@@ -25,8 +25,8 @@ import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+ ...@@ -25,8 +25,8 @@ import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId) import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts" thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts"
display :: String -> Array R.Element -> R.Element display :: String -> Array R.Element -> R.Element
......
...@@ -17,7 +17,6 @@ import Gargantext.Components.Nodes.Lists.Types as NTypes ...@@ -17,7 +17,6 @@ import Gargantext.Components.Nodes.Lists.Types as NTypes
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..)) import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..))
import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs" thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs"
......
...@@ -8,15 +8,12 @@ import Data.Maybe (Maybe(..)) ...@@ -8,15 +8,12 @@ import Data.Maybe (Maybe(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core (CoreState, Versioned(..) , VersionedNgramsTable)
(CoreState, NgramsTerm, Replace, Versioned(..) , VersionedNgramsTable)
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (TabType, TermList) import Gargantext.Types (TabType)
type DocPath = type DocPath =
{ { corpusId :: Maybe Int
corpusId :: Maybe Int
, listIds :: Array Int , listIds :: Array Int
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
...@@ -50,12 +47,6 @@ initialState {loaded: {ngramsTable: Versioned {version}}} = ...@@ -50,12 +47,6 @@ initialState {loaded: {ngramsTable: Versioned {version}}} =
, ngramsVersion: version , ngramsVersion: version
} }
-- This is a subset of NgramsTable.Action.
data Action
= SetTermListItem NgramsTerm (Replace TermList)
| AddNewNgram NgramsTerm TermList
| Synchronize
newtype Status = Status { failed :: Int newtype Status = Status { failed :: Int
, succeeded :: Int , succeeded :: Int
, remaining :: Int , remaining :: Int
......
...@@ -14,7 +14,6 @@ import Gargantext.Components.Table as Table ...@@ -14,7 +14,6 @@ import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.Nodes.Lists" thisModule = "Gargantext.Components.Nodes.Lists"
......
module Gargantext.Components.Nodes.Lists.Tabs where module Gargantext.Components.Nodes.Lists.Tabs where
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
......
...@@ -23,8 +23,8 @@ import Gargantext.Components.Table as Table ...@@ -23,8 +23,8 @@ import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Texts" thisModule = "Gargantext.Components.Nodes.Texts"
-------------------------------------------------------- --------------------------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment