Skip to content

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

Merge branch 'dev' into dev-css

parents 0f07fe61 83a1f2c7
Hide whitespace changes
Inline Side-by-side
Showing with 1587 additions and 918 deletions
dist/styles/sass.css
View file @ b142da83
......@@ -533,7 +533,9 @@ li .leaf:hover a.settings {
}
.code-editor-heading {
display: flex;
/* .buttons-right */
/* display: flex */
/* justify-content: flex-end */
}
.code-editor-heading .renameable {
flex-grow: 2;
......@@ -541,20 +543,7 @@ li .leaf:hover a.settings {
.code-editor-heading .renameable .text {
padding-right: 10px;
}
.code-editor-heading .buttons-right {
display: flex;
justify-content: flex-end;
}
.code-editor .toolbar {
display: flex;
justify-content: flex-start;
width: 100%;
}
.code-editor .editor {
display: flex;
width: 100%;
}
.code-editor .editor .code-area {
flex-grow: 1;
max-height: 200px;
......@@ -785,4 +774,49 @@ ul li {
width: 85%;
}
.annotation-run {
cursor: pointer;
}
.annotation-run.candidate-term.graph-term.stop-term {
color: #000;
background-image: linear-gradient(rgba(184, 184, 184, 0.34), rgba(184, 184, 184, 0.34)), linear-gradient(rgba(149, 210, 149, 0.33), rgba(149, 210, 149, 0.33)), linear-gradient(rgba(245, 148, 153, 0.33), rgba(245, 148, 153, 0.33));
}
.annotation-run.candidate-term.graph-term {
color: #000;
background-image: linear-gradient(rgba(184, 184, 184, 0.5), rgba(184, 184, 184, 0.5)), linear-gradient(rgba(149, 210, 149, 0.5), rgba(149, 210, 149, 0.5));
}
.annotation-run.candidate-term.stop-term {
color: #000;
background-image: linear-gradient(rgba(184, 184, 184, 0.5), rgba(184, 184, 184, 0.5)), linear-gradient(rgba(245, 148, 153, 0.5), rgba(245, 148, 153, 0.5));
}
.annotation-run.graph-term.stop-term {
color: #000;
background-image: linear-gradient(rgba(149, 210, 149, 0.5), rgba(149, 210, 149, 0.5)), linear-gradient(rgba(245, 148, 153, 0.5), rgba(245, 148, 153, 0.5));
}
.annotation-run.candidate-term {
color: #000;
background-color: #B8B8B876;
}
.annotation-run.graph-term {
color: #000;
background-color: #95D29593;
}
.annotation-run.stop-term {
color: #000;
background-color: #F5949931;
}
.context-menu .candidate-term {
color: #000;
background-color: #B8B8B876;
}
.context-menu .graph-term {
color: #000;
background-color: #95D29593;
}
.context-menu .stop-term {
color: #000;
background-color: #F5949931;
}
/*# sourceMappingURL=sass.css.map */
dist/styles/sass.css.map
View file @ b142da83
{"version":3,"sourceRoot":"","sources":["../../src/sass/_menu.sass","../../src/sass/_context_menu.sass","../../src/sass/_graph.sass","../../src/sass/_login.sass","../../src/sass/_tree.sass","../../src/sass/_code_editor.sass","../../src/sass/_styles.sass","../../src/sass/_range_slider.sass"],"names":[],"mappings":"AAAA;AAEA;AACA;AACA;AACA;AACA;AAEA;EACI;EACA;;;AAEJ;EACI;EACA;EACA;EACA;;;AAEJ;EACE;;;AAEF;AACI;EACA;;;AAEJ;AACI;EACA;;;AAGJ;AACA;EACI;;;AAEJ;EACI;EACA;EACA;EACA;;;AAEJ;EACE;EACA;;;AAEF;EACE;;;AC7CF;EACE;EACA;EACA;EACA;EACA;;;AAEF;EACE;;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;;;AAEF;EACE;EACA;EACA;;;AAEF;EACE;;;AClBF;EACE;EACA;EACA;;;AAEF;AAkCE;AACA;AACA;AACA;AACA;AACA;AACA;AACA;;AAxCA;EAZA;EACA;EAEA;EAWE;EACA;EACA;EACA;;AAEA;EACE;EACA;;AAEF;EACE;EACA;;AAGA;EACE;EACA;;AACN;EACE;;AACF;EACE;;AAEF;EApCA;EACA;EAEA;EAmCE;EACA;;AACF;EACE;;AACF;EACE;;AAWF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;AAEJ;EACE;;AAEA;EACE;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;EACA;;;ACpFJ;EACE;;;AAOF;EACE;;AACA;EACE;EACA;;;AAEJ;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAGF;EACE;;AAEE;EACE;EACA;;AACA;EACE;;;AAIJ;EACE;EACA;EACA;EACA;;;AAKJ;EACE;EACA;EACA;;;AAGJ;EACE;EACA;EACA;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACA;EACE;EACA;EACA;EACA;;AACA;EACE;;AACF;EACE;EACA;EACA;EACA;;AACA;EACE;;AACN;EACE;EACA;EACA;EACA;;;AAGN;EACE;EACA;EACA;EACA;EACA;;AAGE;EACE;;;AAEN;EACE;EACA;EACA;EACA;EACA;;AAGE;EACE;;;AAEN;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;EACA;EACA;;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;;AACA;EACE;EACA;;;AAGF;EACE;;;AAEJ;EACI;EACA;;;AAGF;EACE;;;AAEJ;EACE;;;AAEF;EACE;EACA;;;AAEF;EACE;EACA;EACA;;;AAEF;EACE;EACA;;;AAEF;EACE;;;ACvKF;EACE;;;AAGA;EACE;EACA;EACA;;AAEA;EACE;EACA;;AAEF;EACE;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;;AAER;EACE;;AAEE;EACE;;AACA;EACE;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;EACA;EACA;;AACF;EACE;;AACF;EACE;EACA;EACA;EAEA;EACA;EACA;;AAEA;EACE;;AACF;EACE;;AAGN;EACE;;AACF;EACE;;AACA;EACE;EACA;;AAEE;EACE;EACA;;AACF;EACE;EACA;;AAIR;EACE;;AACF;EACE;;AACA;EACE;EACA;;AAEE;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAEV;EACE;;AACF;EACE;;AAEE;EACE;;AACF;EACE;;AACN;EACE;;AAEE;EACE;;;AAGR;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EAEE;EACA;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;;AAEF;EACE;;;AAIF;EACE;;AAEA;EACE;;;AAGN;EACE;;AACF;EACE;;AACF;EACE;;;AC7IJ;EACE;;AAEA;EACE;;AACA;EACE;;AACJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;;AACF;EACE;EACA;;AACA;EACE;EACA;EACA;EACA;;AACA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EArDR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AA2DM;EACE;EACA;EACA;EACA;EACA;EA7DR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAmEE;EACE;EACA;EACA;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAGE;EACE;;AAEF;EACE;;;ACtGV;EACE;;AACF;EACE;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;;AAGE;EACE;EACA;;AAEF;EACE;EACA;;;AAEV;EACE;;AACA;EACE;EACA;EACA;;;AAIA;EACE;;AACA;EACE;EACA;;AACF;EACE;;AACA;EACE;;AACJ;EACE;;;AAER;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAEF;AAGI;EACE;;AACF;EACE;;;AAEN;EACE;EACA;EACA;;;AAIA;EACE;;AACF;EACE;;;ACtEJ;EACE;AACA;EACA;;AAEA;EACE;EACA;;AAEA;EACE;EACA;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EAEA;EAEA;EAEA;;AAEA;EACE;EAEA;EACA;EACA;;;AAGN;EACE","file":"sass.css"}
\ No newline at end of file
{"version":3,"sourceRoot":"","sources":["../../src/sass/_menu.sass","../../src/sass/_context_menu.sass","../../src/sass/_graph.sass","../../src/sass/_login.sass","../../src/sass/_tree.sass","../../src/sass/_code_editor.sass","../../src/sass/_styles.sass","../../src/sass/_range_slider.sass","../../src/sass/_annotation.sass"],"names":[],"mappings":"AAAA;AAEA;AACA;AACA;AACA;AACA;AAEA;EACI;EACA;;;AAEJ;EACI;EACA;EACA;EACA;;;AAEJ;EACE;;;AAEF;AACI;EACA;;;AAEJ;AACI;EACA;;;AAGJ;AACA;EACI;;;AAEJ;EACI;EACA;EACA;EACA;;;AAEJ;EACE;EACA;;;AAEF;EACE;;;AC7CF;EACE;EACA;EACA;EACA;EACA;;;AAEF;EACE;;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;;;AAEF;EACE;EACA;EACA;;;AAEF;EACE;;;AClBF;EACE;EACA;EACA;;;AAEF;AAkCE;AACA;AACA;AACA;AACA;AACA;AACA;AACA;;AAxCA;EAZA;EACA;EAEA;EAWE;EACA;EACA;EACA;;AAEA;EACE;EACA;;AAEF;EACE;EACA;;AAGA;EACE;EACA;;AACN;EACE;;AACF;EACE;;AAEF;EApCA;EACA;EAEA;EAmCE;EACA;;AACF;EACE;;AACF;EACE;;AAWF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;AAEJ;EACE;;AAEA;EACE;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;EACA;;;ACpFJ;EACE;;;AAOF;EACE;;AACA;EACE;EACA;;;AAEJ;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAGF;EACE;;AAEE;EACE;EACA;;AACA;EACE;;;AAIJ;EACE;EACA;EACA;EACA;;;AAKJ;EACE;EACA;EACA;;;AAGJ;EACE;EACA;EACA;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACA;EACE;EACA;EACA;EACA;;AACA;EACE;;AACF;EACE;EACA;EACA;EACA;;AACA;EACE;;AACN;EACE;EACA;EACA;EACA;;;AAGN;EACE;EACA;EACA;EACA;EACA;;AAGE;EACE;;;AAEN;EACE;EACA;EACA;EACA;EACA;;AAGE;EACE;;;AAEN;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;EACA;EACA;;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;;AACA;EACE;EACA;;;AAGF;EACE;;;AAEJ;EACI;EACA;;;AAGF;EACE;;;AAEJ;EACE;;;AAEF;EACE;EACA;;;AAEF;EACE;EACA;EACA;;;AAEF;EACE;EACA;;;AAEF;EACE;;;ACvKF;EACE;;;AAGA;EACE;EACA;EACA;;AAEA;EACE;EACA;;AAEF;EACE;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;;AAER;EACE;;AAEE;EACE;;AACA;EACE;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;EACA;EACA;;AACF;EACE;;AACF;EACE;EACA;EACA;EAEA;EACA;EACA;;AAEA;EACE;;AACF;EACE;;AAGN;EACE;;AACF;EACE;;AACA;EACE;EACA;;AAEE;EACE;EACA;;AACF;EACE;EACA;;AAIR;EACE;;AACF;EACE;;AACA;EACE;EACA;;AAEE;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAEV;EACE;;AACF;EACE;;AAEE;EACE;;AACF;EACE;;AACN;EACE;;AAEE;EACE;;;AAGR;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EAEE;EACA;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;;AAEF;EACE;;;AAIF;EACE;;AAEA;EACE;;;AAGN;EACE;;AACF;EACE;;AACF;EACE;;;AC7IJ;AAKE;AACA;AACA;;AANA;EACE;;AACA;EACE;;;AAOF;EACE;EACA;EACA;EACA;;AACA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EA7CR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAmDM;EACE;EACA;EACA;EACA;EACA;EArDR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AA2DE;EACE;EACA;EACA;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAGE;EACE;;AAEF;EACE;;;AC9FV;EACE;;AACF;EACE;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;;AAGE;EACE;EACA;;AAEF;EACE;EACA;;;AAEV;EACE;;AACA;EACE;EACA;EACA;;;AAIA;EACE;;AACA;EACE;EACA;;AACF;EACE;;AACA;EACE;;AACJ;EACE;;;AAER;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAEF;AAGI;EACE;;AACF;EACE;;;AAEN;EACE;EACA;EACA;;;AAIA;EACE;;AACF;EACE;;;ACtEJ;EACE;AACA;EACA;;AAEA;EACE;EACA;;AAEA;EACE;EACA;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EAEA;EAEA;EAEA;;AAEA;EACE;EAEA;EACA;EACA;;;AAGN;EACE;;;ACzBJ;EACE;;AAEA;EANE;EACA;;AAQF;EAbE;EACA;;AAeF;EAhBE;EACA;;AAkBF;EAnBE;EACA;;AAqBF;EA1BE;EACA,kBALyB;;AAiC3B;EA7BE;EACA,kBANqB;;AAqCvB;EAhCE;EACA,kBAJoB;;;AAuCtB;EApCE;EACA,kBALyB;;AA2C3B;EAvCE;EACA,kBANqB;;AA+CvB;EA1CE;EACA,kBAJoB","file":"sass.css"}
\ No newline at end of file
package.json
View file @ b142da83
{
"name": "Gargantext",
"version": "0.0.2.6",
"version": "0.0.2.7",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @ b142da83
......@@ -23,7 +23,7 @@ import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.Annotation.Utils ( termBootstrapClass, termClass )
import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.Annotation.Menu ( annotationMenu, MenuType(..) )
import Gargantext.Utils.Selection as Sel
......@@ -131,6 +131,7 @@ annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
elt =
case list of
Nothing -> HTML.span { on: { mouseUp: cb } }
Just l -> HTML.span { className: "annotation-run bg-" <> termBootstrapClass l
Just l -> HTML.span { -- className: "annotation-run bg-" <> termBootstrapClass l
className: "annotation-run " <> termClass l
, on: { click: cb }
}
src/Gargantext/Components/App.purs
View file @ b142da83
......@@ -13,7 +13,8 @@ import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Login (login)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout)
import Gargantext.Components.Nodes.Annuaire.User (userLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contact (contactLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentMainLayout)
......@@ -101,17 +102,6 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
Annuaire sid nodeId -> withSession sid $ \session -> forested [
annuaireLayout { frontends, nodeId, session }
]
ContactPage sid aId nodeId -> withSession sid $ \session -> forested [
annuaireUserLayout {
annuaireId: aId
, appReload
, asyncTasksRef
, frontends
, nodeId
, session
, treeReloadRef
}
]
Corpus sid nodeId -> withSession sid $ \session -> forested [
corpusLayout { nodeId, session }
]
......@@ -119,7 +109,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
documentMainLayout { listId, mCorpusId: Just corpusId, nodeId, session } []
]
Dashboard sid nodeId -> withSession sid $ \session -> forested [
dashboardLayout { nodeId, session }
dashboardLayout { nodeId, session } []
]
Document sid listId nodeId ->
withSession sid $
......@@ -204,6 +194,8 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, sessionUpdate
}
} []
----------------------------------------------------------------------------------------
-- | TODO refact UserPage and ContactPage
UserPage sid nodeId -> withSession sid $ \session -> forested [
userLayout {
appReload
......@@ -214,3 +206,17 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, treeReloadRef
}
]
ContactPage sid aId nodeId -> withSession sid $ \session -> forested [
contactLayout {
annuaireId: aId
, appReload
, asyncTasksRef
, frontends
, nodeId
, session
, treeReloadRef
}
]
src/Gargantext/Components/CodeEditor.purs
View file @ b142da83
......@@ -24,6 +24,7 @@ import Gargantext.Prelude
import Gargantext.Utils.HighlightJS as HLJS
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.CodeEditor"
type Code = String
......@@ -117,25 +118,24 @@ codeEditorCpt = R.hooksComponentWithModule thisModule "codeEditor" cpt
setCodeOverlay controls code'
renderHtml code' controls
pure $ H.div { className: "code-editor" } [
toolbar {controls, onChange}
, H.div { className: "row error" } [
errorComponent {error: controls.error}
]
, H.div { className: "row editor" } [
H.div { className: "code-area " <> (codeHidden $ fst controls.viewType) } [
H.div { className: "code-container" } [
H.textarea { defaultValue: code
, on: { change: onEditChange controls onChange }
, placeholder: "Type some code..."
, ref: controls.codeElRef } [ ]
, H.pre { className: (langClass $ fst controls.codeType)
-- , contentEditable: "true"
, ref: controls.codeOverlayElRef
, rows: 30
--, on: { input: onEditChange (fst codeType) codeElRef htmlRef codeRef error }
} []
]
pure $ H.div { className: "code-editor" }
[ toolbar {controls, onChange}
, H.div { className: "row error" }
[ errorComponent {error: controls.error} ]
, H.div { className: "row editor" }
[ H.div { className: "code-area " <> (codeHidden $ fst controls.viewType) }
[ H.div { className: "code-container" }
[ H.textarea { defaultValue: code
, on: { change: onEditChange controls onChange }
, placeholder: "Type some code..."
, ref: controls.codeElRef } [ ]
, H.pre { className: (langClass $ fst controls.codeType)
-- , contentEditable: "true"
, ref: controls.codeOverlayElRef
, rows: 30
--, on: { input: onEditChange (fst codeType) codeElRef htmlRef codeRef error }
} []
]
]
, H.div { className: "v-divider " <> (dividerHidden $ fst controls.viewType) } [ H.text " " ]
, H.div { className: "html " <> (langClass $ fst controls.codeType) <> (previewHidden $ fst controls.viewType)
......@@ -208,13 +208,16 @@ toolbarCpt = R.hooksComponentWithModule thisModule "toolbar" cpt
where
cpt props@{controls: {codeType, error, viewType}} _ = do
pure $
H.div { className: "row toolbar" } [
codeTypeSelector {
codeType
, onChange: onChangeCodeType props
}
, viewTypeSelector {state: viewType}
]
H.div { className: "row toolbar" }
[ H.div { className: "col-2" }
[ codeTypeSelector {
codeType
, onChange: onChangeCodeType props
}
]
, H.div { className: "col-1" }
[ viewTypeSelector {state: viewType} ]
]
-- Handle rerendering of preview when viewType changed
onChangeCodeType :: forall e. Record ToolbarProps -> e -> Effect Unit
......
src/Gargantext/Components/FacetsTable.purs
View file @ b142da83
......@@ -13,6 +13,7 @@ import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.String (Pattern(..), split)
import Data.String as String
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
......@@ -59,6 +60,7 @@ type Deletions = { pending :: Set Int
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
----------------------------------------------------------------------
newtype Pair =
Pair { id :: Int
, label :: String
......@@ -69,6 +71,7 @@ derive instance genericPair :: Generic Pair _
instance showPair :: Show Pair where
show = genericShow
----------------------------------------------------------------------
newtype DocumentsView =
DocumentsView
{ id :: Int
......@@ -85,15 +88,32 @@ newtype DocumentsView =
, publication_day :: Int
}
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
(zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) <> "-" <> (zeroPad 2 publication_day)
derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where
show = genericShow
----------------------------------------------------------------------
newtype ContactsView =
ContactsView
{ id :: Int
, hyperdata :: HyperdataRowContact
, score :: Int
, annuaireId :: Int
, delete :: Boolean
}
derive instance genericContactsView :: Generic ContactsView _
instance showContactsView :: Show ContactsView where
show = genericShow
----------------------------------------------------------------------
data Rows = Docs { docs :: Seq DocumentsView }
| Contacts { contacts :: Seq ContactsView }
----------------------------------------------------------------------
-- | Main layout of the Documents Tab of a Corpus
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []
......@@ -163,7 +183,7 @@ docViewGraphCpt = R.hooksComponentWithModule thisModule "docViewGraph" cpt
path <- R.useState' $ initialPagePath { nodeId, listId, query, session }
pure $ R.fragment
[ H.br {}
, H.p {} [ H.text "" ]
, H.p {} [ H.text "" ]
, H.br {}
, H.div { className: "container-fluid" }
[ R2.row
......@@ -190,7 +210,7 @@ type PagePath = { nodeId :: Int
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
loadPage :: PagePath -> Aff (Seq DocumentsView)
loadPage :: PagePath -> Aff Rows
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
let
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
......@@ -206,21 +226,21 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc
--SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
SearchResult {result} <- post session p query
-- $ SearchQuery {query: concat query, expected: SearchDoc}
pure case result of
SearchResultDoc {docs} -> doc2view <$> Seq.fromFoldable docs
SearchResultContact {contacts} -> contact2view <$> Seq.fromFoldable contacts
errMessage -> pure $ err2view errMessage
pure $ case result of
SearchResultDoc {docs} -> Docs {docs: doc2view <$> Seq.fromFoldable docs}
SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
errMessage -> Docs {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
doc2view :: Document -> DocumentsView
doc2view ( Document { id
, created: date
, hyperdata: HyperdataRowDocument { authors
, title
, source
, publication_year
, publication_month
, publication_day
}
, title
, source
, publication_year
, publication_month
, publication_day
}
, category
, score
}
......@@ -238,36 +258,27 @@ doc2view ( Document { id
, publication_day : fromMaybe 1 publication_day
}
contact2view :: Contact -> DocumentsView
contact2view :: Contact -> ContactsView
contact2view (Contact { c_id
, c_created: date
, c_hyperdata: HyperdataRowContact { firstname
, lastname
, labs
}
, c_hyperdata
, c_annuaireId
, c_score
}
) = DocumentsView { id: c_id
, date
, title : firstname <> lastname
, source: labs
, score: c_score
, authors: labs
, category: decodeCategory 1
, pairs: []
, delete: false
, publication_year: 2020
, publication_month: 10
, publication_day: 1
}
) = ContactsView { id: c_id
, hyperdata: c_hyperdata
, score: c_score
, annuaireId : c_annuaireId
, delete: false
}
err2view message =
DocumentsView { id: 1
, date: "2020-01-01"
, date: ""
, title : "SearchNoResult"
, source: "Source"
, source: ""
, score: 1
, authors: "Authors"
, authors: ""
, category: decodeCategory 1
, pairs: []
, delete: false
......@@ -276,9 +287,6 @@ err2view message =
, publication_day: 1
}
type PageLayoutProps =
( frontends :: Frontends
, totalRecords :: Int
......@@ -288,7 +296,7 @@ type PageLayoutProps =
, path :: R.State PagePath
)
type PageProps = ( documents :: Seq DocumentsView | PageLayoutProps )
type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
-- | Loads and renders a page
pageLayout :: Record PageLayoutProps -> R.Element
......@@ -298,8 +306,8 @@ pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt
where
cpt {frontends, totalRecords, deletions, container, session, path} _ = do
useLoader (fst path) loadPage $ \documents ->
page {frontends, totalRecords, deletions, container, session, path, documents}
useLoader (fst path) loadPage $ \rowsLoaded ->
page {frontends, totalRecords, deletions, container, session, path, rowsLoaded}
page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []
......@@ -307,7 +315,7 @@ page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps
pageCpt = R.hooksComponentWithModule thisModule "page" cpt
where
cpt {frontends, totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
cpt {frontends, totalRecords, container, deletions, rowsLoaded, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
pure $ T.table { syncResetButton : [ H.div {} [] ]
, rows, container, colNames
, totalRecords, params, wrapColElts
......@@ -315,44 +323,75 @@ pageCpt = R.hooksComponentWithModule thisModule "page" cpt
where
setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
params = (fst path).params /\ setParams
colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ]
colNames = case rowsLoaded of
Docs _ -> T.ColumnName <$> [ "", "Date", "Title", "Journal", "", "" ]
Contacts _ -> T.ColumnName <$> [ "", "Contact", "Organization", "", "", "" ]
wrapColElts = const identity
-- TODO: how to interprete other scores?
gi Favorite = "fa fa-star-empty"
gi Trash = "fa fa-star-empty"
gi _ = "fa fa-star"
isChecked id = Set.member id (fst deletions).pending
isDeleted (DocumentsView {id}) = Set.member id (fst deletions).deleted
pairUrl (Pair {id,label})
| id > 1 = H.a { href, target: "blank" } [ H.text label ]
where href = url session $ NodePath (sessionId session) NodeContact (Just id)
| otherwise = H.text label
documentUrl id =
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
comma = H.span {} [ H.text ", " ]
rows = row <$> Seq.filter (not <<< isDeleted) documents
row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
rows = case rowsLoaded of
Docs {docs} -> docRow <$> Seq.filter (not <<< isDeleted) docs
Contacts {contacts} -> contactRow <$> contacts
contactRow (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs}
, score, annuaireId, delete
}) =
{ row:
T.makeRow [
H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
-- TODO show date: Year-Month-Day only
, maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
, maybeStricken delete [ H.text source ]
, maybeStricken delete [ H.text authors ]
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
, H.input { defaultChecked: isChecked id
, on: { click: toggleClick }
, type: "checkbox"
}
]
T.makeRow [ H.div {} [ H.a { className: gi Favorite, on: {click: markClick} } [] ]
, maybeStricken delete [ H.a {target: "_blank", href: contactUrl annuaireId id}
[ H.text $ firstname <> " " <> lastname ]
]
, maybeStricken delete [ H.text labs ]
]
, delete: true
}
where
markClick _ = markCategory session nodeId Favorite [id]
contactUrl aId id = url frontends $ Routes.ContactPage (sessionId session) annuaireId id
docRow dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
{ row:
T.makeRow [ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
, maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
, maybeStricken delete [ H.text source ]
-- , maybeStricken delete [ H.text authors ]
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
{-, H.input { defaultChecked: isChecked id
, on: { click: toggleClick }
, type: "checkbox"
}
-}
]
, delete: true }
where
markClick _ = markCategory session nodeId category [id]
toggleClick _ = togglePendingDeletion deletions id
-- comma = H.span {} [ H.text ", " ]
maybeStricken delete
| delete = H.div { style: { textDecoration: "line-through" } }
| delete = H.div { style: { textDecoration: "line-through" } }
| otherwise = H.div {}
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
(zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month)
-- <> "-" <> (zeroPad 2 publication_day)
---------------------------------------------------------
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
......
src/Gargantext/Components/Forest.purs
View file @ b142da83
......@@ -38,10 +38,10 @@ type Props = (
forest :: R2.Component Props
forest = R.createElement forestCpt
where
forestCpt :: R.Component Props
forestCpt = R.hooksComponentWithModule thisModule "forest" cpt
forestCpt :: R.Component Props
forestCpt = R.hooksComponentWithModule thisModule "forest" cpt
where
cpt { appReload
, asyncTasksRef
, backend
......@@ -124,10 +124,10 @@ type ForestLayoutProps = (
forestLayout :: R2.Component ForestLayoutProps
forestLayout props = R.createElement forestLayoutCpt props
where
forestLayoutCpt :: R.Component ForestLayoutProps
forestLayoutCpt = R.hooksComponentWithModule thisModule "forestLayout" cpt
forestLayoutCpt :: R.Component ForestLayoutProps
forestLayoutCpt = R.hooksComponentWithModule thisModule "forestLayout" cpt
where
cpt props@{ handed } children = do
pure $ R.fragment [ topBar { handed } [], forestLayoutMain props children ]
......@@ -135,10 +135,10 @@ forestLayout props = R.createElement forestLayoutCpt props
-- while the remaining ones are put into the main view
forestLayoutWithTopBar :: R2.Component ForestLayoutProps
forestLayoutWithTopBar props = R.createElement forestLayoutWithTopBarCpt props
where
forestLayoutWithTopBarCpt :: R.Component ForestLayoutProps
forestLayoutWithTopBarCpt = R.hooksComponentWithModule thisModule "forestLayoutWithTopBar" cpt
forestLayoutWithTopBarCpt :: R.Component ForestLayoutProps
forestLayoutWithTopBarCpt = R.hooksComponentWithModule thisModule "forestLayoutWithTopBar" cpt
where
cpt props@{ handed } children = do
let { head: topBarChild, tail: mainChildren } =
fromMaybe { head: H.div {} [], tail: [] } $ A.uncons children
......@@ -149,10 +149,10 @@ forestLayoutWithTopBar props = R.createElement forestLayoutWithTopBarCpt props
forestLayoutMain :: R2.Component ForestLayoutProps
forestLayoutMain props = R.createElement forestLayoutMainCpt props
where
forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
where
cpt props children = do
pure $ forestLayoutRaw props [
mainPage {} children
......@@ -160,10 +160,10 @@ forestLayoutMain props = R.createElement forestLayoutMainCpt props
forestLayoutRaw :: R2.Component ForestLayoutProps
forestLayoutRaw props = R.createElement forestLayoutRawCpt props
where
forestLayoutRawCpt :: R.Component ForestLayoutProps
forestLayoutRawCpt = R.hooksComponentWithModule thisModule "forestLayoutRaw" cpt
forestLayoutRawCpt :: R.Component ForestLayoutProps
forestLayoutRawCpt = R.hooksComponentWithModule thisModule "forestLayoutRaw" cpt
where
cpt { appReload
, asyncTasksRef
, backend
......@@ -194,10 +194,10 @@ forestLayoutRaw props = R.createElement forestLayoutRawCpt props
mainPage :: R2.Component ()
mainPage = R.createElement mainPageCpt
where
mainPageCpt :: R.Component ()
mainPageCpt = R.hooksComponentWithModule thisModule "mainPage" cpt
mainPageCpt :: R.Component ()
mainPageCpt = R.hooksComponentWithModule thisModule "mainPage" cpt
where
cpt {} children = do
pure $ H.div {className: "col-md-10"} [
H.div {id: "page-wrapper"} [
......
src/Gargantext/Components/Forest/Tree.purs
View file @ b142da83
......@@ -63,11 +63,11 @@ type Props = (
)
treeView :: R2.Component Props
treeView = R.createElement elCpt
where
elCpt :: R.Component Props
elCpt = R.hooksComponentWithModule thisModule "treeView" cpt
treeView = R.createElement treeViewCpt
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponentWithModule thisModule "treeView" cpt
where
cpt { appReload
, asyncTasks
, currentRoute
......@@ -90,11 +90,11 @@ treeView = R.createElement elCpt
} []
treeLoadView :: R2.Component Props
treeLoadView = R.createElement elCpt
where
elCpt :: R.Component Props
elCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
treeLoadView = R.createElement treeLoadViewCpt
treeLoadViewCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
where
cpt { appReload
, asyncTasks
, currentRoute
......@@ -135,11 +135,11 @@ type TreeViewProps = (
)
loadedTreeViewFirstLevel :: R2.Component TreeViewProps
loadedTreeViewFirstLevel = R.createElement elCpt
where
elCpt :: R.Component TreeViewProps
elCpt = R.hooksComponentWithModule thisModule "loadedTreeViewFirstLevel" cpt
loadedTreeViewFirstLevel = R.createElement loadedTreeViewFirstLevelCpt
loadedTreeViewFirstLevelCpt :: R.Component TreeViewProps
loadedTreeViewFirstLevelCpt = R.hooksComponentWithModule thisModule "loadedTreeViewFirstLevel" cpt
where
cpt { appReload
, asyncTasks
, currentRoute
......@@ -153,54 +153,64 @@ loadedTreeViewFirstLevel = R.createElement elCpt
} _ = do
pure $ H.ul { className: "tree " <> if handed == GT.RightHanded then "mr-auto" else "ml-auto" } [
H.div { className: if handed == GT.RightHanded then "righthanded" else "lefthanded" } [
toHtmlFirstLevel { appReload
, asyncTasks
, currentRoute
, frontends
, handed
, openNodes
, reload
, reloadTree: reload
, session
-- , tasks
, tree
} []
toHtmlFirstLevel (ToHtmlProps { appReload
, asyncTasks
, currentRoute
, frontends
, handed
, openNodes
, reload
, reloadTree: reload
, render: toHtmlFirstLevel
, session
-- , tasks
, tree
}) []
]
]
------------------------------------------------------------------------
type ToHtmlProps = (
newtype ToHtmlProps = ToHtmlProps {
asyncTasks :: GAT.Reductor
, reloadTree :: GUR.ReloadS
, render :: ToHtmlProps -> Array R.Element -> R.Element
-- , tasks :: Record Tasks
, tree :: FTree
| CommonProps
)
-- | CommonProps
, appReload :: GUR.ReloadS
, currentRoute :: AppRoute
, frontends :: Frontends
, handed :: GT.Handed
, openNodes :: R.State OpenNodes
, reload :: GUR.ReloadS
, session :: Session
}
toHtmlFirstLevel :: R2.Component ToHtmlProps
toHtmlFirstLevel = R.createElement elCpt
toHtmlFirstLevel :: ToHtmlProps -> Array R.Element -> R.Element
toHtmlFirstLevel = R2.ntCreateElement toHtmlFirstLevelCpt
toHtmlFirstLevelCpt :: R2.NTComponent ToHtmlProps
toHtmlFirstLevelCpt = R2.ntHooksComponentWithModule thisModule "toHtmlFirstLevel" cpt
where
elCpt :: R.Component ToHtmlProps
elCpt = R.hooksComponentWithModule thisModule "toHtmlFirstLevel" cpt
cpt p@{ appReload
, asyncTasks
, currentRoute
, frontends
, handed
, openNodes
, reload
, reloadTree
, session
, tree: tree@(NTree (LNode { id
, name
, nodeType
}
) ary
)
} _ = do
cpt (ToHtmlProps p@{ appReload
, asyncTasks
, currentRoute
, frontends
, handed
, openNodes
, reload
, reloadTree
, render
, session
, tree: tree@(NTree (LNode { id
, name
, nodeType
}
) ary
)
}) _ = do
setPopoverRef <- R.useRef Nothing
let pAction a = performAction a (RecordE.pick (Record.merge p { setPopoverRef }) :: Record PerformActionProps)
......@@ -250,6 +260,7 @@ toHtmlFirstLevel = R.createElement elCpt
, handed
, id: cId
, reloadTree
, render
}
) []
) $ sorted publicizedChildren
......@@ -264,15 +275,19 @@ type ChildNodeFirstLevelProps = (
, folderOpen :: R.State Boolean
, id :: ID
, reloadTree :: GUR.ReloadS
, render :: ToHtmlProps -> Array R.Element -> R.Element
| CommonProps
)
childNodeFirstLevel :: R2.Component ChildNodeFirstLevelProps
childNodeFirstLevel = R.createElement elCpt
where
elCpt :: R.Component ChildNodeFirstLevelProps
elCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevel" cpt
childNodeFirstLevel = R.createElement childNodeFirstLevelCpt
-- TODO This shouldn't be here: make it a top-level function but be careful
-- about cyclic defines
-- https://discourse.purescript.org/t/strange-compiler-error-with-an-undefined-reference/2060/3
childNodeFirstLevelCpt :: R.Component ChildNodeFirstLevelProps
childNodeFirstLevelCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevel" cpt
where
cpt props@{ appReload
, asyncTasks
, currentRoute
......@@ -283,6 +298,7 @@ childNodeFirstLevel = R.createElement elCpt
, openNodes
, reload
, reloadTree
, render
, session } _ = do
cptReload <- GUR.new
......@@ -296,6 +312,7 @@ childNodeFirstLevel = R.createElement elCpt
, openNodes
, reload: cptReload
, reloadTree
, render
, session
, tree: loaded } []
......@@ -308,28 +325,33 @@ type ChildNodeFirstLevelPaintProps = (
asyncTasks :: GAT.Reductor
, folderOpen :: R.State Boolean
, reloadTree :: GUR.ReloadS
, render :: ToHtmlProps -> Array R.Element -> R.Element
, tree :: FTree
| CommonProps
)
childNodeFirstLevelPaint :: R2.Component ChildNodeFirstLevelPaintProps
childNodeFirstLevelPaint = R.createElement elCpt
childNodeFirstLevelPaint = R.createElement childNodeFirstLevelPaintCpt
-- TODO This shouldn't be here: make it a top-level function but be careful
-- about cyclic defines
-- https://discourse.purescript.org/t/strange-compiler-error-with-an-undefined-reference/2060/3
childNodeFirstLevelPaintCpt :: R.Component ChildNodeFirstLevelPaintProps
childNodeFirstLevelPaintCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevelPaint" cpt
-- TODO folderOpen is unused
where
elCpt :: R.Component ChildNodeFirstLevelPaintProps
elCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevelPaint" cpt
-- TODO folderOpen is unused
cpt props@{ asyncTasks
, handed
, reload
, reloadTree
, render
, tree: ctree@(NTree (LNode { id }) _) } _ = do
pure $ H.ul {} [
toHtmlFirstLevel (Record.merge commonProps { asyncTasks
, handed
, reloadTree
, tree: ctree }
render (ToHtmlProps (Record.merge commonProps { asyncTasks
, handed
, reloadTree
, render
, tree: ctree })
) []
]
-- pure $ H.div { } [ H.text $ "[closed] Node id " <> show id ]
......
src/Gargantext/Components/Forest/Tree/Node.purs
View file @ b142da83
......@@ -60,19 +60,19 @@ type IsLeaf = Boolean
nodeSpan :: R2.Component NodeMainSpanProps
nodeSpan = R.createElement nodeSpanCpt
where
nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = R.hooksComponentWithModule thisModule "nodeSpan" cpt
nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = R.hooksComponentWithModule thisModule "nodeSpan" cpt
where
cpt props children = do
pure $ H.div {} ([ nodeMainSpan props [] ] <> children)
nodeMainSpan :: R2.Component NodeMainSpanProps
nodeMainSpan = R.createElement nodeMainSpanCpt
where
nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
where
cpt props@{ appReload
, asyncTasks: (asyncTasks /\ dispatchAsyncTasks)
, currentRoute
......@@ -249,10 +249,10 @@ type NodeActionsProps =
nodeActions :: Record NodeActionsProps -> R.Element
nodeActions p = R.createElement nodeActionsCpt p []
where
nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponentWithModule thisModule "nodeActions" cpt
nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponentWithModule thisModule "nodeActions" cpt
where
cpt { id
, nodeType: GT.Graph
, session
......
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ b142da83
......@@ -86,7 +86,6 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
onEnter: \_ -> launchAff_ $ dispatch (AddNode name' nt')
, onValueChanged: \val -> setNodeName $ const val
, autoFocus: true
, autoSave: false
, className: "form-control"
, defaultValue: name'
, placeholder: name'
......
src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs
View file @ b142da83
......@@ -55,8 +55,8 @@ linkNodeType (Just GT.Annuaire) = GT.Corpus
linkNodeType _ = GT.Error
linkNode :: Record SubTreeParamsIn -> R.Element
linkNode p = R.createElement linkNodeCpt p []
linkNode :: R2.Component SubTreeParamsIn
linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = R.hooksComponentWithModule thisModule "linkNode" cpt
......
src/Gargantext/Components/Forest/Tree/Node/Action/Merge.purs
View file @ b142da83
......@@ -22,12 +22,12 @@ mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
mergeNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("merge/" <> show toId)
mergeNode :: Record SubTreeParamsIn -> R.Element
mergeNode p = R.createElement mergeNodeCpt p []
where
mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = R.hooksComponentWithModule thisModule "mergeNode" cpt
mergeNode :: R2.Component SubTreeParamsIn
mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = R.hooksComponentWithModule thisModule "mergeNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
action@(valAction /\ setAction) :: R.State Action <- R.useState' (MergeNode {params:Nothing})
......
src/Gargantext/Components/Forest/Tree/Node/Action/Move.purs
View file @ b142da83
......@@ -14,6 +14,7 @@ import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTre
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Forest.Tree.Node.Action.Move"
......@@ -22,12 +23,12 @@ moveNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
moveNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("move/" <> show toId)
moveNode :: Record SubTreeParamsIn -> R.Element
moveNode p = R.createElement moveNodeCpt p []
where
moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = R.hooksComponentWithModule thisModule "moveNode" cpt
moveNode :: R2.Component SubTreeParamsIn
moveNode = R.createElement moveNodeCpt
moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = R.hooksComponentWithModule thisModule "moveNode" cpt
where
cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do
action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params: Nothing})
......
src/Gargantext/Components/Forest/Tree/Node/Action/Search/Frame.purs
View file @ b142da83
......@@ -41,10 +41,10 @@ type SearchIFramesProps = (
searchIframes :: Record SearchIFramesProps -> R.Element
searchIframes props = R.createElement searchIframesCpt props []
where
searchIframesCpt :: R.Component SearchIFramesProps
searchIframesCpt = R.hooksComponentWithModule thisModule "searchIframes" cpt
searchIframesCpt :: R.Component SearchIFramesProps
searchIframesCpt = R.hooksComponentWithModule thisModule "searchIframes" cpt
where
cpt { iframeRef, search: search@(search' /\ _) } _ = do
pure $ if isIsTex_Advanced search'.datafield
then divIframe { frameSource: Istex, iframeRef, search }
......@@ -62,10 +62,10 @@ type IFrameProps = (
divIframe :: Record IFrameProps -> R.Element
divIframe props = R.createElement divIframeCpt props []
where
divIframeCpt :: R.Component IFrameProps
divIframeCpt = R.hooksComponentWithModule thisModule "divIframe" cpt
divIframeCpt :: R.Component IFrameProps
divIframeCpt = R.hooksComponentWithModule thisModule "divIframe" cpt
where
cpt { frameSource, iframeRef, search: search@(search' /\ _) } _ = do
pure $ H.div { className: "frame-search card" }
[ iframeWith { frameSource, iframeRef, search } ]
......@@ -77,10 +77,10 @@ frameUrl Searx = "https://searx.frame.gargantext.org" -- 192.168.1.4:8080"
iframeWith :: Record IFrameProps -> R.Element
iframeWith props = R.createElement iframeWithCpt props []
where
iframeWithCpt :: R.Component IFrameProps
iframeWithCpt = R.hooksComponentWithModule thisModule "iframeWith" cpt
iframeWithCpt :: R.Component IFrameProps
iframeWithCpt = R.hooksComponentWithModule thisModule "iframeWith" cpt
where
cpt { frameSource, iframeRef, search: (search /\ setSearch) } _ =
pure $ H.iframe { src: src frameSource search.term
, width: "100%"
......
src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchBar.purs
View file @ b142da83
......@@ -26,10 +26,10 @@ type Props = ( langs :: Array Lang
searchBar :: Record Props -> R.Element
searchBar props = R.createElement searchBarCpt props []
where
searchBarCpt :: R.Component Props
searchBarCpt = R.hooksComponentWithModule thisModule "searchBar" cpt
searchBarCpt :: R.Component Props
searchBarCpt = R.hooksComponentWithModule thisModule "searchBar" cpt
where
cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
--onSearchChange session s
pure $ H.div { className: "search-bar" }
......
src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchField.purs
View file @ b142da83
......@@ -266,10 +266,10 @@ type DatabaseInputProps = (
databaseInput :: R2.Component DatabaseInputProps
databaseInput = R.createElement databaseInputCpt
where
databaseInputCpt :: R.Component DatabaseInputProps
databaseInputCpt = R.hooksComponentWithModule thisModule "databaseInput" cpt
databaseInputCpt :: R.Component DatabaseInputProps
databaseInputCpt = R.hooksComponentWithModule thisModule "databaseInput" cpt
where
cpt { databases
, search: (search /\ setSearch) } _ = do
pure $
......@@ -338,10 +338,10 @@ type SearchInputProps =
searchInput :: Record SearchInputProps -> R.Element
searchInput p = R.createElement searchInputCpt p []
where
searchInputCpt :: R.Component SearchInputProps
searchInputCpt = R.hooksComponentWithModule thisModule "searchInput" cpt
searchInputCpt :: R.Component SearchInputProps
searchInputCpt = R.hooksComponentWithModule thisModule "searchInput" cpt
where
cpt {search: (search@{ term } /\ setSearch)} _ = do
valueRef <- R.useRef term
......@@ -349,7 +349,6 @@ searchInput p = R.createElement searchInputCpt p []
inputWithEnter { onEnter: onEnter valueRef setSearch
, onValueChanged: onValueChanged valueRef
, autoFocus: false
, autoSave: true
, className: "form-control"
, defaultValue: R.readRef valueRef
, placeholder: "Your query here"
......@@ -380,10 +379,10 @@ type SubmitButtonProps =
submitButton :: Record SubmitButtonProps -> R.Element
submitButton p = R.createElement submitButtonComponent p []
where
submitButtonComponent :: R.Component SubmitButtonProps
submitButtonComponent = R.hooksComponentWithModule thisModule "submitButton" cpt
submitButtonComponent :: R.Component SubmitButtonProps
submitButtonComponent = R.hooksComponentWithModule thisModule "submitButton" cpt
where
cpt {onSearch, search: (mySearch /\ _), session} _ =
pure $
H.button { className: "btn btn-primary"
......
src/Gargantext/Components/Forest/Tree/Node/Action/Share.purs
View file @ b142da83
......@@ -57,10 +57,10 @@ instance encodeJsonShareNodeParams :: Argonaut.EncodeJson ShareNodeParams where
------------------------------------------------------------------------
shareNode :: Record SubTreeParamsIn -> R.Element
shareNode p = R.createElement shareNodeCpt p []
where
shareNodeCpt :: R.Component SubTreeParamsIn
shareNodeCpt = R.hooksComponentWithModule thisModule "shareNode" cpt
shareNodeCpt :: R.Component SubTreeParamsIn
shareNodeCpt = R.hooksComponentWithModule thisModule "shareNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
action@(valAction /\ setAction) :: R.State Action <- R.useState' (Action.SharePublic {params: Nothing})
......
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @ b142da83
......@@ -71,10 +71,10 @@ type UploadFile =
uploadFileView :: Record Props -> R.Element
uploadFileView props = R.createElement uploadFileViewCpt props []
where
uploadFileViewCpt :: R.Component Props
uploadFileViewCpt = R.hooksComponentWithModule thisModule "uploadFileView" cpt
uploadFileViewCpt :: R.Component Props
uploadFileViewCpt = R.hooksComponentWithModule thisModule "uploadFileView" cpt
where
cpt {dispatch, id, nodeType} _ = do
mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
fileType@(_ /\ setFileType) <- R.useState' CSV
......
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ b142da83
......@@ -48,10 +48,10 @@ type CommonProps =
nodePopupView :: Record NodePopupProps -> R.Element
nodePopupView p = R.createElement nodePopupCpt p []
where
nodePopupCpt :: R.Component NodePopupProps
nodePopupCpt = R.hooksComponentWithModule thisModule "nodePopupView" cpt
nodePopupCpt :: R.Component NodePopupProps
nodePopupCpt = R.hooksComponentWithModule thisModule "nodePopupView" cpt
where
cpt p _ = do
renameIsOpen <- R.useState' false
......@@ -254,10 +254,10 @@ type PanelActionProps =
panelAction :: Record PanelActionProps -> R.Element
panelAction p = R.createElement panelActionCpt p []
where
panelActionCpt :: R.Component PanelActionProps
panelActionCpt = R.hooksComponentWithModule thisModule "panelAction" cpt
panelActionCpt :: R.Component PanelActionProps
panelActionCpt = R.hooksComponentWithModule thisModule "panelAction" cpt
where
cpt {action: Documentation nodeType} _ = actionDoc nodeType
cpt {action: Download, id, nodeType, session} _ = actionDownload nodeType id session
cpt {action: Upload, dispatch, id, nodeType, session} _ = actionUpload nodeType id session dispatch
......@@ -274,13 +274,13 @@ panelAction p = R.createElement panelActionCpt p []
-----------
-- Functions using SubTree
cpt {action: Merge {subTreeParams}, dispatch, id, nodeType, session, handed} _ = do
pure $ mergeNode {dispatch, id, nodeType, session, subTreeParams, handed}
pure $ mergeNode {dispatch, id, nodeType, session, subTreeParams, handed} []
cpt {action: Move {subTreeParams}, dispatch, id, nodeType, session, handed} _ = do
pure $ moveNode {dispatch, id, nodeType, session, subTreeParams, handed}
pure $ moveNode {dispatch, id, nodeType, session, subTreeParams, handed} []
cpt {action: Link {subTreeParams}, dispatch, id, nodeType, session, handed} _ = do
pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed}
pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed} []
-----------
cpt {action : Share, dispatch, id, name } _ = do
......
src/Gargantext/Components/Forest/Tree/Node/Settings.purs
View file @ b142da83
......@@ -130,7 +130,7 @@ settingsBox Team =
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
, NodeFrameNotebook
-- , NodeFrameNotebook
, Team
, FolderShared
]
......
src/Gargantext/Components/Forest/Tree/Node/Tools.purs
View file @ b142da83
......@@ -65,12 +65,12 @@ type TextInputBoxProps =
)
textInputBox :: R2.Component TextInputBoxProps
textInputBox props@{ boxName } = R.createElement el props
where
el :: R.Component TextInputBoxProps
el = R.hooksComponentWithModule thisModule (boxName <> "Box") cpt
textInputBox = R.createElement textInputBoxCpt
cpt p@{ boxAction, dispatch, id, isOpen: (true /\ setIsOpen), text } _ = do
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = R.hooksComponentWithModule thisModule "textInputBox" cpt
where
cpt p@{ boxAction, boxName, dispatch, id, isOpen: (true /\ setIsOpen), text } _ = do
renameNodeNameRef <- R.useRef text
pure $ H.div { className: "from-group row" }
......@@ -85,7 +85,6 @@ textInputBox props@{ boxName } = R.createElement el props
onEnter: submit renameNodeNameRef
, onValueChanged: R.setRef renameNodeNameRef
, autoFocus: true
, autoSave: false
, className: "form-control"
, defaultValue: text
, placeholder: (boxName <> " Node")
......@@ -105,8 +104,8 @@ textInputBox props@{ boxName } = R.createElement el props
, title: "Cancel"
} []
submit renameNodeNameRef _ = do
setIsOpen $ const false
launchAff_ $ dispatch ( boxAction $ R.readRef renameNodeNameRef )
setIsOpen $ const false
cpt { isOpen: (false /\ _) } _ = pure $ H.div {} []
-- | END Rename Box
......@@ -292,10 +291,10 @@ type NodeLinkProps = (
nodeLink :: R2.Component NodeLinkProps
nodeLink = R.createElement nodeLinkCpt
where
nodeLinkCpt :: R.Component NodeLinkProps
nodeLinkCpt = R.hooksComponentWithModule thisModule "nodeLink" cpt
nodeLinkCpt :: R.Component NodeLinkProps
nodeLinkCpt = R.hooksComponentWithModule thisModule "nodeLink" cpt
where
cpt { folderOpen: (_ /\ setFolderOpen)
, frontends
, handed
......@@ -348,10 +347,10 @@ type NodeTextProps =
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement nodeTextCpt p []
where
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = R.hooksComponentWithModule thisModule "nodeText" cpt
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = R.hooksComponentWithModule thisModule "nodeText" cpt
where
cpt { isSelected: true, name } _ = do
pure $ H.u {} [
H.b {} [
......
src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree.purs
View file @ b142da83
......@@ -36,10 +36,10 @@ type SubTreeParamsProps =
subTreeView :: Record SubTreeParamsProps -> R.Element
subTreeView props = R.createElement subTreeViewCpt props []
where
subTreeViewCpt :: R.Component SubTreeParamsProps
subTreeViewCpt = R.hooksComponentWithModule thisModule "subTreeView" cpt
subTreeViewCpt :: R.Component SubTreeParamsProps
subTreeViewCpt = R.hooksComponentWithModule thisModule "subTreeView" cpt
where
cpt params@{ action
, dispatch
, handed
......
src/Gargantext/Components/Forest/Tree/Node/Tools/Sync.purs
View file @ b142da83
......@@ -110,7 +110,7 @@ nodeListUpdateButtonCpt = R.hooksComponentWithModule thisModule "nodeListUpdateB
cpt { listId, nodeId, nodeType, session, triggerRefresh } _ = do
enabled <- R.useState' true
pure $ H.div { className: "update-button "
pure $ H.div {} [] {- { className: "update-button "
<> if (fst enabled) then "enabled" else "disabled text-muted"
} [ H.span { className: "fa fa-refresh"
, on: { click: onClick enabled } } []
......@@ -124,3 +124,4 @@ nodeListUpdateButtonCpt = R.hooksComponentWithModule thisModule "nodeListUpdateB
liftEffect $ setEnabled $ const true
triggerRefresh unit
pure unit
-}
src/Gargantext/Components/Graph.purs
View file @ b142da83
......@@ -225,60 +225,60 @@ type SigmaSettings =
-- selected nodes <=> special label
sigmaSettings :: {|SigmaSettings}
sigmaSettings =
{ animationsTime: 30000.0
, autoRescale: true
, autoResize: true
, batchEdgesDrawing: true
, borderSize: 1.0 -- for ex, bigger border when hover
, defaultEdgeHoverColor: "#f00"
, defaultEdgeType: "curve" -- 'curve' or 'line' (curve iff ourRendering)
, defaultHoverLabelBGColor: "#fff"
, defaultHoverLabelColor: "#000"
, defaultLabelColor: "#000" -- labels text color
, defaultLabelSize: 15.0 -- (old tina: showLabelsIfZoom)
, defaultNodeBorderColor : "#000" -- <- if nodeBorderColor = 'default'
, defaultNodeColor: "#FFF"
, doubleClickEnabled: false -- indicates whether or not the graph can be zoomed on double-click
, drawEdgeLabels: true
, drawEdges: true
, drawLabels: true
, drawNodes: true
, enableEdgeHovering: false
, edgeHoverExtremities: true
, edgeHoverColor: "edge"
, edgeHoverPrecision: 2.0
, edgeHoverSizeRatio: 2.0
, enableHovering: true
, font: "arial" -- font params
, fontStyle: "bold"
, hideEdgesOnMove: true
--, labelSize : "proportional" -- alt : proportional, fixed
, labelSize: "fixed"
, labelSizeRatio: 2.0 -- label size in ratio of node size
, labelThreshold: 7.0 -- min node cam size to start showing label
, maxEdgeSize: 1.0
, maxNodeSize: 8.0
, minEdgeSize: 0.5 -- in fact used in tina as edge size
, minNodeSize: 1.0
, mouseEnabled: true
, mouseSelectorSize: 15.0
, mouseZoomDuration: 150.0
, nodeBorderColor: "default" -- choices: "default" color vs. "node" color
--, nodesPowRatio : 10.8
, rescaleIgnoreSize : false
, singleHover : true
, touchEnabled : true
, twBorderGreyColor : "rgba(100, 100, 100, 0.9)"
, twEdgeDefaultOpacity : 0.4 -- initial opacity added to src/tgt colors
, twEdgeGreyColor : "rgba(100, 100, 100, 0.25)"
, twNodeRendBorderColor : "#FFF"
, twNodeRendBorderSize : 2.5 -- node borders (only iff ourRendering)
, twNodesGreyOpacity : 5.5 -- smaller value: more grey
, twSelectedColor : "node" -- "node" for a label bg like the node color, "default" for white background
, verbose : true
, zoomMax: 1.7
, zoomMin: 0.0
, zoomingRatio: 1.7
{ animationsTime : 30000.0
, autoRescale : true
, autoResize : true
, batchEdgesDrawing : true
, borderSize : 1.0 -- for ex, bigger border when hover
, defaultEdgeHoverColor : "#f00"
, defaultEdgeType : "curve" -- 'curve' or 'line' (curve iff ourRendering)
, defaultHoverLabelBGColor : "#fff"
, defaultHoverLabelColor : "#000"
, defaultLabelColor : "#000" -- labels text color
, defaultLabelSize : 15.0 -- (old tina: showLabelsIfZoom)
, defaultNodeBorderColor : "#000" -- <- if nodeBorderColor = 'default'
, defaultNodeColor : "#FFF"
, doubleClickEnabled : false -- indicates whether or not the graph can be zoomed on double-click
, drawEdgeLabels : true
, drawEdges : true
, drawLabels : true
, drawNodes : true
, enableEdgeHovering : false
, edgeHoverExtremities : true
, edgeHoverColor : "edge"
, edgeHoverPrecision : 2.0
, edgeHoverSizeRatio : 2.0
, enableHovering : true
, font : "arial"
, fontStyle : ""
, hideEdgesOnMove : true
, labelSize : "proportional" -- alt : proportional, fixed
-- , labelSize : "fixed"
, labelSizeRatio : 2.0 -- label size in ratio of node size
, labelThreshold : 9.0 -- 5.0 for more labels -- min node cam size to start showing label
, maxEdgeSize : 1.0
, maxNodeSize : 10.0
, minEdgeSize : 0.5 -- in fact used in tina as edge size
, minNodeSize : 1.0
, mouseEnabled : true
, mouseSelectorSize : 15.0
, mouseZoomDuration : 150.0
, nodeBorderColor : "default" -- choices: "default" color vs. "node" color
--, nodesPowRatio : 10.8
, rescaleIgnoreSize : false
, singleHover : true
, touchEnabled : true
, twBorderGreyColor : "rgba(100, 100, 100, 0.9)"
, twEdgeDefaultOpacity : 0.4 -- initial opacity added to src/tgt colors
, twEdgeGreyColor : "rgba(100, 100, 100, 0.25)"
, twNodeRendBorderColor : "#FFF"
, twNodeRendBorderSize : 2.5 -- node borders (only iff ourRendering)
, twNodesGreyOpacity : 5.5 -- smaller value: more grey
, twSelectedColor : "node" -- "node" for a label bg like the node color, "default" for white background
, verbose : true
, zoomMax : 1.7
, zoomMin : 0.0
, zoomingRatio : 1.4
}
type ForceAtlas2Settings =
......@@ -306,11 +306,11 @@ forceAtlas2Settings =
, barnesHutOptimize : true
, edgeWeightInfluence : 1.0
-- fixedY : false
, gravity : 1.0
, iterationsPerRender : 10.0
, gravity : 0.01
, iterationsPerRender : 50.0 -- 10.0
, linLogMode : false -- false
, outboundAttractionDistribution: false
, scalingRatio : 10.0
, scalingRatio : 1000.0
, skipHidden: false
, slowDown : 1.0
, startingIterations : 10.0
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ b142da83
......@@ -54,10 +54,10 @@ type Props =
sidebar :: Record Props -> R.Element
sidebar props = R.createElement sidebarCpt props []
where
sidebarCpt :: R.Component Props
sidebarCpt = R.hooksComponentWithModule thisModule "sidebar" cpt
sidebarCpt :: R.Component Props
sidebarCpt = R.hooksComponentWithModule thisModule "sidebar" cpt
where
cpt {showSidePanel: (GET.Closed /\ _)} _children = do
pure $ RH.div {} []
cpt {showSidePanel: (GET.InitialClosed /\ _)} _children = do
......@@ -70,7 +70,7 @@ sidebar props = R.createElement sidebarCpt props []
sideTabNav :: R.State SidePanelState -> Array SideTab -> R.Element
sideTabNav (sidePanel /\ setSidePanel) sideTabs =
R.fragment [ H.div { className: "text-primary center"} [H.text "SideTab"]
R.fragment [ H.div { className: "text-primary center"} [H.text ""]
, H.div {className: "nav nav-tabs"} (liItem <$> sideTabs)
-- , H.div {className: "center"} [ H.text "Doc sideTabs"]
]
......@@ -133,36 +133,46 @@ sideTab _ _ = H.div {} []
-------------------------------------------
-- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
selectedNodes props nodesMap = R2.row [ R2.col 12
[ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"}
[ RH.div { className: "tab-content" }
[ RH.div { className: "", role: "tabpanel" }
( Seq.toUnfoldable
$ ( Seq.map (badge props.selectedNodeIds)
(badges props.graph props.selectedNodeIds)
)
)
]
, RH.div { className: "tab-content flex-space-between" }
[ removeButton "Move as candidate" CandidateTerm props nodesMap
, removeButton "Move as stop" StopTerm props nodesMap
]
]
]
]
selectedNodes props nodesMap =
R2.row [ R2.col 12
[ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
, id: "myTab"
, role: "tablist" }
[ RH.div { className: "tab-content" }
[ RH.div { className: "d-flex flex-wrap justify-content-center"
, role: "tabpanel" }
( Seq.toUnfoldable
$ ( Seq.map (badge props.selectedNodeIds)
(badges props.graph props.selectedNodeIds)
)
)
, H.br {}
]
]
, RH.div { className: "tab-content flex-space-between" }
[ removeButton "primary" "Move as candidate" CandidateTerm props nodesMap
, H.br {}
, removeButton "danger" "Move as stop" StopTerm props nodesMap
]
]
]
neighborhood props = RH.div { className: "tab-content", id: "myTabContent" }
[ RH.div { className: "", id: "home", role: "tabpanel" }
[ RH.div { -- className: "flex-space-around d-flex justify-content-center"
className: "d-flex flex-wrap flex-space-around"
, id: "home"
, role: "tabpanel"
}
(Seq.toUnfoldable $ Seq.map (badge props.selectedNodeIds)
$ neighbourBadges props.graph props.selectedNodeIds
)
]
removeButton text rType props' nodesMap' =
removeButton btnType text rType props' nodesMap' =
if Set.isEmpty $ fst props'.selectedNodeIds then
RH.div {} []
else
RH.button { className: "btn btn-info"
RH.button { className: "btn btn-sm btn-" <> btnType
, on: { click: onClickRemove rType props' nodesMap' }
}
[ RH.text text ]
......@@ -183,9 +193,9 @@ onClickRemove rType props' nodesMap' e = do
badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} =
RH.a { className: "badge badge-light"
RH.a { className: "badge badge-pill badge-light"
, on: { click: onClick }
} [ RH.text label ]
} [ RH.h6 {} [ RH.text label ] ]
where
onClick e = do
setNodeIds $ const $ Set.singleton id
......@@ -200,11 +210,11 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected
type DeleteNodes =
( graphId :: Int
, metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node)
, session :: Session
, termList :: TermList
( graphId :: Int
, metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node)
, session :: Session
, termList :: TermList
, treeReload :: GUR.ReloadS
)
......@@ -332,6 +342,3 @@ Global/local view:
To explore the neighborhood of a selection click on the 'change level' button.
-}
src/Gargantext/Components/GraphExplorer/SlideButton.purs
View file @ b142da83
......@@ -51,7 +51,7 @@ labelSizeButton sigmaRef state =
sizeButton {
state
, caption: "Label Size"
, min: 5.0
, min: 1.0
, max: 30.0
, onChange: \e -> do
let sigma = R.readRef sigmaRef
......@@ -61,7 +61,8 @@ labelSizeButton sigmaRef state =
Sigma.setSettings s {
defaultLabelSize: newValue
, drawLabels: true
, labelSizeRatio: newValue / 2.5
, maxNodeSize: newValue / 2.5
--, labelSizeRatio: newValue / 2.5
}
setValue $ const newValue
}
......
src/Gargantext/Components/InputWithEnter.purs
View file @ b142da83
module Gargantext.Components.InputWithEnter where
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -9,6 +7,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.InputWithEnter"
type Props a = (
......@@ -16,7 +15,6 @@ type Props a = (
, onValueChanged :: String -> Effect Unit
, autoFocus :: Boolean
, autoSave :: Boolean
, className :: String
, defaultValue :: String
, placeholder :: String
......@@ -25,14 +23,13 @@ type Props a = (
inputWithEnter :: forall a. Record (Props a) -> R.Element
inputWithEnter props = R.createElement inputWithEnterCpt props []
where
inputWithEnterCpt :: forall a. R.Component (Props a)
inputWithEnterCpt = R.hooksComponentWithModule thisModule "inputWithEnter" cpt
inputWithEnterCpt :: forall a. R.Component (Props a)
inputWithEnterCpt = R.hooksComponentWithModule thisModule "inputWithEnter" cpt
where
cpt props@{ onEnter, onValueChanged
, autoFocus, autoSave, className, defaultValue, placeholder } _ = do
pure $ H.input { on: { blur: \_ -> if autoSave then onEnter unit else pure unit
, input: onInput
, autoFocus, className, defaultValue, placeholder } _ = do
pure $ H.input { on: { input: onInput
, keyPress: onKeyPress }
, autoFocus
, className
......@@ -41,8 +38,7 @@ inputWithEnter props = R.createElement inputWithEnterCpt props []
, type: props.type }
where
onInput e = do
onValueChanged $ R.unsafeEventValue e
onInput e = onValueChanged $ R.unsafeEventValue e
onKeyPress e = do
char <- R2.keyCode e
......
src/Gargantext/Components/NgramsTable.purs
View file @ b142da83
......@@ -274,10 +274,9 @@ type Props = (
loadedNgramsTable :: R2.Component Props
loadedNgramsTable = R.createElement loadedNgramsTableCpt
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" cpt
where
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" cpt
cpt props@{ afterSync
, appReload
, asyncTasksRef
......@@ -524,10 +523,9 @@ type MainNgramsTableProps = (
mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
where
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
cpt props@{ afterSync
, appReload
, asyncTasksRef
......@@ -631,10 +629,10 @@ type MainNgramsTablePaintProps = (
mainNgramsTablePaint :: R2.Component MainNgramsTablePaintProps
mainNgramsTablePaint = R.createElement mainNgramsTablePaintCpt
where
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt
where
cpt props@{ afterSync
, appReload
, asyncTasksRef
......@@ -670,10 +668,10 @@ type MainNgramsTablePaintNoCacheProps = (
mainNgramsTablePaintNoCache :: R2.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCache = R.createElement mainNgramsTablePaintNoCacheCpt
where
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaintNoCache" cpt
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaintNoCache" cpt
where
cpt props@{ afterSync
, appReload
, asyncTasksRef
......
src/Gargantext/Components/NgramsTable/Core.purs
View file @ b142da83
......@@ -1129,10 +1129,10 @@ type SyncResetButtonsProps =
syncResetButtons :: Record SyncResetButtonsProps -> R.Element
syncResetButtons p = R.createElement syncResetButtonsCpt p []
where
syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = R.hooksComponentWithModule thisModule "syncResetButtons" cpt
syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = R.hooksComponentWithModule thisModule "syncResetButtons" cpt
where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do
synchronizing@(s /\ setSynchronizing) <- R.useState' false
......
src/Gargantext/Components/Nodes/Annuaire.purs
View file @ b142da83
......@@ -104,8 +104,7 @@ annuaireCpt = R.hooksComponentWithModule thisModule "annuaire" cpt
, title: name
, user: "" }
, H.p {} []
, H.div {className: "col-md-3"}
[ H.text " Filter ", H.input { className: "form-control", style } ]
-- , H.div {className: "col-md-3"} [ H.text " Filter ", H.input { className: "form-control", style } ]
, H.br {}
, pageLayout { info, session, pagePath, frontends} ]
where
......@@ -164,7 +163,7 @@ pageCpt = R.hooksComponentWithModule thisModule "page" cpt
, session }
, delete: false }) <$> Seq.fromFoldable docs
container = T.defaultContainer { title: "Annuaire" } -- TODO
colNames = T.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Lab", "Role"]
colNames = T.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Role"]
wrapColElts = const identity
setParams f = snd pagePath $ \pp@{params: ps} ->
pp {params = f ps}
......@@ -199,26 +198,27 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
]
cpt { annuaireId
, contact: (CT.NodeContact { id
, hyperdata: ( CT.HyperdataContact { who : Just (CT.ContactWho { firstName
, lastName
}
)
}
)
}
, hyperdata: ( CT.HyperdataContact
{ who : Just (CT.ContactWho { firstName
, lastName
}
)
, ou : ou
}
)
}
)
, frontends
, session } _ = do
pure $ T.makeRow [
H.text ""
, H.text $ fromMaybe "First Name" firstName
, H.a { target: "_blank", href: contactUrl annuaireId id} [H.text $ fromMaybe "First Name" firstName]
, H.text $ fromMaybe "First Name" lastName
, H.text "CNRS"
-- , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
--, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
--, H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou)
-- , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
, H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou)
, H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
-- , H.div {className: "nooverflow"} [
-- H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
]
......@@ -226,6 +226,7 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
--nodepath = NodePath (sessionId session) NodeContact (Just id)
nodepath = Routes.ContactPage (sessionId session) annuaireId id
href = url frontends nodepath
contactUrl aId id = url frontends $ Routes.ContactPage (sessionId session) annuaireId id
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) =
......
src/Gargantext/Components/Nodes/Annuaire/Tabs.purs 0 → 100644
View file @ b142da83
-- TODO copy of Gargantext.Components.Nodes.Corpus.Tabs.Specs
module Gargantext.Components.Nodes.Annuaire.User.Tabs where
import Prelude hiding (div)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Components.Nodes.Lists.Types as LTypes
import Gargantext.Components.Nodes.Texts.Types as TTypes
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), NodeID, PTabNgramType(..), TabType(..), TabSubType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs"
data Mode = Patents | Books | Communication
derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
show = genericShow
derive instance eqMode :: Eq Mode
modeTabType :: Mode -> PTabNgramType
modeTabType Patents = PTabPatents
modeTabType Books = PTabBooks
modeTabType Communication = PTabCommunication
-- TODO fix this type
modeTabType' :: Mode -> CTabNgramType
modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type TabsProps = (
appReload :: GUR.ReloadS
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, cacheState :: R.State LTypes.CacheState
, contactData :: ContactData
, frontends :: Frontends
, nodeId :: Int
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, treeReloadRef :: GUR.ReloadWithInitializeRef
)
tabs :: Record TabsProps -> R.Element
tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where
cpt { appReload
, asyncTasksRef
, cacheState
, contactData: {defaultListId}
, frontends
, nodeId
, session
, sidePanelTriggers
, treeReloadRef } _ = do
active <- R.useState' 0
textsSidePanelTriggers <- TTypes.emptySidePanelTriggers
pure $ Tab.tabs { selected: fst active, tabs: tabs' textsSidePanelTriggers }
where
tabs' trg =
[ "Documents" /\ docs trg
, "Patents" /\ ngramsView patentsView []
, "Books" /\ ngramsView booksView []
, "Communication" /\ ngramsView commView []
, "Trash" /\ docs trg -- TODO pass-in trash mode
]
where
patentsView = { appReload
, asyncTasksRef
, cacheState
, defaultListId
, mode: Patents
, nodeId
, session
, sidePanelTriggers
, treeReloadRef }
booksView = { appReload
, asyncTasksRef
, cacheState
, defaultListId
, mode: Books
, nodeId
, session
, sidePanelTriggers
, treeReloadRef }
commView = { appReload, asyncTasksRef
, cacheState
, defaultListId
, mode: Communication
, nodeId
, session
, sidePanelTriggers
, treeReloadRef }
chart = mempty
totalRecords = 4736 -- TODO
docs sidePanelTriggers = DT.docViewLayout
{ cacheState
, chart
, frontends
, listId: defaultListId
, mCorpusId: Nothing
, nodeId
, session
, showSearch: true
, sidePanelTriggers
, tabType: TabPairing TabDocs
, totalRecords
}
type NgramsViewTabsProps = (
appReload :: GUR.ReloadS
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, cacheState :: R.State LTypes.CacheState
, defaultListId :: Int
, mode :: Mode
, nodeId :: Int
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, treeReloadRef :: GUR.ReloadWithInitializeRef
)
ngramsView :: R2.Component NgramsViewTabsProps
ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
where
cpt { appReload
, asyncTasksRef
, cacheState
, defaultListId
, mode
, nodeId
, session
, sidePanelTriggers
, treeReloadRef } _ = do
pathS <- R.useState' $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
pure $ NT.mainNgramsTable {
appReload
, afterSync: \_ -> pure unit
, asyncTasksRef
, cacheState
, defaultListId
, nodeId
, pathS
, tabType
, session
, sidePanelTriggers
, tabNgramType
, treeReloadRef
, withAutoUpdate: false
} []
where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs → src/Gargantext/Components/Nodes/Annuaire/User.purs
View file @ b142da83
module Gargantext.Components.Nodes.Annuaire.User.Contacts
module Gargantext.Components.Nodes.Annuaire.User
( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, annuaireUserLayout
, userLayout )
, userLayout
)
where
import DOM.Simple.Console (log2)
......@@ -17,7 +17,7 @@ import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Ends (Frontends)
......@@ -30,7 +30,7 @@ import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts"
thisModule = "Gargantext.Components.Nodes.Annuaire.User"
type DisplayProps = (
title :: String
......@@ -128,7 +128,6 @@ contactInfoItemCpt = R.hooksComponentWithModule thisModule "contactInfoItem" cpt
H.div { className: "input-group col-sm-6" } [
inputWithEnter {
autoFocus: true
, autoSave: false
, className: "form-control"
, defaultValue: R.readRef valueRef
, onEnter: onClick
......@@ -150,8 +149,8 @@ contactInfoItemCpt = R.hooksComponentWithModule thisModule "contactInfoItem" cpt
listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }
type LayoutProps = (
appReload :: GUR.ReloadS
type LayoutProps =
( appReload :: GUR.ReloadS
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, frontends :: Frontends
, nodeId :: Int
......@@ -196,10 +195,11 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey"
sidePanelTriggers <- LT.emptySidePanelTriggers
useLoader {nodeId, reload: GUR.value reload, session} getContactWithReload $
useLoader {nodeId, reload: GUR.value reload, session} getUserWithReload $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" name } (contactInfos hyperdata (onUpdateHyperdata reload))
display { title: fromMaybe "no name" name }
(contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs {
appReload
, asyncTasksRef
......@@ -219,10 +219,10 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey"
_ <- saveContactHyperdata session nodeId hd
liftEffect $ GUR.bump reload
-- | toUrl to get data
-- | toUrl to get data XXX
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
contactNode <- get session $ Routes.NodeAPI Node (Just id) ""
contactNode :: Contact <- get session $ Routes.NodeAPI Node (Just id) ""
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
......@@ -232,59 +232,10 @@ getContact session id = do
-- throwError $ error "Missing default list"
pure {contactNode, defaultListId: 424242}
getContactWithReload :: {nodeId :: Int, reload :: GUR.Reload, session :: Session} -> Aff ContactData
getContactWithReload {nodeId, session} = getContact session nodeId
getUserWithReload :: {nodeId :: Int, reload :: GUR.Reload, session :: Session} -> Aff ContactData
getUserWithReload {nodeId, session} = getContact session nodeId
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff Int
saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
type AnnuaireLayoutProps = (
annuaireId :: Int
| LayoutProps )
annuaireUserLayout :: Record AnnuaireLayoutProps -> R.Element
annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props []
annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps
annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt
where
cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
cacheState <- R.useState' LT.CacheOn
sidePanelTriggers <- LT.emptySidePanelTriggers
useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" name } (contactInfos hyperdata onUpdateHyperdata)
, Tabs.tabs {
appReload
, asyncTasksRef
, cacheState
, contactData
, frontends
, nodeId
, session
, sidePanelTriggers
, treeReloadRef
}
]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata _ = pure unit
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do
contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
-- Just (NodePoly { id: defaultListId }) ->
-- pure {contactNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
pure {contactNode, defaultListId: 424242}
src/Gargantext/Components/Nodes/Annuaire/User/Contact.purs 0 → 100644
View file @ b142da83
module Gargantext.Components.Nodes.Annuaire.User.Contact
( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, contactLayout
)
where
import DOM.Simple.Console (log2)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact'(..), ContactData', ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts"
type DisplayProps = (
title :: String
)
display :: R2.Component DisplayProps
display = R.createElement displayCpt
displayCpt :: R.Component DisplayProps
displayCpt = R.hooksComponentWithModule thisModule "display" cpt
where
cpt { title } children = do
pure $ H.div { className: "container-fluid" }
[ H.div { className: "row", id: "contact-page-header" }
[ H.div { className: "col-md-6"} [ H.h3 {} [ H.text title ] ]
, H.div { className: "col-md-8"} []
, H.div { className: "col-md-2"} [ H.span {} [ H.text "" ] ]
]
, H.div { className: "row", id: "contact-page-info" }
[ H.div { className: "col-md-12" }
[ H.div { className: "row" }
[ H.div { className: "col-md-2" } [ H.img { src: "/images/Gargantextuel-212x300.jpg"} ]
, H.div { className: "col-md-1"} []
, H.div { className: "col-md-8"} children
]]]]
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataContact -> (HyperdataContact -> Effect Unit) -> Array R.Element
contactInfos h onUpdateHyperdata = item <$> contactInfoItems
where
item {label, defaultVal, lens} =
contactInfoItem { hyperdata: h
, label
, lens
, onUpdateHyperdata
, placeholder: defaultVal }
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: HyperdataContactLens}
contactInfoItems =
[ {label: "Last Name" , defaultVal: "Empty Last Name" , lens: _who <<< _lastName }
, {label: "First Name" , defaultVal: "Empty First Name" , lens: _who <<< _firstName }
, {label: "Organisation" , defaultVal: "Empty Organisation" , lens: _ouFirst <<< _organizationJoinComma}
, {label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _ouFirst <<< _labTeamDeptsJoinComma}
, {label: "Office" , defaultVal: "Empty Office" , lens: _ouFirst <<< _office }
, {label: "City" , defaultVal: "Empty City" , lens: _ouFirst <<< _city }
, {label: "Country" , defaultVal: "Empty Country" , lens: _ouFirst <<< _country }
, {label: "Role" , defaultVal: "Empty Role" , lens: _ouFirst <<< _role }
, {label: "Phone" , defaultVal: "Empty Phone" , lens: _ouFirst <<< _touch <<< _phone }
, {label: "Mail" , defaultVal: "Empty Mail" , lens: _ouFirst <<< _touch <<< _mail }
]
type HyperdataContactLens = L.ALens' HyperdataContact String
type ContactInfoItemProps =
( hyperdata :: HyperdataContact
, label :: String
, lens :: HyperdataContactLens
, onUpdateHyperdata :: HyperdataContact -> Effect Unit
, placeholder :: String
)
contactInfoItem :: Record ContactInfoItemProps -> R.Element
contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = R.hooksComponentWithModule thisModule "contactInfoItem" cpt
where
cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do
isEditing <- R.useState' false
let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value
pure $ H.div { className: "form-group row" } [
H.span { className: "col-sm-2 col-form-label" } [ H.text label ]
, item isEditing valueRef
]
where
cLens = L.cloneLens lens
item (false /\ setIsEditing) valueRef =
H.div { className: "input-group col-sm-6" } [
H.input { className: "form-control"
, defaultValue: placeholder
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: onClick } } [
H.div { className: "input-group-text fa fa-pencil" } []
]
]
where
placeholder = R.readRef valueRef
onClick _ = setIsEditing $ const true
item (true /\ setIsEditing) valueRef =
H.div { className: "input-group col-sm-6" } [
inputWithEnter {
autoFocus: true
, className: "form-control"
, defaultValue: R.readRef valueRef
, onEnter: onClick
, onValueChanged: R.setRef valueRef
, placeholder
, type: "text"
}
, H.div { className: "btn input-group-append"
, on: { click: onClick } } [
H.div { className: "input-group-text fa fa-floppy-o" } []
]
]
where
onClick _ = do
setIsEditing $ const false
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataContact
onUpdateHyperdata newHyperdata
listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }
type LayoutProps =
( appReload :: GUR.ReloadS
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, frontends :: Frontends
, nodeId :: Int
, session :: Session
, treeReloadRef :: GUR.ReloadWithInitializeRef
)
type KeyLayoutProps = (
key :: String
| LayoutProps
)
saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff Int
saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
type AnnuaireLayoutProps = ( annuaireId :: Int | LayoutProps )
type AnnuaireKeyLayoutProps = ( key :: String | AnnuaireLayoutProps )
contactLayout :: Record AnnuaireLayoutProps -> R.Element
contactLayout props = R.createElement contactLayoutCpt props []
contactLayoutCpt :: R.Component AnnuaireLayoutProps
contactLayoutCpt = R.hooksComponentWithModule thisModule "contactLayout" cpt
where
cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
let sid = sessionId session
pure $ contactLayoutWithKey { annuaireId,
appReload
, asyncTasksRef
, frontends
, key: show sid <> "-" <> show nodeId
, nodeId
, session
, treeReloadRef
}
contactLayoutWithKey :: Record AnnuaireKeyLayoutProps -> R.Element
contactLayoutWithKey props = R.createElement contactLayoutWithKeyCpt props []
contactLayoutWithKeyCpt :: R.Component AnnuaireKeyLayoutProps
contactLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "contactLayoutWithKey" cpt
where
cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
reload <- GUR.new
cacheState <- R.useState' LT.CacheOn
sidePanelTriggers <- LT.emptySidePanelTriggers
useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact' {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
[ display { title: fromMaybe "no name" name }
(contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs {
appReload
, asyncTasksRef
, cacheState
, contactData
, frontends
, nodeId
, session
, sidePanelTriggers
, treeReloadRef
}
]
where
onUpdateHyperdata :: GUR.ReloadS -> HyperdataContact -> Effect Unit
onUpdateHyperdata reload hd = do
launchAff_ $ do
_ <- saveContactHyperdata session nodeId hd
liftEffect $ GUR.bump reload
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData'
getAnnuaireContact session annuaireId id = do
contactNode :: Contact' <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ show id
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
-- Just (NodePoly { id: defaultListId }) ->
-- pure {contactNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
pure {contactNode, defaultListId: 424242}
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs
View file @ b142da83
......@@ -15,7 +15,7 @@ import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData')
import Gargantext.Components.Nodes.Lists.Types as LTypes
import Gargantext.Components.Nodes.Texts.Types as TTypes
import Gargantext.Ends (Frontends)
......@@ -52,7 +52,7 @@ type TabsProps = (
appReload :: GUR.ReloadS
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, cacheState :: R.State LTypes.CacheState
, contactData :: ContactData
, contactData :: ContactData'
, frontends :: Frontends
, nodeId :: Int
, session :: Session
......@@ -144,10 +144,10 @@ type NgramsViewTabsProps = (
ngramsView :: R2.Component NgramsViewTabsProps
ngramsView = R.createElement ngramsViewCpt
where
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
where
cpt { appReload
, asyncTasksRef
, cacheState
......
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Types.purs
View file @ b142da83
......@@ -23,14 +23,14 @@ newtype NodeContact =
instance decodeNodeContact :: DecodeJson NodeContact where
decodeJson json = do
obj <- decodeJson json
date <- obj .?| "date"
obj <- decodeJson json
date <- obj .?| "date"
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parentId"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parentId"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
pure $ NodeContact { id
, date
......@@ -43,8 +43,43 @@ instance decodeNodeContact :: DecodeJson NodeContact where
derive instance newtypeNodeContact :: Newtype NodeContact _
----------------------------------------------------------------------------
newtype Contact' =
Contact'
{ id :: Int
, date :: Maybe String
, hyperdata :: HyperdataContact
, name :: Maybe String
, parentId :: Maybe Int
, typename :: Maybe Int
, userId :: Maybe Int
}
instance decodeContact' :: DecodeJson Contact' where
decodeJson json = do
obj <- decodeJson json
date <- obj .?| "date"
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parentId"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
pure $ Contact' { id
, date
, hyperdata
, name
, parentId
, typename
, userId
}
-- | TODO rename Contact with User
-- and fix shared decodeJson
newtype Contact =
Contact
{ id :: Int
......@@ -57,17 +92,16 @@ newtype Contact =
}
instance decodeUser :: DecodeJson Contact where
instance decodeContact :: DecodeJson Contact where
decodeJson json = do
obj <- decodeJson json
date <- obj .?| "date"
obj <- decodeJson json
date <- obj .?| "date"
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parentId"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parentId"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
pure $ Contact { id
, date
......@@ -78,7 +112,39 @@ instance decodeUser :: DecodeJson Contact where
, userId
}
derive instance newtypeContact :: Newtype Contact _
----------------------------------------------------------------------------
newtype User =
User
{ id :: Int
, date :: Maybe String
, hyperdata :: HyperdataUser
, name :: Maybe String
, parentId :: Maybe Int
, typename :: Maybe Int
, userId :: Maybe Int
}
instance decodeUser :: DecodeJson User where
decodeJson json = do
obj <- decodeJson json
date <- obj .?| "date"
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parentId"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
pure $ User { id
, date
, hyperdata
, name
, parentId
, typename
, userId
}
newtype ContactWho =
ContactWho
......@@ -130,15 +196,15 @@ newtype ContactWhere =
ContactWhere
{ organization :: (Array String)
, labTeamDepts :: (Array String)
, role :: Maybe String
, office :: Maybe String
, country :: Maybe String
, city :: Maybe String
, touch :: Maybe ContactTouch
, entry :: Maybe String
, exit :: Maybe String }
......@@ -226,15 +292,15 @@ defaultContactTouch =
newtype HyperdataContact =
HyperdataContact { bdd :: Maybe String
HyperdataContact { bdd :: Maybe String
, lastValidation :: Maybe String
, ou :: (Array ContactWhere)
, source :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
, uniqIdBdd :: Maybe String
, who :: Maybe ContactWho
}
, ou :: (Array ContactWhere)
, source :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
, uniqIdBdd :: Maybe String
, who :: Maybe ContactWho
}
derive instance newtypeHyperdataContact :: Newtype HyperdataContact _
instance decodeHyperdataContact :: DecodeJson HyperdataContact
......@@ -321,6 +387,7 @@ defaultHyperdataUser =
-- pure $ HyperData {common, shared, specific}
type ContactData = {contactNode :: Contact, defaultListId :: Int}
type ContactData' = {contactNode :: Contact', defaultListId :: Int}
_shared :: Lens' HyperdataUser HyperdataContact
_shared = lens getter setter
......
src/Gargantext/Components/Nodes/Corpus.purs
View file @ b142da83
......@@ -21,7 +21,8 @@ import Gargantext.Prelude
import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, FTField, Field(..), FieldType(..), Hash, Hyperdata(..), defaultField, defaultHaskell', defaultPython', defaultJSON', defaultMarkdown')
import Gargantext.Components.Nodes.Types
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
......@@ -58,7 +59,6 @@ corpusLayoutCpt = R.hooksComponentWithModule thisModule "corpusLayout" cpt
corpusLayoutWithKey :: Record KeyProps -> R.Element
corpusLayoutWithKey props = R.createElement corpusLayoutWithKeyCpt props []
corpusLayoutWithKeyCpt :: R.Component KeyProps
corpusLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "corpusLayoutWithKey" cpt
where
......@@ -74,12 +74,6 @@ type ViewProps =
| Props
)
-- We need FTFields with indices because it's the only way to identify the
-- FTField element inside a component (there are no UUIDs and such)
type Index = Int
type FTFieldWithIndex = Tuple Index FTField
type FTFieldsWithIndex = List.List FTFieldWithIndex
corpusLayoutView :: Record ViewProps -> R.Element
corpusLayoutView props = R.createElement corpusLayoutViewCpt props []
......@@ -99,24 +93,25 @@ corpusLayoutViewCpt = R.hooksComponentWithModule thisModule "corpusLayoutView" c
R.setRef fieldsRef fields
snd fieldsS $ const fieldsWithIndex
pure $ H.div {} [
H.div { className: "row" } [
H.div { className: "btn btn-secondary " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} }
} [
H.span { className: "fa fa-floppy-o" } [ ]
]
]
, H.div {} [ fieldsCodeEditor { fields: fieldsS
, nodeId
, session } ]
, H.div { className: "row" } [
H.div { className: "btn btn-secondary"
, on: { click: onClickAdd fieldsS }
} [
H.span { className: "fa fa-plus" } [ ]
]
]
pure $ H.div {}
[ H.div { className: "row" }
[ H.div { className: "btn btn-secondary " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} }
}
[ H.span { className: "fa fa-floppy-o" } [ ]
]
]
, H.div {}
[ fieldsCodeEditor { fields: fieldsS
, nodeId
, session } [] ]
, H.div { className: "row" }
[ H.div { className: "btn btn-secondary"
, on: { click: onClickAdd fieldsS }
}
[ H.span { className: "fa fa-plus" } [ ]
]
]
]
saveEnabled :: FTFieldsWithIndex -> R.State FTFieldsWithIndex -> String
......@@ -127,7 +122,6 @@ corpusLayoutViewCpt = R.hooksComponentWithModule thisModule "corpusLayoutView" c
, reload :: GUR.ReloadS
, session :: Session } -> e -> Effect Unit
onClickSave {fields: (fieldsS /\ _), nodeId, reload, session} _ = do
log2 "[corpusLayoutViewCpt] onClickSave fieldsS" fieldsS
launchAff_ do
saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS}
, nodeId
......@@ -144,14 +138,14 @@ type FieldsCodeEditorProps =
| LoadProps
)
fieldsCodeEditor :: Record FieldsCodeEditorProps -> R.Element
fieldsCodeEditor props = R.createElement fieldsCodeEditorCpt props []
fieldsCodeEditor :: R2.Component FieldsCodeEditorProps
fieldsCodeEditor = R.createElement fieldsCodeEditorCpt
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt = R.hooksComponentWithModule thisModule "fieldsCodeEditorCpt" cpt
where
cpt {nodeId, fields: fS@(fields /\ _), session} _ = do
masterKey <- R.useState' 0
masterKey <- GUR.new
pure $ H.div {} $ List.toUnfoldable (editors masterKey)
where
......@@ -175,13 +169,13 @@ fieldsCodeEditorCpt = R.hooksComponentWithModule thisModule "fieldsCodeEditorCpt
List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields
onMoveDown :: GUR.ReloadS -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onMoveDown (_ /\ setMasterKey) (fs /\ setFields) idx _ = do
setMasterKey $ (+) 1
onMoveDown masterKey (_ /\ setFields) idx _ = do
GUR.bump masterKey
setFields $ recomputeIndices <<< (GDA.swapList idx (idx + 1))
onMoveUp :: GUR.ReloadS -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onMoveUp (_ /\ setMasterKey) (_ /\ setFields) idx _ = do
setMasterKey $ (+) 1
onMoveUp masterKey (_ /\ setFields) idx _ = do
GUR.bump masterKey
setFields $ recomputeIndices <<< (GDA.swapList idx (idx - 1))
onRemove :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
......@@ -223,19 +217,17 @@ fieldCodeEditorWrapperCpt = R.hooksComponentWithModule thisModule "fieldCodeEdit
pure $ H.div { className: "row card" } [
H.div { className: "card-header" } [
H.div { className: "code-editor-heading row" } [
H.div { className: "col-sm-4" } [
H.div { className: "col-4" } [
renameable {onRename, text: name}
]
, H.div { className: "col-sm-7" } []
, H.div { className: "buttons-right col-sm-1" } [
, H.div { className: "col-7" } []
, H.div { className: "buttons-right col-1" } ([
H.div { className: "btn btn-danger"
, on: { click: \_ -> onRemove unit }
} [
H.span { className: "fa fa-trash" } [ ]
]
, moveDownButton canMoveDown
, moveUpButton canMoveUp
]
] <> moveButtons)
]
]
, H.div { className: "card-body" } [
......@@ -243,15 +235,15 @@ fieldCodeEditorWrapperCpt = R.hooksComponentWithModule thisModule "fieldCodeEdit
]
]
where
moveDownButton false = H.div {} []
moveDownButton true =
moveButtons = [] <> (if canMoveDown then [moveDownButton] else [])
<> (if canMoveUp then [moveUpButton] else [])
moveDownButton =
H.div { className: "btn btn-secondary"
, on: { click: \_ -> onMoveDown unit }
} [
H.span { className: "fa fa-arrow-down" } [ ]
]
moveUpButton false = H.div {} []
moveUpButton true =
moveUpButton =
H.div { className: "btn btn-secondary"
, on: { click: \_ -> onMoveUp unit }
} [
......@@ -301,32 +293,31 @@ renameableTextCpt :: R.Component RenameableTextProps
renameableTextCpt = R.hooksComponentWithModule thisModule "renameableTextCpt" cpt
where
cpt {isEditing: (false /\ setIsEditing), state: (text /\ _)} _ = do
pure $ H.div { className: "input-group" } [
H.input { className: "form-control"
, defaultValue: text
, disabled: 1
, type: "text" }
pure $ H.div { className: "input-group" }
[ H.input { className: "form-control"
, defaultValue: text
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: \_ -> setIsEditing $ const true } } [
H.span { className: "fa fa-pencil" } []
]
, on: { click: \_ -> setIsEditing $ const true } }
[ H.span { className: "fa fa-pencil" } []
]
]
cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do
pure $ H.div { className: "input-group" } [
inputWithEnter {
autoFocus: false
, autoSave: false
, className: "form-control text"
, defaultValue: text
, onEnter: submit
, onValueChanged: setText <<< const
, placeholder: ""
, type: "text"
}
pure $ H.div { className: "input-group" }
[ inputWithEnter {
autoFocus: false
, className: "form-control text"
, defaultValue: text
, onEnter: submit
, onValueChanged: setText <<< const
, placeholder: ""
, type: "text"
}
, H.div { className: "btn input-group-append"
, on: { click: submit } } [
H.span { className: "fa fa-floppy-o" } []
]
, on: { click: submit } }
[ H.span { className: "fa fa-floppy-o" } []
]
]
where
submit _ = do
......
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
View file @ b142da83
......@@ -29,10 +29,10 @@ cacheName = "metrics"
metricsLoadView :: forall a. Record (MetricsLoadViewProps a) -> R.Element
metricsLoadView p = R.createElement metricsLoadViewCpt p []
where
metricsLoadViewCpt :: R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = R.hooksComponentWithModule thisModule "metricsLoadView" cpt
metricsLoadViewCpt :: forall a. R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = R.hooksComponentWithModule thisModule "metricsLoadView" cpt
where
cpt { getMetrics, loaded, path, reload, session } _ = do
useLoader (fst reload /\ path) (getMetrics session) $ \l ->
loaded { path, reload, session } l
......@@ -48,10 +48,11 @@ type MetricsWithCacheLoadViewProps res ret = (
metricsWithCacheLoadView :: forall res ret. DecodeJson res =>
Record (MetricsWithCacheLoadViewProps res ret) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
where
metricsWithCacheLoadViewCpt :: R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = R.hooksComponentWithModule thisModule "metricsWithCacheLoadView" cpt
metricsWithCacheLoadViewCpt :: forall res ret. DecodeJson res =>
R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = R.hooksComponentWithModule thisModule "metricsWithCacheLoadView" cpt
where
cpt { getMetricsHash, handleResponse, loaded, mkRequest, path, reload, session } _ = do
useLoaderWithCacheAPI { cacheEndpoint: (getMetricsHash session)
, handleResponse
......
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
View file @ b142da83
......@@ -81,10 +81,10 @@ mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGet
histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props []
where
histoCpt :: R.Component Props
histoCpt = R.hooksComponentWithModule thisModule "histo" cpt
histoCpt :: R.Component Props
histoCpt = R.hooksComponentWithModule thisModule "histo" cpt
where
cpt { path, session } _ = do
reload <- R.useState' 0
pure $ metricsWithCacheLoadView {
......
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
View file @ b142da83
module Gargantext.Components.Nodes.Corpus.Dashboard where
import DOM.Simple.Console (log2)
import Gargantext.Components.Nodes.Types
import Gargantext.Prelude
import DOM.Simple.Console (log, log2)
import Data.Array as A
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Reactix as R
import Reactix.DOM.HTML as H
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Corpus.Dashboard"
type Props =
......@@ -27,8 +31,8 @@ type Props =
, session :: Session
)
dashboardLayout :: Record Props -> R.Element
dashboardLayout props = R.createElement dashboardLayoutCpt props []
dashboardLayout :: R2.Component Props
dashboardLayout = R.createElement dashboardLayoutCpt
dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt = R.hooksComponentWithModule thisModule "dashboardLayout" cpt
......@@ -36,15 +40,15 @@ dashboardLayoutCpt = R.hooksComponentWithModule thisModule "dashboardLayout" cpt
cpt { nodeId, session } _ = do
let sid = sessionId session
pure $ dashboardLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session }
pure $ dashboardLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session } []
type KeyProps = (
key :: String
| Props
)
dashboardLayoutWithKey :: Record KeyProps -> R.Element
dashboardLayoutWithKey props = R.createElement dashboardLayoutWithKeyCpt props []
dashboardLayoutWithKey :: R2.Component KeyProps
dashboardLayoutWithKey = R.createElement dashboardLayoutWithKeyCpt
dashboardLayoutWithKeyCpt :: R.Component KeyProps
dashboardLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "dashboardLayoutWithKey" cpt
......@@ -54,20 +58,20 @@ dashboardLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "dashboardLayo
useLoader {nodeId, reload: GUR.value reload, session} DT.loadDashboardWithReload $
\dashboardData@{hyperdata: DT.Hyperdata h, parentId} -> do
let { charts } = h
let { charts, fields } = h
dashboardLayoutLoaded { charts
, corpusId: parentId
, defaultListId: 0
, key: show $ GUR.value reload
, fields
, nodeId
, onChange: onChange nodeId reload (DT.Hyperdata h)
, session }
, session } []
where
onChange :: NodeID -> GUR.ReloadS -> DT.Hyperdata -> Array P.PredefinedChart -> Effect Unit
onChange nodeId' reload (DT.Hyperdata h) charts = do
onChange :: NodeID -> GUR.ReloadS -> DT.Hyperdata -> { charts :: Array P.PredefinedChart
, fields :: List.List FTField } -> Effect Unit
onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do
launchAff_ do
DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts }
DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields }
, nodeId:nodeId'
, session }
liftEffect $ GUR.bump reload
......@@ -76,38 +80,113 @@ type LoadedProps =
( charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, key :: String
, onChange :: Array P.PredefinedChart -> Effect Unit
, fields :: List.List FTField
, onChange :: { charts :: Array P.PredefinedChart
, fields :: List.List FTField } -> Effect Unit
| Props
)
dashboardLayoutLoaded :: Record LoadedProps -> R.Element
dashboardLayoutLoaded props = R.createElement dashboardLayoutLoadedCpt props []
dashboardLayoutLoaded :: R2.Component LoadedProps
dashboardLayoutLoaded = R.createElement dashboardLayoutLoadedCpt
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = R.hooksComponentWithModule thisModule "dashboardLayoutLoaded" cpt
where
cpt props@{ charts, corpusId, defaultListId, onChange, session } _ = do
pure $
H.div {} ([ H.h1 {} [ H.text "Board" ]
, H.p {} [ H.text "Summary of all your charts here" ]
] <> chartsEls <> [addNew])
cpt props@{ charts, corpusId, defaultListId, fields, nodeId, onChange, session } _ = do
pure $ H.div {}
[ H.div { className: "row" }
[ H.div { className: "col-12" }
([ H.h1 {} [ H.text "Board" ]
, H.p {} [ H.text "Summary of all your charts here" ]
] <> chartsEls <> [addNew])
]
, dashboardCodeEditor { fields
, nodeId
, onChange: \fs -> onChange { charts, fields: fs }
, session } []
]
where
addNew = H.div { className: "row" } [
H.span { className: "btn btn-secondary"
, on: { click: onClickAdd }} [ H.span { className: "fa fa-plus" } [] ]
, on: { click: onClickAddChart }} [ H.span { className: "fa fa-plus" } [] ]
]
where
onClickAdd _ = onChange $ A.cons P.CDocsHistogram charts
onClickAddChart _ = onChange { charts: A.cons P.CDocsHistogram charts
, fields }
chartsEls = A.mapWithIndex chartIdx charts
chartIdx idx chart =
renderChart { chart, corpusId, defaultListId, onChange: onChangeChart, onRemove, session }
renderChart { chart, corpusId, defaultListId, onChange: onChangeChart, onRemove, session } []
where
onChangeChart c = do
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
onChange { charts: fromMaybe charts (A.modifyAt idx (\_ -> c) charts)
, fields }
onRemove _ = onChange { charts: fromMaybe charts $ A.deleteAt idx charts
, fields }
type CodeEditorProps =
( fields :: List.List FTField
, onChange :: List.List FTField -> Effect Unit
| Props
)
dashboardCodeEditor :: R2.Component CodeEditorProps
dashboardCodeEditor = R.createElement dashboardCodeEditorCpt
dashboardCodeEditorCpt :: R.Component CodeEditorProps
dashboardCodeEditorCpt = R.hooksComponentWithModule thisModule "dashboardCodeEditor" cpt
where
cpt props@{ fields, nodeId, onChange, session } _ = do
let fieldsWithIndex = List.mapWithIndex (\idx -> \t -> Tuple idx t) fields
fieldsS <- R.useState' fieldsWithIndex
fieldsRef <- R.useRef fields
-- handle props change of fields
R.useEffect1' fields $ do
if R.readRef fieldsRef == fields then
pure unit
else do
R.setRef fieldsRef fields
snd fieldsS $ const fieldsWithIndex
pure $ R.fragment
[ H.div { className: "row" }
[ H.div { className: "btn btn-secondary " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave fieldsS }
}
[ H.span { className: "fa fa-floppy-o" } [ ]
]
]
, H.div { className: "row" }
[ H.div { className: "col-12" }
[ fieldsCodeEditor { fields: fieldsS
, nodeId
, session} []
]
]
, H.div { className: "row" }
[ H.div { className: "btn btn-secondary"
, on: { click: onClickAddField fieldsS }
}
[ H.span { className: "fa fa-plus" } [ ]
]
]
]
where
saveEnabled :: FTFieldsWithIndex -> R.State FTFieldsWithIndex -> String
saveEnabled fs (fsS /\ _) = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit
onClickSave (fields /\ _) _ = do
log "[dashboardCodeEditor] saving (TODO)"
onChange $ snd <$> fields
-- launchAff_ do
-- saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS}
-- , nodeId
-- , session }
onClickAddField :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit
onClickAddField (_ /\ setFieldsS) _ = do
setFieldsS $ \fieldsS -> List.snoc fieldsS $ Tuple (List.length fieldsS) defaultField
type PredefinedChartProps =
( chart :: P.PredefinedChart
......@@ -118,28 +197,33 @@ type PredefinedChartProps =
, session :: Session
)
renderChart :: Record PredefinedChartProps -> R.Element
renderChart props = R.createElement renderChartCpt props []
renderChart :: R2.Component PredefinedChartProps
renderChart = R.createElement renderChartCpt
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = R.hooksComponentWithModule thisModule "renderChart" cpt
where
cpt { chart, corpusId, defaultListId, onChange, onRemove, session } _ = do
pure $ H.div { className: "chart" }
[ H.div { className: "row" }
[ H.div { className: "col-2" }
[ R2.select { defaultValue: show chart
, on: { change: onSelectChange }
} (option <$> P.allPredefinedCharts)
]
, H.div { className: "col-1" }
[ H.span { className: "btn btn-danger"
, on: { click: onRemoveClick }} [ H.span { className: "fa fa-trash" } [] ]
pure $ H.div { className: "row chart card" }
[ H.div { className: "card-header" }
[ H.div { className: "row" }
[ H.div { className: "col-2" }
[ R2.select { defaultValue: show chart
, on: { change: onSelectChange }
} (option <$> P.allPredefinedCharts)
]
, H.div { className: "col-9" } []
, H.div { className: "col-1" }
[ H.span { className: "btn btn-danger"
, on: { click: onRemoveClick }} [ H.span { className: "fa fa-trash" } [] ]
]
]
]
, H.div { className: "row" }
[ H.div { className: "col-12 chart" }
[ P.render chart params ]
, H.div { className: "card-body" }
[ H.div { className: "row" }
[ H.div { className: "col-12 chart" }
[ P.render chart params ]
]
]
]
where
......
src/Gargantext/Components/Nodes/Corpus/Document.purs
View file @ b142da83
......@@ -54,10 +54,10 @@ type DocViewProps = (
docView :: R2.Component DocViewProps
docView = R.createElement docViewCpt
where
docViewCpt :: R.Component DocViewProps
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
docViewCpt :: R.Component DocViewProps
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
where
cpt { path
, loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }
, state: state@({ ngramsVersion: version, ngramsLocalPatch } /\ _)
......
src/Gargantext/Components/Nodes/Corpus/Types.purs
View file @ b142da83
module Gargantext.Components.Nodes.Corpus.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.List as List
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Gargantext.Components.Node (NodePoly)
import Gargantext.Prelude
type Author = String
type Description = String
type Query = String
type Tag = String
type Title = String
type HaskellCode = String
type MarkdownText = String
type Hash = String
import Gargantext.Components.Nodes.Types (FTField, Field(..), FieldType(..), isJSON)
import Gargantext.Prelude (bind, pure, ($))
newtype Hyperdata =
Hyperdata { fields :: List.List FTField }
......@@ -35,182 +22,6 @@ instance encodeHyperdata :: EncodeJson Hyperdata where
"fields" := fields
~> jsonEmptyObject
newtype Field a =
Field { name :: String
, typ :: a
}
type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where
eq = genericEq
instance showFTField :: Show (Field FieldType) where
show = genericShow
data FieldType =
Haskell { haskell :: HaskellCode
, tag :: Tag
}
| Python { python :: HaskellCode
, tag :: Tag
}
| JSON { authors :: Author
, desc :: Description
, query :: Query
, tag :: Tag
, title :: Title
}
| Markdown { tag :: Tag
, text :: MarkdownText
}
isJSON :: FTField -> Boolean
isJSON (Field {typ}) = isJSON' typ
where
isJSON' (JSON _) = true
isJSON' _ = false
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
, desc
, query
, authors
, totalRecords: 0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, totalRecords: 0
}
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
instance showFieldType :: Show FieldType where
show = genericShow
instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do
obj <- decodeJson json
name <- obj .: "name"
type_ <- obj .: "type"
data_ <- obj .: "data"
typ <- case type_ of
"Haskell" -> do
haskell <- data_ .: "haskell"
tag <- data_ .: "tag"
pure $ Haskell {haskell, tag}
"Python" -> do
python <- data_ .: "python"
tag <- data_ .: "tag"
pure $ Python {python, tag}
"JSON" -> do
authors <- data_ .: "authors"
desc <- data_ .: "desc"
query <- data_ .: "query"
tag <- data_ .: "tag"
title <- data_ .: "title"
pure $ JSON {authors, desc, query, tag, title}
"Markdown" -> do
tag <- data_ .: "tag"
text <- data_ .: "text"
pure $ Markdown {tag, text}
_ -> Left $ TypeMismatch $ "Unsupported 'type' " <> type_
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) =
"data" := typ
~> "name" := name
~> "type" := typ' typ
~> jsonEmptyObject
where
typ' (Haskell _) = "Haskell"
typ' (Python _) = "Python"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) =
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (Python {python}) =
"python" := python
~> "tag" := "PythonField"
~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) =
"authors" := authors
~> "desc" := desc
~> "query" := query
~> "tag" := "JsonField"
~> "title" := title
~> jsonEmptyObject
encodeJson (Markdown {text}) =
"tag" := "MarkdownField"
~> "text" := text
~> jsonEmptyObject
defaultPython :: FieldType
defaultPython = Python defaultPython'
defaultPython' :: { python :: String, tag :: String }
defaultPython' = { python: "import Foo"
, tag : "PythonField"
}
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' :: { haskell :: String, tag :: String }
defaultHaskell' = { haskell: ""
, tag : "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' :: { authors :: String
, desc :: String
, query :: String
, tag :: String
, title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' :: { tag :: String
, text :: String
}
defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField = Field { name: "New file"
, typ: defaultMarkdown
}
newtype CorpusInfo =
CorpusInfo { title :: String
, authors :: String
......@@ -232,3 +43,18 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly Hyperdata -- CorpusInfo
, defaultListId :: Int }
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
, desc
, query
, authors
, totalRecords: 0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, totalRecords: 0
}
src/Gargantext/Components/Nodes/Dashboard/Types.purs
View file @ b142da83
module Gargantext.Components.Nodes.Dashboard.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
import Data.List as List
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Types (FTField, Field(..), FieldType(..), isJSON)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
......@@ -14,17 +17,20 @@ type Preferences = Maybe String
newtype Hyperdata =
Hyperdata
{ charts :: Array P.PredefinedChart
, fields :: List.List FTField
, preferences :: Preferences
}
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
charts <- obj .: "charts"
fields <- obj .: "fields"
preferences <- obj .:? "preferences"
pure $ Hyperdata {charts, preferences}
pure $ Hyperdata {charts, fields, preferences}
instance encodeHyperdata :: EncodeJson Hyperdata where
encodeJson (Hyperdata {charts, preferences}) = do
encodeJson (Hyperdata {charts, fields, preferences}) = do
"charts" := charts
~> "fields" := fields
~> "preferences" := preferences
~> jsonEmptyObject
......
src/Gargantext/Components/Nodes/Lists.purs
View file @ b142da83
......@@ -35,10 +35,10 @@ type ListsWithForest = (
listsWithForest :: R2.Component ListsWithForest
listsWithForest = R.createElement listsWithForestCpt
where
listsWithForestCpt :: R.Component ListsWithForest
listsWithForestCpt = R.hooksComponentWithModule thisModule "listsWithForest" cpt
listsWithForestCpt :: R.Component ListsWithForest
listsWithForestCpt = R.hooksComponentWithModule thisModule "listsWithForest" cpt
where
cpt { forestProps
, listsProps: listsProps@{ session } } _ = do
controls <- initialControls
......@@ -58,10 +58,10 @@ type TopBarProps = (
topBar :: R2.Component TopBarProps
topBar = R.createElement topBarCpt
where
topBarCpt :: R.Component TopBarProps
topBarCpt = R.hooksComponentWithModule thisModule "topBar" cpt
topBarCpt :: R.Component TopBarProps
topBarCpt = R.hooksComponentWithModule thisModule "topBar" cpt
where
cpt { controls } _ = do
-- empty for now because the button is moved to the side panel
pure $ H.div {} []
......@@ -93,10 +93,10 @@ type WithTreeProps = (
listsLayout :: R2.Component Props
listsLayout = R.createElement listsLayoutCpt
where
listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponentWithModule thisModule "listsLayout" cpt
listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponentWithModule thisModule "listsLayout" cpt
where
cpt path@{ nodeId, session } _ = do
let sid = sessionId session
......@@ -109,10 +109,10 @@ type KeyProps = (
listsLayoutWithKey :: Record KeyProps -> R.Element
listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
where
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
where
cpt { appReload
, asyncTasksRef
, controls
......@@ -122,7 +122,7 @@ listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
, treeReloadRef } _ = do
let path = { nodeId, session }
cacheState <- R.useState' $ getCacheState CacheOff session nodeId
cacheState <- R.useState' $ getCacheState CacheOn session nodeId
useLoader path loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } ->
......@@ -164,10 +164,10 @@ type SidePanelProps = (
sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt
where
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = R.hooksComponentWithModule thisModule "sidePanel" cpt
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = R.hooksComponentWithModule thisModule "sidePanel" cpt
where
cpt { controls: { triggers: { toggleSidePanel
, triggerSidePanel
} }
......@@ -208,10 +208,10 @@ type SidePanelDocView = (
sidePanelDocView :: R2.Component SidePanelDocView
sidePanelDocView = R.createElement sidePanelDocViewCpt
where
sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = R.hooksComponentWithModule thisModule "sidePanelDocView" cpt
sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = R.hooksComponentWithModule thisModule "sidePanelDocView" cpt
where
cpt { session } _ = do
-- pure $ H.h4 {} [ H.text txt ]
pure $ H.div {} [ H.text "Hello ngrams" ]
src/Gargantext/Components/Nodes/Types.purs 0 → 100644
View file @ b142da83
module Gargantext.Components.Nodes.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
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 as List
import Data.Tuple (Tuple)
import Gargantext.Prelude
type Author = String
type Description = String
type HaskellCode = String
type Hash = String
type MarkdownText = String
type Query = String
type Tag = String
type Title = String
-- We need FTFields with indices because it's the only way to identify the
-- FTField element inside a component (there are no UUIDs and such)
type Index = Int
type FTFieldWithIndex = Tuple Index FTField
type FTFieldsWithIndex = List.List FTFieldWithIndex
newtype Field a =
Field { name :: String
, typ :: a
}
type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where
eq = genericEq
instance showFTField :: Show (Field FieldType) where
show = genericShow
data FieldType =
Haskell { haskell :: HaskellCode
, tag :: Tag
}
| Python { python :: HaskellCode
, tag :: Tag
}
| JSON { authors :: Author
, desc :: Description
, query :: Query
, tag :: Tag
, title :: Title
}
| Markdown { tag :: Tag
, text :: MarkdownText
}
isJSON :: FTField -> Boolean
isJSON (Field {typ}) = isJSON' typ
where
isJSON' (JSON _) = true
isJSON' _ = false
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
instance showFieldType :: Show FieldType where
show = genericShow
instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do
obj <- decodeJson json
name <- obj .: "name"
type_ <- obj .: "type"
data_ <- obj .: "data"
typ <- case type_ of
"Haskell" -> do
haskell <- data_ .: "haskell"
tag <- data_ .: "tag"
pure $ Haskell {haskell, tag}
"Python" -> do
python <- data_ .: "python"
tag <- data_ .: "tag"
pure $ Python {python, tag}
"JSON" -> do
authors <- data_ .: "authors"
desc <- data_ .: "desc"
query <- data_ .: "query"
tag <- data_ .: "tag"
title <- data_ .: "title"
pure $ JSON {authors, desc, query, tag, title}
"Markdown" -> do
tag <- data_ .: "tag"
text <- data_ .: "text"
pure $ Markdown {tag, text}
_ -> Left $ TypeMismatch $ "Unsupported 'type' " <> type_
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) =
"data" := typ
~> "name" := name
~> "type" := typ' typ
~> jsonEmptyObject
where
typ' (Haskell _) = "Haskell"
typ' (Python _) = "Python"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) =
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (Python {python}) =
"python" := python
~> "tag" := "PythonField"
~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) =
"authors" := authors
~> "desc" := desc
~> "query" := query
~> "tag" := "JsonField"
~> "title" := title
~> jsonEmptyObject
encodeJson (Markdown {text}) =
"tag" := "MarkdownField"
~> "text" := text
~> jsonEmptyObject
defaultPython :: FieldType
defaultPython = Python defaultPython'
defaultPython' :: { python :: String, tag :: String }
defaultPython' = { python: "import Foo"
, tag : "PythonField"
}
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' :: { haskell :: String, tag :: String }
defaultHaskell' = { haskell: ""
, tag : "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' :: { authors :: String
, desc :: String
, query :: String
, tag :: String
, title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' :: { tag :: String
, text :: String
}
defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField = Field { name: "New file"
, typ: defaultMarkdown
}
src/Gargantext/Components/Search.purs
View file @ b142da83
......@@ -58,9 +58,8 @@ instance encodeJsonSearchResult :: Argonaut.EncodeJson SearchResult where
------------------------------------------------------------------------
data SearchResultTypes =
SearchResultDoc { docs :: Array Document}
| SearchNoResult { message :: String }
data SearchResultTypes = SearchResultDoc { docs :: Array Document}
| SearchNoResult { message :: String }
| SearchResultContact { contacts :: Array Contact }
derive instance eqSearchResultTypes :: Eq SearchResultTypes
......@@ -132,6 +131,7 @@ data Contact =
, c_created :: String
, c_hyperdata :: HyperdataRowContact
, c_score :: Int
, c_annuaireId :: Int
}
derive instance eqContact :: Eq Contact
......
src/Gargantext/Components/Tab.purs
View file @ b142da83
......@@ -14,7 +14,7 @@ thisModule = "Gargantext.Components.Tab"
type TabsProps = (
selected :: Int
, tabs :: Array (Tuple String R.Element)
, tabs :: Array (Tuple String R.Element)
)
tabs :: Record TabsProps -> R.Element
......@@ -29,17 +29,23 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
pure $
H.div {}
[ H.nav {}
[ H.div { className: "nav nav-tabs"
, title : "Tab for ngrams"
}
(mapWithIndex (button setActiveTab activeTab) props.tabs) ]
, H.div { className: "tab-content" } $ mapWithIndex (item activeTab) props.tabs ]
[ H.br {}
, H.div { className: "nav nav-tabs"
, title : "Search result"
} -- [H.text "" ]
(mapWithIndex (button setActiveTab activeTab) props.tabs)
]
, H.div { className: "tab-content" }
$ mapWithIndex (item activeTab) props.tabs
]
--{-
button setActiveTab selected index (name /\ _) =
H.a { className, on: { click } } [ H.text name ]
where
eq = index == selected
className = "nav-item nav-link" <> (if eq then " active" else "")
click e = setActiveTab (const index)
--}
item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ]
-- TODO: document what these are (selection, item indices)
......
src/Gargantext/Components/Table.purs
View file @ b142da83
......@@ -58,10 +58,9 @@ initialParams = stateParams {page: 1, pageSize: PS10, orderBy: Nothing, searchTy
tableHeaderLayout :: Record TableHeaderLayoutProps -> R.Element
tableHeaderLayout props = R.createElement tableHeaderLayoutCpt props []
tableHeaderLayoutCpt :: R.Component TableHeaderLayoutProps
tableHeaderLayoutCpt = R.hooksComponentWithModule thisModule "tableHeaderLayout" cpt
where
tableHeaderLayoutCpt :: R.Component TableHeaderLayoutProps
tableHeaderLayoutCpt = R.hooksComponentWithModule thisModule "tableHeaderLayout" cpt
cpt { afterCacheStateChange, cacheState, date, desc, query, title, user } _ =
pure $ R.fragment
[ R2.row
......@@ -115,10 +114,9 @@ tableHeaderLayout props = R.createElement tableHeaderLayoutCpt props []
table :: Record Props -> R.Element
table props = R.createElement tableCpt props []
tableCpt :: R.Component Props
tableCpt = R.hooksComponentWithModule thisModule "table" cpt
where
tableCpt :: R.Component Props
tableCpt = R.hooksComponentWithModule thisModule "table" cpt
cpt {container, syncResetButton, colNames, wrapColElts, totalRecords, rows, params} _ = do
let
state = paramsState $ fst params
......@@ -194,10 +192,10 @@ type SizeDDProps =
sizeDD :: Record SizeDDProps -> R.Element
sizeDD p = R.createElement sizeDDCpt p []
where
sizeDDCpt :: R.Component SizeDDProps
sizeDDCpt = R.hooksComponentWithModule thisModule "sizeDD" cpt
sizeDDCpt :: R.Component SizeDDProps
sizeDDCpt = R.hooksComponentWithModule thisModule "sizeDD" cpt
where
cpt {params: params /\ setParams} _ = do
pure $ H.span {} [
R2.select { className, defaultValue: show pageSize, on: {change} } sizes
......
src/Gargantext/Components/TopBar.purs
View file @ b142da83
......@@ -151,10 +151,10 @@ type MenuButtonProps = (
menuButton :: R2.Component MenuButtonProps
menuButton = R.createElement menuButtonCpt
where
menuButtonCpt :: R.Component MenuButtonProps
menuButtonCpt = R.hooksComponentWithModule thisModule "menuButton" cpt
menuButtonCpt :: R.Component MenuButtonProps
menuButtonCpt = R.hooksComponentWithModule thisModule "menuButton" cpt
where
cpt { element: LiNav { title, href, icon, text }, show: (_ /\ setShow) } _ = do
pure $ H.a { className: "dropdown-toggle navbar-text"
-- , data: {toggle: "dropdown"}
......@@ -173,10 +173,10 @@ type MenuElementsProps = (
menuElements :: R2.Component MenuElementsProps
menuElements = R.createElement menuElementsCpt
where
menuElementsCpt :: R.Component MenuElementsProps
menuElementsCpt = R.hooksComponentWithModule thisModule "menuElements" cpt
menuElementsCpt :: R.Component MenuElementsProps
menuElementsCpt = R.hooksComponentWithModule thisModule "menuElements" cpt
where
cpt { show: false /\ _ } _ = do
pure $ H.div {} []
cpt { elements, show: (true /\ setShow) } _ = do
......
src/Gargantext/Ends.purs
View file @ b142da83
......@@ -222,6 +222,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) =
<> defaultListAddMaybe listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- misc routing stuff
defaultList :: Int -> String
......
src/Gargantext/Routes.purs
View file @ b142da83
......@@ -5,39 +5,36 @@ import Prelude
import Data.Maybe (Maybe(..))
import Gargantext.Types (ChartOpts, ChartType, CorpusMetricOpts, CTabNgramType, Id, Limit,
ListId, NgramsGetOpts, NgramsGetTableAllOpts, NodeType,
ListId, DocId, ContactId, NgramsGetOpts, NgramsGetTableAllOpts, NodeType,
Offset, OrderBy, SearchOpts, SessionId, TabSubType, TabType, TermList)
import Gargantext.Types as GT
data AppRoute
= Annuaire SessionId Int
= Annuaire SessionId Int
| ContactPage SessionId Int Int
| Corpus SessionId Int
| Corpus SessionId Int
| CorpusDocument SessionId Int Int Int
| Dashboard SessionId Int
| Document SessionId Int Int
| Folder SessionId Int
| FolderPrivate SessionId Int
| FolderPublic SessionId Int
| FolderShared SessionId Int
| Folder SessionId Int
| FolderPrivate SessionId Int
| FolderPublic SessionId Int
| FolderShared SessionId Int
| Home
| Lists SessionId Int
| Login
| PGraphExplorer SessionId Int
| PGraphExplorer SessionId Int
| RouteFile SessionId Int
| RouteFrameCalc SessionId Int
| RouteFrameCode SessionId Int
| RouteFrameWrite SessionId Int
| Team SessionId Int
| Texts SessionId Int
| UserPage SessionId Int
| Team SessionId Int
| Texts SessionId Int
| UserPage SessionId Int
derive instance eqAppRoute :: Eq AppRoute
type AnnuaireId = Int
type ContactId = Int
data SessionRoute
= Tab TabType (Maybe Id)
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
......@@ -53,12 +50,13 @@ data SessionRoute
| TreeFirstLevel (Maybe Id) String
| GraphAPI Id String
| ListsRoute ListId
| ListDocument (Maybe ListId) (Maybe Id)
| ListDocument (Maybe ListId) (Maybe DocId)
| Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id)
| CorpusMetricsHash { listId :: ListId, tabType :: TabType } (Maybe Id)
| Chart ChartOpts (Maybe Id)
| ChartHash { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id)
-- | AnnuaireContact AnnuaireId DocId
instance showAppRoute :: Show AppRoute where
show Home = "Home"
......
src/Gargantext/Types.purs
View file @ b142da83
......@@ -333,8 +333,11 @@ nodeTypePath (NodePublic nt) = nodeTypePath nt
nodeTypePath NodeFile = "file"
------------------------------------------------------------
type ListId = Int
type CorpusId = Int
type DocId = Int
type ListId = Int
type AnnuaireId = Int
type ContactId = Int
data ScoreType = Occurrences
......
src/Gargantext/Utils/Reactix.purs
View file @ b142da83
......@@ -45,6 +45,35 @@ import Web.Storage.Storage (Storage, getItem, setItem)
type Component p = Record p -> Array R.Element -> R.Element
-- newtypes
type NTHooksComponent props = props -> Array R.Element -> R.Hooks R.Element
newtype NTComponent p = NTComponent (EffectFn1 p R.Element)
class NTIsComponent component (props :: Type) children
| component -> props, component -> children where
ntCreateElement :: component -> props -> children -> R.Element
instance componentIsNTComponent :: NTIsComponent (NTComponent props) props (Array R.Element) where
ntCreateElement = R.rawCreateElement
-- | Turns a `HooksComponent` function into a Component
ntHooksComponent :: forall props. String -> NTHooksComponent props -> NTComponent props
ntHooksComponent name c = NTComponent $ named name $ mkEffectFn1 c'
where
c' :: props -> Effect R.Element
c' props = R.runHooks $ c props (children props)
ntHooksComponentWithModule :: forall props. Module -> String -> NTHooksComponent props -> NTComponent props
ntHooksComponentWithModule module' name c = ntHooksComponent (module' <> "." <> name) c
---------------------------
-- TODO Copied from reactix, export these:
children :: forall a. a -> Array R.Element
children a = react .. "Children" ... "toArray" $ [ (a .. "children") ]
type Module = String
---------------------------
newtype Point = Point { x :: Number, y :: Number }
-- a reducer function living in effector, for useReductor
......
src/Gargantext/Utils/Reload.purs
View file @ b142da83
module Gargantext.Utils.Reload where
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested((/\))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
......
src/sass/_annotation.sass
View file @ b142da83
......@@ -3,56 +3,52 @@
// $annotation-stop-color: #f00
// Copied from bootstrap's bg-warning, bg-success, bg-danger:
$annotation-candidate-color: #FF9800
$annotation-graph-color: #43A047
$annotation-stop-color: #E53935
$annotation-graph-color: #95D29593
$annotation-candidate-color: #B8B8B876
$annotation-stop-color: #F5949931
@mixin lg1($color)
color: #000
background-color: $color
@mixin lg2($color1, $color2)
color: #000
background-image: linear-gradient(rgba($color1, 0.5), rgba($color1, 0.5)), linear-gradient(rgba($color2, 0.5), rgba($color2, 0.5))
@mixin lg3($color1, $color2, $color3)
color: #000
background-image: linear-gradient(rgba($color1, 0.34), rgba($color1, 0.34)), linear-gradient(rgba($color2, 0.33), rgba($color2, 0.33)), linear-gradient(rgba($color3, 0.33), rgba($color3, 0.33))
.annotation-run
cursor: pointer
&.candidate-term.graph-term.stop-term
color: #000
@include lg3($annotation-candidate-color, $annotation-graph-color, $annotation-stop-color)
&.candidate-term.graph-term
color: #000
@include lg2($annotation-candidate-color, $annotation-graph-color)
&.candidate-term.stop-term
color: #000
@include lg2($annotation-candidate-color, $annotation-stop-color)
&.graph-term.stop-term
color: #000
@include lg2($annotation-graph-color, $annotation-stop-color)
&.candidate-term
color: #000
background-color: $annotation-candidate-color
@include lg1($annotation-candidate-color)
&.graph-term
color: #000
background-color: $annotation-graph-color
@include lg1($annotation-graph-color)
&.stop-term
color: #000
background-color: $annotation-stop-color
@include lg1($annotation-stop-color)
.context-menu
.candidate-term
color: #000
background-color: $annotation-candidate-color
@include lg1($annotation-candidate-color)
.graph-term
color: #000
background-color: $annotation-graph-color
@include lg1($annotation-graph-color)
.stop-term
color: #000
background-color: $annotation-stop-color
@include lg1($annotation-stop-color)
src/sass/_code_editor.sass
View file @ b142da83
......@@ -20,24 +20,16 @@
word-break: keep-all
.code-editor-heading
display: flex
//justify-content: space-between
.renameable
flex-grow: 2
.text
padding-right: 10px
.buttons-right
display: flex
justify-content: flex-end
/* .buttons-right
/* display: flex
/* justify-content: flex-end
.code-editor
.toolbar
display: flex
justify-content: flex-start
width: 100%
.editor
display: flex
width: 100%
.code-area
flex-grow: 1
max-height: 200px
......
src/sass/sass.sass
View file @ b142da83
......@@ -6,3 +6,4 @@
@use "_code_editor.sass"
@use "_styles.sass"
@use "_range_slider.sass"
@use "_annotation.sass"
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