Commit df89d465 authored by Alexandre Delanoë's avatar Alexandre Delanoë
parents 0a49343d 3fbee957
/bower_components/
/node_modules/
/.cache/
/.pulp-cache/
/output/
/generated-docs/
......
......@@ -12,6 +12,7 @@ import Web.Storage.Storage as WSS
import Gargantext.Prelude
import Gargantext.Types as GT
import Gargantext.Utils as GU
import Gargantext.Utils.Reactix as R2
......@@ -33,13 +34,8 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
handleEither (Left err) = err *> pure empty
handleEither (Right ss) = pure ss
parse s = mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
decode j = mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
mapLeft f (Left l) = Left (f l)
mapLeft _ (Right r) = Right r
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
decode j = GU.mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
removeTaskFromList :: Array GT.AsyncTaskWithType -> GT.AsyncTaskWithType -> Array GT.AsyncTaskWithType
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
......
module Gargantext.Components.Charts.Options.Series where
import Prelude (class Show, bind, map, pure, show, ($), (+), (<<<), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (foldl)
import Data.Maybe (Maybe(..), maybe)
import Record.Unsafe (unsafeSet)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Types (class Optional)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
......@@ -196,7 +199,12 @@ instance decodeTreeNode :: DecodeJson TreeNode where
children <- obj .: "children"
pure $ TreeNode {name, value, children}
instance encodeTreeNode :: EncodeJson TreeNode where
encodeJson (TreeNode { children, name, value }) =
"children" := encodeJson children
~> "name" := encodeJson name
~> "value" := encodeJson value
~> jsonEmptyObject
treeNode :: String -> Int -> Array TreeNode -> TreeNode
treeNode n v ts = TreeNode {name : n, value:v, children:ts}
......
module Gargantext.Components.Nodes.Corpus.Chart.Common where
import Data.Argonaut (class DecodeJson, class EncodeJson)
import Data.Tuple (fst, Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
......@@ -8,7 +9,7 @@ import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCache)
import Gargantext.Sessions (Session)
type MetricsLoadViewProps a = (
......@@ -26,3 +27,20 @@ metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt
cpt {getMetrics, loaded, path, reload, session} _ = do
useLoader (fst reload /\ path) (getMetrics session) $ \l ->
loaded session path reload l
type MetricsWithCacheLoadViewProps a = (
--keyFunc :: Record Path -> String
| MetricsLoadViewProps a
)
metricsWithCacheLoadView :: forall a. DecodeJson a => EncodeJson a =>
Record (MetricsLoadViewProps a) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadViewCpt :: forall a. DecodeJson a => EncodeJson a => R.Component (MetricsLoadViewProps a)
metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt
where
cpt {getMetrics, loaded, path, reload, session} _ = do
useLoaderWithCache (fst reload /\ path) keyFunc (getMetrics session) $ \l ->
loaded session path reload l
keyFunc (_ /\ { corpusId, listId, tabType }) = "metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId)
module Gargantext.Components.Nodes.Corpus.Chart.Histo where
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
......@@ -15,7 +16,7 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1)
import Gargantext.Components.Charts.Options.Color (grey)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
......@@ -39,6 +40,12 @@ instance decodeHistoMetrics :: DecodeJson HistoMetrics where
c <- obj .: "count"
pure $ HistoMetrics { dates : d , count: c}
instance encodeHistoMetrics :: EncodeJson HistoMetrics where
encodeJson (HistoMetrics { dates, count }) =
"count" := encodeJson count
~> "dates" := encodeJson dates
~> jsonEmptyObject
type Loaded = HistoMetrics
chartOptions :: HistoMetrics -> Options
......@@ -67,7 +74,8 @@ histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
where
cpt {path, session} _ = do
reload <- R.useState' 0
pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session}
loaded :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element
loaded session path reload loaded =
......
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Prelude (bind, negate, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Map as Map
import Data.Map (Map)
import Data.Maybe (Maybe(..))
......@@ -17,7 +18,7 @@ import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
import Gargantext.Components.Charts.Options.Color (green, grey, red)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
......@@ -40,6 +41,14 @@ instance decodeMetric :: DecodeJson Metric where
cat <- obj .: "cat"
pure $ Metric { label, x, y, cat }
instance encodeMetric :: EncodeJson Metric where
encodeJson (Metric { label, x, y, cat }) =
"label" := encodeJson label
~> "x" := encodeJson x
~> "y" := encodeJson y
~> "cat" := encodeJson cat
~> jsonEmptyObject
newtype Metrics = Metrics
{ "data" :: Array Metric
}
......@@ -101,7 +110,9 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt
where
cpt {path, session} _ = do
reload <- R.useState' 0
pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session}
loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
loaded session path reload loaded =
......
module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Prelude (bind, map, pure, ($), (>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (zip, filter)
import Data.Array as A
import Data.Maybe (Maybe(..))
......@@ -17,7 +18,7 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Components.Charts.Options.Color (blue)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
......@@ -46,6 +47,12 @@ instance decodeHistoMetrics :: DecodeJson HistoMetrics where
c <- obj .: "count"
pure $ HistoMetrics { dates : d , count: c}
instance encodeHistoMetrics :: EncodeJson HistoMetrics where
encodeJson (HistoMetrics { dates, count }) =
"count" := encodeJson count
~> "dates" := encodeJson dates
~> jsonEmptyObject
type Loaded = HistoMetrics
chartOptionsBar :: HistoMetrics -> Options
......@@ -86,7 +93,8 @@ pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
where
cpt {path,session} _ = do
reload <- R.useState' 0
pure $ metricsLoadView {getMetrics, loaded: loadedPie, path, reload, session}
--pure $ metricsLoadView {getMetrics, loaded: loadedPie, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded: loadedPie, path, reload, session}
loadedPie :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element
loadedPie session path reload loaded =
......@@ -105,7 +113,8 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt
where
cpt {path, session} _ = do
reload <- R.useState' 0
pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session}
--pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded: loadedBar, path, reload, session}
loadedBar :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
loadedBar session path reload loaded =
......
module Gargantext.Components.Nodes.Corpus.Chart.Tree where
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
......@@ -14,7 +15,7 @@ import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis',
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
......@@ -30,6 +31,11 @@ instance decodeMetrics :: DecodeJson Metrics where
d <- obj .: "data"
pure $ Metrics { "data": d }
instance encodeMetrics :: EncodeJson Metrics where
encodeJson (Metrics { "data": d }) =
"data" := encodeJson d
~> jsonEmptyObject
type Loaded = Array TreeNode
scatterOptions :: Array TreeNode -> Options
......@@ -61,7 +67,8 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
where
cpt {path, session} _ = do
reload <- R.useState' 0
pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session}
loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
loaded session path reload loaded =
......
module Gargantext.Hooks.Loader where
import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
import Data.Argonaut.Core (stringify)
import Data.Argonaut.Parser (jsonParser)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
import Gargantext.Utils.Reactix as R2
import Web.Storage.Storage as WSS
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Utils as GU
import Gargantext.Utils.Reactix as R2
useLoader :: forall path st. Eq path =>
path -> (path -> Aff st)
......@@ -30,6 +39,53 @@ useLoaderEffect path state@(state' /\ setState) loader = do
else do
R.setRef oPath path
R2.affEffect "G.H.Loader.useLoaderEffect2" $ do
R2.affEffect "G.H.Loader.useLoaderEffect" $ do
l <- loader path
liftEffect $ setState $ const $ Just l
useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st =>
path
-> (path -> String)
-> (path -> Aff st)
-> (st -> R.Element) -> R.Hooks R.Element
useLoaderWithCache path keyFunc loader render = do
state <- R.useState' Nothing
useCachedLoaderEffect path keyFunc state loader
pure $ maybe (loadingSpinner {}) render (fst state)
useCachedLoaderEffect :: forall path st. Eq path => DecodeJson st => EncodeJson st =>
path
-> (path -> String)
-> R.State (Maybe st)
-> (path -> Aff st)
-> R.Hooks Unit
useCachedLoaderEffect path keyFunc state@(state' /\ setState) loader = do
oPath <- R.useRef path
R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then
pure $ pure unit
else do
R.setRef oPath path
let key = keyFunc path
localStorage <- R2.getls
mState <- WSS.getItem key localStorage
case mState of
Nothing -> pure unit
Just stStr ->
case (parse stStr >>= decode) of
Left err -> pure unit
Right st -> setState $ const $ Just st
R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do
l <- loader path
liftEffect $ do
let value = stringify $ encodeJson l
WSS.setItem key value localStorage
setState $ const $ Just l
where
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
decode j = GU.mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
module Gargantext.Utils where
import Prelude
import Data.Either (Either(..))
import Data.Lens (Lens', lens)
import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Set as Set
......@@ -68,3 +69,8 @@ queryMatchesLabel :: String -> String -> Boolean
queryMatchesLabel q l = S.contains (S.Pattern $ normalize q) (normalize l)
where
normalize = S.toLower
mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
mapLeft f (Left l) = Left (f l)
mapLeft _ (Right r) = Right r
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