Commit 3977a1f8 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-doc-annot-issue-213' of...

Merge branch 'dev-doc-annot-issue-213' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents e43e967f a7e6df4d
...@@ -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.
{ listId :: Int
, nodeId :: Int , nodeId :: Int
, params :: T.Params , params :: T.Params
, query :: Query , query :: Query
, tabType :: TabType } -> SessionRoute , 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
......
...@@ -51,11 +51,20 @@ module Gargantext.Components.NgramsTable.Core ...@@ -51,11 +51,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 +116,9 @@ import Effect (Effect) ...@@ -107,7 +116,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 +129,9 @@ import Gargantext.Sessions (Session, get, put) ...@@ -118,6 +129,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 =
...@@ -864,10 +878,21 @@ newNgramPatch list = ...@@ -864,10 +878,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 +974,13 @@ convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc ...@@ -949,9 +974,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 +988,22 @@ data Action ...@@ -959,15 +988,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 +1016,38 @@ filterTermSize :: Maybe TermSize -> NgramsTerm -> Boolean ...@@ -980,3 +1016,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"
......
module Gargantext.Components.Nodes.Corpus.Document where module Gargantext.Components.Nodes.Corpus.Document where
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
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 (bind, pure, show, unit, ($), (<>))
import Gargantext.Components.AutoUpdate (autoUpdate) import Gargantext.Components.AutoUpdate (autoUpdate)
import Gargantext.Components.Search (SearchType(..)) import Gargantext.Components.Search (SearchType(..))
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus.Document.Types import Gargantext.Components.Nodes.Corpus.Document.Types (DocPath, Document(..), LoadedData, NodeDocument, Props, State, initialState)
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..) ( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable
, VersionedNgramsTable, addNewNgram, applyNgramsPatches, commitPatch , replace, setTermListA, syncResetButtons )
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
...@@ -62,11 +57,26 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -62,11 +57,26 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
where where
cpt { path cpt { path
, loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document } , loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }
, state: state@({ ngramsVersion: version } /\ _) , state: state@({ ngramsVersion: version, ngramsLocalPatch } /\ _)
} _children = do } _children = do
pure $ H.div {} [
autoUpdate { duration: 3000, effect: dispatch Synchronize } let
, H.div { className: "container1" } afterSync = \_ -> pure unit
syncResetBtns = [syncResetButtons { afterSync, ngramsLocalPatch
, performAction: dispatch
}]
withAutoUpdate = false
autoUpd :: Array R.Element
autoUpd = if withAutoUpdate then
[ autoUpdate { duration: 5000
, effect: dispatch $ Synchronize { afterSync }
}
]
else []
pure $ H.div {} $
autoUpd <> syncResetBtns <> [
H.div { className: "container1" }
[ [
R2.row R2.row
[ [
...@@ -94,24 +104,15 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -94,24 +104,15 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
] ]
] ]
where where
dispatch :: Action -> Effect Unit dispatch = coreDispatch path state
dispatch (AddNewNgram ngram termList) = do
commitPatch (Versioned {version, data: addNewNgram ngram termList}) state
dispatch (SetTermListItem ngram termList) = do
commitPatch (Versioned {version, data: pt}) state
where
pe = NgramsPatch { patch_list: termList, patch_children: mempty }
pt = singletonNgramsTablePatch ngram pe
dispatch Synchronize = do
syncPatches path state (\_ -> pure unit)
ngrams = applyNgramsPatches (fst state) initTable ngrams = applyNgramsPatches (fst state) initTable
annotate text = AnnotatedField.annotatedField { ngrams annotate text = AnnotatedField.annotatedField { ngrams
, setTermList , setTermList
, text } , text }
badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ] badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
li' = H.li { className: "list-group-item justify-content-between" } li' = H.li { className: "list-group-item justify-content-between" }
setTermList ngram Nothing newList = dispatch (AddNewNgram ngram newList) setTermList ngram Nothing newList = dispatch (addNewNgramA ngram newList)
setTermList ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList)) setTermList ngram (Just oldList) newList = dispatch (setTermListA ngram (replace oldList newList))
text' x = H.text $ fromMaybe "Nothing" x text' x = H.text $ fromMaybe "Nothing" x
NodePoly {hyperdata: Document doc} = document NodePoly {hyperdata: Document doc} = document
......
...@@ -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