Commit 701f2182 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[ngrams] cached ngrams table

parent 4ec844e6
......@@ -23,18 +23,21 @@ import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Loader (loader)
import Gargantext.Components.LoadingSpinner (loadingSpinner)
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.Hooks.Loader (useLoader)
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.Utils (queryMatchesLabel, toggleSet)
import Gargantext.Utils.List (sortWith) as L
......@@ -491,14 +494,28 @@ mainNgramsTable props = R.createElement mainNgramsTableCpt props []
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "G.C.NT.mainNgramsTable" cpt
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
pure $ loader path loadNgramsTableAll \loaded -> do
case Map.lookup tabType loaded of
Just (versioned :: VersionedNgramsTable) ->
mainNgramsTablePaint {path, tabNgramType, versioned, withAutoUpdate}
Nothing -> loadingSpinner {}
useLoaderWithVersionCache (pathNoLimit path) (keyFunc props) (versionEndpoint props) loadNgramsTable \versioned -> do
mainNgramsTablePaint { path, tabNgramType, versioned, withAutoUpdate }
-- useLoaderWithVersionCache path (keyFunc props) (versionEndpoint props) loadNgramsTableAll \loaded -> do
-- useLoader path loadNgramsTableAll \loaded -> do
-- case Map.lookup tabType loaded of
-- Just (versioned :: VersionedNgramsTable) ->
-- mainNgramsTablePaint {path, tabNgramType, versioned, withAutoUpdate}
-- Nothing -> loadingSpinner {}
-- useLoader (pathNoLimit path) loadNgramsTable \versioned -> do
-- mainNgramsTablePaint { path, tabNgramType, versioned, withAutoUpdate }
keyFunc { defaultListId, nodeId, tabType } _ =
"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 =
(
......
......@@ -60,7 +60,7 @@ import Prelude
import Control.Monad.Cont.Trans (lift)
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 as A
import Data.Bifunctor (lmap)
......@@ -177,7 +177,6 @@ newtype NgramsElement = NgramsElement
}
derive instance eqNgramsElement :: Eq NgramsElement
derive instance eqNgramsTable :: Eq NgramsTable
_parent = prop (SProxy :: SProxy "parent")
......@@ -211,12 +210,22 @@ instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
ngrams <- obj .: "ngrams"
list <- obj .: "list"
occurrences <- obj .: "occurrences"
parent <- obj .:! "parent"
root <- obj .:! "root"
parent <- obj .:? "parent"
root <- obj .:? "root"
children' <- obj .: "children"
let children = Set.fromFoldable (children' :: Array NgramsTerm)
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
......@@ -243,6 +252,7 @@ instance decodeJsonVersioned :: DecodeJson a => DecodeJson (Versioned a) where
newtype NgramsTable = NgramsTable (Map NgramsTerm NgramsElement)
derive instance newtypeNgramsTable :: Newtype NgramsTable _
derive instance eqNgramsTable :: Eq NgramsTable
_NgramsTable :: Iso' NgramsTable (Map NgramsTerm NgramsElement)
_NgramsTable = _Newtype
......@@ -261,6 +271,9 @@ instance decodeJsonNgramsTable :: DecodeJson NgramsTable where
$ f <$> (elements :: Array NgramsElement)
where
f e@(NgramsElement e') = Tuple e'.ngrams e
instance encodeJsonNgramsTable :: EncodeJson NgramsTable where
encodeJson (NgramsTable m) = encodeJson $ Map.values m
-----------------------------------------------------------------------------------
wordBoundaryChars :: String
......@@ -715,10 +728,14 @@ loadNgramsTable
{ nodeId, listIds, termListFilter, termSizeFilter, session, scoreType
, searchQuery, tabType, params: {offset, limit, orderBy}}
= get session query
where query = GetNgrams { tabType, offset, limit, listIds
where query = GetNgrams { limit
, offset: Just offset
, listIds
, orderBy: convOrderBy <$> orderBy
, termListFilter, termSizeFilter
, searchQuery, scoreType } (Just nodeId)
, searchQuery
, tabType
, termListFilter
, termSizeFilter } (Just nodeId)
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) =
base opts.tabType
$ "ngrams?ngramsType="
<> showTabType' opts.tabType
<> offsetUrl opts.offset
<> limitUrl opts.limit
<> offset opts.offset
<> orderByUrl opts.orderBy
<> foldMap (\x -> "&list=" <> show x) opts.listIds
<> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
<> foldMap termSizeFilter opts.termSizeFilter
<> "&scoreType=" <> show opts.scoreType
<> search opts.searchQuery
where
base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
base _ = sessionPath <<< R.NodeAPI Url_Document i
offset Nothing = ""
offset (Just o) = offsetUrl o
termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
termSizeFilter MultiTerm = "&minTermSize=2"
search "" = ""
......@@ -150,6 +151,11 @@ sessionPath (R.GetNgramsTableAll opts i) =
<> showTabType' opts.tabType
<> foldMap (\x -> "&list=" <> show x) opts.listIds
<> 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.NodeAPI NodeList lId ("document/" <> (show $ fromMaybe 0 dId))
sessionPath (R.ListsRoute lId) = "lists/" <> show lId
......
......@@ -20,16 +20,20 @@ import Gargantext.Utils.Reactix as R2
useLoader :: forall path st. Eq path =>
path -> (path -> Aff st)
-> (st -> R.Element) -> R.Hooks R.Element
path
-> (path -> Aff st)
-> (st -> R.Element)
-> R.Hooks R.Element
useLoader path loader render = do
state <- R.useState' Nothing
useLoaderEffect path state loader
pure $ maybe (loadingSpinner {}) render (fst state)
useLoaderEffect :: forall st path. Eq path =>
path -> R.State (Maybe st)
-> (path -> Aff st) -> R.Hooks Unit
path
-> R.State (Maybe st)
-> (path -> Aff st)
-> R.Hooks Unit
useLoaderEffect path state@(state' /\ setState) loader = do
oPath <- R.useRef path
......@@ -67,20 +71,41 @@ useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st
-> (path -> String)
-> (path -> Aff String)
-> (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
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)
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 =>
path
-> (path -> String)
-> (path -> Aff String)
-> R.State (Maybe st)
-> (path -> Aff (HashedResponse st))
-> R.Hooks Unit
useCachedLoaderEffect path keyFunc md5Endpoint state@(state' /\ setState) loader = do
Record (CachedLoaderEffectProps String path st)
-> R.Hooks Unit
useCachedLoaderEffect { cacheEndpoint, keyFunc, loadRealData, path, state: state@(state' /\ setState) } = do
oPath <- R.useRef path
R.useEffect' $ do
......@@ -90,47 +115,36 @@ useCachedLoaderEffect path keyFunc md5Endpoint state@(state' /\ setState) loader
R.setRef oPath path
let key = "loader--" <> (keyFunc path)
-- log2 "[useCachedLoader] key" key
let keyMD5 = key <> "-md5"
log2 "[useCachedLoader] key" key
let keyCache = key <> "-cache"
localStorage <- R2.getls
mState <- WSS.getItem key localStorage
mMD5 <- WSS.getItem keyMD5 localStorage
-- log2 "[useCachedLoader] mState" mState
mCache <- WSS.getItem keyCache localStorage
log2 "[useCachedLoader] mState" mState
launchAff_ $ do
case mState of
Nothing -> loadRealData key keyMD5 localStorage
Nothing -> loadRealData key keyCache localStorage
Just stStr -> do
let parsed = parse stStr >>= decode
case parsed of
Left err -> do
-- liftEffect $ log2 "[useCachedLoader] err" err
loadRealData key keyMD5 localStorage
liftEffect $ log2 "[useCachedLoader] err" err
loadRealData key keyCache localStorage
Right (st :: st) -> do
md5Real <- md5Endpoint path
-- liftEffect $ log2 "[useCachedLoader] md5Real" md5Real
case mMD5 of
cacheReal <- cacheEndpoint path
liftEffect $ log2 "[useCachedLoader] cacheReal" cacheReal
case mCache of
Nothing -> do
-- liftEffect $ log2 "[useCachedLoader] no stored md5" Nothing
loadRealData key keyMD5 localStorage
Just md5 -> do
-- liftEffect $ log2 "[useCachedLoader] stored md5" md5
if md5 == md5Real then
liftEffect $ log2 "[useCachedLoader] no stored cache" Nothing
loadRealData key keyCache localStorage
Just cache -> do
liftEffect $ log2 "[useCachedLoader] stored cache" cache
if cache == cacheReal then
-- yay! cache hit!
liftEffect $ setState $ const $ Just st
else
loadRealData key keyMD5 localStorage
loadRealData key keyCache localStorage
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)
decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j)
......@@ -37,6 +37,7 @@ data SessionRoute
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
| GetNgrams NgramsGetOpts (Maybe Id)
| GetNgramsTableAll NgramsGetTableAllOpts (Maybe Id)
| GetNgramsTableVersion { listId :: ListId, tabType :: TabType } (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.
| RecomputeNgrams (TabSubType CTabNgramType) Id ListId
......
......@@ -304,7 +304,8 @@ type ListId = Int
data ScoreType = Occurrences
derive instance genericScoreType :: Generic ScoreType _
instance eqScoreType :: Eq ScoreType where
eq = genericEq
instance showScoreType :: Show ScoreType where
show = genericShow
......@@ -312,13 +313,12 @@ type SearchQuery = String
type NgramsGetOpts =
{ tabType :: TabType
, offset :: Offset
, limit :: Limit
, offset :: Maybe Offset
, orderBy :: Maybe OrderBy
, listIds :: Array ListId
, termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize
, scoreType :: ScoreType
, 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