Commit 11c18cea authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[dashboard] implement charts saving to the backend

parent 23cc8537
...@@ -54,7 +54,7 @@ nodeMainSpan :: (Action -> Aff Unit) ...@@ -54,7 +54,7 @@ nodeMainSpan :: (Action -> Aff Unit)
-> R.Element -> R.Element
nodeMainSpan d p folderOpen session frontends = R.createElement el p [] nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where where
el = R.hooksComponent "NodeMainSpan" cpt el = R.hooksComponent "G.C.F.T.N.B.NodeMainSpan" cpt
cpt props@{id, asyncTasks, mCurrentRoute, name, nodeType, onAsyncTaskFinish} _ = do cpt props@{id, asyncTasks, mCurrentRoute, name, nodeType, onAsyncTaskFinish} _ = do
-- only 1 popup at a time is allowed to be opened -- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup) popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
......
...@@ -396,3 +396,14 @@ loadCorpusWithChild {nodeId:childId, session} = do ...@@ -396,3 +396,14 @@ loadCorpusWithChild {nodeId:childId, session} = do
listNodeRoute = NodeAPI Node <<< Just listNodeRoute = NodeAPI Node <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
type LoadWithReloadProps =
(
reload :: Int
| LoadProps
)
-- Just to make reloading effective
loadCorpusWithChildAndReload :: Record LoadWithReloadProps -> Aff CorpusData
loadCorpusWithChildAndReload {nodeId, reload, session} = loadCorpusWithChild {nodeId, session}
module Gargantext.Components.Nodes.Corpus.Chart.Predefined where module Gargantext.Components.Nodes.Corpus.Chart.Predefined where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare) import Data.Generic.Rep.Ord (genericCompare)
...@@ -27,6 +28,12 @@ instance showPredefinedChart :: Show PredefinedChart where ...@@ -27,6 +28,12 @@ instance showPredefinedChart :: Show PredefinedChart where
derive instance eqPredefinedChart :: Eq PredefinedChart derive instance eqPredefinedChart :: Eq PredefinedChart
instance ordPredefinedChart :: Ord PredefinedChart where instance ordPredefinedChart :: Ord PredefinedChart where
compare = genericCompare compare = genericCompare
instance decodePredefinedChart :: DecodeJson PredefinedChart where
decodeJson json = do
obj <- decodeJson json
pure $ readChart' obj
instance encodePredefinedChart :: EncodeJson PredefinedChart where
encodeJson c = encodeJson $ show c
readChart' :: String -> PredefinedChart readChart' :: String -> PredefinedChart
readChart' "CDocsHistogram" = CDocsHistogram readChart' "CDocsHistogram" = CDocsHistogram
......
...@@ -2,18 +2,21 @@ module Gargantext.Components.Nodes.Corpus.Dashboard where ...@@ -2,18 +2,21 @@ module Gargantext.Components.Nodes.Corpus.Dashboard where
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild) import Gargantext.Components.Nodes.Corpus (loadCorpusWithChildAndReload, saveCorpus)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..)) import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, updateHyperdataCharts, CorpusInfo(..), Hyperdata(..))
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
...@@ -29,21 +32,39 @@ dashboardLayout :: Record Props -> R.Element ...@@ -29,21 +32,39 @@ dashboardLayout :: Record Props -> R.Element
dashboardLayout props = R.createElement dashboardLayoutCpt props [] dashboardLayout props = R.createElement dashboardLayoutCpt props []
dashboardLayoutCpt :: R.Component Props dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt = R.hooksComponent "G.P.C.D.dashboardLayout" cpt dashboardLayoutCpt = R.hooksComponent "G.C.N.C.D.dashboardLayout" cpt
where where
cpt params@{nodeId, session} _ = do cpt params@{nodeId, session} _ = do
predefinedCharts <- R.useState' [] reload <- R.useState' 0
useLoader params loadCorpusWithChild $
useLoader {nodeId, reload: fst reload, session} loadCorpusWithChildAndReload $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} -> do \corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} -> do
let { name, date, hyperdata : Hyperdata h} = poly let { name, date, hyperdata : Hyperdata h} = poly
let CorpusInfo {desc,query,authors} = getCorpusInfo h.fields let CorpusInfo {authors, charts, desc, query} = getCorpusInfo h.fields
dashboardLayoutLoaded {corpusId, defaultListId, nodeId, predefinedCharts, session} dashboardLayoutLoaded { charts
, corpusId
, defaultListId
, key: show $ fst reload
, nodeId
, onChange: onChange corpusId reload (Hyperdata h)
, session }
where
onChange :: NodeID -> R.State Int -> Hyperdata -> Array P.PredefinedChart -> Effect Unit
onChange corpusId (_ /\ setReload) h charts = do
launchAff_ do
saveCorpus $ { hyperdata: updateHyperdataCharts h charts
, nodeId: corpusId
, session }
liftEffect $ setReload $ (+) 1
type LoadedProps = type LoadedProps =
( (
corpusId :: NodeID charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int , defaultListId :: Int
, predefinedCharts :: R.State (Array P.PredefinedChart) , key :: String
, onChange :: Array P.PredefinedChart -> Effect Unit
| Props | Props
) )
...@@ -53,28 +74,27 @@ dashboardLayoutLoaded props = R.createElement dashboardLayoutLoadedCpt props [] ...@@ -53,28 +74,27 @@ dashboardLayoutLoaded props = R.createElement dashboardLayoutLoadedCpt props []
dashboardLayoutLoadedCpt :: R.Component LoadedProps dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cpt dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cpt
where where
cpt props@{ corpusId, defaultListId, predefinedCharts: (predefinedCharts /\ setPredefinedCharts), session } _ = do cpt props@{ charts, corpusId, defaultListId, onChange, session } _ = do
pure $ pure $
H.div {} ([ H.div {} ([
H.h1 {} [ H.text "DashBoard" ] H.h1 {} [ H.text "DashBoard" ]
] <> charts <> [addNew]) ] <> chartsEls <> [addNew])
where where
addNew = H.div { className: "row" } [ addNew = H.div { className: "row" } [
H.span { className: "btn btn-default" H.span { className: "btn btn-default"
, on: { click: onClickAdd }} [ H.span { className: "fa fa-plus" } [] ] , on: { click: onClickAdd }} [ H.span { className: "fa fa-plus" } [] ]
] ]
where where
onClickAdd _ = setPredefinedCharts $ A.cons P.CDocsHistogram onClickAdd _ = onChange $ A.cons P.CDocsHistogram charts
charts = A.mapWithIndex chartIdx predefinedCharts chartsEls = A.mapWithIndex chartIdx charts
chartIdx idx chart = chartIdx idx chart =
renderChart { chart, corpusId, defaultListId, onChange, onRemove, session } renderChart { chart, corpusId, defaultListId, onChange: onChangeChart, onRemove, session }
where where
onChange c = do onChangeChart c = do
log2 "[dashboardLayout] idx" idx log2 "[dashboardLayout] idx" idx
log2 "[dashboardLayout] new chart" c log2 "[dashboardLayout] new chart" c
setPredefinedCharts $ \cs -> fromMaybe cs (A.modifyAt idx (\_ -> c) cs) onChange $ fromMaybe charts (A.modifyAt idx (\_ -> c) charts)
onRemove _ = setPredefinedCharts $ onRemove _ = onChange $ fromMaybe charts $ A.deleteAt idx charts
\cs -> fromMaybe cs $ A.deleteAt idx cs
type PredefinedChartProps = type PredefinedChartProps =
( (
......
...@@ -6,12 +6,14 @@ import Data.Either (Either(..)) ...@@ -6,12 +6,14 @@ import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.List ((:))
import Data.List as List import Data.List as List
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly) import Gargantext.Components.Node (NodePoly)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
type Author = String type Author = String
type Description = String type Description = String
...@@ -55,6 +57,7 @@ data FieldType = ...@@ -55,6 +57,7 @@ data FieldType =
} }
| JSON { | JSON {
authors :: Author authors :: Author
, charts :: Array P.PredefinedChart
, desc :: Description , desc :: Description
, query :: Query , query :: Query
, tag :: Tag , tag :: Tag
...@@ -66,30 +69,39 @@ data FieldType = ...@@ -66,30 +69,39 @@ data FieldType =
} }
isJSON :: Field FieldType -> Boolean isJSON :: FTField -> Boolean
isJSON (Field {typ}) = isJSON' typ isJSON (Field {typ}) = isJSON' typ
where where
isJSON' (JSON _) = true isJSON' (JSON _) = true
isJSON' _ = false isJSON' _ = false
getCorpusInfo :: List.List (Field FieldType) -> CorpusInfo getCorpusInfo :: List.List FTField -> CorpusInfo
getCorpusInfo as = case List.head (List.filter isJSON as) of getCorpusInfo as = case List.head (List.filter isJSON as) of
Just (Field {typ: JSON {authors, desc,query,title}}) -> CorpusInfo { title Just (Field {typ: JSON {authors, charts, desc, query, title}}) -> CorpusInfo { title
, desc , desc
, query , query
, authors , authors
, chart:Nothing , charts
, totalRecords:0 , totalRecords: 0
} }
_ -> CorpusInfo { title:"Empty" _ -> CorpusInfo { title:"Empty"
, desc:"" , desc:""
, query:"" , query:""
, authors:"" , authors:""
, chart:Nothing , charts: []
, totalRecords:0 , 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 _ derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where instance eqFieldType :: Eq FieldType where
eq = genericEq eq = genericEq
...@@ -108,11 +120,12 @@ instance decodeFTField :: DecodeJson (Field FieldType) where ...@@ -108,11 +120,12 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
pure $ Haskell {haskell, tag} pure $ Haskell {haskell, tag}
"JSON" -> do "JSON" -> do
authors <- data_ .: "authors" authors <- data_ .: "authors"
charts <- data_ .: "charts"
desc <- data_ .: "desc" desc <- data_ .: "desc"
query <- data_ .: "query" query <- data_ .: "query"
tag <- data_ .: "tag" tag <- data_ .: "tag"
title <- data_ .: "title" title <- data_ .: "title"
pure $ JSON {authors, desc, query, tag, title} pure $ JSON {authors, charts, desc, query, tag, title}
"Markdown" -> do "Markdown" -> do
tag <- data_ .: "tag" tag <- data_ .: "tag"
text <- data_ .: "text" text <- data_ .: "text"
...@@ -134,8 +147,9 @@ instance encodeFieldType :: EncodeJson FieldType where ...@@ -134,8 +147,9 @@ instance encodeFieldType :: EncodeJson FieldType where
"haskell" := haskell "haskell" := haskell
~> "tag" := "HaskellField" ~> "tag" := "HaskellField"
~> jsonEmptyObject ~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) = encodeJson (JSON {authors, charts, desc, query, tag, title}) =
"authors" := authors "authors" := authors
~> "charts" := charts
~> "desc" := desc ~> "desc" := desc
~> "query" := query ~> "query" := query
~> "tag" := "JsonField" ~> "tag" := "JsonField"
...@@ -157,6 +171,7 @@ defaultJSON :: FieldType ...@@ -157,6 +171,7 @@ defaultJSON :: FieldType
defaultJSON = JSON defaultJSON' defaultJSON = JSON defaultJSON'
defaultJSON' = { defaultJSON' = {
authors: "" authors: ""
, charts: []
, desc: "" , desc: ""
, query: "" , query: ""
, tag: "JSONField" , tag: "JSONField"
...@@ -179,10 +194,10 @@ defaultField = Field { ...@@ -179,10 +194,10 @@ defaultField = Field {
newtype CorpusInfo = newtype CorpusInfo =
CorpusInfo CorpusInfo
{ title :: String { title :: String
, authors :: String
, charts :: Array P.PredefinedChart
, desc :: String , desc :: String
, query :: String , query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int } , totalRecords :: Int }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where instance decodeCorpusInfo :: DecodeJson CorpusInfo where
...@@ -192,10 +207,10 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where ...@@ -192,10 +207,10 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where
desc <- obj .: "desc" desc <- obj .: "desc"
query <- obj .: "query" query <- obj .: "query"
authors <- obj .: "authors" authors <- obj .: "authors"
chart <- obj .:? "chart" charts <- obj .: "charts"
let totalRecords = 47361 -- TODO let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords} pure $ CorpusInfo {title, authors, charts, desc, query, totalRecords}
type CorpusData = { corpusId :: Int type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly Hyperdata -- CorpusInfo , corpusNode :: NodePoly Hyperdata -- CorpusInfo
, defaultListId :: Int} , defaultListId :: Int }
...@@ -208,7 +208,7 @@ fldr FolderPrivate true = "fa fa-lock" ...@@ -208,7 +208,7 @@ fldr FolderPrivate true = "fa fa-lock"
fldr FolderPrivate false = "fa fa-lock-circle" fldr FolderPrivate false = "fa fa-lock-circle"
fldr FolderShared true = "fa fa-share-alt" fldr FolderShared true = "fa fa-share-alt"
fldr FolderShared false = "fa fa-share-circle" fldr FolderShared false = "fa fa-share-alt"
fldr Team true = "fa fa-users" fldr Team true = "fa fa-users"
fldr Team false = "fa fa-users-closed" fldr Team false = "fa fa-users-closed"
...@@ -217,7 +217,7 @@ fldr FolderPublic false = "fa fa-globe" ...@@ -217,7 +217,7 @@ fldr FolderPublic false = "fa fa-globe"
------------------------------------------------------ ------------------------------------------------------
fldr Corpus true = "fa fa-book" fldr Corpus true = "fa fa-book"
fldr Corpus false = "fa fa-book-circle" fldr Corpus false = "fa fa-book"
fldr Phylo _ = "fa fa-code-fork" fldr Phylo _ = "fa fa-code-fork"
......
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