Commit 454187c1 authored by Alexandre Delanoë's avatar Alexandre Delanoë

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

Merge branch 'dev-ngrams-table' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 7f7b5eea 4209481a
This diff is collapsed.
...@@ -16,12 +16,9 @@ module Gargantext.Components.NgramsTable.Core ...@@ -16,12 +16,9 @@ module Gargantext.Components.NgramsTable.Core
, Versioned(..) , Versioned(..)
, VersionedNgramsTable , VersionedNgramsTable
, CoreState , CoreState
, LoadedNgramsTableProps
, highlightNgrams , highlightNgrams
, initialPageParams , initialPageParams
, loadNgramsTable , loadNgramsTable
, ngramsLoader
, ngramsLoaderClass
, convOrderBy , convOrderBy
, Replace(..) -- Ideally we should keep the constructors hidden , Replace(..) -- Ideally we should keep the constructors hidden
, replace , replace
...@@ -86,7 +83,6 @@ import Partial (crashWith) ...@@ -86,7 +83,6 @@ import Partial (crashWith)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Components.OldLoader as Loader
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post) import Gargantext.Sessions (Session, get, put, post)
...@@ -98,6 +94,7 @@ type CoreParams s = ...@@ -98,6 +94,7 @@ type CoreParams s =
-- ^ This node can be a corpus or contact. -- ^ This node can be a corpus or contact.
, listIds :: Array Int , listIds :: Array Int
, tabType :: TabType , tabType :: TabType
, session :: Session
| s | s
} }
...@@ -107,7 +104,6 @@ type PageParams = ...@@ -107,7 +104,6 @@ type PageParams =
, searchQuery :: String , searchQuery :: String
, termListFilter :: Maybe TermList -- Nothing means all , termListFilter :: Maybe TermList -- Nothing means all
, termSizeFilter :: Maybe TermSize -- Nothing means all , termSizeFilter :: Maybe TermSize -- Nothing means all
, session :: Session
) )
initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams
...@@ -564,41 +560,41 @@ type CoreState s = ...@@ -564,41 +560,41 @@ type CoreState s =
| s | s
} }
postNewNgrams :: forall s. Session -> Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit postNewNgrams :: forall s. Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
postNewNgrams session newNgrams mayList {nodeId, listIds, tabType} = postNewNgrams newNgrams mayList {nodeId, listIds, tabType, session} =
when (not (A.null newNgrams)) $ do when (not (A.null newNgrams)) $ do
(_ :: Array Unit) <- post session p newNgrams (_ :: Array Unit) <- post session p newNgrams
pure unit pure unit
where p = PutNgrams tabType (head listIds) mayList (Just nodeId) where p = PutNgrams tabType (head listIds) mayList (Just nodeId)
postNewElems :: forall s. Session -> NewElems -> CoreParams s -> Aff Unit postNewElems :: forall s. NewElems -> CoreParams s -> Aff Unit
postNewElems session newElems params = void $ traverseWithIndex postNewElem newElems postNewElems newElems params = void $ traverseWithIndex postNewElem newElems
where where
postNewElem ngrams list = postNewNgrams session [ngrams] (Just list) params postNewElem ngrams list = postNewNgrams [ngrams] (Just list) params
addNewNgram :: CTabNgramType -> NgramsTerm -> TermList -> NgramsTablePatch addNewNgram :: CTabNgramType -> NgramsTerm -> TermList -> NgramsTablePatch
addNewNgram ntype ngrams list = { ngramsPatches: mempty addNewNgram ntype ngrams list = { ngramsPatches: mempty
, ngramsNewElems: Map.singleton (normNgram ntype ngrams) list } , ngramsNewElems: Map.singleton (normNgram ntype ngrams) list }
putNgramsPatches :: Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches) putNgramsPatches :: forall s. CoreParams s -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
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)
commitPatch :: forall s. Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} commitPatch :: forall p s. CoreParams p
-> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit -> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit
commitPatch session props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNewElems}}) = do commitPatch props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNewElems}}) = do
let pt = Versioned { version, data: ngramsPatches } let pt = Versioned { version, data: ngramsPatches }
lift $ postNewElems session ngramsNewElems props lift $ postNewElems ngramsNewElems props
Versioned {version: newVersion, data: newPatch} <- lift $ putNgramsPatches session props pt Versioned {version: newVersion, data: newPatch} <- lift $ putNgramsPatches props pt
modifyState_ $ \s -> modifyState_ $ \s ->
s { ngramsVersion = newVersion s { ngramsVersion = newVersion
, ngramsTablePatch = fromNgramsPatches newPatch <> tablePatch <> s.ngramsTablePatch , ngramsTablePatch = fromNgramsPatches newPatch <> tablePatch <> s.ngramsTablePatch
} }
-- TODO: check that pt.version == s.ngramsTablePatch.version -- TODO: check that pt.version == s.ngramsTablePatch.version
loadNgramsTable :: Session -> PageParams -> Aff VersionedNgramsTable loadNgramsTable :: PageParams -> Aff VersionedNgramsTable
loadNgramsTable session loadNgramsTable
{ nodeId, listIds, termListFilter, termSizeFilter { nodeId, listIds, termListFilter, termSizeFilter, session
, searchQuery, tabType, params: {offset, limit, orderBy}} , searchQuery, tabType, params: {offset, limit, orderBy}}
= get session query = get session query
where query = GetNgrams { tabType, offset, limit, listIds where query = GetNgrams { tabType, offset, limit, listIds
...@@ -611,11 +607,3 @@ convOrderBy (T.ASC (T.ColumnName "Score (Occurrences)")) = ScoreAsc ...@@ -611,11 +607,3 @@ convOrderBy (T.ASC (T.ColumnName "Score (Occurrences)")) = ScoreAsc
convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc convOrderBy (T.DESC _) = TermDesc
ngramsLoaderClass :: Session -> Loader.LoaderClass PageParams VersionedNgramsTable
ngramsLoaderClass session = Loader.createLoaderClass "NgramsTableLoader" (loadNgramsTable session)
ngramsLoader :: Session -> Loader.Props' PageParams VersionedNgramsTable -> ReactElement
ngramsLoader session props = React.createElement (ngramsLoaderClass session) props []
type LoadedNgramsTableProps = ( path :: PageParams, loaded :: VersionedNgramsTable )
module Gargantext.Components.Nodes.Corpus.Document where module Gargantext.Components.Nodes.Corpus.Document where
import Prelude (class Show, bind, identity, mempty, pure, ($), (<<<)) import Prelude (class Show, bind, identity, mempty, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
...@@ -19,14 +19,18 @@ import Gargantext.Components.NgramsTable.Core ...@@ -19,14 +19,18 @@ import Gargantext.Components.NgramsTable.Core
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch , VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch
, loadNgramsTable, replace, singletonNgramsTablePatch ) , loadNgramsTable, replace, singletonNgramsTablePatch )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList) import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type DocPath = { nodeId :: Int, listIds :: Array Int, corpusId :: Maybe Int, tabType :: TabType } type DocPath =
{ nodeId :: Int
, listIds :: Array Int
, corpusId :: Maybe Int
, tabType :: TabType
, session :: Session }
type NodeDocument = NodePoly Document type NodeDocument = NodePoly Document
...@@ -38,7 +42,6 @@ type LoadedData = ...@@ -38,7 +42,6 @@ type LoadedData =
type Props = type Props =
{ loaded :: LoadedData { loaded :: LoadedData
, path :: DocPath , path :: DocPath
, session :: Session
} }
-- This is a subpart of NgramsTable.State. -- This is a subpart of NgramsTable.State.
...@@ -286,15 +289,15 @@ docViewSpec :: Spec State Props Action ...@@ -286,15 +289,15 @@ docViewSpec :: Spec State Props Action
docViewSpec = simpleSpec performAction render docViewSpec = simpleSpec performAction render
where where
performAction :: PerformAction State Props Action performAction :: PerformAction State Props Action
performAction Refresh {path: {nodeId, listIds, tabType}, session} {ngramsVersion} = do performAction Refresh {path} {ngramsVersion} = do
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty}) commitPatch path (Versioned {version: ngramsVersion, data: mempty})
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}, session} {ngramsVersion} = performAction (SetTermListItem n pl) {path} {ngramsVersion} =
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch path (Versioned {version: ngramsVersion, data: pt})
where where
pe = NgramsPatch { patch_list: pl, patch_children: mempty } pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = singletonNgramsTablePatch CTabTerms n pe pt = singletonNgramsTablePatch CTabTerms n pe
performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType},session} {ngramsVersion} = performAction (AddNewNgram ngram termList) {path} {ngramsVersion} =
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch path (Versioned {version: ngramsVersion, data: pt})
where where
pt = addNewNgram CTabTerms ngram termList pt = addNewNgram CTabTerms ngram termList
...@@ -342,10 +345,7 @@ docViewSpec = simpleSpec performAction render ...@@ -342,10 +345,7 @@ docViewSpec = simpleSpec performAction render
badge s = span [className "badge badge-default badge-pill"] [text s] badge s = span [className "badge badge-default badge-pill"] [text s]
NodePoly {hyperdata : Document doc} = document NodePoly {hyperdata : Document doc} = document
docViewClass docViewClass :: ReactClass { children :: Children
:: ReactClass
{ session :: Session
, children :: Children
, loaded :: LoadedData , loaded :: LoadedData
, path :: DocPath } , path :: DocPath }
docViewClass = createClass "DocumentView" docViewSpec initialState docViewClass = createClass "DocumentView" docViewSpec initialState
...@@ -359,24 +359,24 @@ documentLayoutCpt :: R.Component LayoutProps ...@@ -359,24 +359,24 @@ documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt
where where
cpt {session, nodeId, listId, corpusId} _ = do cpt {session, nodeId, listId, corpusId} _ = do
useLoader path (loadData session) $ \loaded -> useLoader path loadData $ \loaded ->
R2.createElement' docViewClass {session, path, loaded} [] R2.createElement' docViewClass {path, loaded} []
where where
tabType = TabDocument (TabNgramType CTabTerms) tabType = TabDocument (TabNgramType CTabTerms)
path = {nodeId, listIds: [listId], corpusId, tabType} path = {session, nodeId, listIds: [listId], corpusId, tabType}
------------------------------------------------------------------------ ------------------------------------------------------------------------
loadDocument :: Session -> Int -> Aff NodeDocument loadDocument :: Session -> Int -> Aff NodeDocument
loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) "" loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) ""
loadData :: Session -> DocPath -> Aff LoadedData loadData :: DocPath -> Aff LoadedData
loadData session {nodeId, listIds, tabType} = do loadData {session, nodeId, listIds, tabType} = do
document <- loadDocument session nodeId document <- loadDocument session nodeId
ngramsTable <- loadNgramsTable session ngramsTable <- loadNgramsTable
{ session { session
, nodeId , nodeId
, listIds: listIds , listIds
, params: { offset : 0, limit : 100, orderBy: Nothing} , params: { offset : 0, limit : 100, orderBy: Nothing}
, tabType , tabType
, searchQuery : "" , searchQuery : ""
......
...@@ -118,7 +118,7 @@ useSessions :: R.Hooks (R2.Reductor Sessions Action) ...@@ -118,7 +118,7 @@ useSessions :: R.Hooks (R2.Reductor Sessions Action)
useSessions = R2.useReductor actAndSave (const loadSessions) unit useSessions = R2.useReductor actAndSave (const loadSessions) unit
where where
actAndSave :: R2.Actor Sessions Action actAndSave :: R2.Actor Sessions Action
actAndSave s a = act s a >>= saveSessions actAndSave a s = act s a >>= saveSessions
lookup :: SessionId -> Sessions -> Maybe Session lookup :: SessionId -> Sessions -> Maybe Session
lookup sid (Sessions {sessions:ss}) = Seq.head (Seq.filter f ss) where lookup sid (Sessions {sessions:ss}) = Seq.head (Seq.filter f ss) where
......
...@@ -29,7 +29,7 @@ newtype Point = Point { x :: Number, y :: Number } ...@@ -29,7 +29,7 @@ newtype Point = Point { x :: Number, y :: Number }
-- a setter function, for useState -- a setter function, for useState
type Setter t = (t -> t) -> Effect Unit type Setter t = (t -> t) -> Effect Unit
-- a reducer function living in effector, for useReductor -- a reducer function living in effector, for useReductor
type Actor t a = (t -> a -> Effect t) type Actor s a = (a -> s -> Effect s)
-- | Turns a ReactElement into aReactix Element -- | Turns a ReactElement into aReactix Element
-- | buff (v.) to polish -- | buff (v.) to polish
...@@ -158,7 +158,7 @@ type Reductor state action = Tuple state (action -> Effect Unit) ...@@ -158,7 +158,7 @@ type Reductor state action = Tuple state (action -> Effect Unit)
useReductor :: forall s a i. Actor s a -> (i -> Effect s) -> i -> R.Hooks (Reductor s a) useReductor :: forall s a i. Actor s a -> (i -> Effect s) -> i -> R.Hooks (Reductor s a)
useReductor f i j = useReductor f i j =
hook $ \_ -> hook $ \_ ->
pure $ currySecond $ tuple $ react ... "useReducer" $ args3 (mkEffectFn2 f) j (mkEffectFn1 i) pure $ currySecond $ tuple $ react ... "useReducer" $ args3 (mkEffectFn2 (flip f)) j (mkEffectFn1 i)
-- | Like `useReductor`, but takes an initial state instead of an -- | Like `useReductor`, but takes an initial state instead of an
-- | initialiser function and argument -- | initialiser function and argument
......
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