Commit 4ca0c477 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 906b6406 11c18cea
...@@ -240,9 +240,10 @@ codeTypeSelectorCpt = R.hooksComponent "G.C.CE.CodeTypeSelector" cpt ...@@ -240,9 +240,10 @@ codeTypeSelectorCpt = R.hooksComponent "G.C.CE.CodeTypeSelector" cpt
where where
cpt {codeType, onChange} _ = do cpt {codeType, onChange} _ = do
pure $ R2.select { className: "form-control" pure $ R2.select { className: "form-control"
, on: { change: onSelectChange codeType onChange } , defaultValue: show $ fst codeType
, style: { width: "150px" } , on: { change: onSelectChange codeType onChange }
, value: show $ fst codeType } , style: { width: "150px" }
}
(option <$> [Haskell, JSON, Markdown]) (option <$> [Haskell, JSON, Markdown])
option :: CodeType -> R.Element option :: CodeType -> R.Element
......
...@@ -33,7 +33,7 @@ import Gargantext.Utils.Reactix as R2 ...@@ -33,7 +33,7 @@ import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, post, delete, put) import Gargantext.Sessions (Session, sessionId, post, delete, put)
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..), AffTableResult) import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..), AffTableResult, NodeID)
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite data Category = Trash | UnRead | Checked | Topic | Favorite
...@@ -143,7 +143,6 @@ categoryRoute nodeId = NodeAPI Node (Just nodeId) "category" ...@@ -143,7 +143,6 @@ categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int) putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put session $ categoryRoute nodeId putCategories session nodeId = put session $ categoryRoute nodeId
type NodeID = Int
type TotalRecords = Int type TotalRecords = Int
type LayoutProps = type LayoutProps =
......
...@@ -25,13 +25,12 @@ import Gargantext.Components.Table as T ...@@ -25,13 +25,12 @@ import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(Search, NodeAPI)) import Gargantext.Routes (SessionRoute(Search, NodeAPI))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody) import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..)) import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID)
import Gargantext.Utils (toggleSet, zeroPad) import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
------------------------------------------------------------------------ ------------------------------------------------------------------------
type NodeID = Int
type TotalRecords = Int type TotalRecords = Int
-- Example: -- Example:
......
...@@ -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)
......
...@@ -5,7 +5,7 @@ import Data.Argonaut.Parser (jsonParser) ...@@ -5,7 +5,7 @@ import Data.Argonaut.Parser (jsonParser)
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.List as List import Data.List as List
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
...@@ -84,7 +84,7 @@ corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt ...@@ -84,7 +84,7 @@ corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt
H.div { className: "btn btn-default " <> (saveEnabled fieldsWithIndex fieldsS) H.div { className: "btn btn-default " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} } , on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} }
} [ } [
H.span { className: "glyphicon glyphicon-floppy-disk" } [ ] H.span { className: "fa fa-floppy-o" } [ ]
] ]
] ]
, H.div {} [ fieldsCodeEditor { fields: fieldsS , H.div {} [ fieldsCodeEditor { fields: fieldsS
...@@ -94,7 +94,7 @@ corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt ...@@ -94,7 +94,7 @@ corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt
H.div { className: "btn btn-default" H.div { className: "btn btn-default"
, on: { click: onClickAdd fieldsS } , on: { click: onClickAdd fieldsS }
} [ } [
H.span { className: "glyphicon glyphicon-plus" } [ ] H.span { className: "fa fa-plus" } [ ]
] ]
] ]
] ]
...@@ -151,9 +151,8 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt ...@@ -151,9 +151,8 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
onChange :: R.State FTFieldsWithIndex -> Index -> FieldType -> Effect Unit onChange :: R.State FTFieldsWithIndex -> Index -> FieldType -> Effect Unit
onChange (_ /\ setFields) idx typ = do onChange (_ /\ setFields) idx typ = do
setFields $ \fields -> setFields $ \fields ->
case List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields of fromMaybe fields $
Nothing -> fields List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields
Just newFields -> newFields
onMoveDown :: R.State Int -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit onMoveDown :: R.State Int -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onMoveDown (_ /\ setMasterKey) (fs /\ setFields) idx _ = do onMoveDown (_ /\ setMasterKey) (fs /\ setFields) idx _ = do
...@@ -168,16 +167,12 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt ...@@ -168,16 +167,12 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
onRemove :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit onRemove :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onRemove (_ /\ setFields) idx _ = do onRemove (_ /\ setFields) idx _ = do
setFields $ \fields -> setFields $ \fields ->
case List.deleteAt idx fields of fromMaybe fields $ List.deleteAt idx fields
Nothing -> fields
Just newFields -> recomputeIndices newFields
onRename :: R.State FTFieldsWithIndex -> Index -> String -> Effect Unit onRename :: R.State FTFieldsWithIndex -> Index -> String -> Effect Unit
onRename (_ /\ setFields) idx newName = do onRename (_ /\ setFields) idx newName = do
setFields $ \fields -> setFields $ \fields ->
case List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fields of fromMaybe fields $ List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fields
Nothing -> fields
Just newFields -> newFields
recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex
recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t
...@@ -213,7 +208,7 @@ fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt" ...@@ -213,7 +208,7 @@ fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt"
H.div { className: "btn btn-danger" H.div { className: "btn btn-danger"
, on: { click: \_ -> onRemove unit } , on: { click: \_ -> onRemove unit }
} [ } [
H.span { className: "glyphicon glyphicon-trash" } [ ] H.span { className: "fa fa-trash" } [ ]
] ]
] ]
, moveDownButton canMoveDown , moveDownButton canMoveDown
...@@ -230,14 +225,14 @@ fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt" ...@@ -230,14 +225,14 @@ fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt"
H.div { className: "btn btn-default" H.div { className: "btn btn-default"
, on: { click: \_ -> onMoveDown unit } , on: { click: \_ -> onMoveDown unit }
} [ } [
H.span { className: "glyphicon glyphicon-arrow-down" } [ ] H.span { className: "fa fa-arrow-down" } [ ]
] ]
moveUpButton false = H.div {} [] moveUpButton false = H.div {} []
moveUpButton true = moveUpButton true =
H.div { className: "btn btn-default" H.div { className: "btn btn-default"
, on: { click: \_ -> onMoveUp unit } , on: { click: \_ -> onMoveUp unit }
} [ } [
H.span { className: "glyphicon glyphicon-arrow-up" } [ ] H.span { className: "fa fa-arrow-up" } [ ]
] ]
type RenameableProps = type RenameableProps =
...@@ -287,7 +282,7 @@ renameableTextCpt = R.hooksComponent "G.C.N.C.renameableTextCpt" cpt ...@@ -287,7 +282,7 @@ renameableTextCpt = R.hooksComponent "G.C.N.C.renameableTextCpt" cpt
H.span { className: "text" } [ H.text text ] H.span { className: "text" } [ H.text text ]
, H.span { className: "btn btn-default" , H.span { className: "btn btn-default"
, on: { click: \_ -> setIsEditing $ const true } } [ , on: { click: \_ -> setIsEditing $ const true } } [
H.span { className: "glyphicon glyphicon-pencil" } [] H.span { className: "fa fa-pencil" } []
] ]
] ]
cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do
...@@ -300,7 +295,7 @@ renameableTextCpt = R.hooksComponent "G.C.N.C.renameableTextCpt" cpt ...@@ -300,7 +295,7 @@ renameableTextCpt = R.hooksComponent "G.C.N.C.renameableTextCpt" cpt
setIsEditing $ const false setIsEditing $ const false
onRename text onRename text
} } [ } } [
H.span { className: "glyphicon glyphicon-floppy-disk" } [] H.span { className: "fa fa-floppy-o" } []
] ]
] ]
...@@ -401,3 +396,14 @@ loadCorpusWithChild {nodeId:childId, session} = do ...@@ -401,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
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)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe, fromMaybe)
import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType)
data PredefinedChart =
CDocsHistogram
| CAuthorsPie
| CInstitutesTree
| CTermsMetrics
derive instance genericPredefinedChart :: Generic PredefinedChart _
instance showPredefinedChart :: Show PredefinedChart where
show = genericShow
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
readChart' "CAuthorsPie" = CAuthorsPie
readChart' "CInstitutesTree" = CInstitutesTree
readChart' "CTermsMetrics" = CTermsMetrics
readChart' _ = CDocsHistogram
allPredefinedCharts :: Array PredefinedChart
allPredefinedCharts = [
CDocsHistogram
, CAuthorsPie
, CTermsMetrics
, CInstitutesTree
]
type Params =
(
corpusId :: NodeID
, session :: Session
-- optinal params
, limit :: Maybe Int
, listId :: Maybe Int
)
render :: PredefinedChart -> Record Params -> R.Element
render CDocsHistogram { corpusId, session } = histo { path, session }
where
path = { corpusId
, tabType: TabCorpus TabDocs
}
render CAuthorsPie { corpusId, session } = pie { path, session }
where
path = { corpusId
, tabType: TabCorpus (TabNgramType $ modeTabType Authors)
}
render CInstitutesTree { corpusId, limit, listId, session } = tree { path, session }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Institutes)
}
render CTermsMetrics { corpusId, limit, listId, session } = metrics { path, session }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Authors)
}
module Gargantext.Components.Nodes.Corpus.Dashboard where module Gargantext.Components.Nodes.Corpus.Dashboard where
import Data.Array (zipWith) import Data.Array as A
import Data.Int (toNumber) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Maybe (Maybe(..)) import Data.Tuple (fst)
import Data.Tuple (Tuple(..)) 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 as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis', tooltipTriggerAxis)
import Gargantext.Components.Charts.Options.Data
import Gargantext.Components.Charts.Options.Series
( TreeNode, Trees(..), mkTree, seriesBarD1, seriesFunnelD1, seriesPieD1
, seriesSankey, seriesScatterD2, treeLeaf, treeNode )
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.Histo (histo) import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, updateHyperdataCharts, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (Mode(..), TabSubType(..), TabType(..), modeTabType) import Gargantext.Types (NodeID)
type Props = type Props =
( (
nodeId :: Int nodeId :: NodeID
, session :: Session , session :: Session
) )
...@@ -35,20 +32,39 @@ dashboardLayout :: Record Props -> R.Element ...@@ -35,20 +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
useLoader params loadCorpusWithChild $ reload <- R.useState' 0
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} ->
useLoader {nodeId, reload: fst reload, session} loadCorpusWithChildAndReload $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} -> do
let { name, date, hyperdata : Hyperdata h} = poly let { name, date, hyperdata : Hyperdata h} = poly
CorpusInfo {desc,query,authors} = getCorpusInfo h.fields let CorpusInfo {authors, charts, desc, query} = getCorpusInfo h.fields
in dashboardLayoutLoaded { charts
dashboardLayoutLoaded {corpusId, defaultListId, nodeId, session} , 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 :: Int charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int , defaultListId :: Int
, key :: String
, onChange :: Array P.PredefinedChart -> Effect Unit
| Props | Props
) )
...@@ -56,65 +72,89 @@ dashboardLayoutLoaded :: Record LoadedProps -> R.Element ...@@ -56,65 +72,89 @@ dashboardLayoutLoaded :: Record LoadedProps -> R.Element
dashboardLayoutLoaded props = R.createElement dashboardLayoutLoadedCpt props [] dashboardLayoutLoaded props = R.createElement dashboardLayoutLoadedCpt props []
dashboardLayoutLoadedCpt :: R.Component LoadedProps dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = R.hooksComponent "G.P.C.D.dashboardLayoutLoaded" cpt dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cpt
where where
cpt props _ = do cpt props@{ charts, corpusId, defaultListId, onChange, session } _ = do
pure $ H.div {} [ pure $
H.h1 {} [ H.text "DashBoard" ] H.div {} ([
, H.div {className: "row"} [ H.h1 {} [ H.text "DashBoard" ]
--H.div {className: "col-md-9 content"} [ chart globalPublis ] ] <> chartsEls <> [addNew])
H.div {className: "col-md-12 content"} [ histo (globalPublisParams props) ]
--, H.div {className: "col-md-3 content"} [ chart naturePublis ]
]
--, chart distriBySchool
, pie (authorsParams props)
--, H.div {className: "row"} (aSchool <$> schools)
--, chart scatterEx
, metrics (termsParams props)
--, chart sankeyEx
, tree (institutesParams props)
--, chart treeMapEx
--, chart treeEx
]
authorsParams {corpusId, session} = {path, session}
where where
path = {corpusId, tabType: TabCorpus (TabNgramType $ modeTabType Authors)} addNew = H.div { className: "row" } [
globalPublisParams {corpusId, session} = { path, session} H.span { className: "btn btn-default"
where , on: { click: onClickAdd }} [ H.span { className: "fa fa-plus" } [] ]
path = {corpusId, tabType: TabCorpus TabDocs} ]
institutesParams {corpusId, defaultListId, session} = {path, session} where
where onClickAdd _ = onChange $ A.cons P.CDocsHistogram charts
path = { corpusId chartsEls = A.mapWithIndex chartIdx charts
, limit: Just 1000 -- TODO Fix chartIdx idx chart =
, listId: defaultListId -- TODO Is this correct? renderChart { chart, corpusId, defaultListId, onChange: onChangeChart, onRemove, session }
, tabType: TabCorpus (TabNgramType $ modeTabType Institutes) where
} onChangeChart c = do
termsParams {corpusId, defaultListId, session} = {path, session} log2 "[dashboardLayout] idx" idx
log2 "[dashboardLayout] new chart" c
onChange $ fromMaybe charts (A.modifyAt idx (\_ -> c) charts)
onRemove _ = onChange $ fromMaybe charts $ A.deleteAt idx charts
type PredefinedChartProps =
(
corpusId :: NodeID
, chart :: P.PredefinedChart
, defaultListId :: Int
, onChange :: P.PredefinedChart -> Effect Unit
, onRemove :: Unit -> Effect Unit
, session :: Session
)
renderChart :: Record PredefinedChartProps -> R.Element
renderChart props = R.createElement renderChartCpt props []
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = R.hooksComponent "G.C.N.C.D.renderChart" cpt
where
cpt { chart, corpusId, defaultListId, onChange, onRemove, session } _ = do
pure $ H.div { className: "row" } [
H.div {} [
R2.select { defaultValue: show chart
, on: { change: onSelectChange }
} (option <$> P.allPredefinedCharts)
]
, H.div {} [
H.span { className: "btn btn-danger"
, on: { click: onRemoveClick }} [ H.span { className: "fa fa-trash" } [] ]
]
, P.render chart params
]
where where
path = { corpusId option pc =
, limit: Just 1000 -- TODO Fix H.option { value: show pc } [ H.text $ show pc ]
, listId: defaultListId -- TODO Is this correct? onSelectChange e = onChange $ P.readChart' value
, tabType: TabCorpus (TabNgramType $ modeTabType Terms) where
} value = R2.unsafeEventValue e
onRemoveClick _ = onRemove unit
aSchool school = H.div {className: "col-md-4 content"} [ chart $ focus school ] params = { corpusId
schools = [ "Télécom Bretagne", "Mines Nantes", "Eurecom" ] , limit: Just 1000
myData = , listId: Just defaultListId
[seriesBarD1 {name: "Bar Data"} , session
[ dataSerie {name: "val1", value: 50.0} }
, dataSerie {name: "val2", value: 70.0}
, dataSerie {name: "val3", value: 80.0} ] ] -- aSchool school = H.div {className: "col-md-4 content"} [ chart $ focus school ]
focus :: String -> Options -- schools = [ "Télécom Bretagne", "Mines Nantes", "Eurecom" ]
focus school = -- myData =
Options -- [seriesBarD1 {name: "Bar Data"}
{ mainTitle : "Focus " <> school -- [ dataSerie {name: "val1", value: 50.0}
, subTitle : "Total scientific publications" -- , dataSerie {name: "val2", value: 70.0}
, xAxis : xAxis' ["2015", "2016", "2017"] -- , dataSerie {name: "val3", value: 80.0} ] ]
, yAxis : yAxis' { position: "left", show: false, min : 0 } -- focus :: String -> Options
, series : myData -- focus school =
, addZoom : false -- Options
, tooltip : tooltipTriggerAxis } -- Necessary? -- { mainTitle : "Focus " <> school
-- , subTitle : "Total scientific publications"
-- , xAxis : xAxis' ["2015", "2016", "2017"]
-- , yAxis : yAxis' { position: "left", show: false, min : 0 }
-- , series : myData
-- , addZoom : false
-- , tooltip : tooltipTriggerAxis } -- Necessary?
----------------------------------------------------------------------------------------------------------- -----------------------------------------------------------------------------------------------------------
......
...@@ -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 }
...@@ -16,6 +16,7 @@ import Prim.Row (class Union) ...@@ -16,6 +16,7 @@ import Prim.Row (class Union)
import URI.Query (Query) import URI.Query (Query)
newtype SessionId = SessionId String newtype SessionId = SessionId String
type NodeID = Int
derive instance genericSessionId :: Generic SessionId _ derive instance genericSessionId :: Generic SessionId _
...@@ -207,7 +208,7 @@ fldr FolderPrivate true = "fa fa-lock" ...@@ -207,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"
...@@ -216,7 +217,7 @@ fldr FolderPublic false = "fa fa-globe" ...@@ -216,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