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
module Gargantext.Components.NgramsTable where module Gargantext.Components.NgramsTable
( MainNgramsTableProps
, mainNgramsTable
) where
import Prelude import Prelude
( class Show, Unit, bind, const, discard, identity, map, mempty, not ( class Show, Unit, bind, const, discard, identity, map, mempty, not
, pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<) , pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<)
, (==), (||) ) , (==), (||) )
import Data.Array as A import Data.Array as A
import Data.Lens (to, view, (%~), (.~), (^.), (^..)) import Data.Lens (Lens', to, view, (%~), (.~), (^.), (^..))
import Data.Lens.Common (_Just) import Data.Lens.Common (_Just)
import Data.Lens.At (at) import Data.Lens.At (at)
import Data.Lens.Index (ix) import Data.Lens.Index (ix)
...@@ -23,24 +26,25 @@ import Data.Tuple.Nested ((/\)) ...@@ -23,24 +26,25 @@ import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import React (ReactElement) import React (ReactClass, ReactElement, Children)
import React.DOM (a, i, input, li, span, text, ul) import React.DOM (a, i, input, li, span, text, ul)
import React.DOM.Props (_type, checked, className, onChange, onClick, style) import React.DOM.Props (_type, checked, className, onChange, onClick, style)
import React.DOM.Props as DOM import React.DOM.Props as DOM
import Thermite (PerformAction, Render, Spec, modifyState_, simpleSpec) import Thermite as Thermite
import Thermite (modifyState_)
import Gargantext.Types import Gargantext.Types
( CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList ( CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList
, readTermSize, termLists, termSizes) , readTermSize, termLists, termSizes)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
( CoreState, LoadedNgramsTableProps, NgramsElement(..), NgramsPatch(..) ( CoreState, NgramsElement(..), NgramsPatch(..)
, NgramsTable, NgramsTerm, PageParams, Replace(..), Versioned(..) , NgramsTable, NgramsTerm, PageParams, Replace(..), Versioned(..)
, VersionedNgramsTable, _NgramsElement, _NgramsTable, _children , VersionedNgramsTable, _NgramsElement, _NgramsTable, _children
, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsTablePatch , _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsTablePatch
, applyPatchSet, commitPatch, convOrderBy, initialPageParams, loadNgramsTable , applyPatchSet, commitPatch, convOrderBy, initialPageParams, loadNgramsTable
, patchSetFromMap, replace, singletonNgramsTablePatch ) , patchSetFromMap, replace, singletonNgramsTablePatch )
import Gargantext.Components.Loader (loader)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Hooks.Loader (useLoader2)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -54,6 +58,7 @@ type State = ...@@ -54,6 +58,7 @@ type State =
-- be removed. -- be removed.
) )
_ngramsChildren :: forall row. Lens' { ngramsChildren :: Map NgramsTerm Boolean | row } (Map NgramsTerm Boolean)
_ngramsChildren = prop (SProxy :: SProxy "ngramsChildren") _ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")
initialState :: VersionedNgramsTable -> State initialState :: VersionedNgramsTable -> State
...@@ -81,17 +86,15 @@ data Action ...@@ -81,17 +86,15 @@ data Action
type Dispatch = Action -> Effect Unit type Dispatch = Action -> Effect Unit
tableContainer :: { pageParams :: PageParams tableContainer :: { path :: R.State PageParams
, dispatch :: Dispatch , dispatch :: Dispatch
, setPath :: R2.Setter PageParams
, ngramsParent :: Maybe NgramsTerm , ngramsParent :: Maybe NgramsTerm
, ngramsChildren :: Map NgramsTerm Boolean , ngramsChildren :: Map NgramsTerm Boolean
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
} }
-> Record T.TableContainerProps -> R.Element -> Record T.TableContainerProps -> R.Element
tableContainer { pageParams tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, dispatch , dispatch
, setPath
, ngramsParent , ngramsParent
, ngramsChildren , ngramsChildren
, ngramsTable: ngramsTableCache , ngramsTable: ngramsTableCache
...@@ -111,26 +114,26 @@ tableContainer { pageParams ...@@ -111,26 +114,26 @@ tableContainer { pageParams
, name: "search" , name: "search"
, placeholder: "Search" , placeholder: "Search"
, type: "value" , type: "value"
, value: pageParams.searchQuery , value: searchQuery
, on: {input: \e -> setSearchQuery (R2.unsafeEventValue e)}} , on: {input: \e -> setSearchQuery (R2.unsafeEventValue e)}}
, H.div {} ( , H.div {} (
if A.null props.tableBody && pageParams.searchQuery /= "" then [ if A.null props.tableBody && searchQuery /= "" then [
H.button { className: "btn btn-primary" H.button { className: "btn btn-primary"
, on: {click: const $ dispatch $ AddNewNgram pageParams.searchQuery}} , on: {click: const $ dispatch $ AddNewNgram searchQuery}}
[ H.text ("Add " <> pageParams.searchQuery) ] [ H.text ("Add " <> searchQuery) ]
] else [])] ] else [])]
, H.div {className: "col-md-2", style: {marginTop : "6px"}} , H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: " list-group-item"} [ H.li {className: " list-group-item"}
[ R2.select { id: "picklistmenu" [ R2.select { id: "picklistmenu"
, className: "form-control custom-select" , className: "form-control custom-select"
, value: (maybe "" show pageParams.termListFilter) , value: (maybe "" show termListFilter)
, on: {change: (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)}} , on: {change: (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)}}
(map optps1 termLists)]] (map optps1 termLists)]]
, H.div {className: "col-md-2", style: {marginTop : "6px"}} , H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"} [ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype" [ R2.select {id: "picktermtype"
, className: "form-control custom-select" , className: "form-control custom-select"
, value: (maybe "" show pageParams.termSizeFilter) , value: (maybe "" show termSizeFilter)
, on: {change: (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)}} , on: {change: (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)}}
(map optps1 termSizes)]] (map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}} , H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
...@@ -163,98 +166,107 @@ tableContainer { pageParams ...@@ -163,98 +166,107 @@ tableContainer { pageParams
[ H.thead {className: "tableHeader"} [props.tableHead] [ H.thead {className: "tableHeader"} [props.tableHead]
, H.tbody {} props.tableBody]]]]]] , H.tbody {} props.tableBody]]]]]]
where where
setPageParams f = setPath (const $ f pageParams) -- WHY setPath f = origSetPageParams (const $ f path)
setSearchQuery x = setPageParams $ _ { searchQuery = x } setSearchQuery x = setPath $ _ { searchQuery = x }
setTermListFilter x = setPageParams $ _ { termListFilter = x } setTermListFilter x = setPath $ _ { termListFilter = x }
setTermSizeFilter x = setPageParams $ _ { termSizeFilter = x } setTermSizeFilter x = setPath $ _ { termSizeFilter = x }
toggleMap :: forall a. a -> Maybe a -> Maybe a toggleMap :: forall a. a -> Maybe a -> Maybe a
toggleMap _ (Just _) = Nothing toggleMap _ (Just _) = Nothing
toggleMap b Nothing = Just b toggleMap b Nothing = Just b
-- NEXT
data Action' data Action'
= SetParentResetChildren' (Maybe NgramsTerm) = SetParentResetChildren' (Maybe NgramsTerm)
| ToggleChild' (Maybe NgramsTerm) NgramsTerm | ToggleChild' (Maybe NgramsTerm) NgramsTerm
| Refresh' | Refresh'
performNgramsAction :: State -> Action' -> State -- NEXT
performNgramsAction st (SetParentResetChildren' term) = st
performNgramsAction st (ToggleChild' b c) = st
performNgramsAction st Refresh' = st
useNgramsReducer :: State -> R.Hooks (R.Reducer State Action')
useNgramsReducer init = R.useReducer' performNgramsAction init
type Props = type Props =
( session :: Session ( tabNgramType :: CTabNgramType
, tabNgramType :: CTabNgramType
, path :: R.State PageParams , path :: R.State PageParams
, versioned :: VersionedNgramsTable ) , versioned :: VersionedNgramsTable )
ngramsTable :: Record Props -> R.Element -- NEXT
ngramsTable props = R.createElement ngramsTableCpt props [] loadedNgramsTable :: Record Props -> R.Element
loadedNgramsTable props = R.createElement loadedNgramsTableCpt props []
ngramsTableCpt :: R.Component Props -- NEXT
ngramsTableCpt = R.hooksComponent "G.C.NgramsTable.ngramsTable" cpt loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponent "G.C.NgramsTable.loadedNgramsTable" cpt
where where
cpt {versioned} _ = do cpt {versioned} _ = do
state <- useNgramsReducer (initialState versioned) state <- useNgramsReducer (initialState versioned)
pure $ R.fragment [] pure $ R.fragment []
ngramsTableSpec :: Session -> CTabNgramType -> R2.Setter PageParams -> Spec State (Record LoadedNgramsTableProps) Action useNgramsReducer :: State -> R.Hooks (R.Reducer State Action')
ngramsTableSpec session ntype setPath = simpleSpec performAction render useNgramsReducer init = R2.useReductor' performNgramsAction init
performNgramsAction :: Action' -> State -> Effect State
performNgramsAction (SetParentResetChildren' term) = pure -- TODO
performNgramsAction (ToggleChild' b c) = pure -- TODO
performNgramsAction Refresh' = pure -- TODO
type LoadedNgramsTableProps =
( tabNgramType :: CTabNgramType
, path :: R.State PageParams
, versioned :: VersionedNgramsTable
)
loadedNgramsTableSpec :: Thermite.Spec State (Record LoadedNgramsTableProps) Action
loadedNgramsTableSpec = Thermite.simpleSpec performAction render
where where
setParentResetChildren :: Maybe NgramsTerm -> State -> State setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty } setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }
performAction :: PerformAction State (Record LoadedNgramsTableProps) Action performAction :: Thermite.PerformAction State (Record LoadedNgramsTableProps) Action
performAction (SetParentResetChildren p) _ _ = performAction (SetParentResetChildren p) _ _ =
modifyState_ $ setParentResetChildren p modifyState_ $ setParentResetChildren p
performAction (ToggleChild b c) _ _ = performAction (ToggleChild b c) _ _ =
modifyState_ $ _ngramsChildren <<< at c %~ toggleMap b modifyState_ $ _ngramsChildren <<< at c %~ toggleMap b
performAction Refresh {path: {nodeId, listIds, tabType}} {ngramsVersion} = do performAction Refresh {path: 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}} {ngramsVersion} = performAction (SetTermListItem n pl) {path: path /\ _, tabNgramType} {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 ntype n pe pt = singletonNgramsTablePatch tabNgramType n pe
performAction AddTermChildren _ {ngramsParent: Nothing} = performAction AddTermChildren _ {ngramsParent: Nothing} =
-- impossible but harmless -- impossible but harmless
pure unit pure unit
performAction AddTermChildren {path: {nodeId, listIds, tabType}} performAction AddTermChildren {path: path /\ _, tabNgramType}
{ ngramsParent: Just parent { ngramsParent: Just parent
, ngramsChildren , ngramsChildren
, ngramsVersion , ngramsVersion
} = do } = do
modifyState_ $ setParentResetChildren Nothing modifyState_ $ setParentResetChildren Nothing
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch path (Versioned {version: ngramsVersion, data: pt})
where where
pc = patchSetFromMap ngramsChildren pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc } pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch ntype parent pe pt = singletonNgramsTablePatch tabNgramType parent pe
performAction (AddNewNgram ngram) {path: {listIds, nodeId, tabType}} {ngramsVersion} = performAction (AddNewNgram ngram) {path: path /\ _, tabNgramType} {ngramsVersion} =
commitPatch session {listIds, nodeId, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch path (Versioned {version: ngramsVersion, data: pt})
where where
pt = addNewNgram ntype ngram CandidateTerm pt = addNewNgram tabNgramType ngram CandidateTerm
render :: Render State (Record LoadedNgramsTableProps) Action render :: Thermite.Render State (Record LoadedNgramsTableProps) Action
render dispatch { path: pageParams render dispatch { path: path@({params} /\ setPath)
, loaded: Versioned { data: initTable } } , versioned: Versioned { data: initTable } }
{ ngramsTablePatch, ngramsParent, ngramsChildren } { ngramsTablePatch, ngramsParent, ngramsChildren }
_reactChildren = _reactChildren =
[ autoUpdateElt { duration: 3000, effect: dispatch Refresh } [ autoUpdateElt { duration: 3000, effect: dispatch Refresh }
, R2.scuff $ T.table { rows, params, container, colNames, totalRecords} , R2.scuff $ T.table { params: params /\ setParams -- TODO-LENS
, rows, container, colNames, totalRecords}
] ]
where where
totalRecords = 47361 -- TODO totalRecords = 47361 -- TODO
colNames = T.ColumnName <$> ["Map", "Stop", "Terms", "Score (Occurrences)"] -- see convOrderBy colNames = T.ColumnName <$> ["Map", "Stop", "Terms", "Score (Occurrences)"] -- see convOrderBy
container = tableContainer {pageParams, setPath, dispatch, ngramsParent, ngramsChildren, ngramsTable} container = tableContainer {path, dispatch, ngramsParent, ngramsChildren, ngramsTable}
setParams f = setPath $ \p@{params: ps} -> p {params = f ps} setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
params = pageParams.params /\ setParams
ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable
orderWith = orderWith =
case convOrderBy <$> pageParams.params.orderBy of case convOrderBy <$> params.orderBy of
Just ScoreAsc -> A.sortWith \x -> (snd x) ^. _NgramsElement <<< _occurrences Just ScoreAsc -> A.sortWith \x -> (snd x) ^. _NgramsElement <<< _occurrences
Just ScoreDesc -> A.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _occurrences Just ScoreDesc -> A.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _occurrences
_ -> identity -- the server ordering is enough here _ -> identity -- the server ordering is enough here
...@@ -284,11 +296,12 @@ ngramsTableSpec session ntype setPath = simpleSpec performAction render ...@@ -284,11 +296,12 @@ ngramsTableSpec session ntype setPath = simpleSpec performAction render
, delete: false , delete: false
} }
-- ngramsTableClass :: Session -> CTabNgramType -> R2.Setter PageParams -> Loader.InnerClass PageParams (Versioned NgramsTable) loadedNgramsTableClass :: ReactClass { children :: Children | LoadedNgramsTableProps }
-- ngramsTableClass session ct setPath = createClass "NgramsTable" (ngramsTableSpec session ct setPath) initialState loadedNgramsTableClass = Thermite.createClass "LoadedNgramsNgramsTable"
loadedNgramsTableSpec (\{versioned} -> initialState versioned)
-- ngramsTable' :: Session -> CTabNgramType -> R2.Setter PageParams -> Record LoadedNgramsTableProps -> R.Element loadedNgramsTable' :: Record LoadedNgramsTableProps -> R.Element
-- ngramsTable' session ct setPath props = R2.createElement' (ngramsTableClass session ct setPath) props [] loadedNgramsTable' props = R2.createElement' (loadedNgramsTableClass) props []
type MainNgramsTableProps = type MainNgramsTableProps =
( nodeId :: Int ( nodeId :: Int
...@@ -306,9 +319,9 @@ mainNgramsTableCpt :: R.Component MainNgramsTableProps ...@@ -306,9 +319,9 @@ mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
where where
cpt {nodeId, defaultListId, tabType, session, tabNgramType} _ = do cpt {nodeId, defaultListId, tabType, session, tabNgramType} _ = do
path <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType path /\ setPath <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType
useLoader2 path (loadNgramsTable session) $ let paint versioned = loadedNgramsTable' {tabNgramType, path: path /\ setPath, versioned}
\versioned -> ngramsTable {session, tabNgramType, path, versioned} pure $ loader path loadNgramsTable paint
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int} type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit) type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
...@@ -318,10 +331,10 @@ tree :: { ngramsTable :: NgramsTable ...@@ -318,10 +331,10 @@ tree :: { ngramsTable :: NgramsTable
, ngramsEdit :: NgramsClick , ngramsEdit :: NgramsClick
, ngramsClick :: NgramsClick , ngramsClick :: NgramsClick
} -> NgramsDepth -> ReactElement } -> NgramsDepth -> ReactElement
tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd@{ngrams} = tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd =
li [ style {width : "100%"} ] li [ style {width : "100%"} ]
([ i icon [] ([ i icon []
, tag [text $ " " <> ngrams] , tag [text $ " " <> nd.ngrams]
] <> maybe [] edit (ngramsEdit nd) <> ] <> maybe [] edit (ngramsEdit nd) <>
[ forest cs [ forest cs
]) ])
...@@ -339,7 +352,7 @@ tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd@{ngrams} = ...@@ -339,7 +352,7 @@ tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd@{ngrams} =
icon = gray <> [className $ "glyphicon glyphicon-chevron-" <> if open then "down" else "right"] icon = gray <> [className $ "glyphicon glyphicon-chevron-" <> if open then "down" else "right"]
open = not leaf || false {- TODO -} open = not leaf || false {- TODO -}
gray = if leaf then [style {color: "#adb5bd"}] else [] gray = if leaf then [style {color: "#adb5bd"}] else []
cs = ngramsTable ^.. ix ngrams <<< _NgramsElement <<< _children <<< folded cs = ngramsTable ^.. ix nd.ngrams <<< _NgramsElement <<< _children <<< folded
forest = forest =
let depth = nd.depth + 1 in let depth = nd.depth + 1 in
......
...@@ -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