Skip to content

P
purescript-gargantext
Commit 11c18cea authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[dashboard] implement charts saving to the backend

parent 23cc8537
Show whitespace changes
Inline Side-by-side
Showing with 88 additions and 35 deletions
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ 11c18cea
......@@ -54,7 +54,7 @@ nodeMainSpan :: (Action -> Aff Unit)
-> R.Element
nodeMainSpan d p folderOpen session frontends = R.createElement el p []
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
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
......
src/Gargantext/Components/Nodes/Corpus.purs
View file @ 11c18cea
......@@ -396,3 +396,14 @@ loadCorpusWithChild {nodeId:childId, session} = do
listNodeRoute = NodeAPI Node <<< 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}
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
View file @ 11c18cea
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.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
......@@ -27,6 +28,12 @@ instance showPredefinedChart :: Show PredefinedChart where
derive instance eqPredefinedChart :: Eq PredefinedChart
instance ordPredefinedChart :: Ord PredefinedChart where
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' "CDocsHistogram" = CDocsHistogram
......
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
View file @ 11c18cea
......@@ -2,18 +2,21 @@ module Gargantext.Components.Nodes.Corpus.Dashboard where
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
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.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, updateHyperdataCharts, CorpusInfo(..), Hyperdata(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session)
......@@ -29,21 +32,39 @@ dashboardLayout :: Record Props -> R.Element
dashboardLayout props = R.createElement dashboardLayoutCpt 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
cpt params@{nodeId, session} _ = do
predefinedCharts <- R.useState' []
useLoader params loadCorpusWithChild $
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 {desc,query,authors} = getCorpusInfo h.fields
dashboardLayoutLoaded {corpusId, defaultListId, nodeId, predefinedCharts, session}
let CorpusInfo {authors, charts, desc, query} = getCorpusInfo h.fields
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 =
(
corpusId :: NodeID
charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, predefinedCharts :: R.State (Array P.PredefinedChart)
, key :: String
, onChange :: Array P.PredefinedChart -> Effect Unit
| Props
)
......@@ -53,28 +74,27 @@ dashboardLayoutLoaded props = R.createElement dashboardLayoutLoadedCpt props []
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cpt
where
cpt props@{ corpusId, defaultListId, predefinedCharts: (predefinedCharts /\ setPredefinedCharts), session } _ = do
cpt props@{ charts, corpusId, defaultListId, onChange, session } _ = do
pure $
H.div {} ([
H.h1 {} [ H.text "DashBoard" ]
] <> charts <> [addNew])
] <> chartsEls <> [addNew])
where
addNew = H.div { className: "row" } [
H.span { className: "btn btn-default"
, on: { click: onClickAdd }} [ H.span { className: "fa fa-plus" } [] ]
]
where
onClickAdd _ = setPredefinedCharts $ A.cons P.CDocsHistogram
charts = A.mapWithIndex chartIdx predefinedCharts
onClickAdd _ = onChange $ A.cons P.CDocsHistogram charts
chartsEls = A.mapWithIndex chartIdx charts
chartIdx idx chart =
renderChart { chart, corpusId, defaultListId, onChange, onRemove, session }
renderChart { chart, corpusId, defaultListId, onChange: onChangeChart, onRemove, session }
where
onChange c = do
onChangeChart c = do
log2 "[dashboardLayout] idx" idx
log2 "[dashboardLayout] new chart" c
setPredefinedCharts $ \cs -> fromMaybe cs (A.modifyAt idx (\_ -> c) cs)
onRemove _ = setPredefinedCharts $
\cs -> fromMaybe cs $ A.deleteAt idx cs
onChange $ fromMaybe charts (A.modifyAt idx (\_ -> c) charts)
onRemove _ = onChange $ fromMaybe charts $ A.deleteAt idx charts
type PredefinedChartProps =
(
......
src/Gargantext/Components/Nodes/Corpus/Types.purs
View file @ 11c18cea
......@@ -6,12 +6,14 @@ import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.List ((:))
import Data.List as List
import Data.Maybe (Maybe)
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
type Author = String
type Description = String
......@@ -55,6 +57,7 @@ data FieldType =
}
| JSON {
authors :: Author
, charts :: Array P.PredefinedChart
, desc :: Description
, query :: Query
, tag :: Tag
......@@ -66,30 +69,39 @@ data FieldType =
}
isJSON :: Field FieldType -> Boolean
isJSON :: FTField -> Boolean
isJSON (Field {typ}) = isJSON' typ
where
isJSON' (JSON _) = true
isJSON' _ = false
getCorpusInfo :: List.List (Field FieldType) -> CorpusInfo
getCorpusInfo :: List.List FTField -> CorpusInfo
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
, query
, authors
, chart:Nothing
, totalRecords:0
, charts
, totalRecords: 0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, chart:Nothing
, totalRecords:0
, 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
......@@ -108,11 +120,12 @@ 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, desc, query, tag, title}
pure $ JSON {authors, charts, desc, query, tag, title}
"Markdown" -> do
tag <- data_ .: "tag"
text <- data_ .: "text"
......@@ -134,8 +147,9 @@ instance encodeFieldType :: EncodeJson FieldType where
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) =
encodeJson (JSON {authors, charts, desc, query, tag, title}) =
"authors" := authors
~> "charts" := charts
~> "desc" := desc
~> "query" := query
~> "tag" := "JsonField"
......@@ -157,6 +171,7 @@ defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
, charts: []
, desc: ""
, query: ""
, tag: "JSONField"
......@@ -179,10 +194,10 @@ defaultField = Field {
newtype CorpusInfo =
CorpusInfo
{ title :: String
, authors :: String
, charts :: Array P.PredefinedChart
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
......@@ -192,10 +207,10 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .:? "chart"
charts <- obj .: "charts"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
pure $ CorpusInfo {title, authors, charts, desc, query, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly Hyperdata -- CorpusInfo
, defaultListId :: Int}
, defaultListId :: Int }
src/Gargantext/Types.purs
View file @ 11c18cea
......@@ -208,7 +208,7 @@ fldr FolderPrivate true = "fa fa-lock"
fldr FolderPrivate false = "fa fa-lock-circle"
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 false = "fa fa-users-closed"
......@@ -217,7 +217,7 @@ fldr FolderPublic false = "fa fa-globe"
------------------------------------------------------
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"
......
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