Commit 00850750 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-dashboard-charts' of...

Merge branch 'dev-dashboard-charts' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 6c100215 06b9d6d5
......@@ -14,9 +14,8 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChildAndReload, saveCorpus)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, updateHyperdataCharts, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session)
......@@ -37,25 +36,25 @@ dashboardLayoutCpt = R.hooksComponent "G.C.N.C.D.dashboardLayout" cpt
cpt params@{nodeId, session} _ = do
reload <- R.useState' 0
useLoader {nodeId, reload: fst reload, session} loadCorpusWithChildAndReload $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} -> do
let { name, date, hyperdata : Hyperdata h} = poly
let CorpusInfo {authors, charts, desc, query} = getCorpusInfo h.fields
useLoader {nodeId, reload: fst reload, session} DT.loadDashboardWithReload $
\dashboardData@{hyperdata: DT.Hyperdata h, parentId} -> do
let { charts } = h
dashboardLayoutLoaded { charts
, corpusId
, defaultListId
, corpusId: parentId
, defaultListId: 0
, key: show $ fst reload
, nodeId
, onChange: onChange corpusId reload (Hyperdata h)
, onChange: onChange nodeId reload (DT.Hyperdata h)
, session }
where
onChange :: NodeID -> R.State Int -> Hyperdata -> Array P.PredefinedChart -> Effect Unit
onChange corpusId (_ /\ setReload) h charts = do
onChange :: NodeID -> R.State Int -> DT.Hyperdata -> Array P.PredefinedChart -> Effect Unit
onChange nodeId (_ /\ setReload) (DT.Hyperdata h) charts = do
launchAff_ do
saveCorpus $ { hyperdata: updateHyperdataCharts h charts
, nodeId: corpusId
, session }
DT.saveDashboard {
hyperdata: DT.Hyperdata $ h { charts = charts }
, nodeId
, session }
liftEffect $ setReload $ (+) 1
type LoadedProps =
......@@ -98,8 +97,8 @@ dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cp
type PredefinedChartProps =
(
corpusId :: NodeID
, chart :: P.PredefinedChart
chart :: P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, onChange :: P.PredefinedChart -> Effect Unit
, onRemove :: Unit -> Effect Unit
......
......@@ -57,7 +57,6 @@ data FieldType =
}
| JSON {
authors :: Author
, charts :: Array P.PredefinedChart
, desc :: Description
, query :: Query
, tag :: Tag
......@@ -77,31 +76,19 @@ isJSON (Field {typ}) = isJSON' typ
getCorpusInfo :: List.List FTField -> CorpusInfo
getCorpusInfo as = case List.head (List.filter isJSON as) of
Just (Field {typ: JSON {authors, charts, desc, query, title}}) -> CorpusInfo { title
, desc
, query
, authors
, charts
, totalRecords: 0
}
Just (Field {typ: JSON {authors, desc, query, title}}) -> CorpusInfo { title
, desc
, query
, authors
, totalRecords: 0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, charts: []
, totalRecords: 0
}
updateHyperdataCharts :: Hyperdata -> Array P.PredefinedChart -> Hyperdata
updateHyperdataCharts (Hyperdata h@{fields}) charts = Hyperdata $ h { fields = updateFieldsCharts fields charts }
updateFieldsCharts :: List.List FTField -> Array P.PredefinedChart -> List.List FTField
updateFieldsCharts List.Nil _ = List.Nil
updateFieldsCharts fs [] = fs
updateFieldsCharts ((Field f@{typ: JSON j@{charts}}):as) pcharts = (Field $ f { typ = JSON $ j { charts = pcharts } }):as
updateFieldsCharts (a@(Field {typ: _}):as) pcharts = a:(updateFieldsCharts as pcharts)
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
......@@ -120,12 +107,11 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
pure $ Haskell {haskell, tag}
"JSON" -> do
authors <- data_ .: "authors"
charts <- data_ .: "charts"
desc <- data_ .: "desc"
query <- data_ .: "query"
tag <- data_ .: "tag"
title <- data_ .: "title"
pure $ JSON {authors, charts, desc, query, tag, title}
pure $ JSON {authors, desc, query, tag, title}
"Markdown" -> do
tag <- data_ .: "tag"
text <- data_ .: "text"
......@@ -147,9 +133,8 @@ instance encodeFieldType :: EncodeJson FieldType where
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (JSON {authors, charts, desc, query, tag, title}) =
encodeJson (JSON {authors, desc, query, tag, title}) =
"authors" := authors
~> "charts" := charts
~> "desc" := desc
~> "query" := query
~> "tag" := "JsonField"
......@@ -171,7 +156,6 @@ defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
, charts: []
, desc: ""
, query: ""
, tag: "JSONField"
......@@ -195,7 +179,6 @@ newtype CorpusInfo =
CorpusInfo
{ title :: String
, authors :: String
, charts :: Array P.PredefinedChart
, desc :: String
, query :: String
, totalRecords :: Int }
......@@ -207,9 +190,8 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
charts <- obj .: "charts"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, authors, charts, desc, query, totalRecords}
pure $ CorpusInfo {title, authors, desc, query, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly Hyperdata -- CorpusInfo
......
module Gargantext.Components.Nodes.Dashboard.Types where
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Maybe (Maybe)
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..))
type Preferences = Maybe String
newtype Hyperdata =
Hyperdata
{
charts :: Array P.PredefinedChart
, preferences :: Preferences
}
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
charts <- obj .: "charts"
preferences <- obj .:? "preferences"
pure $ Hyperdata {charts, preferences}
instance encodeHyperdata :: EncodeJson Hyperdata where
encodeJson (Hyperdata {charts, preferences}) = do
"charts" := charts
~> "preferences" := preferences
~> jsonEmptyObject
type LoadProps = (
nodeId :: Int
, session :: Session
)
loadDashboard' :: Record LoadProps -> Aff DashboardData
loadDashboard' {nodeId, session} = get session $ NodeAPI Node (Just nodeId) ""
-- Just to make reloading effective
loadDashboardWithReload :: {reload :: Int | LoadProps} -> Aff DashboardData
loadDashboardWithReload {nodeId, session} = loadDashboard' {nodeId, session}
type SaveProps = (
hyperdata :: Hyperdata
| LoadProps
)
saveDashboard :: Record SaveProps -> Aff Unit
saveDashboard {hyperdata, nodeId, session} = do
id_ <- (put session (NodeAPI Node (Just nodeId) "") hyperdata) :: Aff Int
pure unit
type DashboardData = {
id :: Int
, hyperdata :: Hyperdata
, parentId :: Int
}
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