Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
11c18cea
Commit
11c18cea
authored
Feb 06, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[dashboard] implement charts saving to the backend
parent
23cc8537
Changes
6
Show whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
88 additions
and
35 deletions
+88
-35
Box.purs
src/Gargantext/Components/Forest/Tree/Node/Box.purs
+1
-1
Corpus.purs
src/Gargantext/Components/Nodes/Corpus.purs
+11
-0
Predefined.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
+7
-0
Dashboard.purs
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
+38
-18
Types.purs
src/Gargantext/Components/Nodes/Corpus/Types.purs
+29
-14
Types.purs
src/Gargantext/Types.purs
+2
-2
No files found.
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @
11c18cea
...
@@ -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)
...
...
src/Gargantext/Components/Nodes/Corpus.purs
View file @
11c18cea
...
@@ -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}
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
View file @
11c18cea
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
...
...
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
View file @
11c18cea
...
@@ -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 (loadCorpusWithChild
AndReload, 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@{ c
orpusId, defaultListId, predefinedCharts: (predefinedCharts /\ setPredefinedCharts)
, session } _ = do
cpt props@{ c
harts, corpusId, defaultListId, onChange
, session } _ = do
pure $
pure $
H.div {} ([
H.div {} ([
H.h1 {} [ H.text "DashBoard" ]
H.h1 {} [ H.text "DashBoard" ]
] <> charts <> [addNew])
] <> charts
Els
<> [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 predefinedC
harts
charts
Els = A.mapWithIndex chartIdx c
harts
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
onChange
Chart
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 =
(
(
...
...
src/Gargantext/Components/Nodes/Corpus/Types.purs
View file @
11c18cea
...
@@ -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 :: F
ield FieldType
-> Boolean
isJSON :: F
TField
-> 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
, chart
s
, totalRecords:0
, totalRecords:
0
}
}
_ -> CorpusInfo { title:"Empty"
_ -> CorpusInfo { title:"Empty"
, desc:""
, desc:""
, query:""
, query:""
, authors:""
, authors:""
, chart
:Nothing
, chart
s: []
, 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
"
chart
s <- 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
}
src/Gargantext/Types.purs
View file @
11c18cea
...
@@ -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"
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment