Commit 51869b8d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev-list-charts' into dev-doc-table-optimization

parents 1ca6ea40 535ed7fd
...@@ -23,19 +23,21 @@ import Data.Symbol (SProxy(..)) ...@@ -23,19 +23,21 @@ import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst, snd) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Loader (loader)
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Components as NTC import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core (Action(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, _NgramsElement, _NgramsTable, _children, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches, applyPatchSet, commitPatchR, convOrderBy, filterTermSize, fromNgramsPatches, initialPageParams, loadNgramsTableAll, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncPatchesR) import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.NgramsTable.Loader (useLoaderWithVersionCache)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Hooks.Loader (useLoaderWithCache) import Gargantext.Hooks.Loader (useLoaderWithCache)
import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read) import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read)
import Gargantext.Sessions (Session) import Gargantext.Routes as R
import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes) import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet) import Gargantext.Utils (queryMatchesLabel, toggleSet)
import Gargantext.Utils.List (sortWith) as L import Gargantext.Utils.List (sortWith) as L
...@@ -492,14 +494,19 @@ mainNgramsTable props = R.createElement mainNgramsTableCpt props [] ...@@ -492,14 +494,19 @@ mainNgramsTable props = R.createElement mainNgramsTableCpt props []
mainNgramsTableCpt :: R.Component MainNgramsTableProps mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "G.C.NT.mainNgramsTable" cpt mainNgramsTableCpt = R.hooksComponent "G.C.NT.mainNgramsTable" cpt
where where
cpt {nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate} _ = do cpt props@{nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate} _ = do
let path = initialPageParams session nodeId [defaultListId] tabType let path = initialPageParams session nodeId [defaultListId] tabType
pure $ loader path loadNgramsTableAll \loaded -> do useLoaderWithVersionCache (pathNoLimit path) (keyFunc props) (versionEndpoint props) loadNgramsTable \versioned -> do
case Map.lookup tabType loaded of mainNgramsTablePaint { path, tabNgramType, versioned, withAutoUpdate }
Just (versioned :: VersionedNgramsTable) ->
mainNgramsTablePaint {path, tabNgramType, versioned, withAutoUpdate} keyFunc { defaultListId, nodeId, tabType } _ =
Nothing -> loadingSpinner {} "ngrams-table-" <> (show tabType) <> "-" <> (show nodeId) <> "-" <> (show defaultListId)
versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version
versionEndpoint { defaultListId, nodeId, session, tabType } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
pathNoLimit path@{ params } = path { params = params { limit = 100000 }
, termListFilter = Nothing }
type MainNgramsTablePaintProps = type MainNgramsTablePaintProps =
( (
......
...@@ -60,7 +60,7 @@ import Prelude ...@@ -60,7 +60,7 @@ import Prelude
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Control.Monad.State (class MonadState, execState) import Control.Monad.State (class MonadState, execState)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (.:!), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (.:!), (.:?), (:=), (:=?), (~>), (~>?))
import Data.Array (head) import Data.Array (head)
import Data.Array as A import Data.Array as A
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
...@@ -177,7 +177,6 @@ newtype NgramsElement = NgramsElement ...@@ -177,7 +177,6 @@ newtype NgramsElement = NgramsElement
} }
derive instance eqNgramsElement :: Eq NgramsElement derive instance eqNgramsElement :: Eq NgramsElement
derive instance eqNgramsTable :: Eq NgramsTable
_parent = prop (SProxy :: SProxy "parent") _parent = prop (SProxy :: SProxy "parent")
...@@ -211,12 +210,22 @@ instance decodeJsonNgramsElement :: DecodeJson NgramsElement where ...@@ -211,12 +210,22 @@ instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
ngrams <- obj .: "ngrams" ngrams <- obj .: "ngrams"
list <- obj .: "list" list <- obj .: "list"
occurrences <- obj .: "occurrences" occurrences <- obj .: "occurrences"
parent <- obj .:! "parent" parent <- obj .:? "parent"
root <- obj .:! "root" root <- obj .:? "root"
children' <- obj .: "children" children' <- obj .: "children"
let children = Set.fromFoldable (children' :: Array NgramsTerm) let children = Set.fromFoldable (children' :: Array NgramsTerm)
pure $ NgramsElement {ngrams, list, occurrences, parent, root, children} pure $ NgramsElement {ngrams, list, occurrences, parent, root, children}
instance encodeJsonNgramsElement :: EncodeJson NgramsElement where
encodeJson (NgramsElement { children, list, ngrams, occurrences, parent, root }) =
"children" := children
~> "list" := list
~> "ngrams" := ngrams
~> "occurrences" := occurrences
~> "parent" :=? parent
~>? "root" :=? root
~>? jsonEmptyObject
----------------------------------------------------------------------------------- -----------------------------------------------------------------------------------
type Version = Int type Version = Int
...@@ -243,6 +252,7 @@ instance decodeJsonVersioned :: DecodeJson a => DecodeJson (Versioned a) where ...@@ -243,6 +252,7 @@ instance decodeJsonVersioned :: DecodeJson a => DecodeJson (Versioned a) where
newtype NgramsTable = NgramsTable (Map NgramsTerm NgramsElement) newtype NgramsTable = NgramsTable (Map NgramsTerm NgramsElement)
derive instance newtypeNgramsTable :: Newtype NgramsTable _ derive instance newtypeNgramsTable :: Newtype NgramsTable _
derive instance eqNgramsTable :: Eq NgramsTable
_NgramsTable :: Iso' NgramsTable (Map NgramsTerm NgramsElement) _NgramsTable :: Iso' NgramsTable (Map NgramsTerm NgramsElement)
_NgramsTable = _Newtype _NgramsTable = _Newtype
...@@ -261,6 +271,9 @@ instance decodeJsonNgramsTable :: DecodeJson NgramsTable where ...@@ -261,6 +271,9 @@ instance decodeJsonNgramsTable :: DecodeJson NgramsTable where
$ f <$> (elements :: Array NgramsElement) $ f <$> (elements :: Array NgramsElement)
where where
f e@(NgramsElement e') = Tuple e'.ngrams e f e@(NgramsElement e') = Tuple e'.ngrams e
instance encodeJsonNgramsTable :: EncodeJson NgramsTable where
encodeJson (NgramsTable m) = encodeJson $ Map.values m
----------------------------------------------------------------------------------- -----------------------------------------------------------------------------------
wordBoundaryChars :: String wordBoundaryChars :: String
...@@ -715,10 +728,14 @@ loadNgramsTable ...@@ -715,10 +728,14 @@ loadNgramsTable
{ nodeId, listIds, termListFilter, termSizeFilter, session, scoreType { nodeId, listIds, termListFilter, termSizeFilter, session, scoreType
, 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 { limit
, offset: Just offset
, listIds
, orderBy: convOrderBy <$> orderBy , orderBy: convOrderBy <$> orderBy
, termListFilter, termSizeFilter , searchQuery
, searchQuery, scoreType } (Just nodeId) , tabType
, termListFilter
, termSizeFilter } (Just nodeId)
type NgramsListByTabType = Map TabType VersionedNgramsTable type NgramsListByTabType = Map TabType VersionedNgramsTable
......
module Gargantext.Components.NgramsTable.Loader where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Core (stringify)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
import Web.Storage.Storage as WSS
import Gargantext.Prelude
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (Version(..), Versioned(..))
import Gargantext.Hooks.Loader (useCachedLoaderEffect)
useLoaderWithVersionCache :: forall path st. Eq path => DecodeJson st => EncodeJson st =>
path
-> (path -> String)
-> (path -> Aff Version)
-> (path -> Aff (Versioned st))
-> (Versioned st -> R.Element)
-> R.Hooks R.Element
useLoaderWithVersionCache path keyFunc versionEndpoint loader render = do
state <- R.useState' Nothing
useCachedLoaderEffect { cacheEndpoint: strVersionEndpoint
, keyFunc
, loadRealData: loadRealData state
, path
, state }
pure $ maybe (loadingSpinner {}) render (fst state)
where
strVersionEndpoint :: path -> Aff String
strVersionEndpoint p = do
v <- versionEndpoint p
pure $ show v
loadRealData :: R.State (Maybe (Versioned st)) -> String -> String -> WSS.Storage -> Aff Unit
loadRealData (_ /\ setState) key keyCache localStorage = do
--R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do
v@(Versioned { version }) <- loader path
liftEffect $ do
let value = stringify $ encodeJson v
WSS.setItem key value localStorage
WSS.setItem keyCache (show version) localStorage
setState $ const $ Just v
pure unit
\ No newline at end of file
...@@ -129,17 +129,18 @@ sessionPath (R.GetNgrams opts i) = ...@@ -129,17 +129,18 @@ sessionPath (R.GetNgrams opts i) =
base opts.tabType base opts.tabType
$ "ngrams?ngramsType=" $ "ngrams?ngramsType="
<> showTabType' opts.tabType <> showTabType' opts.tabType
<> offsetUrl opts.offset
<> limitUrl opts.limit <> limitUrl opts.limit
<> offset opts.offset
<> orderByUrl opts.orderBy <> orderByUrl opts.orderBy
<> foldMap (\x -> "&list=" <> show x) opts.listIds <> foldMap (\x -> "&list=" <> show x) opts.listIds
<> foldMap (\x -> "&listType=" <> show x) opts.termListFilter <> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
<> foldMap termSizeFilter opts.termSizeFilter <> foldMap termSizeFilter opts.termSizeFilter
<> "&scoreType=" <> show opts.scoreType
<> search opts.searchQuery <> search opts.searchQuery
where where
base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
base _ = sessionPath <<< R.NodeAPI Url_Document i base _ = sessionPath <<< R.NodeAPI Url_Document i
offset Nothing = ""
offset (Just o) = offsetUrl o
termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1" termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
termSizeFilter MultiTerm = "&minTermSize=2" termSizeFilter MultiTerm = "&minTermSize=2"
search "" = "" search "" = ""
...@@ -150,6 +151,11 @@ sessionPath (R.GetNgramsTableAll opts i) = ...@@ -150,6 +151,11 @@ sessionPath (R.GetNgramsTableAll opts i) =
<> showTabType' opts.tabType <> showTabType' opts.tabType
<> foldMap (\x -> "&list=" <> show x) opts.listIds <> foldMap (\x -> "&list=" <> show x) opts.listIds
<> limitUrl 100000 <> limitUrl 100000
sessionPath (R.GetNgramsTableVersion opts i) =
sessionPath $ R.NodeAPI Node i
$ "ngrams/version?ngramsType="
<> showTabType' opts.tabType
<> "&list=" <> show opts.listId
sessionPath (R.ListDocument lId dId) = sessionPath (R.ListDocument lId dId) =
sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ fromMaybe 0 dId)) sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ fromMaybe 0 dId))
sessionPath (R.ListsRoute lId) = "lists/" <> show lId sessionPath (R.ListsRoute lId) = "lists/" <> show lId
......
...@@ -20,16 +20,20 @@ import Gargantext.Utils.Reactix as R2 ...@@ -20,16 +20,20 @@ import Gargantext.Utils.Reactix as R2
useLoader :: forall path st. Eq path => useLoader :: forall path st. Eq path =>
path -> (path -> Aff st) path
-> (st -> R.Element) -> R.Hooks R.Element -> (path -> Aff st)
-> (st -> R.Element)
-> R.Hooks R.Element
useLoader path loader render = do useLoader path loader render = do
state <- R.useState' Nothing state <- R.useState' Nothing
useLoaderEffect path state loader useLoaderEffect path state loader
pure $ maybe (loadingSpinner {}) render (fst state) pure $ maybe (loadingSpinner {}) render (fst state)
useLoaderEffect :: forall st path. Eq path => useLoaderEffect :: forall st path. Eq path =>
path -> R.State (Maybe st) path
-> (path -> Aff st) -> R.Hooks Unit -> R.State (Maybe st)
-> (path -> Aff st)
-> R.Hooks Unit
useLoaderEffect path state@(state' /\ setState) loader = do useLoaderEffect path state@(state' /\ setState) loader = do
oPath <- R.useRef path oPath <- R.useRef path
...@@ -67,20 +71,41 @@ useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st ...@@ -67,20 +71,41 @@ useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st
-> (path -> String) -> (path -> String)
-> (path -> Aff String) -> (path -> Aff String)
-> (path -> Aff (HashedResponse st)) -> (path -> Aff (HashedResponse st))
-> (st -> R.Element) -> R.Hooks R.Element -> (st -> R.Element)
-> R.Hooks R.Element
useLoaderWithCache path keyFunc md5Endpoint loader render = do useLoaderWithCache path keyFunc md5Endpoint loader render = do
state <- R.useState' Nothing state <- R.useState' Nothing
useCachedLoaderEffect path keyFunc md5Endpoint state loader useCachedLoaderEffect { cacheEndpoint: md5Endpoint
, keyFunc
, loadRealData: loadRealData state
, path
, state }
pure $ maybe (loadingSpinner {}) render (fst state) pure $ maybe (loadingSpinner {}) render (fst state)
where
loadRealData :: R.State (Maybe st) -> String -> String -> WSS.Storage -> Aff Unit
loadRealData (_ /\ setState) key keyCache localStorage = do
--R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do
HashedResponse { md5, value: l } <- loader path
liftEffect $ do
let value = stringify $ encodeJson l
WSS.setItem key value localStorage
WSS.setItem keyCache md5 localStorage
setState $ const $ Just l
pure unit
type CachedLoaderEffectProps cacheKey path st = (
cacheEndpoint :: path -> Aff cacheKey
, keyFunc :: path -> String
, loadRealData :: String -> String -> WSS.Storage -> Aff Unit
, path :: path
, state :: R.State (Maybe st)
)
useCachedLoaderEffect :: forall path st. Eq path => DecodeJson st => EncodeJson st => useCachedLoaderEffect :: forall path st. Eq path => DecodeJson st => EncodeJson st =>
path Record (CachedLoaderEffectProps String path st)
-> (path -> String) -> R.Hooks Unit
-> (path -> Aff String) useCachedLoaderEffect { cacheEndpoint, keyFunc, loadRealData, path, state: state@(state' /\ setState) } = do
-> R.State (Maybe st)
-> (path -> Aff (HashedResponse st))
-> R.Hooks Unit
useCachedLoaderEffect path keyFunc md5Endpoint state@(state' /\ setState) loader = do
oPath <- R.useRef path oPath <- R.useRef path
R.useEffect' $ do R.useEffect' $ do
...@@ -91,46 +116,35 @@ useCachedLoaderEffect path keyFunc md5Endpoint state@(state' /\ setState) loader ...@@ -91,46 +116,35 @@ useCachedLoaderEffect path keyFunc md5Endpoint state@(state' /\ setState) loader
let key = "loader--" <> (keyFunc path) let key = "loader--" <> (keyFunc path)
-- log2 "[useCachedLoader] key" key -- log2 "[useCachedLoader] key" key
let keyMD5 = key <> "-md5" let keyCache = key <> "-cache"
localStorage <- R2.getls localStorage <- R2.getls
mState <- WSS.getItem key localStorage mState <- WSS.getItem key localStorage
mMD5 <- WSS.getItem keyMD5 localStorage mCache <- WSS.getItem keyCache localStorage
-- log2 "[useCachedLoader] mState" mState -- log2 "[useCachedLoader] mState" mState
launchAff_ $ do launchAff_ $ do
case mState of case mState of
Nothing -> loadRealData key keyMD5 localStorage Nothing -> loadRealData key keyCache localStorage
Just stStr -> do Just stStr -> do
let parsed = parse stStr >>= decode let parsed = parse stStr >>= decode
case parsed of case parsed of
Left err -> do Left err -> do
-- liftEffect $ log2 "[useCachedLoader] err" err -- liftEffect $ log2 "[useCachedLoader] err" err
loadRealData key keyMD5 localStorage loadRealData key keyCache localStorage
Right (st :: st) -> do Right (st :: st) -> do
md5Real <- md5Endpoint path cacheReal <- cacheEndpoint path
-- liftEffect $ log2 "[useCachedLoader] md5Real" md5Real -- liftEffect $ log2 "[useCachedLoader] cacheReal" cacheReal
case mMD5 of case mCache of
Nothing -> do Nothing -> do
-- liftEffect $ log2 "[useCachedLoader] no stored md5" Nothing -- liftEffect $ log2 "[useCachedLoader] no stored cache" Nothing
loadRealData key keyMD5 localStorage loadRealData key keyCache localStorage
Just md5 -> do Just cache -> do
-- liftEffect $ log2 "[useCachedLoader] stored md5" md5 -- liftEffect $ log2 "[useCachedLoader] stored cache" cache
if md5 == md5Real then if cache == cacheReal then
-- yay! cache hit! -- yay! cache hit!
liftEffect $ setState $ const $ Just st liftEffect $ setState $ const $ Just st
else else
loadRealData key keyMD5 localStorage loadRealData key keyCache localStorage
where where
loadRealData :: String -> String -> WSS.Storage -> Aff Unit
loadRealData key keyMD5 localStorage = do
--R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do
HashedResponse { md5, value: l } <- loader path
liftEffect $ do
let value = stringify $ encodeJson l
WSS.setItem key value localStorage
WSS.setItem keyMD5 md5 localStorage
setState $ const $ Just l
pure unit
parse s = GU.mapLeft (\err -> "Error parsing serialised sessions:" <> show err) (jsonParser s) parse s = GU.mapLeft (\err -> "Error parsing serialised sessions:" <> show err) (jsonParser s)
decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j) decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j)
...@@ -37,6 +37,7 @@ data SessionRoute ...@@ -37,6 +37,7 @@ data SessionRoute
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id) | Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
| GetNgrams NgramsGetOpts (Maybe Id) | GetNgrams NgramsGetOpts (Maybe Id)
| GetNgramsTableAll NgramsGetTableAllOpts (Maybe Id) | GetNgramsTableAll NgramsGetTableAllOpts (Maybe Id)
| GetNgramsTableVersion { listId :: ListId, tabType :: TabType } (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id) | PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST. -- ^ This name is not good. In particular this URL is used both in PUT and POST.
| RecomputeNgrams (TabSubType CTabNgramType) Id ListId | RecomputeNgrams (TabSubType CTabNgramType) Id ListId
......
...@@ -304,22 +304,21 @@ type ListId = Int ...@@ -304,22 +304,21 @@ type ListId = Int
data ScoreType = Occurrences data ScoreType = Occurrences
derive instance genericScoreType :: Generic ScoreType _ derive instance genericScoreType :: Generic ScoreType _
instance showScoreType :: Show ScoreType where
show = genericShow
instance eqScoreType :: Eq ScoreType where instance eqScoreType :: Eq ScoreType where
eq = genericEq eq = genericEq
instance showScoreType :: Show ScoreType where
show = genericShow
type SearchQuery = String type SearchQuery = String
type NgramsGetOpts = type NgramsGetOpts =
{ tabType :: TabType { tabType :: TabType
, offset :: Offset
, limit :: Limit , limit :: Limit
, offset :: Maybe Offset
, orderBy :: Maybe OrderBy , orderBy :: Maybe OrderBy
, listIds :: Array ListId , listIds :: Array ListId
, termListFilter :: Maybe TermList , termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize , termSizeFilter :: Maybe TermSize
, scoreType :: ScoreType
, searchQuery :: SearchQuery , searchQuery :: SearchQuery
} }
......
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