diff --git a/src/Gargantext/Components/Annotation/Field.purs b/src/Gargantext/Components/Annotation/Field.purs index a9c516b9af9d1c7953fa71628e2eaa095611d2f0..ba5204c48a51e3524c8b8f9072cba86a9744588f 100644 --- a/src/Gargantext/Components/Annotation/Field.purs +++ b/src/Gargantext/Components/Annotation/Field.purs @@ -23,7 +23,8 @@ import Data.Tuple.Nested ((/\)) import Effect (Effect) import Gargantext.Components.Annotation.Menu (annotationMenu, AnnotationMenu) import Gargantext.Components.Annotation.Types (termClass, MenuType(..)) -import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram) +import Gargantext.Components.NgramsTable.Core (findNgramTermList, highlightNgrams, normNgram) +import Gargantext.Core.NgramsTable.Types (NgramsTable, NgramsTerm) import Gargantext.Types (CTabNgramType(..), TermList) import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Selection as Sel diff --git a/src/Gargantext/Components/Document/Layout.purs b/src/Gargantext/Components/Document/Layout.purs index 04f46cebf9dc2fe915f00819d3685dfcfaf6b532..bd735c6f5dde9fc11894aa3a6bb8b7dbb524847a 100644 --- a/src/Gargantext/Components/Document/Layout.purs +++ b/src/Gargantext/Components/Document/Layout.purs @@ -12,8 +12,11 @@ import Gargantext.Components.AutoUpdate (autoUpdate) import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap.Types (SpinnerTheme(..)) import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, initialState) -import Gargantext.Components.NgramsTable.Core (CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, replace, setTermListA, syncResetButtons, useAutoSync) +import Gargantext.Components.NgramsTable.Core (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA) +import Gargantext.Components.NgramsTable.AutoSync (useAutoSync) +import Gargantext.Components.NgramsTable.SyncResetButton (syncResetButtons) import Gargantext.Components.Node (NodePoly(..)) +import Gargantext.Core.NgramsTable.Types (CoreAction(..), Versioned(..), replace) import Gargantext.Utils as U import Gargantext.Utils.Reactix as R2 import Reactix as R diff --git a/src/Gargantext/Components/Document/Types.purs b/src/Gargantext/Components/Document/Types.purs index 59fa305f57be53a4f95a91ccaeb67280573bad0a..c7c4ffcdf83bc941d485b402772c7b9b7140f34c 100644 --- a/src/Gargantext/Components/Document/Types.purs +++ b/src/Gargantext/Components/Document/Types.purs @@ -10,7 +10,7 @@ import Simple.JSON as JSON import Gargantext.Prelude import Gargantext.Components.Node (NodePoly(..)) -import Gargantext.Components.NgramsTable.Core (CoreState, Versioned(..) , VersionedNgramsTable) +import Gargantext.Core.NgramsTable.Types (CoreState, Versioned(..) , VersionedNgramsTable) import Gargantext.Sessions (Session) import Gargantext.Types (ListId, NodeID, TabType) diff --git a/src/Gargantext/Components/GraphExplorer/API.purs b/src/Gargantext/Components/GraphExplorer/API.purs index b77e9963ce4eb7787d4808ba9aa773c74731b919..3f0948abc541d43d4efaefe7014ce9ea1c0df104 100644 --- a/src/Gargantext/Components/GraphExplorer/API.purs +++ b/src/Gargantext/Components/GraphExplorer/API.purs @@ -4,8 +4,8 @@ import Gargantext.Prelude import Data.Maybe (Maybe(..)) import Gargantext.Components.GraphExplorer.Types as GET -import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Config.REST (AffRESTError) +import Gargantext.Core.NgramsTable.Types as CNT import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes as GR @@ -20,7 +20,7 @@ type GraphAsyncUpdateParams = , nodes :: Array (Record SigmaxT.Node) , session :: Session , termList :: GT.TermList - , version :: NTC.Version + , version :: CNT.Version ) graphAsyncUpdate :: Record GraphAsyncUpdateParams -> AffRESTError GT.AsyncTaskWithType diff --git a/src/Gargantext/Components/GraphExplorer/Sidebar/Sidebar.purs b/src/Gargantext/Components/GraphExplorer/Sidebar.purs similarity index 97% rename from src/Gargantext/Components/GraphExplorer/Sidebar/Sidebar.purs rename to src/Gargantext/Components/GraphExplorer/Sidebar.purs index 96488324bea217703ad245e094e02633be200a7b..e28d9e415d6e8b90b7eac93da9d620740836570b 100644 --- a/src/Gargantext/Components/GraphExplorer/Sidebar/Sidebar.purs +++ b/src/Gargantext/Components/GraphExplorer/Sidebar.purs @@ -30,6 +30,7 @@ import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.Lang (Lang(..)) import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Config.REST (AffRESTError) +import Gargantext.Core.NgramsTable.Types as CNT import Gargantext.Data.Array (mapMaybe) import Gargantext.Ends (Frontends) import Gargantext.Hooks.FirstEffect (useFirstEffect') @@ -634,14 +635,14 @@ type SendPatches = sendPatches :: Record SendPatches -> Effect Unit sendPatches { errors, metaData, nodes, reloadForest, session, termList } = do launchAff_ do - patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array NTC.VersionedNgramsPatches) + patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array CNT.VersionedNgramsPatches) let mPatch = last patches case mPatch of Nothing -> pure unit Just (Left err) -> liftEffect $ do T.modify_ (A.cons $ FRESTError { error: err }) errors here.warn2 "[sendPatches] RESTError" err - Just (Right (NTC.Versioned _patch)) -> do + Just (Right (CNT.Versioned _patch)) -> do liftEffect $ T2.reload reloadForest -- Why is this called delete node? @@ -649,7 +650,7 @@ sendPatch :: TermList -> Session -> GET.MetaData -> Record SigmaxT.Node - -> AffRESTError NTC.VersionedNgramsPatches + -> AffRESTError CNT.VersionedNgramsPatches sendPatch termList session (GET.MetaData metaData) node = do eRet <- NTC.putNgramsPatches coreParams versioned case eRet of @@ -661,10 +662,10 @@ sendPatch termList session (GET.MetaData metaData) node = do nodeId :: NodeID nodeId = unsafePartial $ fromJust $ fromString node.id - versioned :: NTC.VersionedNgramsPatches - versioned = NTC.Versioned {version: metaData.list.version, data: np} + versioned :: CNT.VersionedNgramsPatches + versioned = CNT.Versioned {version: metaData.list.version, data: np} - coreParams :: NTC.CoreParams () + coreParams :: CNT.CoreParams () coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType} tabNgramType :: CTabNgramType @@ -673,14 +674,14 @@ sendPatch termList session (GET.MetaData metaData) node = do tabType :: TabType tabType = TabCorpus (TabNgramType tabNgramType) - term :: NTC.NgramsTerm + term :: CNT.NgramsTerm term = NTC.normNgram tabNgramType node.label - np :: NTC.NgramsPatches - np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list } + np :: CNT.NgramsPatches + np = NTC.singletonPatchMap term $ CNT.NgramsPatch { patch_children: mempty, patch_list } - patch_list :: NTC.Replace TermList - patch_list = NTC.Replace { new: termList, old: MapTerm } + patch_list :: CNT.Replace TermList + patch_list = CNT.Replace { new: termList, old: MapTerm } diff --git a/src/Gargantext/Components/NgramsTable.purs b/src/Gargantext/Components/NgramsTable.purs index 4a476bf64558c1935345ca7580cc559ef19d68a5..45e364310cea58848cd461afbcd2411ab154a97a 100644 --- a/src/Gargantext/Components/NgramsTable.purs +++ b/src/Gargantext/Components/NgramsTable.purs @@ -37,12 +37,14 @@ import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Variant(..)) import Gargantext.Components.NgramsTable.Components as NTC -import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsActionRef, NgramsClick, NgramsDepth, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm(..), PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, setTermListA, singletonNgramsTablePatch, syncResetButtons, toVersioned) +import Gargantext.Components.NgramsTable.Core (addNewNgramA, applyNgramsPatches, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, ngramsRepoElementToNgramsElement, normNgram, patchSetFromMap, setTermListA, singletonNgramsTablePatch, toVersioned) import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI) +import Gargantext.Components.NgramsTable.SyncResetButton (syncResetButtons) import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Table as TT import Gargantext.Components.Table.Types as TT -import Gargantext.Config.REST (AffRESTError, logRESTError) +import Gargantext.Config.REST (AffRESTError, RESTError, logRESTError) +import Gargantext.Core.NgramsTable.Types (Action(..), CoreAction(..), CoreState, Dispatch, NgramsActionRef, NgramsClick, NgramsDepth, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTablePatch(..), NgramsTerm(..), PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, applyPatchSet, ngramsTermText, replace) import Gargantext.Hooks.Loader (useLoaderBox) import Gargantext.Routes (SessionRoute(..)) as R import Gargantext.Sessions (Session, get) @@ -85,18 +87,21 @@ initialTreeEdit = , ngramsChildrenDiff: Map.empty , ngramsParent : Nothing } -initialState :: VersionedNgramsTable -> State -initialState (Versioned {version}) = { - ngramsLocalPatch: mempty +initialState :: State +initialState = + { ngramsLocalPatch: mempty , ngramsSelection: mempty , ngramsStagePatch: mempty , ngramsValidPatch: mempty - , ngramsVersion: version + , ngramsVersion: 0 } +initialStateWithVersion :: VersionedNgramsTable -> State +initialStateWithVersion (Versioned { version }) = initialState { ngramsVersion = version } + setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action setTermListSetA ngramsTable ns new_list = - CoreAction $ CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns + CoreAction $ CommitPatch $ NgramsTablePatch $ PatchMap $ mapWithIndex f $ toMap ns where f :: NgramsTerm -> Unit -> NgramsPatch f n _unit = NgramsPatch { patch_list, patch_children: mempty } @@ -568,10 +573,12 @@ type MainNgramsTableProps = ( getNgramsChildrenAff :: Session -> NodeID -> Array ListId -> TabType -> NgramsTerm -> Aff (Array NgramsTerm) getNgramsChildrenAff session nodeId listIds tabType (NormNgramsTerm ngrams) = do - res <- get session $ R.GetNgrams params (Just nodeId) + res :: Either RESTError ({ data :: Array { children :: Array String, ngrams :: String }}) <- get session $ R.GetNgrams params (Just nodeId) case res of Left err -> pure [] - Right r -> pure r + Right { data: lst } -> case A.uncons (A.filter (\d -> d.ngrams == ngrams) lst) of + Nothing -> pure [] + Just { head } -> pure $ NormNgramsTerm <$> head.children where params = { limit: 10 , listIds @@ -593,7 +600,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt onCancelRef <- R.useRef Nothing onNgramsClickRef <- R.useRef Nothing onSaveRef <- R.useRef Nothing - treeEditBox <- T.useBox initialTreeEdit + state <- T.useBox initialState + ngramsLocalPatch <- T.useFocused (_.ngramsLocalPatch) (\a b -> b { ngramsLocalPatch = a }) state nodeId <- T.useFocused (_.nodeId) (\a b -> b { nodeId = a }) path nodeId' <- T.useLive T.unequal nodeId @@ -611,18 +619,19 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt NT.CacheOn -> pure $ R.fragment [ loadedNgramsTableHeader { searchQuery } [] - , mainNgramsTableCacheOn props [] + , mainNgramsTableCacheOn (Record.merge props { state }) [] ] NT.CacheOff -> pure $ R.fragment [ loadedNgramsTableHeader { searchQuery } [] - , ngramsTreeEdit treeEdit [] - , mainNgramsTableCacheOff props [] + , ngramsTreeEdit (treeEdit) [] + , mainNgramsTableCacheOff (Record.merge props { state }) [] ] type NgramsTreeEditProps = ( box :: T.Box TreeEdit , getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm) + --, ngramsLocalPatch :: T.Box NgramsTablePatch , onCancelRef :: NgramsActionRef , onNgramsClickRef :: R.Ref (Maybe NgramsClick) , onSaveRef :: NgramsActionRef @@ -649,16 +658,30 @@ ngramsTreeEditReal :: R2.Component NgramsTreeEditRealProps ngramsTreeEditReal = R.createElement ngramsTreeEditRealCpt ngramsTreeEditRealCpt :: R.Component NgramsTreeEditRealProps ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where - cpt { box, getNgramsChildren, ngramsParent', onCancelRef, onNgramsClickRef, onSaveRef } _ = do + cpt { box + , getNgramsChildren + , ngramsParent' + , onCancelRef + , onNgramsClickRef + , onSaveRef } _ = do { ngramsChildren, ngramsChildrenDiff } <- T.useLive T.unequal box - let ngramsDepth = { depth: 1, ngrams: ngramsParent' } + R.useEffect' $ do + here.log2 "[ngramsTreeEditReal] ngramsParent'" ngramsParent' + here.log2 "[ngramsTreeEditReal] ngramsChildrenDiff" ngramsChildrenDiff + + let ngramsDepth = { depth: 0, ngrams: ngramsParent' } ngramsChildrenPatched :: Set NgramsTerm ngramsChildrenPatched = applyPatchSet (patchSetFromMap ngramsChildrenDiff) $ Set.fromFoldable ngramsChildren + -- A patched version of getNgramsChildren. This is used + -- because we're editing the tree and so won't fetch the API + -- ngrams children. gnc ngrams = if ngrams == ngramsParent' then do + liftEffect $ here.log2 "[gnc] ngrams" ngrams pure $ A.fromFoldable ngramsChildrenPatched else do + liftEffect $ here.log2 "[gnc] ngrams" ngrams pure [] pure $ H.div {} @@ -669,6 +692,9 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where , ngramsDepth , ngramsEdit , ngramsStyle: [] + , key: show ngramsParent' + <> "-" <> show ngramsChildren + <> "-" <> show ngramsChildrenDiff } , H.button { className: "btn btn-primary" , on: { click: onSaveClick } --(const $ dispatch AddTermChildren)} @@ -695,14 +721,19 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where Nothing -> pure unit Just onSave -> onSave unit -mainNgramsTableCacheOn :: R2.Component MainNgramsTableProps +type MainNgramsTableCacheProps = + ( state :: T.Box State + | MainNgramsTableProps ) + +mainNgramsTableCacheOn :: R2.Component MainNgramsTableCacheProps mainNgramsTableCacheOn = R.createElement mainNgramsTableCacheOnCpt -mainNgramsTableCacheOnCpt :: R.Component MainNgramsTableProps +mainNgramsTableCacheOnCpt :: R.Component MainNgramsTableCacheProps mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where cpt { afterSync , boxes , defaultListId , path + , state , tabNgramType , treeEdit , withAutoUpdate } _ = do @@ -714,6 +745,7 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where , boxes , cacheState: NT.CacheOn , path + , state , tabNgramType , treeEdit , versioned @@ -740,13 +772,14 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where handleResponse :: VersionedNgramsTable -> VersionedNgramsTable handleResponse v = v -mainNgramsTableCacheOff :: R2.Component MainNgramsTableProps +mainNgramsTableCacheOff :: R2.Component MainNgramsTableCacheProps mainNgramsTableCacheOff = R.createElement mainNgramsTableCacheOffCpt -mainNgramsTableCacheOffCpt :: R.Component MainNgramsTableProps +mainNgramsTableCacheOffCpt :: R.Component MainNgramsTableCacheProps mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where cpt { afterSync , boxes , path + , state , tabNgramType , treeEdit , withAutoUpdate } _ = do @@ -754,6 +787,7 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where , boxes , cacheState: NT.CacheOff , path + , state , tabNgramType , treeEdit , versionedWithCount @@ -792,6 +826,7 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where type MainNgramsTablePaintProps = ( cacheState :: NT.CacheState , path :: T.Box PageParams + , state :: T.Box State , treeEdit :: Record NgramsTreeEditProps , versioned :: VersionedNgramsTable | CommonProps @@ -806,14 +841,16 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt , boxes , cacheState , path + , state , tabNgramType , treeEdit , versioned , withAutoUpdate } _ = do - state <- T.useBox $ initialState versioned + R.useEffectOnce' $ do + let (Versioned { version }) = versioned + T.modify_ (_ { ngramsVersion = version }) state pure $ - loadedNgramsTableBody { afterSync , boxes @@ -830,6 +867,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt type MainNgramsTablePaintNoCacheProps = ( cacheState :: NT.CacheState , path :: T.Box PageParams + , state :: T.Box State , treeEdit :: Record NgramsTreeEditProps , versionedWithCount :: VersionedWithCountNgramsTable | CommonProps @@ -844,6 +882,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp , boxes , cacheState , path + , state , tabNgramType , treeEdit , versionedWithCount @@ -851,7 +890,9 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp -- TODO This is lame, make versionedWithCount a proper box? let count /\ versioned = toVersioned versionedWithCount - state <- T.useBox $ initialState versioned + R.useEffectOnce' $ do + let (Versioned { version }) = versioned + T.modify_ (_ { ngramsVersion = version }) state pure $ loadedNgramsTableBody diff --git a/src/Gargantext/Components/NgramsTable/AutoSync.purs b/src/Gargantext/Components/NgramsTable/AutoSync.purs new file mode 100644 index 0000000000000000000000000000000000000000..950be3942cbaf2d026427ffa35dd68ca8c9c28ae --- /dev/null +++ b/src/Gargantext/Components/NgramsTable/AutoSync.purs @@ -0,0 +1,65 @@ +module Gargantext.Components.NgramsTable.AutoSync where + +import Data.Maybe (Maybe(..)) +import Effect.Class (liftEffect) +import Gargantext.Core.NgramsTable.Types (CoreAction(..), CoreDispatch, CoreState) +import Gargantext.Prelude +import Gargantext.Utils.Reactix as R2 +import Reactix as R +import Toestand as T + +------------------------------------------------------------------ + +here :: R2.Here +here = R2.here "Gargantext.Components.NgramsTable.AutoSync" + + +type AutoSyncInput s = + ( state :: T.Box (CoreState s) + , action :: CoreDispatch + ) + +type AutoSyncOutput = + -- @XXX: cannot use an Either here due to the mecanism of `syncPatches` only + -- returning an `Aff Unit` + -- ( result :: T.Box (Maybe (Either RESTError Unit)) + ( result :: T.Box (Maybe Unit) + , onPending :: T.Box Boolean + ) + +useAutoSync :: forall s. + Record (AutoSyncInput s) + -> R.Hooks (Record AutoSyncOutput) +useAutoSync { state, action } = do + -- States + onPending <- T.useBox false + result <- T.useBox Nothing + + ngramsLocalPatch <- + T.useFocused + (_.ngramsLocalPatch) + (\a b -> b { ngramsLocalPatch = a }) state + + -- Computed + let + exec { new } = + let hasChanges = new /= mempty + in when hasChanges do + T.write_ true onPending + T.write_ Nothing result + action $ Synchronize + { afterSync: onSuccess + } + + onSuccess _ = liftEffect do + T.write_ false onPending + T.write_ (Just unit) result + + -- Hooks + R.useEffectOnce' $ T.listen exec ngramsLocalPatch + + -- Output + pure + { onPending + , result + } diff --git a/src/Gargantext/Components/NgramsTable/Components.purs b/src/Gargantext/Components/NgramsTable/Components.purs index d9117a75a5e1491f21738e21f476a8ff5ceafd15..6de94b7ec7aeebfcab57f5de8fdbded5959799ad 100644 --- a/src/Gargantext/Components/NgramsTable/Components.purs +++ b/src/Gargantext/Components/NgramsTable/Components.purs @@ -1,5 +1,6 @@ module Gargantext.Components.NgramsTable.Components where +import Data.Array as A import Data.Either (Either(..)) import Data.Lens ((^..), (^.), view) import Data.Lens.At (at) @@ -7,19 +8,23 @@ import Data.Lens.Fold (folded) import Data.Lens.Index (ix) import Data.List (List) import Data.List as L +import Data.Map (Map) +import Data.Map as Map import Data.Maybe (Maybe(..), maybe, isJust) -import Data.Nullable (null, toMaybe) +import Data.Nullable (Nullable, null, toMaybe) import Data.Set (Set) import Data.Set as Set +import DOM.Simple as DOM import Effect (Effect) import Effect.Aff (Aff, launchAff_) import Effect.Class (liftEffect) import FFI.Simple (delay) -import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, setTermListA) +import Gargantext.Components.NgramsTable.Core (applyNgramsPatches, setTermListA) +import Gargantext.Core.NgramsTable.Types (Action(..), Dispatch, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch(..), NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace) import Gargantext.Components.Table as Tbl import Gargantext.Config.REST (logRESTError) import Gargantext.Hooks.Loader (useLoader) -import Gargantext.Prelude (Unit, bind, const, discard, map, not, otherwise, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||)) +import Gargantext.Prelude (Unit, bind, const, discard, map, mempty, not, otherwise, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||)) import Gargantext.Types as GT import Gargantext.Utils.Reactix as R2 import React.DOM (a, span, text) @@ -44,51 +49,57 @@ searchInputCpt :: R.Component ( key :: String | SearchInputProps ) searchInputCpt = here.component "searchInput" cpt where cpt { searchQuery } _ = do + inputRef <- R.useRef null + pure $ R2.row [ H.div { className: "col-12" } [ H.div { className: "input-group" } - [ searchButton { searchQuery } [] - , searchFieldInput { searchQuery } [] + [ searchButton { inputRef, searchQuery } [] + , searchFieldInput { inputRef, searchQuery } [] ] ] ] type SearchButtonProps = - ( searchQuery :: T.Box String + ( inputRef :: R.Ref (Nullable DOM.Element) + , searchQuery :: T.Box String ) searchButton :: R2.Component SearchButtonProps searchButton = R.createElement searchButtonCpt searchButtonCpt :: R.Component SearchButtonProps searchButtonCpt = here.component "searchButton" cpt where - cpt { searchQuery } _ = do + cpt { inputRef, searchQuery } _ = do searchQuery' <- T.useLive T.unequal searchQuery pure $ H.div { className: "input-group-prepend" } [ if searchQuery' /= "" then H.button { className: "btn btn-danger" - , on: {click: \_ -> T.write "" searchQuery}} + , on: { click: \_ -> R2.setInputValue inputRef "" } } + -- T.write "" searchQuery } } [ H.span {className: "fa fa-times"} []] else H.span { className: "fa fa-search input-group-text" } [] ] type SearchFieldInputProps = - ( searchQuery :: T.Box String + ( inputRef :: R.Ref (Nullable DOM.Element) + , searchQuery :: T.Box String ) searchFieldInput :: R2.Component SearchFieldInputProps searchFieldInput = R.createElement searchFieldInputCpt searchFieldInputCpt :: R.Component SearchFieldInputProps searchFieldInputCpt = here.component "searchFieldInput" cpt where - cpt { searchQuery } _ = do + cpt { inputRef, searchQuery } _ = do -- searchQuery' <- T.useLive T.unequal searchQuery - + pure $ H.input { className: "form-control" -- , defaultValue: searchQuery' , name: "search" , on: { input: \e -> T.write (R.unsafeEventValue e) searchQuery } , placeholder: "Search" + , ref: inputRef , type: "value" } @@ -132,6 +143,7 @@ type RenderNgramsTree = , ngramsEdit :: NgramsClick , ngramsStyle :: Array DOM.Props --, ngramsTable :: NgramsTable + , key :: String -- used to refresh the tree on diff change ) renderNgramsTree :: Record RenderNgramsTree -> R.Element @@ -139,20 +151,20 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p [] renderNgramsTreeCpt :: R.Component RenderNgramsTree renderNgramsTreeCpt = here.component "renderNgramsTree" cpt where - cpt { getNgramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = + cpt { getNgramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do pure $ H.ul {} - [ H.span { className: "tree" } - [ H.span { className: "righthanded" } - [ tree { getNgramsChildren - --, ngramsChildren - , ngramsClick - , ngramsDepth - , ngramsEdit - , ngramsStyle - } + [ H.span { className: "tree" } + [ H.span { className: "righthanded" } + [ tree { getNgramsChildren + --, ngramsChildren + , ngramsClick + , ngramsDepth + , ngramsEdit + , ngramsStyle + } + ] ] ] - ] type TagProps = @@ -253,7 +265,7 @@ renderNgramsItemCpt :: R.Component RenderNgramsItem renderNgramsItemCpt = here.component "renderNgramsItem" cpt where cpt { dispatch - , getNgramsChildren + --, getNgramsChildren , ngrams , ngramsElement , ngramsLocalPatch @@ -261,6 +273,9 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt , ngramsSelection , ngramsTable } _ = do + R.useEffect' $ do + here.log2 "[renderNgramsItem] tbl" tbl + pure $ Tbl.makeRow [ H.div { className: "ngrams-selector" } [ H.span { className: "ngrams-chooser fa fa-eye-slash" @@ -271,11 +286,12 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt , checkbox GT.StopTerm , H.div {} ( if ngramsParent == Nothing - then [ renderNgramsTree { getNgramsChildren + then [ renderNgramsTree { getNgramsChildren: getNgramsChildren' , ngramsClick , ngramsDepth , ngramsEdit - , ngramsStyle } ] + , ngramsStyle + , key: "" } ] else [ H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } } [ H.i { className: "fa fa-plus" } [] ] , R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] @@ -297,7 +313,13 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt termList = ngramsElement ^. _NgramsElement <<< _list ngramsStyle = [termStyle termList ngramsOpacity] ngramsEdit { ngrams } = Just $ dispatch $ SetParentResetChildren (Just ngrams) ngramsChildren - ngramsChildren = ngramsTable ^.. ix ngrams <<< _NgramsRepoElement <<< _children <<< folded + tbl = applyNgramsPatches { ngramsLocalPatch + , ngramsStagePatch: mempty + , ngramsValidPatch: mempty + , ngramsVersion: 0 } ngramsTable + getNgramsChildren' :: NgramsTerm -> Aff (Array NgramsTerm) + getNgramsChildren' n = if n == ngrams then (pure $ A.fromFoldable ngramsChildren) else pure [] + ngramsChildren = tbl ^.. ix ngrams <<< _NgramsRepoElement <<< _children <<< folded ngramsClick = Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams -- ^ This is the old behavior it is nicer to use since one can @@ -349,8 +371,8 @@ termStyle GT.CandidateTerm opacity = DOM.style } tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean -tablePatchHasNgrams ngramsTablePatch ngrams = - isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams +tablePatchHasNgrams (NgramsTablePatch ngramsPatches) ngrams = + isJust $ ngramsPatches ^. _PatchMap <<< at ngrams nextTermList :: GT.TermList -> GT.TermList diff --git a/src/Gargantext/Components/NgramsTable/Core.purs b/src/Gargantext/Components/NgramsTable/Core.purs index 84f652abd796399ba591fcb15476df7a12a490a7..41481b23a052f1bcac08d541e5b700812e00256f 100644 --- a/src/Gargantext/Components/NgramsTable/Core.purs +++ b/src/Gargantext/Components/NgramsTable/Core.purs @@ -1,87 +1,4 @@ module Gargantext.Components.NgramsTable.Core - ( PageParams - , CoreParams - , NgramsElement(..) - , _NgramsElement - , NgramsRepoElementT - , NgramsRepoElement(..) - , _NgramsRepoElement - , ngramsRepoElementToNgramsElement - , NgramsTable(..) - , NewElems - , NgramsPatch(..) - , NgramsPatches - , _NgramsTable - , NgramsTerm(..) - , normNgram - , ngramsTermText - , findNgramRoot - , findNgramTermList - , Version - , Versioned(..) - , Count - , VersionedWithCount(..) - , toVersioned - , VersionedNgramsPatches - , AsyncNgramsChartsUpdate(..) - , VersionedNgramsTable - , VersionedWithCountNgramsTable - , NgramsTablePatch - , CoreState - , HighlightElement - , highlightNgrams - , initialPageParams - , loadNgramsTable - , loadNgramsTableAll - , convOrderBy - , Replace(..) -- Ideally we should keep the constructors hidden - , replace - , PatchSet(..) - , PatchMap(..) - , _PatchMap - , patchSetFromMap - , applyPatchSet ---, applyNgramsTablePatch -- re-export only if we have a good reason not to use applyNgramsPatches - , applyNgramsPatches - , rootsOf - , singletonPatchMap - , fromNgramsPatches - , singletonNgramsTablePatch - , isEmptyNgramsTablePatch - , _list - , _occurrences - , _children - , _ngrams - , _parent - , _root - , _ngrams_repo_elements - , _ngrams_scores - , commitPatch - , putNgramsPatches - , postNgramsChartsAsync - , syncPatches - , addNewNgramP - , addNewNgramA - , setTermListP - , setTermListA - , CoreAction(..) - , CoreDispatch - , Action(..) - , Dispatch - , coreDispatch - , isSingleNgramsTerm - , filterTermSize - - -- Reset Button TODO put elsewhere this file is too big - , SyncResetButtonsProps - , syncResetButtons - , chartsAfterSync - , useAutoSync - - , NgramsDepth - , NgramsClick - , NgramsActionRef - ) where import Gargantext.Prelude @@ -89,36 +6,24 @@ import Gargantext.Prelude import Control.Monad.State (class MonadState, execState) import Data.Array (head) import Data.Array as A -import Data.Bifunctor (lmap) import Data.Either (Either(..)) -import Data.Eq.Generic (genericEq) -import Data.Foldable (class Foldable, foldMap, foldl, foldr) -import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) -import Data.Generic.Rep (class Generic) -import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?)) -import Data.Lens.At (class At, at) +import Data.Foldable (foldl) +import Data.Lens (use, view, (^?), (?=), (%~), (%=), (.~)) +import Data.Lens.At (at) import Data.Lens.Common (_Just) import Data.Lens.Fold (folded, traverseOf_) -import Data.Lens.Index (class Index, ix) import Data.Lens.Iso.Newtype (_Newtype) -import Data.Lens.Record (prop) import Data.List ((:), List(Nil)) import Data.List as L import Data.Map (Map) import Data.Map as Map -import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust) -import Data.Monoid.Additive (Additive(..)) -import Data.Newtype (class Newtype) -import Data.Ord.Generic (genericCompare) +import Data.Maybe (Maybe(..), fromMaybe, fromMaybe') import Data.Set (Set) -import Data.Set as Set -import Data.Show.Generic (genericShow) import Data.String as S import Data.String.Common as DSC import Data.String.Regex (Regex, regex, replace) as R import Data.String.Regex.Flags (global, multiline) as R import Data.String.Utils as SU -import Data.Symbol (SProxy(..)) import Data.These (These(..)) import Data.Traversable (for, traverse_, traverse) import Data.TraversableWithIndex (traverseWithIndex) @@ -127,155 +32,30 @@ import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff, launchAff_) import Effect.Class (liftEffect) -import Effect.Exception.Unsafe (unsafeThrow) -import FFI.Simple.Functions (delay) -import Foreign as F -import Foreign.Object as FO import Gargantext.AsyncTasks as GAT import Gargantext.Components.Table as T import Gargantext.Components.Table.Types as T import Gargantext.Config.REST (AffRESTError, RESTError) import Gargantext.Config.Utils (handleRESTError) +import Gargantext.Core.NgramsTable.Types import Gargantext.Routes (SessionRoute(..)) import Gargantext.Sessions (Session, get, post, put) -import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..)) +import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..)) import Gargantext.Utils.Either (eitherMap) import Gargantext.Utils.KarpRabin (indicesOfAny) import Gargantext.Utils.Reactix as R2 import Partial (crashWith) import Partial.Unsafe (unsafePartial) -import Reactix (Component, Element, createElement) as R import Reactix as R -import Reactix.DOM.HTML as H -import Simple.JSON as JSON import Toestand as T here :: R2.Here here = R2.here "Gargantext.Components.NgramsTable.Core" -type Endo a = a -> a - - --- | Main Types -type Version = Int - -newtype Versioned a = Versioned - { version :: Version - , data :: a - } -derive instance Generic (Versioned a) _ -derive instance Newtype (Versioned a) _ -instance Eq a => Eq (Versioned a) where eq = genericEq -derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (Versioned a) -derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (Versioned a) ------------------------------------------------------------------------- -type Count = Int - -newtype VersionedWithCount a = VersionedWithCount - { version :: Version - , count :: Count - , data :: a - } -derive instance Generic (VersionedWithCount a) _ -derive instance Newtype (VersionedWithCount a) _ -instance Eq a => Eq (VersionedWithCount a) where eq = genericEq -derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (VersionedWithCount a) -derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (VersionedWithCount a) - toVersioned :: forall a. VersionedWithCount a -> Tuple Count (Versioned a) toVersioned (VersionedWithCount { count, data: d, version }) = Tuple count $ Versioned { data: d, version } ------------------------------------------------------------------------ --- TODO replace by NgramsPatches directly -type NgramsTablePatch = { ngramsPatches :: NgramsPatches } - -newtype PatchMap k p = PatchMap (Map k p) - -derive instance Generic (PatchMap k p) _ -derive instance Newtype (PatchMap k p) _ -derive instance (Eq k, Eq p) => Eq (PatchMap k p) - --- TODO generalize -instance JSON.WriteForeign p => JSON.WriteForeign (PatchMap NgramsTerm p) where - writeImpl (PatchMap m) = - JSON.writeImpl $ FO.fromFoldable $ map (lmap ngramsTermText) (Map.toUnfoldable m :: Array _) -instance (JSON.ReadForeign p, Monoid p) => JSON.ReadForeign (PatchMap NgramsTerm p) where - readImpl f = do - inst <- JSON.readImpl f - pure $ PatchMap $ foldlWithIndex (\k m v -> Map.insert (NormNgramsTerm k) v m) Map.empty (inst :: FO.Object p) - -- TODO we assume that the ngrams are already normalized ^^^^^^^^^^^^^ - -type NgramsPatches = PatchMap NgramsTerm NgramsPatch - -data NgramsPatch - = NgramsReplace - { patch_old :: Maybe NgramsRepoElement - , patch_new :: Maybe NgramsRepoElement - } - | NgramsPatch - { patch_children :: PatchSet NgramsTerm - , patch_list :: Replace TermList - } -derive instance Generic NgramsPatch _ -derive instance Eq NgramsPatch -instance Monoid NgramsPatch where - mempty = NgramsPatch { patch_children: mempty, patch_list: mempty } -instance Semigroup NgramsPatch where - append (NgramsReplace p) (NgramsReplace q) - | p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new" - | otherwise = ngramsReplace q.patch_old p.patch_new - append (NgramsPatch p) (NgramsPatch q) = NgramsPatch - { patch_children: p.patch_children <> q.patch_children - , patch_list: p.patch_list <> q.patch_list - } - append (NgramsPatch p) (NgramsReplace q) = ngramsReplace q.patch_old (q.patch_new # _Just <<< _Newtype %~ applyNgramsPatch' p) - append (NgramsReplace p) (NgramsPatch q) = ngramsReplace (p.patch_old # _Just <<< _Newtype %~ applyNgramsPatch' (invert q)) p.patch_new -instance JSON.WriteForeign NgramsPatch where - writeImpl (NgramsReplace { patch_old, patch_new }) = JSON.writeImpl { patch_old, patch_new } - writeImpl (NgramsPatch { patch_children, patch_list }) = JSON.writeImpl { patch_children, patch_list } -instance JSON.ReadForeign NgramsPatch where - readImpl f = do - inst :: { patch_old :: Maybe NgramsRepoElement - , patch_new :: Maybe NgramsRepoElement - , patch_children :: PatchSet NgramsTerm - , patch_list :: Replace TermList } <- JSON.readImpl f - -- TODO handle empty fields - -- TODO handle patch_new - if isJust inst.patch_new || isJust inst.patch_old then - pure $ NgramsReplace { patch_old: inst.patch_old, patch_new: inst.patch_new } - else do - pure $ NgramsPatch { patch_list: inst.patch_list, patch_children: inst.patch_children } - ------------------------------------------------------------------------- -newtype NgramsTerm = NormNgramsTerm String -derive instance Generic NgramsTerm _ -derive instance Newtype NgramsTerm _ -instance Eq NgramsTerm where eq = genericEq -instance Ord NgramsTerm where compare = genericCompare -instance Show NgramsTerm where show = genericShow -derive newtype instance JSON.ReadForeign NgramsTerm -derive newtype instance JSON.WriteForeign NgramsTerm -derive newtype instance Monoid NgramsTerm - ------------------------------------------------------------------------- - -type CoreParams s = - { nodeId :: Int - -- ^ This node can be a corpus or contact. - , listIds :: Array Int - , tabType :: TabType - , session :: Session - | s - } - -type PageParams = - CoreParams - ( params :: T.Params - , searchQuery :: String - , termListFilter :: Maybe TermList -- Nothing means all - , termSizeFilter :: Maybe TermSize -- Nothing means all - , scoreType :: ScoreType - ) initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams initialPageParams session nodeId listIds tabType = @@ -294,10 +74,6 @@ initialPageParams session nodeId listIds tabType = - -ngramsTermText :: NgramsTerm -> String -ngramsTermText (NormNgramsTerm t) = t - -- TODO normNgramInternal :: CTabNgramType -> String -> String normNgramInternal CTabAuthors = identity @@ -311,104 +87,6 @@ normNgramWithTrim nt = DSC.trim <<< normNgramInternal nt normNgram :: CTabNgramType -> String -> NgramsTerm normNgram tabType = NormNgramsTerm <<< normNgramWithTrim tabType ------------------------------------------------------------------------------------ -newtype NgramsElement = NgramsElement - { ngrams :: NgramsTerm -- HERE - , size :: Int -- MISSING - , list :: TermList -- ok - , root :: Maybe NgramsTerm -- ok - , parent :: Maybe NgramsTerm -- ok - , children :: Set NgramsTerm -- ok - , occurrences :: Int -- HERE - } - -derive instance Eq NgramsElement - - -_parent :: forall parent row. Lens' { parent :: parent | row } parent -_parent = prop (SProxy :: SProxy "parent") - -_root :: forall root row. Lens' { root :: root | row } root -_root = prop (SProxy :: SProxy "root") - -_ngrams :: forall row. Lens' { ngrams :: NgramsTerm | row } NgramsTerm -_ngrams = prop (SProxy :: SProxy "ngrams") - -_children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm) -_children = prop (SProxy :: SProxy "children") - -_occurrences :: forall row. Lens' { occurrences :: Int | row } Int -_occurrences = prop (SProxy :: SProxy "occurrences") - -_list :: forall a row. Lens' { list :: a | row } a -_list = prop (SProxy :: SProxy "list") - -_ngrams_repo_elements :: forall a row. Lens' { ngrams_repo_elements :: a | row } a -_ngrams_repo_elements = prop (SProxy :: SProxy "ngrams_repo_elements") - -_ngrams_scores :: forall a row. Lens' { ngrams_scores :: a | row } a -_ngrams_scores = prop (SProxy :: SProxy "ngrams_scores") - -derive instance Newtype NgramsElement _ -derive instance Generic NgramsElement _ -instance Show NgramsElement where show = genericShow - -_NgramsElement :: Iso' NgramsElement { - children :: Set NgramsTerm - , size :: Int - , list :: TermList - , ngrams :: NgramsTerm - , occurrences :: Int - , parent :: Maybe NgramsTerm - , root :: Maybe NgramsTerm - } -_NgramsElement = _Newtype - -instance JSON.ReadForeign NgramsElement where - readImpl f = do - inst :: { children :: Array NgramsTerm - , size :: Int - , list :: TermList - , ngrams :: NgramsTerm - , occurrences :: Int - , parent :: Maybe NgramsTerm - , root :: Maybe NgramsTerm }<- JSON.readImpl f - pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children } -instance JSON.WriteForeign NgramsElement where - writeImpl (NgramsElement ne) = - JSON.writeImpl $ ne { children = Set.toUnfoldable ne.children :: Array _ } - -type NgramsRepoElementT = - ( size :: Int - , list :: TermList - , root :: Maybe NgramsTerm - , parent :: Maybe NgramsTerm - ) -newtype NgramsRepoElement = NgramsRepoElement - { children :: Set NgramsTerm - | NgramsRepoElementT } -derive instance Generic NgramsRepoElement _ -derive instance Newtype NgramsRepoElement _ -derive instance Eq NgramsRepoElement -instance JSON.ReadForeign NgramsRepoElement where - readImpl f = do - inst :: { children :: Array NgramsTerm | NgramsRepoElementT } <- JSON.readImpl f - pure $ NgramsRepoElement $ inst { children = Set.fromFoldable inst.children } -instance JSON.WriteForeign NgramsRepoElement where - writeImpl (NgramsRepoElement nre) = - JSON.writeImpl $ nre { children = Set.toUnfoldable nre.children :: Array _ } -instance Show NgramsRepoElement where show = genericShow - -_NgramsRepoElement :: Iso' NgramsRepoElement { - children :: Set NgramsTerm - , size :: Int - , list :: TermList - , parent :: Maybe NgramsTerm - , root :: Maybe NgramsTerm --- , occurrences :: Int - } -_NgramsRepoElement = _Newtype - ngramsRepoElementToNgramsElement :: NgramsTerm -> Int -> NgramsRepoElement -> NgramsElement ngramsRepoElementToNgramsElement ngrams occurrences (NgramsRepoElement { children, list, parent, root, size }) = NgramsElement @@ -422,57 +100,6 @@ ngramsRepoElementToNgramsElement ngrams occurrences (NgramsRepoElement { childre } ----------------------------------------------------------------------------------- -{- - NgramsRepoElement does not have the occurrences field. - Instead NgramsTable has a ngrams_scores map. - - Pro: - * Does not encumber NgramsRepoElement with the score which is not part of repo. - * Enables for multiple scores through multiple maps. - Cons: - * Having a map on the side is equivalent to a `occurrences :: Maybe Int`, which is - less precise. - * It is a tiny bit less performant to access the score. --} -newtype NgramsTable = NgramsTable - { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement - , ngrams_scores :: Map NgramsTerm (Additive Int) - } - -derive instance Newtype NgramsTable _ -derive instance Generic NgramsTable _ -instance Eq NgramsTable where eq = genericEq -instance Show NgramsTable where show = genericShow - -_NgramsTable :: Iso' NgramsTable - { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement - , ngrams_scores :: Map NgramsTerm (Additive Int) - } -_NgramsTable = _Newtype - -instance Index NgramsTable NgramsTerm NgramsRepoElement where - ix k = _NgramsTable <<< _ngrams_repo_elements <<< ix k - -instance At NgramsTable NgramsTerm NgramsRepoElement where - at k = _NgramsTable <<< _ngrams_repo_elements <<< at k - -instance JSON.ReadForeign NgramsTable where - readImpl ff = do - inst <- JSON.readImpl ff - pure $ NgramsTable - { ngrams_repo_elements: Map.fromFoldable $ f <$> (inst :: Array NgramsElement) - , ngrams_scores: Map.fromFoldable $ g <$> inst - } - where - f (NgramsElement {ngrams, size, list, root, parent, children}) = - Tuple ngrams (NgramsRepoElement {size, list, root, parent, children}) - g (NgramsElement e) = Tuple e.ngrams (Additive e.occurrences) - -{- NOT USED -instance EncodeJson NgramsTable where - encodeJson (NgramsTable {ngrams_repo_elements, ngrams_scores}) = encodeJson $ Map.values ... TODO --} ------------------------------------------------------------------------------------ lookupRootList :: NgramsTerm -> NgramsTable -> Maybe TermList lookupRootList ngram (NgramsTable {ngrams_repo_elements: elts}) = @@ -497,9 +124,6 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global < Left e -> unsafePartial $ crashWith e Right r -> r -type HighlightElement = Tuple String (List (Tuple NgramsTerm TermList)) -type HighlightAccumulator = List HighlightElement - -- TODO: while this function works well with word boundaries, -- it inserts too many spaces. highlightNgrams :: CTabNgramType -> NgramsTable -> String -> Array HighlightElement @@ -562,162 +186,22 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 = fromMaybe' (\_ -> crashWith "highlightNgrams: out of bounds pattern") $ traverse (A.index pats) pis ------------------------------------------------------------------------------------ - -type VersionedNgramsTable = Versioned NgramsTable -type VersionedWithCountNgramsTable = VersionedWithCount NgramsTable - ------------------------------------------------------------------------------------ -data Replace a - = Keep - | Replace { old :: a, new :: a } - -derive instance Generic (Replace a) _ - -replace :: forall a. Eq a => a -> a -> Replace a -replace old new - | old == new = Keep - | otherwise = Replace { old, new } - -derive instance Eq a => Eq (Replace a) - -instance Eq a => Semigroup (Replace a) where - append Keep p = p - append p Keep = p - append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new" - append (Replace { new }) (Replace { old }) = replace old new - -instance Eq a => Monoid (Replace a) where mempty = Keep - -applyReplace :: forall a. Eq a => Replace a -> a -> a -applyReplace Keep a = a -applyReplace (Replace { old, new }) a - | a == old = new - | otherwise = a - -instance JSON.WriteForeign a => JSON.WriteForeign (Replace a) where - writeImpl Keep = JSON.writeImpl { tag: "Keep" } - writeImpl (Replace {old, new}) = JSON.writeImpl { old, new, tag: "Replace" } -instance (JSON.ReadForeign a, Eq a) => JSON.ReadForeign (Replace a) where - readImpl f = do - impl :: { old :: Maybe a, new :: Maybe a } <- JSON.readImpl f - case Tuple impl.old impl.new of - Tuple (Just old) (Just new) -> pure $ replace old new - Tuple Nothing Nothing -> pure Keep - _ -> F.fail $ F.ForeignError "decodeJsonReplace" - --- Representing a PatchSet as `Map a Boolean` would have the advantage --- of enforcing rem and add to be disjoint. -newtype PatchSet a = PatchSet - { rem :: Set a - , add :: Set a - } - -derive instance Generic (PatchSet a) _ -derive instance Newtype (PatchSet a) _ - -instance Ord a => Semigroup (PatchSet a) where - append (PatchSet p) (PatchSet q) = PatchSet - { rem: q.rem <> p.rem - , add: Set.difference q.add p.rem <> p.add - } - -instance Ord a => Monoid (PatchSet a) where - mempty = PatchSet { rem: Set.empty, add: Set.empty } - -instance JSON.WriteForeign a => JSON.WriteForeign (PatchSet a) where - writeImpl (PatchSet {rem, add}) = JSON.writeImpl { rem: (Set.toUnfoldable rem :: Array a) - , add: (Set.toUnfoldable add :: Array a) } - -instance (Ord a, JSON.ReadForeign a) => JSON.ReadForeign (PatchSet a) where - readImpl f = do - -- TODO handle empty fields - inst :: { rem :: Array a, add :: Array a } <- JSON.readImpl f - let rem = mkSet inst.rem - add = mkSet inst.add - pure $ PatchSet { rem, add } - where - mkSet :: forall b. Ord b => Array b -> Set b - mkSet = Set.fromFoldable - -applyPatchSet :: forall a. Ord a => PatchSet a -> Set a -> Set a -applyPatchSet (PatchSet p) s = Set.difference s p.rem <> p.add +--applyNgramsTablePatchToSingleTerm :: NgramsTerm -> NgramsTablePatch -> Set NgramsTerm -> Set NgramsTerm +--applyNgramsTablePatchToSingleTerm ngram patch s = +-- applyNgramsTablePatch patch $ patchSetFromMap :: forall a. Ord a => Map a Boolean -> PatchSet a patchSetFromMap m = PatchSet { rem: Map.keys (Map.filter not m) , add: Map.keys (Map.filter identity m) } -- TODO Map.partition would be nice here --- TODO shall we normalise as in replace? shall we make a type class Replaceable? -ngramsReplace :: Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch -ngramsReplace patch_old patch_new = NgramsReplace {patch_old, patch_new} - -derive instance Eq (PatchSet NgramsTerm) - --- TODO -invert :: forall a. a -> a -invert _ = unsafeThrow "invert: TODO" - -applyNgramsPatch' :: forall row. - { patch_children :: PatchSet NgramsTerm - , patch_list :: Replace TermList - } -> - Endo { list :: TermList - , children :: Set NgramsTerm - | row - } -applyNgramsPatch' p e = - e { list = applyReplace p.patch_list e.list - , children = applyPatchSet p.patch_children e.children - } - applyNgramsPatch :: NgramsPatch -> Maybe NgramsRepoElement -> Maybe NgramsRepoElement applyNgramsPatch (NgramsReplace {patch_new}) _ = patch_new applyNgramsPatch (NgramsPatch p) m = m # _Just <<< _Newtype %~ applyNgramsPatch' p -fromMap :: forall k p. Ord k => Eq p => Monoid p => Map k p -> PatchMap k p -fromMap = PatchMap <<< Map.filter (\v -> v /= mempty) - -instance (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where - append (PatchMap p) (PatchMap q) = fromMap $ Map.unionWith append p q - -instance (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where - mempty = PatchMap Map.empty - -_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p) -_PatchMap = _Newtype - -{- -instance Functor (PatchMap k) where - map f (PatchMap m) = PatchMap (map f m) -- NO NORM: fromMap would not typecheck - -instance FunctorWithIndex k (PatchMap k) where - mapWithIndex f (PatchMap m) = PatchMap (mapWithIndex f m) -- NO NORM: fromMap would not typecheck --} - -instance Foldable (PatchMap k) where - foldr f z (PatchMap m) = foldr f z m - foldl f z (PatchMap m) = foldl f z m - foldMap f (PatchMap m) = foldMap f m - -instance FoldableWithIndex k (PatchMap k) where - foldrWithIndex f z (PatchMap m) = foldrWithIndex f z m - foldlWithIndex f z (PatchMap m) = foldlWithIndex f z m - foldMapWithIndex f (PatchMap m) = foldMapWithIndex f m - -{- fromMap is preventing these to type check: - -instance Ord k => Traversable (PatchMap k) where - traverse f (PatchMap m) = fromMap <$> traverse f m - sequence (PatchMap m) = fromMap <$> sequence m - -instance Ord k => TraversableWithIndex k (PatchMap k) where - traverseWithIndex f (PatchMap m) = fromMap <$> traverseWithIndex f m --} - traversePatchMapWithIndex :: forall f a b k. Applicative f => Ord k => Eq b => Monoid b => (k -> a -> f b) -> PatchMap k a -> f (PatchMap k b) @@ -748,26 +232,12 @@ applyPatchMap applyPatchValue (PatchMap pm) m = where go m' (Tuple k pv) = Map.alter (applyPatchValue pv) k m' -type VersionedNgramsPatches = Versioned NgramsPatches - -newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate { - listId :: Maybe ListId - , tabType :: TabType - } -derive instance Generic AsyncNgramsChartsUpdate _ -derive instance Newtype AsyncNgramsChartsUpdate _ -instance JSON.WriteForeign AsyncNgramsChartsUpdate where - writeImpl (AsyncNgramsChartsUpdate { listId, tabType }) = - JSON.writeImpl { list_id: listId, tab_type: tabType } - -type NewElems = Map NgramsTerm TermList - ---------------------------------------------------------------------------------- isEmptyNgramsTablePatch :: NgramsTablePatch -> Boolean -isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches +isEmptyNgramsTablePatch (NgramsTablePatch ngramsPatches) = isEmptyPatchMap ngramsPatches fromNgramsPatches :: NgramsPatches -> NgramsTablePatch -fromNgramsPatches ngramsPatches = {ngramsPatches} +fromNgramsPatches ngramsPatches = NgramsTablePatch ngramsPatches findNgramRoot :: NgramsTable -> NgramsTerm -> NgramsTerm findNgramRoot (NgramsTable m) n = @@ -786,10 +256,6 @@ rootsOf (NgramsTable m) = Map.keys $ Map.mapMaybe isRoot m.ngrams_repo_elements where isRoot (NgramsRepoElement { parent }) = parent -type RootParent = { root :: NgramsTerm, parent :: NgramsTerm } - -type ReParent a = forall m. MonadState NgramsTable m => a -> m Unit - reRootMaxDepth :: Int reRootMaxDepth = 100 -- TODO: this is a hack @@ -841,7 +307,7 @@ newElemsTable = mapWithIndex newElem -} applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable -applyNgramsTablePatch { ngramsPatches } (NgramsTable m) = +applyNgramsTablePatch (NgramsTablePatch ngramsPatches) (NgramsTable m) = execState (reParentNgramsTablePatch ngramsPatches) $ NgramsTable $ m { ngrams_repo_elements = applyPatchMap applyNgramsPatch ngramsPatches m.ngrams_repo_elements } @@ -850,19 +316,6 @@ applyNgramsPatches :: forall s. CoreState s -> NgramsTable -> NgramsTable applyNgramsPatches {ngramsLocalPatch, ngramsStagePatch, ngramsValidPatch} = applyNgramsTablePatch (ngramsLocalPatch <> ngramsStagePatch <> ngramsValidPatch) -- First the valid patch, then the stage patch, and finally the local patch. ------------------------------------------------------------------------------------ - -type CoreState s = - { ngramsLocalPatch :: NgramsTablePatch - -- ^ These patches are local and not yet staged. - , ngramsStagePatch :: NgramsTablePatch - -- ^ These patches are staged (scheduled for synchronization). - -- Requests are being performed at the moment. - , ngramsValidPatch :: NgramsTablePatch - -- ^ These patches have been synchronized with the server. - , ngramsVersion :: Version - | s - } {- postNewNgrams :: forall s. Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit @@ -895,7 +348,7 @@ newNgramPatch list = addNewNgramP :: NgramsTerm -> TermList -> NgramsTablePatch addNewNgramP ngrams list = - { ngramsPatches: singletonPatchMap ngrams (newNgramPatch list) } + NgramsTablePatch $ singletonPatchMap ngrams (newNgramPatch list) addNewNgramA :: NgramsTerm -> TermList -> CoreAction addNewNgramA ngrams list = CommitPatch $ addNewNgramP ngrams list @@ -914,7 +367,7 @@ putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams syncPatches :: forall p s. CoreParams p -> T.Box (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit syncPatches props state callback = do - { ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches } + { ngramsLocalPatch: ngramsLocalPatch@(NgramsTablePatch ngramsPatches) , ngramsStagePatch , ngramsVersion } <- T.read state when (isEmptyNgramsTablePatch ngramsStagePatch) $ do @@ -991,8 +444,6 @@ loadNgramsTable -- , termListFilter -- , termSizeFilter } (Just nodeId) -type NgramsListByTabType = Map TabType VersionedNgramsTable - loadNgramsTableAll :: PageParams -> AffRESTError NgramsListByTabType loadNgramsTableAll { nodeId, listIds, session } = do let @@ -1017,36 +468,13 @@ convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc convOrderBy (T.ASC _) = TermAsc convOrderBy (T.DESC _) = TermDesc -data CoreAction - = CommitPatch NgramsTablePatch - | Synchronize { afterSync :: Unit -> Aff Unit } - | ResetPatches - -data Action - = CoreAction CoreAction - | ClearTreeEdit - | SetParentResetChildren (Maybe NgramsTerm) (List NgramsTerm) - -- ^ This sets `ngramsParent` and resets `ngramsChildren`. - | ToggleChild Boolean NgramsTerm - -- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`. - -- If the `Boolean` is `true` it means we want to add it if it is not here, - -- if it is `false` it is meant to be removed if not here. - | AddTermChildren - | ToggleSelect NgramsTerm - -- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`. - | ToggleSelectAll - - -type CoreDispatch = CoreAction -> Effect Unit -type Dispatch = Action -> Effect Unit - coreDispatch :: forall p s. CoreParams p -> T.Box (CoreState s) -> CoreDispatch coreDispatch path state (Synchronize { afterSync }) = syncPatches path state afterSync coreDispatch _ state (CommitPatch pt) = commitPatch pt state coreDispatch _ state ResetPatches = - T.modify_ (_ { ngramsLocalPatch = { ngramsPatches: mempty } }) state + T.modify_ (_ { ngramsLocalPatch = mempty :: NgramsTablePatch }) state isSingleNgramsTerm :: NgramsTerm -> Boolean isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt @@ -1063,111 +491,7 @@ filterTermSize _ _ = true ------------------------------------------------------------------------ --- | Reset Button -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 = here.component "syncResetButtons" cpt - where - cpt { afterSync, ngramsLocalPatch, performAction } _ = do - synchronizing <- T.useBox false - synchronizing' <- T.useLive T.unequal synchronizing - - let - hasChanges = ngramsLocalPatch /= mempty - hasChangesClass = if hasChanges then "" else " disabled" - - synchronizingClass = if synchronizing' then " disabled" else "" - - resetClick _ = do - performAction ResetPatches - - synchronizeClick _ = delay unit $ \_ -> do - T.write_ true synchronizing - performAction $ Synchronize { afterSync: newAfterSync } - - newAfterSync x = do - afterSync x - liftEffect $ T.write_ false synchronizing - - pure $ H.div { className: "btn-toolbar" } - [ H.div { className: "btn-group mr-2" } - [ H.button { className: "btn btn-danger " <> hasChangesClass <> synchronizingClass - , on: { click: resetClick } - } [ H.text "Reset" ] - ] - , H.div { className: "btn-group mr-2" } - [ H.button { className: "btn btn-primary " <> hasChangesClass <> synchronizingClass - , on: { click: synchronizeClick } - } [ H.text "Sync" ] - ] - ] - ------------------------------------------------------------------- - - -type AutoSyncInput s = - ( state :: T.Box (CoreState s) - , action :: CoreDispatch - ) - -type AutoSyncOutput = - -- @XXX: cannot use an Either here due to the mecanism of `syncPatches` only - -- returning an `Aff Unit` - -- ( result :: T.Box (Maybe (Either RESTError Unit)) - ( result :: T.Box (Maybe Unit) - , onPending :: T.Box Boolean - ) - -useAutoSync :: forall s. - Record (AutoSyncInput s) - -> R.Hooks (Record AutoSyncOutput) -useAutoSync { state, action } = do - -- States - onPending <- T.useBox false - result <- T.useBox Nothing - - ngramsLocalPatch <- - T.useFocused - (_.ngramsLocalPatch) - (\a b -> b { ngramsLocalPatch = a }) state - - -- Computed - let - exec { new } = - let hasChanges = new /= mempty - in when hasChanges do - T.write_ true onPending - T.write_ Nothing result - action $ Synchronize - { afterSync: onSuccess - } - - onSuccess _ = liftEffect do - T.write_ false onPending - T.write_ (Just unit) result - - -- Hooks - R.useEffectOnce' $ T.listen exec ngramsLocalPatch - - -- Output - pure - { onPending - , result - } - ------------------------------------------------------------------- - -type ResetButton = (Unit -> Aff Unit) - -> { ngramsPatches :: PatchMap NgramsTerm NgramsPatch } - -> (Action -> Effect Unit) - -> Array R.Element + chartsAfterSync :: forall props discard. { listIds :: Array Int @@ -1194,8 +518,3 @@ postNgramsChartsAsync { listIds, nodeId, session, tabType } = do acu = AsyncNgramsChartsUpdate { listId: head listIds , tabType } putNgramsAsync = PostNgramsChartsAsync (Just nodeId) - - -type NgramsDepth = { ngrams :: NgramsTerm, depth :: Int } -type NgramsClick = NgramsDepth -> Maybe (Effect Unit) -type NgramsActionRef = R.Ref (Maybe (Unit -> Effect Unit)) diff --git a/src/Gargantext/Components/NgramsTable/Loader.purs b/src/Gargantext/Components/NgramsTable/Loader.purs index 2413fd551563d0d04f549d60efa87b72c360bcf6..e032f2becf9fc94668eb220f8b00340c8edffe12 100644 --- a/src/Gargantext/Components/NgramsTable/Loader.purs +++ b/src/Gargantext/Components/NgramsTable/Loader.purs @@ -10,8 +10,8 @@ import Effect.Aff (Aff, launchAff_, throwError) import Effect.Class (liftEffect) import Effect.Exception (error) import Gargantext.Components.LoadingSpinner (loadingSpinner) -import Gargantext.Components.NgramsTable.Core (Version, Versioned(..)) import Gargantext.Config.REST (RESTError(..), AffRESTError) +import Gargantext.Core.NgramsTable.Types (Version, Versioned(..)) import Gargantext.Utils.CacheAPI as GUC import Reactix as R import Simple.JSON as JSON diff --git a/src/Gargantext/Components/NgramsTable/SyncResetButton.purs b/src/Gargantext/Components/NgramsTable/SyncResetButton.purs new file mode 100644 index 0000000000000000000000000000000000000000..f906c015b296bbd5714ffa9b2f45f6eb3d525ff7 --- /dev/null +++ b/src/Gargantext/Components/NgramsTable/SyncResetButton.purs @@ -0,0 +1,62 @@ +module Gargantext.Components.NgramsTable.SyncResetButton where + +import Effect.Aff (Aff) +import Effect.Class (liftEffect) +import FFI.Simple.Functions (delay) +import Gargantext.Core.NgramsTable.Types (CoreAction(..), CoreDispatch, NgramsTablePatch) +import Gargantext.Prelude +import Gargantext.Utils.Reactix as R2 +import Reactix as R +import Reactix.DOM.HTML as H +import Toestand as T + +here :: R2.Here +here = R2.here "Gargantext.Components.NgramsTable.SyncResetButton" + + +-- | Reset Button +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 = here.component "syncResetButtons" cpt + where + cpt { afterSync, ngramsLocalPatch, performAction } _ = do + synchronizing <- T.useBox false + synchronizing' <- T.useLive T.unequal synchronizing + + let + hasChanges = ngramsLocalPatch /= mempty + hasChangesClass = if hasChanges then "" else " disabled" + + synchronizingClass = if synchronizing' then " disabled" else "" + + resetClick _ = do + performAction ResetPatches + + synchronizeClick _ = delay unit $ \_ -> do + T.write_ true synchronizing + performAction $ Synchronize { afterSync: newAfterSync } + + newAfterSync x = do + afterSync x + liftEffect $ T.write_ false synchronizing + + pure $ H.div { className: "btn-toolbar" } + [ H.div { className: "btn-group mr-2" } + [ H.button { className: "btn btn-danger " <> hasChangesClass <> synchronizingClass + , on: { click: resetClick } + } [ H.text "Reset" ] + ] + , H.div { className: "btn-group mr-2" } + [ H.button { className: "btn btn-primary " <> hasChangesClass <> synchronizingClass + , on: { click: synchronizeClick } + } [ H.text "Sync" ] + ] + ] + diff --git a/src/Gargantext/Components/Nodes/Lists/Tabs.purs b/src/Gargantext/Components/Nodes/Lists/Tabs.purs index 997e3a8aa9be403c08d82dbcc9ee02bcd0b655f8..1a8b6c1f1fd94dbdfae0e68e131af9b896984696 100644 --- a/src/Gargantext/Components/Nodes/Lists/Tabs.purs +++ b/src/Gargantext/Components/Nodes/Lists/Tabs.purs @@ -8,7 +8,6 @@ import Data.Tuple.Nested ((/\)) import Effect.Class (liftEffect) import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.NgramsTable as NT -import Gargantext.Components.NgramsTable.Core (PageParams) import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) @@ -17,6 +16,7 @@ import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType) import Gargantext.Components.Nodes.Corpus.Types (CorpusData) import Gargantext.Components.Tab as Tab import Gargantext.Components.Table.Types (Params) +import Gargantext.Core.NgramsTable.Types (PageParams) import Gargantext.Prelude (bind, pure, unit, ($)) import Gargantext.Sessions (Session) import Gargantext.Types (CTabNgramType(..), Mode(..), TabSubType(..), TabType(..), modeTabType) diff --git a/src/Gargantext/Core/NgramsTable/Types.purs b/src/Gargantext/Core/NgramsTable/Types.purs new file mode 100644 index 0000000000000000000000000000000000000000..c8a4dec9139980ff72a5b95b3b0f5917606339bd --- /dev/null +++ b/src/Gargantext/Core/NgramsTable/Types.purs @@ -0,0 +1,532 @@ +module Gargantext.Core.NgramsTable.Types where + +import Control.Monad.State (class MonadState, execState) +import Data.Bifunctor (lmap) +import Data.Eq.Generic (genericEq) +import Data.Foldable (class Foldable, foldMap, foldl, foldr) +import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) +import Data.Generic.Rep (class Generic) +import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?)) +import Data.Lens.At (class At, at) +import Data.Lens.Common (_Just) +import Data.Lens.Index (class Index, ix) +import Data.Lens.Iso.Newtype (_Newtype) +import Data.Lens.Record (prop) +import Data.List (List) +import Data.Map (Map) +import Data.Map as Map +import Data.Maybe (Maybe(..), isJust) +import Data.Monoid.Additive (Additive(..)) +import Data.Newtype (class Newtype) +import Data.Ord.Generic (genericCompare) +import Data.Show.Generic (genericShow) +import Data.Set (Set) +import Data.Set as Set +import Data.String.Regex (Regex, regex, replace) as R +import Data.Symbol (SProxy(..)) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Aff (Aff) +import Effect.Exception.Unsafe (unsafeThrow) +import Foreign as F +import Foreign.Object as FO +import Gargantext.Components.Table.Types as T +import Gargantext.Prelude +import Gargantext.Sessions (Session) +import Gargantext.Types as GT +import Simple.JSON as JSON +import Reactix as R + +type Endo a = a -> a + + +-- | Main Types +type Version = Int + +newtype Versioned a = Versioned + { version :: Version + , data :: a + } +derive instance Generic (Versioned a) _ +derive instance Newtype (Versioned a) _ +instance Eq a => Eq (Versioned a) where eq = genericEq +derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (Versioned a) +derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (Versioned a) +------------------------------------------------------------------------ +type Count = Int + +newtype VersionedWithCount a = VersionedWithCount + { version :: Version + , count :: Count + , data :: a + } +derive instance Generic (VersionedWithCount a) _ +derive instance Newtype (VersionedWithCount a) _ +instance Eq a => Eq (VersionedWithCount a) where eq = genericEq +derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (VersionedWithCount a) +derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (VersionedWithCount a) + +--------------------------------------------------- +newtype NgramsTablePatch = NgramsTablePatch NgramsPatches +derive instance Generic NgramsTablePatch _ +derive instance Newtype NgramsTablePatch _ +instance Eq NgramsTablePatch where eq = genericEq +derive newtype instance JSON.ReadForeign NgramsTablePatch +derive newtype instance JSON.WriteForeign NgramsTablePatch +derive newtype instance Semigroup NgramsTablePatch +derive newtype instance Monoid NgramsTablePatch + + +type NgramsPatches = PatchMap NgramsTerm NgramsPatch + + + +fromMap :: forall k p. Ord k => Eq p => Monoid p => Map k p -> PatchMap k p +fromMap = PatchMap <<< Map.filter (\v -> v /= mempty) + + + +ngramsTermText :: NgramsTerm -> String +ngramsTermText (NormNgramsTerm t) = t + + + +newtype PatchMap k p = PatchMap (Map k p) +derive instance Generic (PatchMap k p) _ +derive instance Newtype (PatchMap k p) _ +derive instance (Eq k, Eq p) => Eq (PatchMap k p) +-- TODO generalize +instance JSON.WriteForeign p => JSON.WriteForeign (PatchMap NgramsTerm p) where + writeImpl (PatchMap m) = + JSON.writeImpl $ FO.fromFoldable $ map (lmap ngramsTermText) (Map.toUnfoldable m :: Array _) +instance (JSON.ReadForeign p, Monoid p) => JSON.ReadForeign (PatchMap NgramsTerm p) where + readImpl f = do + inst <- JSON.readImpl f + pure $ PatchMap $ foldlWithIndex (\k m v -> Map.insert (NormNgramsTerm k) v m) Map.empty (inst :: FO.Object p) + -- TODO we assume that the ngrams are already normalized ^^^^^^^^^^^^^ +instance (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where + append (PatchMap p) (PatchMap q) = fromMap $ Map.unionWith append p q +instance (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where + mempty = PatchMap Map.empty +instance Foldable (PatchMap k) where + foldr f z (PatchMap m) = foldr f z m + foldl f z (PatchMap m) = foldl f z m + foldMap f (PatchMap m) = foldMap f m +instance FoldableWithIndex k (PatchMap k) where + foldrWithIndex f z (PatchMap m) = foldrWithIndex f z m + foldlWithIndex f z (PatchMap m) = foldlWithIndex f z m + foldMapWithIndex f (PatchMap m) = foldMapWithIndex f m + +{- +instance Functor (PatchMap k) where + map f (PatchMap m) = PatchMap (map f m) -- NO NORM: fromMap would not typecheck + +instance FunctorWithIndex k (PatchMap k) where + mapWithIndex f (PatchMap m) = PatchMap (mapWithIndex f m) -- NO NORM: fromMap would not typecheck +-} + +{- fromMap is preventing these to type check: + +instance Ord k => Traversable (PatchMap k) where + traverse f (PatchMap m) = fromMap <$> traverse f m + sequence (PatchMap m) = fromMap <$> sequence m + +instance Ord k => TraversableWithIndex k (PatchMap k) where + traverseWithIndex f (PatchMap m) = fromMap <$> traverseWithIndex f m +-} + +_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p) +_PatchMap = _Newtype + + + +-- TODO shall we normalise as in replace? shall we make a type class Replaceable? +ngramsReplace :: Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch +ngramsReplace patch_old patch_new = NgramsReplace {patch_old, patch_new} + + +applyReplace :: forall a. Eq a => Replace a -> a -> a +applyReplace Keep a = a +applyReplace (Replace { old, new }) a + | a == old = new + | otherwise = a + + + +applyPatchSet :: forall a. Ord a => PatchSet a -> Set a -> Set a +applyPatchSet (PatchSet p) s = Set.difference s p.rem <> p.add + + + +applyNgramsPatch' :: forall row. + { patch_children :: PatchSet NgramsTerm + , patch_list :: Replace GT.TermList + } -> + Endo { list :: GT.TermList + , children :: Set NgramsTerm + | row + } +applyNgramsPatch' p e = + e { list = applyReplace p.patch_list e.list + , children = applyPatchSet p.patch_children e.children + } + + +-- TODO +invert :: forall a. a -> a +invert _ = unsafeThrow "invert: TODO" + + + +data NgramsPatch + = NgramsReplace + { patch_old :: Maybe NgramsRepoElement + , patch_new :: Maybe NgramsRepoElement + } + | NgramsPatch + { patch_children :: PatchSet NgramsTerm + , patch_list :: Replace GT.TermList + } +derive instance Generic NgramsPatch _ +derive instance Eq NgramsPatch +instance Monoid NgramsPatch where + mempty = NgramsPatch { patch_children: mempty, patch_list: mempty } +instance Semigroup NgramsPatch where + append (NgramsReplace p) (NgramsReplace q) + | p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new" + | otherwise = ngramsReplace q.patch_old p.patch_new + append (NgramsPatch p) (NgramsPatch q) = NgramsPatch + { patch_children: p.patch_children <> q.patch_children + , patch_list: p.patch_list <> q.patch_list + } + append (NgramsPatch p) (NgramsReplace q) = ngramsReplace q.patch_old (q.patch_new # _Just <<< _Newtype %~ applyNgramsPatch' p) + append (NgramsReplace p) (NgramsPatch q) = ngramsReplace (p.patch_old # _Just <<< _Newtype %~ applyNgramsPatch' (invert q)) p.patch_new +instance JSON.WriteForeign NgramsPatch where + writeImpl (NgramsReplace { patch_old, patch_new }) = JSON.writeImpl { patch_old, patch_new } + writeImpl (NgramsPatch { patch_children, patch_list }) = JSON.writeImpl { patch_children, patch_list } +instance JSON.ReadForeign NgramsPatch where + readImpl f = do + inst :: { patch_old :: Maybe NgramsRepoElement + , patch_new :: Maybe NgramsRepoElement + , patch_children :: PatchSet NgramsTerm + , patch_list :: Replace GT.TermList } <- JSON.readImpl f + -- TODO handle empty fields + -- TODO handle patch_new + if isJust inst.patch_new || isJust inst.patch_old then + pure $ NgramsReplace { patch_old: inst.patch_old, patch_new: inst.patch_new } + else do + pure $ NgramsPatch { patch_list: inst.patch_list, patch_children: inst.patch_children } + +----------------------------------------------------- +newtype NgramsTerm = NormNgramsTerm String +derive instance Generic NgramsTerm _ +derive instance Newtype NgramsTerm _ +instance Eq NgramsTerm where eq = genericEq +instance Ord NgramsTerm where compare = genericCompare +instance Show NgramsTerm where show = genericShow +derive newtype instance JSON.ReadForeign NgramsTerm +derive newtype instance JSON.WriteForeign NgramsTerm +derive newtype instance Monoid NgramsTerm + +-------------------------------------------------------- +type CoreParams s = + { nodeId :: Int + -- ^ This node can be a corpus or contact. + , listIds :: Array Int + , tabType :: GT.TabType + , session :: Session + | s + } + +type PageParams = + CoreParams + ( params :: T.Params + , searchQuery :: String + , termListFilter :: Maybe GT.TermList -- Nothing means all + , termSizeFilter :: Maybe GT.TermSize -- Nothing means all + , scoreType :: GT.ScoreType + ) + +----------------------------------------------------------------------------------- +newtype NgramsElement = NgramsElement + { ngrams :: NgramsTerm -- HERE + , size :: Int -- MISSING + , list :: GT.TermList -- ok + , root :: Maybe NgramsTerm -- ok + , parent :: Maybe NgramsTerm -- ok + , children :: Set NgramsTerm -- ok + , occurrences :: Int -- HERE + } +derive instance Eq NgramsElement +derive instance Newtype NgramsElement _ +derive instance Generic NgramsElement _ +instance Show NgramsElement where show = genericShow +instance JSON.ReadForeign NgramsElement where + readImpl f = do + inst :: { children :: Array NgramsTerm + , size :: Int + , list :: GT.TermList + , ngrams :: NgramsTerm + , occurrences :: Int + , parent :: Maybe NgramsTerm + , root :: Maybe NgramsTerm }<- JSON.readImpl f + pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children } +instance JSON.WriteForeign NgramsElement where + writeImpl (NgramsElement ne) = + JSON.writeImpl $ ne { children = Set.toUnfoldable ne.children :: Array _ } + +_parent :: forall parent row. Lens' { parent :: parent | row } parent +_parent = prop (SProxy :: SProxy "parent") + +_root :: forall root row. Lens' { root :: root | row } root +_root = prop (SProxy :: SProxy "root") + +_ngrams :: forall row. Lens' { ngrams :: NgramsTerm | row } NgramsTerm +_ngrams = prop (SProxy :: SProxy "ngrams") + +_children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm) +_children = prop (SProxy :: SProxy "children") + +_occurrences :: forall row. Lens' { occurrences :: Int | row } Int +_occurrences = prop (SProxy :: SProxy "occurrences") + +_list :: forall a row. Lens' { list :: a | row } a +_list = prop (SProxy :: SProxy "list") + +_ngrams_repo_elements :: forall a row. Lens' { ngrams_repo_elements :: a | row } a +_ngrams_repo_elements = prop (SProxy :: SProxy "ngrams_repo_elements") + +_ngrams_scores :: forall a row. Lens' { ngrams_scores :: a | row } a +_ngrams_scores = prop (SProxy :: SProxy "ngrams_scores") + +_NgramsElement :: Iso' NgramsElement { + children :: Set NgramsTerm + , size :: Int + , list :: GT.TermList + , ngrams :: NgramsTerm + , occurrences :: Int + , parent :: Maybe NgramsTerm + , root :: Maybe NgramsTerm + } +_NgramsElement = _Newtype + +type NgramsRepoElementT = + ( size :: Int + , list :: GT.TermList + , root :: Maybe NgramsTerm + , parent :: Maybe NgramsTerm + ) +newtype NgramsRepoElement = NgramsRepoElement + { children :: Set NgramsTerm + | NgramsRepoElementT } +derive instance Generic NgramsRepoElement _ +derive instance Newtype NgramsRepoElement _ +derive instance Eq NgramsRepoElement +instance JSON.ReadForeign NgramsRepoElement where + readImpl f = do + inst :: { children :: Array NgramsTerm | NgramsRepoElementT } <- JSON.readImpl f + pure $ NgramsRepoElement $ inst { children = Set.fromFoldable inst.children } +instance JSON.WriteForeign NgramsRepoElement where + writeImpl (NgramsRepoElement nre) = + JSON.writeImpl $ nre { children = Set.toUnfoldable nre.children :: Array _ } +instance Show NgramsRepoElement where show = genericShow + +_NgramsRepoElement :: Iso' NgramsRepoElement { + children :: Set NgramsTerm + , size :: Int + , list :: GT.TermList + , parent :: Maybe NgramsTerm + , root :: Maybe NgramsTerm +-- , occurrences :: Int + } +_NgramsRepoElement = _Newtype + +----------------------------------------------------------------------------------- +{- + NgramsRepoElement does not have the occurrences field. + Instead NgramsTable has a ngrams_scores map. + + Pro: + * Does not encumber NgramsRepoElement with the score which is not part of repo. + * Enables for multiple scores through multiple maps. + Cons: + * Having a map on the side is equivalent to a `occurrences :: Maybe Int`, which is + less precise. + * It is a tiny bit less performant to access the score. +-} +newtype NgramsTable = NgramsTable + { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement + , ngrams_scores :: Map NgramsTerm (Additive Int) + } +derive instance Newtype NgramsTable _ +derive instance Generic NgramsTable _ +instance Eq NgramsTable where eq = genericEq +instance Show NgramsTable where show = genericShow +instance JSON.ReadForeign NgramsTable where + readImpl ff = do + inst <- JSON.readImpl ff + pure $ NgramsTable + { ngrams_repo_elements: Map.fromFoldable $ f <$> (inst :: Array NgramsElement) + , ngrams_scores: Map.fromFoldable $ g <$> inst + } + where + f (NgramsElement {ngrams, size, list, root, parent, children}) = + Tuple ngrams (NgramsRepoElement {size, list, root, parent, children}) + g (NgramsElement e) = Tuple e.ngrams (Additive e.occurrences) + +_NgramsTable :: Iso' NgramsTable + { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement + , ngrams_scores :: Map NgramsTerm (Additive Int) + } +_NgramsTable = _Newtype + +instance Index NgramsTable NgramsTerm NgramsRepoElement where + ix k = _NgramsTable <<< _ngrams_repo_elements <<< ix k + +instance At NgramsTable NgramsTerm NgramsRepoElement where + at k = _NgramsTable <<< _ngrams_repo_elements <<< at k + +{- NOT USED +instance EncodeJson NgramsTable where + encodeJson (NgramsTable {ngrams_repo_elements, ngrams_scores}) = encodeJson $ Map.values ... TODO +-} +-------------------------------------------- + +type HighlightElement = Tuple String (List (Tuple NgramsTerm GT.TermList)) +type HighlightAccumulator = List HighlightElement + +----------------------------------------------------------------------------------- + +type VersionedNgramsTable = Versioned NgramsTable +type VersionedWithCountNgramsTable = VersionedWithCount NgramsTable + +----------------------------------------------------------------------------------- + +replace :: forall a. Eq a => a -> a -> Replace a +replace old new + | old == new = Keep + | otherwise = Replace { old, new } + + +data Replace a + = Keep + | Replace { old :: a, new :: a } +derive instance Generic (Replace a) _ +derive instance Eq a => Eq (Replace a) +instance Eq a => Semigroup (Replace a) where + append Keep p = p + append p Keep = p + append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new" + append (Replace { new }) (Replace { old }) = replace old new +instance Eq a => Monoid (Replace a) where mempty = Keep +instance JSON.WriteForeign a => JSON.WriteForeign (Replace a) where + writeImpl Keep = JSON.writeImpl { tag: "Keep" } + writeImpl (Replace {old, new}) = JSON.writeImpl { old, new, tag: "Replace" } +instance (JSON.ReadForeign a, Eq a) => JSON.ReadForeign (Replace a) where + readImpl f = do + impl :: { old :: Maybe a, new :: Maybe a } <- JSON.readImpl f + case Tuple impl.old impl.new of + Tuple (Just old) (Just new) -> pure $ replace old new + Tuple Nothing Nothing -> pure Keep + _ -> F.fail $ F.ForeignError "decodeJsonReplace" + +--------------------------------------------------- + +-- Representing a PatchSet as `Map a Boolean` would have the advantage +-- of enforcing rem and add to be disjoint. +newtype PatchSet a = PatchSet + { rem :: Set a + , add :: Set a + } +derive instance Generic (PatchSet a) _ +derive instance Newtype (PatchSet a) _ +instance Ord a => Semigroup (PatchSet a) where + append (PatchSet p) (PatchSet q) = PatchSet + { rem: q.rem <> p.rem + , add: Set.difference q.add p.rem <> p.add + } +instance Ord a => Monoid (PatchSet a) where + mempty = PatchSet { rem: Set.empty, add: Set.empty } +instance JSON.WriteForeign a => JSON.WriteForeign (PatchSet a) where + writeImpl (PatchSet {rem, add}) = JSON.writeImpl { rem: (Set.toUnfoldable rem :: Array a) + , add: (Set.toUnfoldable add :: Array a) } +instance (Ord a, JSON.ReadForeign a) => JSON.ReadForeign (PatchSet a) where + readImpl f = do + -- TODO handle empty fields + inst :: { rem :: Array a, add :: Array a } <- JSON.readImpl f + let rem = mkSet inst.rem + add = mkSet inst.add + pure $ PatchSet { rem, add } + where + mkSet :: forall b. Ord b => Array b -> Set b + mkSet = Set.fromFoldable +derive instance Eq (PatchSet NgramsTerm) +----------------------------------------------------- + +type VersionedNgramsPatches = Versioned NgramsPatches + +newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate { + listId :: Maybe GT.ListId + , tabType :: GT.TabType + } +derive instance Generic AsyncNgramsChartsUpdate _ +derive instance Newtype AsyncNgramsChartsUpdate _ +instance JSON.WriteForeign AsyncNgramsChartsUpdate where + writeImpl (AsyncNgramsChartsUpdate { listId, tabType }) = + JSON.writeImpl { list_id: listId, tab_type: tabType } + +type NewElems = Map NgramsTerm GT.TermList + +type RootParent = { root :: NgramsTerm, parent :: NgramsTerm } + +type ReParent a = forall m. MonadState NgramsTable m => a -> m Unit +----------------------------------------------------------------------------------- + +type CoreState s = + { ngramsLocalPatch :: NgramsTablePatch + -- ^ These patches are local and not yet staged. + , ngramsStagePatch :: NgramsTablePatch + -- ^ These patches are staged (scheduled for synchronization). + -- Requests are being performed at the moment. + , ngramsValidPatch :: NgramsTablePatch + -- ^ These patches have been synchronized with the server. + , ngramsVersion :: Version + | s + } + +type NgramsListByTabType = Map GT.TabType VersionedNgramsTable + +data CoreAction + = CommitPatch NgramsTablePatch + | Synchronize { afterSync :: Unit -> Aff Unit } + | ResetPatches + +data Action + = CoreAction CoreAction + | ClearTreeEdit + | SetParentResetChildren (Maybe NgramsTerm) (List NgramsTerm) + -- ^ This sets `ngramsParent` and resets `ngramsChildren`. + | ToggleChild Boolean NgramsTerm + -- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`. + -- If the `Boolean` is `true` it means we want to add it if it is not here, + -- if it is `false` it is meant to be removed if not here. + | AddTermChildren + | ToggleSelect NgramsTerm + -- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`. + | ToggleSelectAll + + +type CoreDispatch = CoreAction -> Effect Unit +type Dispatch = Action -> Effect Unit + + + +type NgramsDepth = { ngrams :: NgramsTerm, depth :: Int } +type NgramsClick = NgramsDepth -> Maybe (Effect Unit) +type NgramsActionRef = R.Ref (Maybe (Unit -> Effect Unit)) + + +type ResetButton = (Unit -> Aff Unit) + -> NgramsTablePatch + -> (Action -> Effect Unit) + -> Array R.Element diff --git a/src/Gargantext/Utils/Reactix.js b/src/Gargantext/Utils/Reactix.js index 17e2aac2096d1c4a5363ef7a55d4880cc7cb2b6f..d9b61e47e969b89a1b4167665d0b5b64828d411a 100644 --- a/src/Gargantext/Utils/Reactix.js +++ b/src/Gargantext/Utils/Reactix.js @@ -39,6 +39,16 @@ function blur(el) { return el.blur(); } +function triggerEvent(el, evtType) { + // https://stackoverflow.com/questions/8789423/trigger-onchange-event + var event = new UIEvent(evtType, { + view: window, + bubbles: true, + cancelable: true + }); + el.dispatchEvent(event); +} + exports._addRootElement = addRootElement; exports._getSelection = getSelection; exports._stringify = stringify; @@ -53,3 +63,4 @@ exports._keyCode = function(e) { // https://www.w3schools.com/jsref/event_key_keycode.asp return e.which || e.keyCode; } +exports._triggerEvent = triggerEvent; diff --git a/src/Gargantext/Utils/Reactix.purs b/src/Gargantext/Utils/Reactix.purs index b3ba720a231d804cabf39c5fcb9f0b796c9ade2a..411e1b203015857adb3150b392c36de4f8ff046f 100644 --- a/src/Gargantext/Utils/Reactix.purs +++ b/src/Gargantext/Utils/Reactix.purs @@ -3,25 +3,25 @@ module Gargantext.Utils.Reactix where import Prelude import ConvertableOptions as CO -import DOM.Simple as DOM -import DOM.Simple.Console (log2) -import DOM.Simple.Document (document) -import DOM.Simple.Element as Element -import DOM.Simple.Event as DE -import DOM.Simple.Types (class IsNode, class IsElement, DOMRect) import Data.Array as A import Data.Either (hush) import Data.Function.Uncurried (Fn1, runFn1, Fn2, runFn2) import Data.Maybe (Maybe(..), fromJust, fromMaybe) import Data.Maybe as Maybe -import Data.Nullable (Nullable, null, toMaybe) +import Data.Nullable (Nullable, notNull, null, toMaybe) import Data.Tuple (Tuple) import Data.Tuple.Nested ((/\)) +import DOM.Simple as DOM +import DOM.Simple.Console (log2) +import DOM.Simple.Document (document) +import DOM.Simple.Element as Element +import DOM.Simple.Event as DE +import DOM.Simple.Types (class IsNode, class IsElement, DOMRect) import Effect (Effect) import Effect.Aff (Aff, launchAff, launchAff_, killFiber) import Effect.Class (liftEffect) import Effect.Exception (error) -import Effect.Uncurried (EffectFn1, EffectFn3, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn3) +import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2, runEffectFn3) import FFI.Simple (applyTo, args2, args3, defineProperty, delay, getProperty, (..), (...), (.=)) import Gargantext.Utils.Console (RowConsole) import Gargantext.Utils.Console as Console @@ -601,3 +601,17 @@ externalOpeningFlag event = ado metaKey <- SE.metaKey event middleClick <- SE.button event in ctrlKey || shiftKey || metaKey || (middleClick == 1.0) + +foreign import _triggerEvent + :: forall e. EffectFn2 e String Unit + +triggerEvent :: forall el. el -> String -> Effect Unit +triggerEvent = runEffectFn2 _triggerEvent +------------------------------------------------------- +setInputValue :: R.Ref (Nullable DOM.Element) -> String -> Effect Unit +setInputValue elNullableRef val = case toMaybe (R.readRef elNullableRef) of + Nothing -> pure unit + Just el -> do + _ <- pure $ (el .= "value") val + triggerEvent el "change" + triggerEvent el "input" diff --git a/src/Gargantext/Utils/Toestand.purs b/src/Gargantext/Utils/Toestand.purs index fd186c6eef83e4813c22946131233faecdcaa45b..98d8674c8259205ba5709c7d0c4423f4f39cc68f 100644 --- a/src/Gargantext/Utils/Toestand.purs +++ b/src/Gargantext/Utils/Toestand.purs @@ -55,4 +55,3 @@ useMemberBox val box = T.useFocused (Set.member val) (toggleSet val) box toggleSet :: forall s. Ord s => s -> Boolean -> Set s -> Set s toggleSet val true set = Set.insert val set toggleSet val false set = Set.delete val set - diff --git a/test/Gargantext/Components/NgramsTable/Spec.purs b/test/Gargantext/Components/NgramsTable/Spec.purs index dae1c48b93dd51795744ea299f60af85129f0a9f..d35503e0f26305f4584b666395822774328dd835 100644 --- a/test/Gargantext/Components/NgramsTable/Spec.purs +++ b/test/Gargantext/Components/NgramsTable/Spec.purs @@ -12,7 +12,8 @@ import Test.Spec (Spec, describe, it) import Test.Utils (shouldEqualArray) -import Gargantext.Components.NgramsTable.Core (highlightNgrams, HighlightElement, NgramsElement(..), NgramsRepoElement(..), NgramsTable(..), NgramsTerm, normNgram) +import Gargantext.Components.NgramsTable.Core (highlightNgrams, normNgram) +import Gargantext.Core.NgramsTable.Types (HighlightElement, NgramsElement(..), NgramsRepoElement(..), NgramsTable(..), NgramsTerm) import Gargantext.Types (CTabNgramType(..), TermList(..))