Commit 1158c26d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into feature/toestand-global-state

parents 13080243 cdc7f851
...@@ -123,7 +123,8 @@ the docker container. ...@@ -123,7 +123,8 @@ the docker container.
### Basic tasks ### Basic tasks
Now we must install our javascript and purescript dependencies: Now we must install our javascript and purescript dependencies:
*Note: if you're installing manually you might also need to manually install [psc-package](https://github.com/purescript/psc-package)*
```shell ```shell
darn install -D && darn install-ps # for docker setup darn install -D && darn install-ps # for docker setup
...@@ -192,6 +193,14 @@ yarn css # for manual setup ...@@ -192,6 +193,14 @@ yarn css # for manual setup
A guide to getting set up with the IDE integration is coming soon, I hope. A guide to getting set up with the IDE integration is coming soon, I hope.
### Testing
To run unit tests, just run:
``` shell
test-ps
```
### Note to contributors ### Note to contributors
Please follow CONTRIBUTING.md Please follow CONTRIBUTING.md
......
.annotation-run {
cursor: pointer;
}
.annotation-run.candidate-term, .context-menu .candidate-term{
color: #000;
background-color: #aaa;
}
.annotation-run.graph-term, .context-menu .graph-term {
color: #000;
background-color: #0f0;
}
.annotation-run.stop-term, .context-menu .stop-term {
color: #000;
background-color: #f00;
}
body {
background-color: #303030;
color: #fff;
}
a {
color: #007bff;
}
.bg-dark {
background-color: #212121 !important;
}
.text-dark {
color: #fff !important;
}
.text-muted {
color: #9e9e9e !important;
}
.dropdown-menu {
background-color: #343a40;
color: #fff;
}
.dropdown-item {
color: inherit;
}
.dropdown-item:hover, .dropdown-item.active {
color: inherit;
background-color: #4b545c;
}
.breadcrumb {
background-color: #343a40;
}
.breadcrumb-item.active {
color: #fff;
}
.nav-tabs {
border-bottom-color: #454d55;
}
.nav-tabs .nav-link {
color: #fff;
background-color: #343a40;
}
.nav-tabs .nav-link:hover, .nav-tabs .nav-link.active {
color: inherit;
background-color: #43494E;
border-color: #454d55;
}
.card {
background-color: #424242;
}
.card.bg-light {
color: #383d41;
}
.modal-content {
background-color: #424242;
}
.close {
color: #fff;
}
.close:hover {
color: #fff;
}
.jumbotron {
background-color: #212121;
}
.form-control,
.form-control:active,
.form-control:focus {
border-color: #454d55;
background-color: #343a40;
color: #fff;
/*Change text in autofill textbox */
}
.form-control:-webkit-autofill,
.form-control:active:-webkit-autofill,
.form-control:focus:-webkit-autofill {
-webkit-box-shadow: 0 0 0 50px #343a40 inset;
/* Change the color to your own background color */
-webkit-text-fill-color: #fff;
}
.form-control::-webkit-input-placeholder,
.form-control:active::-webkit-input-placeholder,
.form-control:focus::-webkit-input-placeholder {
color: #888;
}
.form-control:-ms-input-placeholder,
.form-control:active:-ms-input-placeholder,
.form-control:focus:-ms-input-placeholder {
color: #888;
}
.form-control::-ms-input-placeholder,
.form-control:active::-ms-input-placeholder,
.form-control:focus::-ms-input-placeholder {
color: #888;
}
.form-control::placeholder,
.form-control:active::placeholder,
.form-control:focus::placeholder {
color: #888;
}
.custom-select {
border-color: #454d55;
background: url("data:image/svg+xml,%3csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 4 5'%3e%3cpath fill='%23fff' d='M2 0L0 2h4zm0 5L0 3h4z'/%3e%3c/svg%3e") no-repeat right 0.75rem center/8px 10px;
background-color: #343a40;
color: #fff;
}
.custom-control-label::before {
background-color: #343a40;
}
.input-group-text {
border-color: #454d55;
background-color: #4b545c;
color: #fff;
}
.list-group-item {
background-color: #343a40;
}
.list-group-item-action {
color: inherit;
}
.list-group-item-action:not(.active):hover {
color: inherit;
background-color: #43494E;
}
.list-group-item-action.disabled {
background-color: #343a40;
}
.page-link {
background-color: #343a40;
border-color: #454d55;
}
.page-link:hover {
border-color: #454d55;
background-color: #43494E;
}
.page-item.disabled .page-link {
background-color: #343a40;
border-color: #454d55;
}
.progress {
background-color: #343a40;
}
/*# sourceMappingURL=bootstrap-dark.css.map */
\ No newline at end of file
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -140,11 +140,10 @@ ...@@ -140,11 +140,10 @@
left: 0%; left: 0%;
} }
.graph-container #controls-container { .graph-container #controls-container {
position: fixed; position: absolute;
z-index: 999; z-index: 999;
backdrop-filter: blur(4px); backdrop-filter: blur(4px);
background: rgba(255, 255, 255, 0.75); background: rgba(255, 255, 255, 0.75);
overflow: auto;
left: 0; left: 0;
right: 0; right: 0;
top: 60px; top: 60px;
...@@ -168,7 +167,7 @@ ...@@ -168,7 +167,7 @@
max-height: 300px; max-height: 300px;
overflow-y: scroll; overflow-y: scroll;
width: 300px; width: 300px;
top: 100px; top: 50px;
} }
#dafixedtop { #dafixedtop {
...@@ -368,9 +367,12 @@ li .leaf .folder-icon { ...@@ -368,9 +367,12 @@ li .leaf .folder-icon {
padding: 0 2 0 2; padding: 0 2 0 2;
cursor: pointer; cursor: pointer;
} }
li .leaf .node-link { li .leaf .node-link a {
cursor: pointer; cursor: pointer;
} }
li .leaf .node-link > .node-text {
color: #000000;
}
li .leaf a.settings { li .leaf a.settings {
cursor: pointer; cursor: pointer;
display: block; display: block;
...@@ -537,18 +539,6 @@ li .leaf:hover a.settings { ...@@ -537,18 +539,6 @@ li .leaf:hover a.settings {
padding-top: 60px; padding-top: 60px;
} }
.code-editor-heading {
/* .buttons-right */
/* display: flex */
/* justify-content: flex-end */
}
.code-editor-heading .renameable {
flex-grow: 2;
}
.code-editor-heading .renameable .text {
padding-right: 10px;
}
.code-editor .editor .code-area { .code-editor .editor .code-area {
flex-grow: 1; flex-grow: 1;
max-height: 200px; max-height: 200px;
...@@ -656,11 +646,11 @@ li .leaf:hover a.settings { ...@@ -656,11 +646,11 @@ li .leaf:hover a.settings {
cursor: pointer; cursor: pointer;
} }
#page-wrapper .side-panel { #page-wrapper .side-panel {
background-color: white;
left: 70%; left: 70%;
padding: 5px; padding: 5px;
position: fixed; position: fixed;
top: 60px; top: 60px;
background-color: #fff;
width: 28%; width: 28%;
} }
#page-wrapper .side-panel .header { #page-wrapper .side-panel .header {
...@@ -737,6 +727,15 @@ ul li { ...@@ -737,6 +727,15 @@ ul li {
color: #005a9aff; color: #005a9aff;
} }
.frame iframe {
border: 0;
}
.join-button {
padding-bottom: 100px;
padding-top: 100px;
}
.range { .range {
width: 400px; width: 400px;
/* some space for the right knob */ /* some space for the right knob */
......
{"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;;;AAGN;EACE;;;AAIA;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;;;AAEJ;EACE;;;ACnJF;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;;AACF;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;;;ACxEJ;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"} {"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;EAEE;EACA;EACA;EACA;EAEA;EACA;EACA;;AAEA;EACE;;AAEJ;EACE;;AAEA;EACE;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;EACA;;;ACrFJ;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;;AAGA;EACE;;AACF;EACE;;AAEJ;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;;AAGN;EACE;;;AAIA;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;;;AAEJ;EACE;;;ACpJE;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;EApCR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AA0CM;EACE;EACA;EACA;EACA;EACA;EA5CR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAkDE;EACE;EACA;EACA;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAGE;EACE;;AAEF;EACE;;;ACrFV;EACE;;AACF;EAEE;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;;AAGE;EACE;EACA;;AAEF;EACE;EACA;;;AAEV;EACE;;AACA;EACE;;AACF;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;;;AAGF;EACE;;;AAEJ;EACE;EACA;;;ACjFF;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;;;ACxBJ;EACE;;AAEA;EANE;EACA;;AAQF;EAbE;EACA;;AAeF;EAhBE;EACA;;AAkBF;EAnBE;EACA;;AAqBF;EA1BE;EACA,kBANyB;;AAkC3B;EA7BE;EACA,kBAPqB;;AAsCvB;EAhCE;EACA,kBAJoB;;;AAuCtB;EApCE;EACA,kBANyB;;AA4C3B;EAvCE;EACA,kBAPqB;;AAgDvB;EA1CE;EACA,kBAJoB","file":"sass.css"}
\ No newline at end of file \ No newline at end of file
...@@ -5,8 +5,8 @@ import ...@@ -5,8 +5,8 @@ import
pkgs.fetchFromGitHub { pkgs.fetchFromGitHub {
owner = "justinwoo"; owner = "justinwoo";
repo = "easy-purescript-nix"; repo = "easy-purescript-nix";
rev = "7ebddd8613cf6736dbecef9fce4c32f2a104ef82"; rev = "c8c32741bc09e2ac0a94d5140cf51fa5de809e24";
sha256 = "1g1hlybld298kimd1varvwiflpb0k7sdqlmcqha3kswjvy5z4k6k"; sha256 = "0rn938nbxqsd7lp7l8z1y7bhzaq29vbziq6hq9llb3yh9xs10lmf";
} }
) { ) {
inherit pkgs; inherit pkgs;
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
"install-ps": "psc-package install", "install-ps": "psc-package install",
"compile": "pulp build", "compile": "pulp build",
"build": "pulp browserify -t dist/bundle.js", "build": "pulp browserify -t dist/bundle.js",
"css": "sass src/sass/sass.sass:dist/styles/sass.css && sass src/sass/bootstrap/default.sass:dist/styles/bootstrap-default.css && cp node_modules/bootstrap-dark/src/bootstrap-dark.css dist/styles/bootstrap-dark.css && sass src/sass/bootstrap/greyson.scss:dist/styles/bootstrap-greyson.css && sass src/sass/bootstrap/monotony.scss:dist/styles/bootstrap-monotony.css", "css": "sass src/sass/sass.sass:dist/styles/sass.css && sass src/sass/bootstrap/default.sass:dist/styles/bootstrap-default.css && cp node_modules/bootstrap-dark/src/bootstrap-dark.css dist/styles/bootstrap-dark.css && sass src/sass/bootstrap/greyson.scss:dist/styles/bootstrap-greyson.css && sass src/sass/bootstrap/monotony.scss:dist/styles/bootstrap-monotony.css && sass src/sass/bootstrap/darkster.scss:dist/styles/bootstrap-darkster.css && sass src/sass/bootstrap/herbie.scss:dist/styles/bootstrap-herbie.css",
"docs": "pulp docs -- --format html", "docs": "pulp docs -- --format html",
"repl": "pulp repl", "repl": "pulp repl",
"clean": "rm -Rf output node_modules", "clean": "rm -Rf output node_modules",
......
...@@ -26,6 +26,18 @@ let ...@@ -26,6 +26,18 @@ let
yarn pulp repl yarn pulp repl
''; '';
test-ps = pkgs.writeShellScriptBin "test-ps" ''
#!/usr/bin/env bash
set -e
echo "Compiling"
build-purs
echo "Testing"
# yarn pulp browserify --skip-compile -t dist/bundle.js --src-path output
# yarn pulp test --src-path output --test-path output
NODE_PATH=output node -e "require('Test.Main').main();"
'';
in in
pkgs.mkShell { pkgs.mkShell {
buildInputs = [ buildInputs = [
...@@ -35,6 +47,7 @@ pkgs.mkShell { ...@@ -35,6 +47,7 @@ pkgs.mkShell {
build build
repl repl
pkgs.yarn pkgs.yarn
test-ps
]; ];
shellHook = '' shellHook = ''
......
...@@ -11,10 +11,12 @@ ...@@ -11,10 +11,12 @@
-- | 2. We will need a more ambitious search algorithm for skipgrams. -- | 2. We will need a more ambitious search algorithm for skipgrams.
module Gargantext.Components.Annotation.AnnotatedField where module Gargantext.Components.Annotation.AnnotatedField where
import Gargantext.Prelude (Unit, bind, const, discard, not, pure, ($), (<$>), (<>)) import Data.Array as A
import Data.Maybe (Maybe(..), maybe) import Data.List ( List(..), (:), length )
import Data.Tuple (Tuple) import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple.Nested ((/\)) import Data.String.Common ( joinWith )
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ( (/\) )
--import DOM.Simple.Console (log2) --import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect (Effect) import Effect (Effect)
...@@ -22,13 +24,14 @@ import Reactix as R ...@@ -22,13 +24,14 @@ import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E import Reactix.SyntheticEvent as E
import Gargantext.Types (CTabNgramType(..), TermList) import Gargantext.Prelude
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.Annotation.Menu ( annotationMenu, AnnotationMenu, MenuType(..) )
( NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram ) import Gargantext.Components.Annotation.Utils ( termBootstrapClass, termClass )
import Gargantext.Components.Annotation.Menu (annotationMenu, MenuType(..)) import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Utils.Selection as Sel
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
import Gargantext.Types (CTabNgramType(..), TermList)
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.AnnotatedField" here = R2.here "Gargantext.Components.Annotation.AnnotatedField"
...@@ -44,96 +47,113 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent ...@@ -44,96 +47,113 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- defaultProps :: Record Props -- defaultProps :: Record Props
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit } -- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: Record Props -> R.Element annotatedField :: R2.Component Props
annotatedField p = R.createElement annotatedFieldComponent p [] annotatedField = R.createElement annotatedFieldComponent
annotatedFieldComponent :: R.Component Props annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = here.component "annotatedField" cpt annotatedFieldComponent = here.component "annotatedField" cpt
where where
cpt {ngrams,setTermList,text: fieldText} _ = do cpt {ngrams, setTermList, text: fieldText} _ = do
(_ /\ setRedrawMenu) <- R.useState' false (_ /\ setRedrawMenu) <- R.useState' false
menuRef <- R.useRef Nothing menuRef <- R.useRef (Nothing :: Maybe AnnotationMenu)
let wrapperProps = { className: "annotated-field-wrapper" } let wrapperProps = { className: "annotated-field-wrapper" }
redrawMenu = setRedrawMenu not wrap (text /\ list) = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList }
hideMenu = do , text }
R.setRef menuRef Nothing
redrawMenu
showMenu { event, text, getList, menuType } = do
let x = E.clientX event
y = E.clientY event
n = normNgram CTabTerms text
list = getList n
setList t = do
setTermList n list t
hideMenu
E.preventDefault event
--range <- Sel.getRange sel 0
--log2 "[showMenu] selection range" $ Sel.rangeToTuple range
let menu = Just
{ x
, y
, list
, menuType
, onClose: hideMenu
, setList
}
R.setRef menuRef menu
redrawMenu
onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
onSelect text mList event =
case mList of
Just list ->
showMenu { event, text, getList: const (Just list), menuType: SetTermListItem }
Nothing -> do
s <- Sel.getSelection
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> hideMenu
sel' -> do
showMenu { event, text: sel', getList: findNgramTermList ngrams, menuType: NewNgram }
Nothing -> hideMenu
wrap (text /\ list) = {text, list, onSelect}
pure $ HTML.div wrapperProps pure $ HTML.div wrapperProps
[ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef [ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
, HTML.div { className: "annotated-field-runs" } , HTML.div { className: "annotated-field-runs" }
$ annotateRun ((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText)
<$> wrap
<$> compile ngrams fieldText
] ]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList)) compile :: NgramsTable -> Maybe String -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams) compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs -- Runs
onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList } Nothing event = do
s <- Sel.getSelection
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> hideMenu { menuRef, setRedrawMenu }
sel' -> do
showMenu { event
, getList: findNgramTermList ngrams
, menuRef
, menuType: NewNgram
, ngram: normNgram CTabTerms sel'
, setRedrawMenu
, setTermList }
Nothing -> hideMenu { menuRef, setRedrawMenu }
onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList } (Just (Tuple ngram list)) event =
showMenu { event
, getList: const (Just list)
, menuRef
, menuType: SetTermListItem
, ngram
, setRedrawMenu
, setTermList }
showMenu { event, getList, menuRef, menuType, ngram, setRedrawMenu, setTermList } = do
let x = E.clientX event
y = E.clientY event
-- n = normNgram CTabTerms text
list = getList ngram
redrawMenu = setRedrawMenu not
setList t = do
setTermList ngram list t
hideMenu { menuRef, setRedrawMenu }
E.preventDefault event
--range <- Sel.getRange sel 0
--log2 "[showMenu] selection range" $ Sel.rangeToTuple range
let menu = Just
{ x
, y
, list
, menuType
, onClose: hideMenu { menuRef, setRedrawMenu }
, setList
}
R.setRef menuRef menu
redrawMenu
hideMenu { menuRef, setRedrawMenu } = do
let redrawMenu = setRedrawMenu not
R.setRef menuRef Nothing
redrawMenu
type Run = type Run =
( list :: (Maybe TermList) ( list :: List (Tuple NgramsTerm TermList)
, onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit , onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit
, text :: String , text :: String
) )
annotateRun :: Record Run -> R.Element annotateRun :: R2.Component Run
annotateRun p = R.createElement annotatedRunComponent p [] annotateRun = R.createElement annotatedRunComponent
annotatedRunComponent :: R.Component Run annotatedRunComponent :: R.Component Run
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where where
cpt { list, onSelect, text } _ = elt [ HTML.text text ] cpt { list: Nil, onSelect, text } _ =
HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ]
cpt { list: lst@((ngram /\ list) : otherLists), onSelect, text } _ =
HTML.span { className
, on: { click: onSelect (Just (ngram /\ list)) } } [ HTML.text text ]
where where
cb = onSelect text list bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst
elt = -- className = "annotation-run bg-" <> termBootstrapClass list
case list of className = "annotation-run " <> bgClasses
Nothing -> HTML.span { on: { mouseUp: cb } } -- cb = onSelect text list
Just l -> HTML.span { -- className: "annotation-run bg-" <> termBootstrapClass l -- elt =
className: "annotation-run " <> termClass l -- case list of
, on: { click: cb } -- Nothing -> HTML.span { on: { mouseUp: cb } }
} -- Just l -> HTML.span { -- className: "annotation-run bg-" <> termBootstrapClass l
-- className: "annotation-run " <> termClass l
-- , on: { click: cb }
-- }
...@@ -3,11 +3,12 @@ module Gargantext.Components.Annotation.Utils where ...@@ -3,11 +3,12 @@ module Gargantext.Components.Annotation.Utils where
import Gargantext.Types ( TermList(..) ) import Gargantext.Types ( TermList(..) )
termClass :: TermList -> String termClass :: TermList -> String
termClass CandidateTerm = "candidate-term"
termClass MapTerm = "graph-term" termClass MapTerm = "graph-term"
termClass StopTerm = "stop-term" termClass StopTerm = "stop-term"
termClass CandidateTerm = "candidate-term"
termBootstrapClass :: TermList -> String termBootstrapClass :: TermList -> String
-- termBootstrapClass CandidateTerm = "warning"
termBootstrapClass MapTerm = "success" termBootstrapClass MapTerm = "success"
termBootstrapClass StopTerm = "danger" termBootstrapClass StopTerm = "danger"
termBootstrapClass CandidateTerm = "primary" termBootstrapClass CandidateTerm = "primary"
...@@ -9,8 +9,9 @@ import Data.Maybe (Maybe(..)) ...@@ -9,8 +9,9 @@ import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Components.Category.Types import Gargantext.Components.Category.Types
( Category(..), Star(..), cat2score, categories, star2score, stars ) ( Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars )
import Gargantext.Components.DocsTable.Types import Gargantext.Components.DocsTable.Types
( DocumentsView(..), LocalCategories, LocalUserScore ) ( DocumentsView(..), LocalCategories, LocalUserScore )
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -34,19 +35,27 @@ rating = R.createElement ratingCpt ...@@ -34,19 +35,27 @@ rating = R.createElement ratingCpt
ratingCpt :: R.Component RatingProps ratingCpt :: R.Component RatingProps
ratingCpt = here.component "rating" cpt where ratingCpt = here.component "rating" cpt where
cpt { score, nodeId, row: DocumentsView r, session, setLocalCategories } _ = cpt { nodeId, row: DocumentsView r, score, session, setLocalCategories } _ =
pure $ H.div {className:"flex"} divs where pure $ H.div { className:"flex" } divs where
divs = map (\s -> H.div { className : icon' score s, on: { click: onClick s } } []) stars divs = map (\s -> H.div { className : icon' score s
, on: { click: onClick s } } []) stars
icon' Star_0 Star_0 = "fa fa-times-circle" icon' Star_0 Star_0 = "fa fa-times-circle"
icon' _ Star_0 = "fa fa-times" icon' _ Star_0 = "fa fa-times"
icon' c s = if star2score c < star2score s then "fa fa-star-o" else "fa fa-star" icon' c s = if star2score c < star2score s then "fa fa-star-o" else "fa fa-star"
onClick c = \_-> do onClick c _ = do
setLocalCategories $ Map.insert r._id c let c' = if score == c
then clickAgain c
else c
setLocalCategories $ Map.insert r._id c'
void $ launchAff void $ launchAff
$ putRating session nodeId $ putRating session nodeId
$ RatingQuery {nodeIds: [r._id], rating: c} $ RatingQuery { nodeIds: [r._id], rating: c' }
newtype RatingQuery = RatingQuery { nodeIds :: Array Int, rating :: Star } newtype RatingQuery =
RatingQuery { nodeIds :: Array Int
, rating :: Star
}
instance encodeJsonRatingQuery :: EncodeJson RatingQuery where instance encodeJsonRatingQuery :: EncodeJson RatingQuery where
encodeJson (RatingQuery post) = encodeJson (RatingQuery post) =
......
...@@ -41,6 +41,12 @@ star2score Star_2 = 2 ...@@ -41,6 +41,12 @@ star2score Star_2 = 2
star2score Star_3 = 3 star2score Star_3 = 3
star2score Star_4 = 4 star2score Star_4 = 4
clickAgain :: Star -> Star
clickAgain Star_0 = Star_1
clickAgain s = decodeStar (star2score s - 1)
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite data Category = Trash | UnRead | Checked | Topic | Favorite
......
...@@ -384,7 +384,7 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -384,7 +384,7 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
where where
sid = sessionId session sid = sessionId session
gi Star_1 = "fa fa-star" gi Star_1 = "fa fa-star"
gi _ = "fa fa-star-empty" gi _ = "fa fa-star-empty"
trashClassName Star_0 _ = "trash" trashClassName Star_0 _ = "trash"
trashClassName _ true = "active" trashClassName _ true = "active"
trashClassName _ false = "" trashClassName _ false = ""
...@@ -399,23 +399,26 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -399,23 +399,26 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
row dv@(DocumentsView r) = row dv@(DocumentsView r) =
{ row: { row:
TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ] TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
H.div { className: "" } [ docChooser { listId, mCorpusId, nodeId: r._id, selected, sidePanelTriggers, tableReload: reload } [] H.div { className: "" }
[ docChooser { listId, mCorpusId, nodeId: r._id, selected, sidePanelTriggers, tableReload: reload } []
] ]
--, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ] --, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
, H.div { className: "column-tag flex" } [ rating { score: cat, nodeId, row: dv, session, setLocalCategories } [] ] , H.div { className: "column-tag flex" }
[ rating { score: cat, nodeId, row: dv, session, setLocalCategories } [] ]
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} } --, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, H.div { className: tClassName } [ R2.showText r.date ] , H.div { className: tClassName } [ R2.showText r.date ]
, H.div { className: tClassName } [ , H.div { className: tClassName }
H.a { href: url frontends $ corpusDocument r._id, target: "_blank"} [ H.text r.title ] [ H.a { href: url frontends $ corpusDocument r._id, target: "_blank"}
] [ H.text r.title ]
]
, H.div { className: tClassName } [ H.text $ if r.source == "" then "Source" else r.source ] , H.div { className: tClassName } [ H.text $ if r.source == "" then "Source" else r.source ]
, H.div {} [ H.text $ maybe "-" show r.ngramCount ] , H.div {} [ H.text $ maybe "-" show r.ngramCount ]
] ]
, delete: true } , delete: true }
where where
cat = getCategory lc r cat = getCategory lc r
checked = Star_1 == cat -- checked = Star_1 == cat
tClassName = trashClassName cat selected tClassName = trashClassName cat selected
className = gi cat className = gi cat
selected = R.readRef currentDocIdRef == Just r._id selected = R.readRef currentDocIdRef == Just r._id
......
...@@ -10,7 +10,6 @@ module Gargantext.Components.Forest ...@@ -10,7 +10,6 @@ module Gargantext.Components.Forest
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Set as Set
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
......
...@@ -68,26 +68,30 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p [] ...@@ -68,26 +68,30 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
nodeName@(name' /\ setNodeName) <- R.useState' "Name" nodeName@(name' /\ setNodeName) <- R.useState' "Name"
nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe Folder $ head nodeTypes nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe Folder $ head nodeTypes
let let
SettingsBox {edit} = settingsBox nt SettingsBox {edit} = settingsBox nt
setNodeType' nt = do
setNodeName $ const $ GT.prettyNodeType nt
setNodeType $ const nt
(maybeChoose /\ nt') = if length nodeTypes > 1 (maybeChoose /\ nt') = if length nodeTypes > 1
then ([ formChoiceSafe nodeTypes Error setNodeType ] /\ nt) then ([ formChoiceSafe nodeTypes Error setNodeType' ] /\ nt)
else ([H.div {} [H.text $ "Creating a node of type " else ([H.div {} [H.text $ "Creating a node of type "
<> show defaultNt <> show defaultNt
<> " with name:" <> " with name:"
] ]
] /\ defaultNt ] /\ defaultNt
) )
where where
defaultNt = (fromMaybe Error $ head nodeTypes) defaultNt = (fromMaybe Error $ head nodeTypes)
maybeEdit = [ if edit maybeEdit = [ if edit
then inputWithEnter { then inputWithEnter {
onEnter: \_ -> launchAff_ $ dispatch (AddNode name' nt') onBlur: \val -> setNodeName $ const val
, onEnter: \_ -> launchAff_ $ dispatch (AddNode name' nt')
, onValueChanged: \val -> setNodeName $ const val , onValueChanged: \val -> setNodeName $ const val
, autoFocus: true , autoFocus: true
, className: "form-control" , className: "form-control"
, defaultValue: name' , defaultValue: name' -- (prettyNodeType nt')
, placeholder: name' , placeholder: name' -- (prettyNodeType nt')
, type: "text" , type: "text"
} }
else H.div {} [] else H.div {} []
......
...@@ -345,7 +345,8 @@ searchInputCpt = here.component "searchInput" cpt ...@@ -345,7 +345,8 @@ searchInputCpt = here.component "searchInput" cpt
valueRef <- R.useRef term valueRef <- R.useRef term
pure $ H.div { className: "" } [ pure $ H.div { className: "" } [
inputWithEnter { onEnter: onEnter valueRef setSearch inputWithEnter { onBlur: onBlur valueRef setSearch
, onEnter: onEnter valueRef setSearch
, onValueChanged: onValueChanged valueRef , onValueChanged: onValueChanged valueRef
, autoFocus: false , autoFocus: false
, className: "form-control" , className: "form-control"
...@@ -363,6 +364,9 @@ searchInputCpt = here.component "searchInput" cpt ...@@ -363,6 +364,9 @@ searchInputCpt = here.component "searchInput" cpt
-- , type: "text" -- , type: "text"
-- } -- }
-- ] -- ]
onBlur valueRef setSearch value = do
R.setRef valueRef value
setSearch $ _ { term = value }
onEnter valueRef setSearch _ = do onEnter valueRef setSearch _ = do
setSearch $ _ { term = R.readRef valueRef } setSearch $ _ { term = R.readRef valueRef }
......
...@@ -17,7 +17,7 @@ import Gargantext.Sessions (Session(..), post) ...@@ -17,7 +17,7 @@ import Gargantext.Sessions (Session(..), post)
import Gargantext.Types as GT import Gargantext.Types as GT
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
import URI.Query as Q import URI.Query as Q
import Data.String as String
type Search = { databases :: Database type Search = { databases :: Database
, datafield :: Maybe DataField , datafield :: Maybe DataField
...@@ -93,7 +93,7 @@ instance encodeJsonDataOriginApi :: EncodeJson DataOriginApi where ...@@ -93,7 +93,7 @@ instance encodeJsonDataOriginApi :: EncodeJson DataOriginApi where
datafield2dataOriginApi :: DataField -> DataOriginApi datafield2dataOriginApi :: DataField -> DataOriginApi
datafield2dataOriginApi (External (Just a)) = ExternalOrigin { api : a } datafield2dataOriginApi (External (Just a)) = ExternalOrigin { api : a }
datafield2dataOriginApi _ = InternalOrigin { api : IsTex } -- TOD fixme datafield2dataOriginApi _ = InternalOrigin { api : IsTex } -- TODO fixme
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Database search specifications -- | Database search specifications
...@@ -368,7 +368,7 @@ instance searchQueryToQuery :: GT.ToQuery SearchQuery where ...@@ -368,7 +368,7 @@ instance searchQueryToQuery :: GT.ToQuery SearchQuery where
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery {query, databases, datafield, node_id, lang}) encodeJson (SearchQuery {query, databases, datafield, node_id, lang})
= "query" := query = "query" := (String.replace (String.Pattern "\"") (String.Replacement "\\\"") query)
-- ~> "datafield" := "" -- fromMaybe "" datafield -- ~> "datafield" := "" -- fromMaybe "" datafield
~> "databases" := databases ~> "databases" := databases
~> "lang" := maybe "EN" show lang ~> "lang" := maybe "EN" show lang
......
...@@ -3,16 +3,18 @@ module Gargantext.Components.Forest.Tree.Node.Action.Update where ...@@ -3,16 +3,18 @@ module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Types (NodeType(..), ID) import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Prelude (Unit, bind, ($), pure)
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Reactix as R
import Reactix.DOM.HTML as H
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
...@@ -28,29 +30,41 @@ update :: NodeType ...@@ -28,29 +30,41 @@ update :: NodeType
-> R.Hooks R.Element -> R.Hooks R.Element
update NodeList dispatch = do update NodeList dispatch = do
meth @( methodList /\ setMethod ) <- R.useState' Basic meth @( methodList /\ setMethod ) <- R.useState' Basic
let setMethod' = setMethod <<< const
pure $ panel [ -- H.text "Update with" pure $ panel [ -- H.text "Update with"
formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod'
] ]
(submitButton (UpdateNode $ UpdateNodeParamsList {methodList}) dispatch) (submitButton (UpdateNode $ UpdateNodeParamsList {methodList}) dispatch)
update Graph dispatch = do update Graph dispatch = do
meth @( methodGraph /\ setMethod ) <- R.useState' Order1 meth @( methodGraph /\ setMethod ) <- R.useState' Order1
let setMethod' = setMethod <<< const
pure $ panel [ -- H.text "Update with" pure $ panel [ -- H.text "Update with"
formChoiceSafe [Order1, Order2] Order1 setMethod formChoiceSafe [Order1, Order2] Order1 setMethod'
] ]
(submitButton (UpdateNode $ UpdateNodeParamsGraph {methodGraph}) dispatch) (submitButton (UpdateNode $ UpdateNodeParamsGraph {methodGraph}) dispatch)
update Texts dispatch = do update Texts dispatch = do
meth @( methodTexts /\ setMethod ) <- R.useState' NewNgrams meth @( methodTexts /\ setMethod ) <- R.useState' NewNgrams
let setMethod' = setMethod <<< const
pure $ panel [ -- H.text "Update with" pure $ panel [ -- H.text "Update with"
formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams setMethod formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams setMethod'
] ]
(submitButton (UpdateNode $ UpdateNodeParamsTexts {methodTexts}) dispatch) (submitButton (UpdateNode $ UpdateNodeParamsTexts {methodTexts}) dispatch)
update Dashboard dispatch = do update Dashboard dispatch = do
meth @( methodBoard /\ setMethod ) <- R.useState' All meth @( methodBoard /\ setMethod ) <- R.useState' All
let setMethod' = setMethod <<< const
pure $ panel [ -- H.text "Update with" pure $ panel [ -- H.text "Update with"
formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All setMethod formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All setMethod'
] ]
(submitButton (UpdateNode $ UpdateNodeParamsBoard {methodBoard}) dispatch) (submitButton (UpdateNode $ UpdateNodeParamsBoard {methodBoard}) dispatch)
......
...@@ -80,6 +80,9 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -80,6 +80,9 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
fileType@(_ /\ setFileType) <- R.useState' CSV fileType@(_ /\ setFileType) <- R.useState' CSV
lang@( _chosenLang /\ setLang) <- R.useState' EN lang@( _chosenLang /\ setLang) <- R.useState' EN
let setFileType' = setFileType <<< const
let setLang' = setLang <<< const
let bodies = let bodies =
[ R2.row [ R2.row
[ H.div { className:"col-12 flex-space-around"} [ H.div { className:"col-12 flex-space-around"}
...@@ -99,12 +102,12 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -99,12 +102,12 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
, WOS , WOS
, PresseRIS , PresseRIS
, Arbitrary , Arbitrary
] CSV setFileType ] CSV setFileType'
] ]
] ]
, R2.row , R2.row
[ H.div {className:"col-6 flex-space-around"} [ H.div {className:"col-6 flex-space-around"}
[ formChoiceSafe [EN, FR, No_extraction, Universal] EN setLang ] [ formChoiceSafe [EN, FR, No_extraction, Universal] EN setLang' ]
] ]
] ]
......
...@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Box where ...@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Box where
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -27,9 +28,9 @@ import Gargantext.Components.Forest.Tree.Node.Box.Types (NodePopupProps, NodePop ...@@ -27,9 +28,9 @@ import Gargantext.Components.Forest.Tree.Node.Box.Types (NodePopupProps, NodePop
import Gargantext.Components.Forest.Tree.Node.Settings import Gargantext.Components.Forest.Tree.Node.Settings
(NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox) (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Status (Status(..), hasStatus) import Gargantext.Components.Forest.Tree.Node.Status (Status(..), hasStatus)
import Gargantext.Components.Forest.Tree.Node.Tools (textInputBox, fragmentPT, panel, prettyNodeType) import Gargantext.Components.Forest.Tree.Node.Tools (textInputBox, fragmentPT, panel)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (Name, ID) import Gargantext.Types (Name, ID, prettyNodeType)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, glyphiconActive) import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
......
...@@ -11,6 +11,7 @@ import Data.Set as Set ...@@ -11,6 +11,7 @@ import Data.Set as Set
import Data.String as S import Data.String as S
import Data.String.CodeUnits as DSCU import Data.String.CodeUnits as DSCU
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_) import Effect.Aff (Aff, launchAff, launchAff_)
import Reactix as R import Reactix as R
...@@ -20,8 +21,9 @@ import Toestand as T ...@@ -20,8 +21,9 @@ import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action, icon, text) import Gargantext.Components.Forest.Tree.Node.Action (Action, icon, text)
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (ID, Name)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, toggleSet) import Gargantext.Utils (glyphicon, toggleSet)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -49,11 +51,11 @@ panel bodies submit = ...@@ -49,11 +51,11 @@ panel bodies submit =
[ H.div { className: "mx-auto"} [ submit ] ]]] [ H.div { className: "mx-auto"} [ submit ] ]]]
type TextInputBoxProps = type TextInputBoxProps =
( id :: ID ( id :: GT.ID
, dispatch :: Action -> Aff Unit , dispatch :: Action -> Aff Unit
, text :: String , text :: String
, isOpen :: T.Box Boolean , isOpen :: T.Box Boolean
, boxName :: String , boxName :: String
, boxAction :: String -> Action , boxAction :: String -> Action
) )
...@@ -68,17 +70,31 @@ textInputBoxCpt = here.component "textInputBox" cpt where ...@@ -68,17 +70,31 @@ textInputBoxCpt = here.component "textInputBox" cpt where
content false _ = (R.fragment []) content false _ = (R.fragment [])
content true renameNodeNameRef = content true renameNodeNameRef =
H.div { className: "from-group row" } H.div { className: "from-group row" }
[ H.div { className: "col-8" } [ textInput renameNodeNameRef
[ inputWithEnter , submitBtn renameNodeNameRef
{ type: "text", autoFocus: true, defaultValue: text, className: "form-control" , cancelBtn
, onEnter: submit renameNodeNameRef ]
, onValueChanged: R.setRef renameNodeNameRef textInput renameNodeNameRef =
, placeholder: boxName <> " Node" } ] H.div { className: "col-8" }
, H.a { type: "button", title: "Submit" [ inputWithEnter {
, on: { click: submit renameNodeNameRef } autoFocus: true
, className: "col-2 " <> glyphicon "floppy-o" } [] , className: "form-control"
, H.a { type: "button", title: "Cancel", on: { click } , defaultValue: text
, className: "text-danger col-2 " <> glyphicon "times" } [] ] , onBlur: R.setRef renameNodeNameRef
, onEnter: submit renameNodeNameRef
, onValueChanged: R.setRef renameNodeNameRef
, placeholder: (boxName <> " Node")
, type: "text"
}
]
submitBtn renameNodeNameRef =
H.a { type: "button"
, title: "Submit"
, on: { click: submit renameNodeNameRef }
, className: "col-2 " <> glyphicon "floppy-o" } []
cancelBtn =
H.a { type: "button", title: "Cancel", on: { click }
, className: "text-danger col-2 " <> glyphicon "times" } []
submit ref _ = do submit ref _ = do
launchAff_ $ dispatch (boxAction $ R.readRef ref) launchAff_ $ dispatch (boxAction $ R.readRef ref)
T.write_ false isOpen T.write_ false isOpen
...@@ -96,9 +112,14 @@ formEdit defaultValue setter = ...@@ -96,9 +112,14 @@ formEdit defaultValue setter =
-- | Form Choice input -- | Form Choice input
-- if the list of options is not big enough, a button is used instead -- if the list of options is not big enough, a button is used instead
formChoiceSafe formChoiceSafe :: forall a b c
:: forall a b c. Read a => Show a . Read a
=> Array a -> a -> ((b -> a) -> Effect c) -> R.Element => Show a
=> Array a
-> a
-> (a -> Effect c)
-- -> ((b -> a) -> Effect c)
-> R.Element
formChoiceSafe [] _ _ = H.div {} [] formChoiceSafe [] _ _ = H.div {} []
formChoiceSafe [n] _defaultNodeType setNodeType = formChoiceSafe [n] _defaultNodeType setNodeType =
...@@ -108,27 +129,44 @@ formChoiceSafe nodeTypes defaultNodeType setNodeType = ...@@ -108,27 +129,44 @@ formChoiceSafe nodeTypes defaultNodeType setNodeType =
formChoice nodeTypes defaultNodeType setNodeType formChoice nodeTypes defaultNodeType setNodeType
-- | List Form -- | List Form
formChoice formChoice :: forall a b c d
:: forall a b c d. Read b => Show d . Read b
=> Array d -> b -> ((c -> b) -> Effect a) -> R.Element => Show d
=> Array d
-> b
-> (b -> Effect a)
-- -> ((c -> b) -> Effect a)
-> R.Element
formChoice nodeTypes defaultNodeType setNodeType = formChoice nodeTypes defaultNodeType setNodeType =
H.div { className: "form-group"} H.div { className: "form-group"}
[ R2.select { className: "form-control", on: { change } } [ R2.select { className: "form-control"
(map (\opt -> H.option {} [ H.text $ show opt ]) nodeTypes) , on: { change: \e -> setNodeType $ fromMaybe defaultNodeType $ read $ R.unsafeEventValue e }
] where }
change = setNodeType <<< const <<< fromMaybe defaultNodeType <<< read <<< R.unsafeEventValue (map (\opt -> H.option {} [ H.text $ show opt ]) nodeTypes)
]
-- | Button Form -- | Button Form
-- FIXME: currently needs a click from the user (by default, we could avoid such click) -- FIXME: currently needs a click from the user (by default, we could avoid such click)
formButton :: forall a b c. Show a => a -> ((b -> a) -> Effect c) -> R.Element formButton :: forall a b c
. Show a
=> a
-> (a -> Effect c)
-- -> ((b -> a) -> Effect c)
-> R.Element
formButton nodeType setNodeType = formButton nodeType setNodeType =
H.div {} H.div {} [ H.text $ "Confirm the selection of: " <> show nodeType
[ H.text $ "Confirm the selection of: " <> show nodeType , bouton
, H.button ]
{ className: "cold-md-5 btn btn-primary center", on: { click } where
, type: "button", title: "Form Button", style : { width: "100%" } } bouton = H.button { className : "cold-md-5 btn btn-primary center"
[ H.text $ "Confirmation" ]] where , type : "button"
click _ = setNodeType $ const nodeType , title: "Form Button"
, style : { width: "100%" }
, on: { click: \_ -> setNodeType nodeType }
} [H.text $ "Confirmation"]
------------------------------------------------------------------------
------------------------------------------------------------------------
submitButton :: Action -> (Action -> Aff Unit) -> R.Element submitButton :: Action -> (Action -> Aff Unit) -> R.Element
submitButton action dispatch = submitButton action dispatch =
...@@ -189,64 +227,88 @@ prettyNodeType ...@@ -189,64 +227,88 @@ prettyNodeType
<<< S.replace (S.Pattern "Folder") (S.Replacement " ") <<< S.replace (S.Pattern "Folder") (S.Replacement " ")
<<< show <<< show
tooltipId :: GT.NodeID -> String
tooltipId id = "node-link-" <> show id
-- START node link -- START node link
type NodeLinkProps = ( type NodeLinkProps = (
frontends :: Frontends frontends :: Frontends
, id :: Int
, folderOpen :: T.Box Boolean , folderOpen :: T.Box Boolean
, handed :: GT.Handed
, id :: Int
, isSelected :: Boolean , isSelected :: Boolean
, name :: Name , name :: GT.Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, session :: Session , session :: Session
, handed :: GT.Handed
) )
nodeLink :: R2.Component NodeLinkProps nodeLink :: R2.Component NodeLinkProps
nodeLink = R.createElement nodeLinkCpt nodeLink = R.createElement nodeLinkCpt
nodeLinkCpt :: R.Component NodeLinkProps nodeLinkCpt :: R.Component NodeLinkProps
nodeLinkCpt = here.component "nodeLink" cpt where nodeLinkCpt = here.component "nodeLink" cpt
cpt { frontends, handed, id, isSelected, name, nodeType, session where
, folderOpen } _ = do cpt { folderOpen
popoverRef <- R.useRef null , frontends
pure $ , handed
H.div { className: "node-link", on: { click } } , id
[ H.a { href, data: { for: tooltipId, tip: true } } , isSelected
[ nodeText { isSelected, name, handed } ] , name
, ReactTooltip.reactTooltip { id: tooltipId } , nodeType
[ R2.row , session
[ H.h4 {className: GT.fldr nodeType true} } _ = do
[ H.text $ prettyNodeType nodeType ] popoverRef <- R.useRef null
, R2.row [ H.span {} [ H.text $ name ]]
]]] where pure $
-- NOTE Don't toggle tree if it is not selected H.div { className: "node-link"
-- click on closed -> open , on: { click } }
-- click on open -> ? [ H.a { href, data: { for: tooltipId, tip: true } }
click _ = when (not isSelected) (T.write_ true folderOpen) [ nodeText { handed, isSelected, name } []
tooltipId = "node-link-" <> show id , ReactTooltip.reactTooltip { id: tooltipId id }
href = url frontends $ GT.NodePath (sessionId session) nodeType (Just id) [ R2.row
[ H.h4 {className: GT.fldr nodeType true}
[ H.text $ GT.prettyNodeType nodeType ]
]
, R2.row [ H.span {} [ H.text $ name ]]
]
]
]
where
-- NOTE Don't toggle tree if it is not selected
-- click on closed -> open
-- click on open -> ?
click _ = when (not isSelected) (T.write_ true folderOpen)
tooltipId id = "node-link-" <> show id
href = url frontends $ GT.NodePath (sessionId session) nodeType (Just id)
-- END node link
type NodeTextProps = type NodeTextProps =
( isSelected :: Boolean ( isSelected :: Boolean
, name :: Name
, handed :: GT.Handed , handed :: GT.Handed
, name :: GT.Name
) )
nodeText :: Record NodeTextProps -> R.Element nodeText :: R2.Component NodeTextProps
nodeText p = R.createElement nodeTextCpt p [] nodeText = R.createElement nodeTextCpt
nodeTextCpt :: R.Component NodeTextProps nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = here.component "nodeText" cpt where nodeTextCpt = here.component "nodeText" cpt where
cpt { isSelected: true, name } _ = cpt { isSelected, handed, name } _ =
pure $ H.u {} [ H.b {} [ H.text ("| " <> name15 name <> " | ") ] ] pure $ if isSelected then
cpt { isSelected: false, name, handed } _ = do H.u { className }
pure $ GT.flipHanded l r handed where [ H.b {}
l = H.text "..." [ H.text ("| " <> name15 name <> " | ") ]
r = H.text (name15 name) ]
else
GT.flipHanded l r handed where
l = H.text "..."
r = H.text (name15 name)
name_ len n = name_ len n =
if S.length n < len then n if S.length n < len then n
else case (DSCU.slice 0 len n) of else case (DSCU.slice 0 len n) of
Nothing -> "???" Nothing -> "???"
Just s -> s <> "..." Just s -> s <> "..."
name15 = name_ 15 name15 = name_ 15
className = "node-text"
...@@ -104,13 +104,18 @@ subTreeTreeView props = R.createElement subTreeTreeViewCpt props [] ...@@ -104,13 +104,18 @@ subTreeTreeView props = R.createElement subTreeTreeViewCpt props []
subTreeTreeViewCpt :: R.Component CorpusTreeProps subTreeTreeViewCpt :: R.Component CorpusTreeProps
subTreeTreeViewCpt = here.component "subTreeTreeViewCpt" cpt where subTreeTreeViewCpt = here.component "subTreeTreeViewCpt" cpt where
cpt p@{ tree: NTree (LNode { id: targetId, name, nodeType }) ary cpt p@{ tree: NTree (LNode { id: targetId, name, nodeType }) ary
, id, subTreeParams, dispatch, action, handed } _ = , id, subTreeParams, dispatch, action, handed } _ = do
pure $ H.div {} $ GT.reverseHanded pure $ H.div {} $ GT.reverseHanded
[ H.div { className: nodeClass validNodeType } [ H.div { className: nodeClass validNodeType }
[ H.span { className: "text", on: { click } } [ H.span { className: "text"
[ nodeText { isSelected: isSelected targetId valAction , on: { click } }
, name: " " <> name, handed } [ nodeText { handed
, H.span { className: "children" } children ]]] , isSelected: isSelected targetId valAction
, name: " " <> name } []
, H.span { className: "children" } children
]
]
]
handed handed
where where
nodeClass vnt = "node " <> GT.fldr nodeType true <> " " <> validNodeTypeClass where nodeClass vnt = "node " <> GT.fldr nodeType true <> " " <> validNodeTypeClass where
......
...@@ -26,6 +26,7 @@ import Gargantext.AsyncTasks as GAT ...@@ -26,6 +26,7 @@ import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Search (nodeSearchControl)
import Gargantext.Components.GraphExplorer.Sidebar as Sidebar import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
...@@ -175,6 +176,9 @@ explorerCpt = here.component "explorer" cpt ...@@ -175,6 +176,9 @@ explorerCpt = here.component "explorer" cpt
[ col [ spaces [ Toggle.treeToggleButton { state: controls.showTree } [] ]] [ col [ spaces [ Toggle.treeToggleButton { state: controls.showTree } [] ]]
, col [ spaces [ Toggle.controlsToggleButton { state: controls.showControls } [] ]] , col [ spaces [ Toggle.controlsToggleButton { state: controls.showControls } [] ]]
, col [ spaces [ Toggle.sidebarToggleButton { state: controls.showSidePanel } [] ]] , col [ spaces [ Toggle.sidebarToggleButton { state: controls.showSidePanel } [] ]]
, col [ spaces [ nodeSearchControl { graph
, multiSelectEnabled: controls.multiSelectEnabled
, selectedNodeIds: controls.selectedNodeIds } [] ] ]
] ]
] ]
, RH.div { className: "graph-container" } [ , RH.div { className: "graph-container" } [
......
...@@ -85,7 +85,7 @@ cameraButton { id ...@@ -85,7 +85,7 @@ cameraButton { id
edges <- Sigmax.getEdges s edges <- Sigmax.getEdges s
nodes <- Sigmax.getNodes s nodes <- Sigmax.getNodes s
let graphData = GET.GraphData $ hyperdataGraph { edges = map GEU.stEdgeToGET edges let graphData = GET.GraphData $ hyperdataGraph { edges = map GEU.stEdgeToGET edges
, nodes = map GEU.stNodeToGET nodes } , nodes = GEU.normalizeNodes $ map GEU.stNodeToGET nodes }
let cameras = map Sigma.toCamera $ Sigma.cameras s let cameras = map Sigma.toCamera $ Sigma.cameras s
let camera = case cameras of let camera = case cameras of
[c] -> GET.Camera { ratio: c.ratio, x: c.x, y: c.y } [c] -> GET.Camera { ratio: c.ratio, x: c.x, y: c.y }
......
...@@ -22,7 +22,6 @@ import Toestand as T ...@@ -22,7 +22,6 @@ import Toestand as T
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Button (centerButton, cameraButton) import Gargantext.Components.GraphExplorer.Button (centerButton, cameraButton)
import Gargantext.Components.GraphExplorer.RangeControl (edgeConfluenceControl, edgeWeightControl, nodeSizeControl) import Gargantext.Components.GraphExplorer.RangeControl (edgeConfluenceControl, edgeWeightControl, nodeSizeControl)
import Gargantext.Components.GraphExplorer.Search (nodeSearchControl)
import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSelectorSizeButton) import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSelectorSizeButton)
import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, louvainToggleButton, pauseForceAtlasButton) import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, louvainToggleButton, pauseForceAtlasButton)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
...@@ -180,15 +179,13 @@ controlsCpt = here.component "controls" cpt ...@@ -180,15 +179,13 @@ controlsCpt = here.component "controls" cpt
, RH.li { className: "nav-item" } [ multiSelectEnabledButton { state: multiSelectEnabled } [] ] -- toggle multi node selection , RH.li { className: "nav-item" } [ multiSelectEnabledButton { state: multiSelectEnabled } [] ] -- toggle multi node selection
-- save button -- save button
, RH.li { className: "nav-item" } , RH.li { className: "nav-item" }
[ nodeSearchControl { graph: graph [ mouseSelectorSizeButton sigmaRef localControls.mouseSelectorSize ]
, multiSelectEnabled: multiSelectEnabled , RH.li { className: "nav-item" }
, selectedNodeIds: selectedNodeIds } [] ] [ cameraButton { id: graphId
, RH.li { className: "nav-item" } [ mouseSelectorSizeButton sigmaRef localControls.mouseSelectorSize ] , hyperdataGraph: hyperdataGraph
, RH.li { className: "nav-item" } [ cameraButton { id: graphId , session: session
, hyperdataGraph: hyperdataGraph , sigmaRef: sigmaRef
, session: session , reloadForest: reloadForest } ]
, sigmaRef: sigmaRef
, reloadForest: reloadForest } ]
] ]
] ]
-- RH.ul {} [ -- change type button (?) -- RH.ul {} [ -- change type button (?)
......
module Gargantext.Components.GraphExplorer.Utils module Gargantext.Components.GraphExplorer.Utils where
where
import Data.Maybe (Maybe(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as ST import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils.Array as GUA
stEdgeToGET :: Record ST.Edge -> GET.Edge stEdgeToGET :: Record ST.Edge -> GET.Edge
...@@ -20,3 +22,29 @@ stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } } ...@@ -20,3 +22,29 @@ stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } }
, x , x
, y , y
} }
normalizeNodes :: Array GET.Node -> Array GET.Node
normalizeNodes ns = map normalizeNode ns
where
xs = map (\(GET.Node { x }) -> x) ns
ys = map (\(GET.Node { y }) -> y) ns
mMinx = GUA.min xs
mMaxx = GUA.max xs
mMiny = GUA.min ys
mMaxy = GUA.max ys
mXrange = do
minx <- mMinx
maxx <- mMaxx
pure $ maxx - minx
mYrange = do
miny <- mMiny
maxy <- mMaxy
pure $ maxy - miny
xdivisor = case mXrange of
Nothing -> 1.0
Just xdiv -> 1.0 / xdiv
ydivisor = case mYrange of
Nothing -> 1.0
Just ydiv -> 1.0 / ydiv
normalizeNode (GET.Node n@{ x, y }) = GET.Node $ n { x = x * xdivisor
, y = y * ydivisor }
...@@ -11,7 +11,8 @@ here :: R2.Here ...@@ -11,7 +11,8 @@ here :: R2.Here
here = R2.here "Gargantext.Components.InputWithEnter" here = R2.here "Gargantext.Components.InputWithEnter"
type Props a = ( type Props a = (
onEnter :: Unit -> Effect Unit onBlur :: String -> Effect Unit
, onEnter :: Unit -> Effect Unit
, onValueChanged :: String -> Effect Unit , onValueChanged :: String -> Effect Unit
, autoFocus :: Boolean , autoFocus :: Boolean
...@@ -27,9 +28,10 @@ inputWithEnter props = R.createElement inputWithEnterCpt props [] ...@@ -27,9 +28,10 @@ inputWithEnter props = R.createElement inputWithEnterCpt props []
inputWithEnterCpt :: forall a. R.Component (Props a) inputWithEnterCpt :: forall a. R.Component (Props a)
inputWithEnterCpt = here.component "inputWithEnter" cpt inputWithEnterCpt = here.component "inputWithEnter" cpt
where where
cpt props@{ onEnter, onValueChanged cpt props@{ onBlur, onEnter, onValueChanged
, autoFocus, className, defaultValue, placeholder } _ = do , autoFocus, className, defaultValue, placeholder } _ = do
pure $ H.input { on: { input: onInput pure $ H.input { on: { blur: onBlur'
, input: onInput
, keyPress: onKeyPress } , keyPress: onKeyPress }
, autoFocus , autoFocus
, className , className
...@@ -38,6 +40,7 @@ inputWithEnterCpt = here.component "inputWithEnter" cpt ...@@ -38,6 +40,7 @@ inputWithEnterCpt = here.component "inputWithEnter" cpt
, type: props.type } , type: props.type }
where where
onBlur' e = onBlur $ R.unsafeEventValue e
onInput e = onValueChanged $ R.unsafeEventValue e onInput e = onValueChanged $ R.unsafeEventValue e
onKeyPress e = do onKeyPress e = do
......
...@@ -142,7 +142,7 @@ tableContainerCpt { dispatch ...@@ -142,7 +142,7 @@ tableContainerCpt { dispatch
$ CoreAction $ CoreAction
$ addNewNgramA $ addNewNgramA
(normNgram tabNgramType searchQuery) (normNgram tabNgramType searchQuery)
CandidateTerm MapTerm
} }
} }
[ H.text ("Add " <> searchQuery) ] [ H.text ("Add " <> searchQuery) ]
...@@ -531,9 +531,8 @@ selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ng ...@@ -531,9 +531,8 @@ selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ng
type MainNgramsTableProps = ( type MainNgramsTableProps = (
cacheState :: T.Box NT.CacheState cacheState :: T.Box NT.CacheState
, defaultListId :: Int , defaultListId :: Int
, nodeId :: Int
-- ^ This node can be a corpus or contact. -- ^ This node can be a corpus or contact.
, path :: T.Box PageParams , path :: T.Box PageParams
, session :: Session , session :: Session
, tabType :: TabType , tabType :: TabType
| CommonProps | CommonProps
...@@ -548,18 +547,15 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -548,18 +547,15 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
cpt props@{ afterSync cpt props@{ afterSync
, cacheState , cacheState
, defaultListId , defaultListId
, nodeId
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, session
, sidePanelTriggers , sidePanelTriggers
, tabNgramType , tabNgramType
, tabType
, tasks , tasks
, withAutoUpdate } _ = do , withAutoUpdate } _ = do
cacheState' <- T.useLive T.unequal cacheState cacheState' <- T.useLive T.unequal cacheState
path' <- T.useLive T.unequal path path'@{ nodeId, tabType, session } <- T.useLive T.unequal path
-- let path = initialPageParams session nodeId [defaultListId] tabType -- let path = initialPageParams session nodeId [defaultListId] tabType
...@@ -576,7 +572,7 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -576,7 +572,7 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
, versioned , versioned
, withAutoUpdate } [] , withAutoUpdate } []
useLoaderWithCacheAPI { useLoaderWithCacheAPI {
cacheEndpoint: versionEndpoint props cacheEndpoint: versionEndpoint { defaultListId, path: path' }
, handleResponse , handleResponse
, mkRequest , mkRequest
, path: path' , path: path'
...@@ -597,8 +593,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -597,8 +593,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
useLoader path' loader render useLoader path' loader render
-- NOTE With cache on -- NOTE With cache on
versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version -- versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version
versionEndpoint { defaultListId, nodeId, session, tabType } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId) versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
-- NOTE With cache off -- NOTE With cache off
loader :: PageParams -> Aff VersionedWithCountNgramsTable loader :: PageParams -> Aff VersionedWithCountNgramsTable
......
...@@ -297,7 +297,7 @@ termStyle :: T.TermList -> Number -> DOM.Props ...@@ -297,7 +297,7 @@ termStyle :: T.TermList -> Number -> DOM.Props
termStyle T.MapTerm opacity = DOM.style { color: "green", opacity } termStyle T.MapTerm opacity = DOM.style { color: "green", opacity }
termStyle T.StopTerm opacity = DOM.style { color: "red", opacity termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" } , textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity } termStyle T.CandidateTerm opacity = DOM.style { color: "#767676", opacity }
tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams = tablePatchHasNgrams ngramsTablePatch ngrams =
......
...@@ -27,6 +27,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -27,6 +27,7 @@ module Gargantext.Components.NgramsTable.Core
, VersionedWithCountNgramsTable , VersionedWithCountNgramsTable
, NgramsTablePatch , NgramsTablePatch
, CoreState , CoreState
, HighlightElement
, highlightNgrams , highlightNgrams
, initialPageParams , initialPageParams
, loadNgramsTable , loadNgramsTable
...@@ -100,9 +101,10 @@ import Data.Lens.Index (class Index, ix) ...@@ -100,9 +101,10 @@ import Data.Lens.Index (class Index, ix)
import Data.Lens.Iso.Newtype (_Newtype) import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop) import Data.Lens.Record (prop)
import Data.List ((:), List(Nil)) import Data.List ((:), List(Nil))
import Data.List as L
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust) import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
import Data.Monoid.Additive (Additive(..)) import Data.Monoid.Additive (Additive(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Set (Set) import Data.Set (Set)
...@@ -114,7 +116,7 @@ import Data.String.Regex.Flags (global, multiline) as R ...@@ -114,7 +116,7 @@ import Data.String.Regex.Flags (global, multiline) as R
import Data.String.Utils as SU import Data.String.Utils as SU
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.These (These(..)) import Data.These (These(..))
import Data.Traversable (for, traverse_) import Data.Traversable (for, traverse_, traverse)
import Data.TraversableWithIndex (traverseWithIndex) import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..), snd) import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
...@@ -499,67 +501,70 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global < ...@@ -499,67 +501,70 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global <
Left e -> unsafePartial $ crashWith e Left e -> unsafePartial $ crashWith e
Right r -> r Right r -> r
type HighlightElement = Tuple String (List (Tuple NgramsTerm TermList))
type HighlightAccumulator = List HighlightElement
-- TODO: while this function works well with word boundaries, -- TODO: while this function works well with word boundaries,
-- it inserts too many spaces. -- it inserts too many spaces.
highlightNgrams :: CTabNgramType -> NgramsTable -> String -> Array (Tuple String (Maybe TermList)) highlightNgrams :: CTabNgramType -> NgramsTable -> String -> Array HighlightElement
highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 = highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
-- trace {pats, input0, input, ixs} \_ -> -- trace {pats, input0, input, ixs} \_ ->
let sN = unsafePartial (foldl goFold {i0: 0, s: input, l: Nil} ixs) in A.fromFoldable ((\(s /\ ls)-> undb s /\ ls) <$> unsafePartial (foldl goFold ((input /\ Nil) : Nil) ixs))
A.reverse (A.fromFoldable (consNonEmpty (undb (init sN.s)) sN.l))
where where
spR x = " " <> R.replace wordBoundaryReg "$1$1" x <> " " spR x = " " <> R.replace wordBoundaryReg "$1$1" x <> " "
reR = R.replace wordBoundaryReg " " reR = R.replace wordBoundaryReg " "
db = S.replaceAll (S.Pattern " ") (S.Replacement " ") db = S.replaceAll (S.Pattern " ") (S.Replacement " ")
sp x = " " <> db x <> " " sp x = " " <> db x <> " "
undb = R.replace wordBoundaryReg2 "$1" undb = R.replace wordBoundaryReg2 "$1"
init x = S.take (S.length x - 1) x
input = spR input0 input = spR input0
pats = A.fromFoldable (Map.keys elts) pats = A.fromFoldable (Map.keys elts)
ixs = indicesOfAny (sp <<< ngramsTermText <$> pats) (normNgramInternal ntype input) ixs = indicesOfAny (sp <<< ngramsTermText <$> pats) (normNgramInternal ntype input)
consOnJustTail s xs@(Tuple _ (Just _) : _) = splitAcc :: Partial => Int -> HighlightAccumulator
Tuple s Nothing : xs -> Tuple HighlightAccumulator HighlightAccumulator
consOnJustTail _ xs = xs splitAcc i = go 0 Nil
where
consNonEmpty x xs go j pref acc =
| S.null x = xs case compare i j of
| otherwise = Tuple x Nothing : xs LT -> crashWith "highlightNgrams: splitAcc': i < j"
EQ -> L.reverse pref /\ acc
-- NOTE that only the first matching pattern is used, the others are ignored! GT ->
goFold :: Partial => _ -> Tuple Int (Array Int) -> _ case acc of
goFold { i0, s, l } (Tuple i pis) Nil -> crashWith "highlightNgrams: splitAcc': acc=Nil" -- pref /\ Nil
| i < i0 = elt@(s /\ ls) : elts ->
-- Skip this pattern which is overlapping with a previous one. let slen = S.length s in
{ i0, s, l } case compare i (j + slen) of
| otherwise = LT -> let {before: s0, after: s1} = S.splitAt (i - j) s in
case A.index pis 0 of L.reverse ((s0 /\ ls) : pref) /\ ((s1 /\ ls) : elts)
EQ -> L.reverse (elt : pref) /\ elts
GT -> go (j + slen) (elt : pref) elts
extractInputTextMatch :: Int -> Int -> String -> String
extractInputTextMatch i len input = undb $ S.take len $ S.drop (i + 1) input
addNgramElt ng ne_list (elt /\ elt_lists) = (elt /\ ((ng /\ ne_list) : elt_lists))
goAcc :: Partial => Int -> HighlightAccumulator -> Tuple NgramsTerm Int -> HighlightAccumulator
goAcc i acc (pat /\ lpat) =
case lookupRootList pat table of
Nothing -> Nothing ->
{ i0, s, l } crashWith "highlightNgrams: pattern missing from table"
Just pi -> Just ne_list ->
case A.index pats pi of let
Nothing -> (acc0 /\ acc1_2) = splitAcc i acc
crashWith "highlightNgrams: out of bounds pattern" (acc1 /\ acc2) = splitAcc (lpat + 1) acc1_2
Just pat -> text = extractInputTextMatch i lpat input
let lpat = S.length (db (ngramsTermText pat)) in ng = normNgram ntype text
case lookupRootList pat table of in
Nothing -> acc0 <> (addNgramElt ng ne_list <$> acc1) <> acc2
crashWith "highlightNgrams: pattern missing from table"
Just ne_list -> goFold :: Partial => HighlightAccumulator -> Tuple Int (Array Int) -> HighlightAccumulator
let goFold acc (Tuple i pis) = foldl (goAcc i) acc $
s1 = S.splitAt (i - i0) s -- A.sortWith snd $
s2 = S.splitAt lpat (S.drop 1 s1.after) map (\pat -> pat /\ S.length (db (ngramsTermText pat))) $
s3 = S.splitAt 1 s2.after fromMaybe' (\_ -> crashWith "highlightNgrams: out of bounds pattern") $
unspB = if i0 == 0 then S.drop 1 else identity traverse (A.index pats) pis
s3b = s3.before
in
-- trace {s, i, i0, s1, s2, s3, pat, lpat, s3b} \_ ->
-- `undb s2.before` and pat might differ by casing only!
{ i0: i + lpat + 2
, s: s3.after
, l: Tuple (undb s2.before) (Just ne_list) :
consOnJustTail s3b
(consNonEmpty (unspB (undb s1.before)) l)
}
----------------------------------------------------------------------------------- -----------------------------------------------------------------------------------
......
...@@ -132,7 +132,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -132,7 +132,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where
type NTCommon = type NTCommon =
( cacheState :: T.Box LTypes.CacheState ( cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int , defaultListId :: Int
, nodeId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
......
...@@ -130,6 +130,7 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt ...@@ -130,6 +130,7 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
autoFocus: true autoFocus: true
, className: "form-control" , className: "form-control"
, defaultValue: R.readRef valueRef , defaultValue: R.readRef valueRef
, onBlur: R.setRef valueRef
, onEnter: onClick , onEnter: onClick
, onValueChanged: R.setRef valueRef , onValueChanged: R.setRef valueRef
, placeholder , placeholder
......
...@@ -119,9 +119,14 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt ...@@ -119,9 +119,14 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
item (true /\ setIsEditing) valueRef = item (true /\ setIsEditing) valueRef =
H.div { className: "input-group col-sm-6" } H.div { className: "input-group col-sm-6" }
[ inputWithEnter [ inputWithEnter
{ autoFocus: true, className: "form-control", type: "text" { autoFocus: true
, defaultValue: R.readRef valueRef, onEnter: click , className: "form-control"
, onValueChanged: R.setRef valueRef, placeholder } , defaultValue: R.readRef valueRef
, onBlur: R.setRef valueRef
, onEnter: click
, onValueChanged: R.setRef valueRef
, placeholder
, type: "text" }
, H.div { className: "btn input-group-append", on: { click } } , H.div { className: "btn input-group-append", on: { click } }
[ H.div { className: "input-group-text fa fa-floppy-o" } [] ]] [ H.div { className: "input-group-text fa fa-floppy-o" } [] ]]
where where
......
...@@ -148,30 +148,29 @@ ngramsView = R.createElement ngramsViewCpt ...@@ -148,30 +148,29 @@ ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewTabsProps ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt ngramsViewCpt = here.component "ngramsView" cpt
where where
cpt { reloadRoot cpt { cacheState
, tasks
, cacheState
, defaultListId , defaultListId
, reloadForest
, reloadRoot
, mode , mode
, nodeId , nodeId
, session , session
, sidePanelTriggers , sidePanelTriggers
, reloadForest } _ = do , tasks } _ = do
path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs) path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
pure $ NT.mainNgramsTable { pure $ NT.mainNgramsTable {
reloadRoot afterSync: \_ -> pure unit
, afterSync: \_ -> pure unit
, tasks
, cacheState , cacheState
, defaultListId , defaultListId
, nodeId
, path , path
, tabType , reloadForest
, reloadRoot
, session , session
, sidePanelTriggers , sidePanelTriggers
, tabNgramType , tabNgramType
, reloadForest , tabType
, tasks
, withAutoUpdate: false , withAutoUpdate: false
} [] } []
where where
......
...@@ -220,7 +220,14 @@ fieldCodeEditorWrapperCpt = here.component "fieldCodeEditorWrapperCpt" cpt ...@@ -220,7 +220,14 @@ fieldCodeEditorWrapperCpt = here.component "fieldCodeEditorWrapperCpt" cpt
H.div { className: "card-header" } [ H.div { className: "card-header" } [
H.div { className: "code-editor-heading row" } [ H.div { className: "code-editor-heading row" } [
H.div { className: "col-4" } [ H.div { className: "col-4" } [
renameable {onRename, text: name} inputWithEnter { onBlur: onRename
, onEnter: \_ -> pure unit
, onValueChanged: onRename
, autoFocus: false
, className: "form-control"
, defaultValue: name
, placeholder: "Enter file name"
, type: "text" }
] ]
, H.div { className: "col-7" } [] , H.div { className: "col-7" } []
, H.div { className: "buttons-right col-1" } ([ , H.div { className: "buttons-right col-1" } ([
...@@ -311,6 +318,7 @@ renameableTextCpt = here.component "renameableTextCpt" cpt ...@@ -311,6 +318,7 @@ renameableTextCpt = here.component "renameableTextCpt" cpt
autoFocus: false autoFocus: false
, className: "form-control text" , className: "form-control text"
, defaultValue: text , defaultValue: text
, onBlur: setText <<< const
, onEnter: submit , onEnter: submit
, onValueChanged: setText <<< const , onValueChanged: setText <<< const
, placeholder: "" , placeholder: ""
......
...@@ -92,14 +92,14 @@ docViewCpt = here.component "docView" cpt ...@@ -92,14 +92,14 @@ docViewCpt = here.component "docView" cpt
[ H.div { className: "corpus-doc-view container1" } [ H.div { className: "corpus-doc-view container1" }
[ R2.row [ R2.row
[ R2.col 12 [ R2.col 12
[ H.h4 {} [ H.span {} [ badge "title", annotate doc.title ] ] [ H.h4 {} [ H.span {} [ badge "title", annotate doc.title [] ] ]
, H.ul { className: "list-group" } , H.ul { className: "list-group" }
[ li' [ badgeLi "source", text' doc.source ] [ li' [ badgeLi "source", text' doc.source ]
-- TODO add href to /author/ if author present in -- TODO add href to /author/ if author present in
, li' [ badgeLi "authors", text' doc.authors ] , li' [ badgeLi "authors", text' doc.authors ]
, li' [ badgeLi "date", H.text $ publicationDate $ Document doc ] , li' [ badgeLi "date", H.text $ publicationDate $ Document doc ]
] ]
, H.span {} [ badge "abstract", annotate doc.abstract ] , H.span {} [ badge "abstract", annotate doc.abstract [] ]
, H.div { className: "jumbotron" } [ H.p {} [ H.text "Empty Full Text" ] ] , H.div { className: "jumbotron" } [ H.p {} [ H.text "Empty Full Text" ] ]
]]]] ]]]]
where where
......
...@@ -8,6 +8,7 @@ import Data.Generic.Rep.Show (genericShow) ...@@ -8,6 +8,7 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
...@@ -102,12 +103,16 @@ frameLayoutViewCpt = here.component "frameLayoutView" cpt ...@@ -102,12 +103,16 @@ frameLayoutViewCpt = here.component "frameLayoutView" cpt
where where
cpt { frame: (NodePoly { hyperdata: Hyperdata { base, frame_id }}) cpt { frame: (NodePoly { hyperdata: Hyperdata { base, frame_id }})
, nodeId, reload, session, nodeType } _ = , nodeId, reload, session, nodeType } _ =
pure $ pure $ H.div { className : "frame"
R2.frameset { className : "frame", rows: "100%,*" } , rows: "100%,*" }
[ R2.frame { src, width: "100%", height: "100%" } [] ] where [ H.iframe { src: hframeUrl nodeType base frame_id
src = hframeUrl nodeType base frame_id , width: "100%"
, height: "100%"
type LoadProps = ( nodeId :: Int, session :: Session ) } []
]
type LoadProps = ( nodeId :: Int
, session :: Session )
type ReloadProps = ( nodeId :: Int type ReloadProps = ( nodeId :: Int
, reload :: T2.Reload , reload :: T2.Reload
......
...@@ -60,14 +60,22 @@ listsWithForest :: R2.Component ListsWithForest ...@@ -60,14 +60,22 @@ listsWithForest :: R2.Component ListsWithForest
listsWithForest = R.createElement listsWithForestCpt listsWithForest = R.createElement listsWithForestCpt
listsWithForestCpt :: R.Component ListsWithForest listsWithForestCpt :: R.Component ListsWithForest
listsWithForestCpt = here.component "listsWithForest" cpt where listsWithForestCpt = here.component "listsWithForest" cpt
cpt { forestProps, listsProps: listsProps@{ session } } _ = do where
controls <- initialControls cpt { forestProps
pure $ Forest.forestLayoutWithTopBar forestProps , listsProps: listsProps@{ session } } _ = do
[ topBar { controls } [] controls <- initialControls
, listsLayout (Record.merge listsProps { controls }) []
, H.div { className: "side-panel" } [ sidePanel { controls, session } [] ] pure $ Forest.forestLayoutWithTopBar forestProps
] [ topBar { controls } []
, listsLayout (Record.merge listsProps { controls }) []
-- TODO remove className "side-panel" is preview is not triggered
-- , H.div { className: "" }
, H.div { className: "side-panel" }
[ sidePanel { controls, session } []]
]
--------------------------------------------------------
type TopBarProps = ( controls :: Record ListsLayoutControls ) type TopBarProps = ( controls :: Record ListsLayoutControls )
...@@ -166,26 +174,39 @@ sidePanel :: R2.Component SidePanelProps ...@@ -166,26 +174,39 @@ sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt sidePanel = R.createElement sidePanelCpt
sidePanelCpt :: R.Component SidePanelProps sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = here.component "sidePanel" cpt where sidePanelCpt = here.component "sidePanel" cpt
cpt { controls: { triggers: { toggleSidePanel, triggerSidePanel } } where
, session } _ = do cpt { controls: { triggers: { toggleSidePanel
showSidePanel <- R.useState' InitialClosed , triggerSidePanel
R.useEffect' $ do } }
let toggleSidePanel' _ = snd showSidePanel toggleSidePanelState , session } _ = do
triggerSidePanel' _ = snd showSidePanel $ const Opened
R2.setTrigger toggleSidePanel toggleSidePanel' showSidePanel <- R.useState' InitialClosed
R2.setTrigger triggerSidePanel triggerSidePanel'
(mCorpusId /\ setMCorpusId) <- R.useState' Nothing R.useEffect' $ do
(mListId /\ setMListId) <- R.useState' Nothing let toggleSidePanel' _ = snd showSidePanel toggleSidePanelState
(mNodeId /\ setMNodeId) <- R.useState' Nothing triggerSidePanel' _ = snd showSidePanel $ const Opened
let mainStyle = case fst showSidePanel of R2.setTrigger toggleSidePanel toggleSidePanel'
Opened -> { display: "block" } R2.setTrigger triggerSidePanel triggerSidePanel'
_ -> { display: "none" }
let closeSidePanel _ = snd showSidePanel $ const Closed (mCorpusId /\ setMCorpusId) <- R.useState' Nothing
pure $ H.div { style: mainStyle } (mListId /\ setMListId ) <- R.useState' Nothing
[ H.div { className: "header" } (mNodeId /\ setMNodeId ) <- R.useState' Nothing
[ H.span { className: "btn btn-danger", on: { click: closeSidePanel } }
[ H.span { className: "fa fa-times" } [] ]] let mainStyle = case fst showSidePanel of
Opened -> { display: "block" }
_ -> { display: "none" }
let closeSidePanel _ = do
snd showSidePanel $ const Closed
pure $ H.div { style: mainStyle } [
H.div { className: "header" } [
H.span { className: "btn btn-danger"
, on: { click: closeSidePanel } } [
H.span { className: "fa fa-times" } []
]
]
, sidePanelDocView { session } [] , sidePanelDocView { session } []
] ]
......
...@@ -21,7 +21,8 @@ import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) ...@@ -21,7 +21,8 @@ import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType) import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType)
import Gargantext.Components.Nodes.Lists.Types (CacheState, SidePanelTriggers) import Gargantext.Components.Nodes.Lists.Types
import Gargantext.Components.Search as S
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types import Gargantext.Types
...@@ -53,18 +54,18 @@ tabsCpt = here.component "tabs" cpt where ...@@ -53,18 +54,18 @@ tabsCpt = here.component "tabs" cpt where
cpt props _ = do cpt props _ = do
(selected /\ setSelected) <- R.useState' 0 (selected /\ setSelected) <- R.useState' 0
pure $ Tab.tabs { selected, tabs: tabs' } where pure $ Tab.tabs { selected, tabs: tabs' } where
tabs' = [ "Terms" /\ view Terms tabs' = [ "Terms" /\ view Terms []
, "Authors" /\ view Authors , "Authors" /\ view Authors []
, "Institutes" /\ view Institutes , "Institutes" /\ view Institutes []
, "Sources" /\ view Sources , "Sources" /\ view Sources []
] ]
common = RX.pick props :: Record Props common = RX.pick props :: Record Props
view mode = ngramsView $Record.merge common { mode } view mode = ngramsView $ Record.merge common { mode }
type NgramsViewProps = ( mode :: Mode | Props ) type NgramsViewProps = ( mode :: Mode | Props )
ngramsView :: Record NgramsViewProps -> R.Element ngramsView :: R2.Component NgramsViewProps
ngramsView props = R.createElement ngramsViewCpt props [] ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewProps ngramsViewCpt :: R.Component NgramsViewProps
ngramsViewCpt = here.component "ngramsView" cpt where ngramsViewCpt = here.component "ngramsView" cpt where
...@@ -99,7 +100,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -99,7 +100,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where
<> [ NT.mainNgramsTable { afterSync: afterSync chartsReload <> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
, cacheState , cacheState
, defaultListId , defaultListId
, nodeId: corpusId
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
......
...@@ -76,11 +76,12 @@ textsWithForestCpt = here.component "textsWithForest" cpt ...@@ -76,11 +76,12 @@ textsWithForestCpt = here.component "textsWithForest" cpt
pure $ Forest.forestLayoutWithTopBar forestProps pure $ Forest.forestLayoutWithTopBar forestProps
[ topBar { controls } [] [ topBar { controls } []
, textsLayout (Record.merge textProps { controls }) [] , textsLayout (Record.merge textProps { controls }) []
-- TODO remove className "side-panel" is preview is not triggered
-- , H.div { className: "" }
, H.div { className: "side-panel" } , H.div { className: "side-panel" }
[ sidePanel { controls, session } [] ]] [ sidePanel { controls, session } [] ]]
type TopBarProps = ( controls :: Record TextsLayoutControls ) type TopBarProps = ( controls :: Record TextsLayoutControls )
topBar :: R2.Component TopBarProps topBar :: R2.Component TopBarProps
...@@ -361,7 +362,6 @@ docViewLayoutRec { cacheState ...@@ -361,7 +362,6 @@ docViewLayoutRec { cacheState
-------------------------------------------------------- --------------------------------------------------------
type SidePanelProps = ( type SidePanelProps = (
controls :: Record TextsLayoutControls controls :: Record TextsLayoutControls
, session :: Session , session :: Session
......
module Gargantext.Components.Renameable where
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Renameable"
type RenameableProps =
(
onRename :: String -> Effect Unit
, text :: String
)
renameable :: Record RenameableProps -> R.Element
renameable props = R.createElement renameableCpt props []
renameableCpt :: R.Component RenameableProps
renameableCpt = R.hooksComponentWithModule thisModule "renameableCpt" cpt
where
cpt {onRename, text} _ = do
isEditing <- R.useState' false
state <- R.useState' text
textRef <- R.useRef text
-- handle props change of text
R.useEffect1' text $ do
if R.readRef textRef == text then
pure unit
else do
R.setRef textRef text
snd state $ const text
pure $ H.div { className: "renameable" } [
renameableText { isEditing, onRename, state }
]
type RenameableTextProps =
(
isEditing :: R.State Boolean
, onRename :: String -> Effect Unit
, state :: R.State String
)
renameableText :: Record RenameableTextProps -> R.Element
renameableText props = R.createElement renameableTextCpt props []
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" }
, H.div { className: "btn input-group-append"
, 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
, className: "form-control text"
, defaultValue: text
, onBlur: setText <<< const
, 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" } []
]
]
where
submit _ = do
setIsEditing $ const false
onRename text
...@@ -36,8 +36,16 @@ monotonyTheme :: Theme ...@@ -36,8 +36,16 @@ monotonyTheme :: Theme
monotonyTheme = Theme { name: "monotony" monotonyTheme = Theme { name: "monotony"
, location: "styles/bootstrap-monotony.css" } , location: "styles/bootstrap-monotony.css" }
herbieTheme :: Theme
herbieTheme = Theme { name: "herbie"
, location: "styles/bootstrap-herbie.css" }
darksterTheme :: Theme
darksterTheme = Theme { name: "darkster (bêta)"
, location: "styles/bootstrap-darkster.css" }
allThemes :: Array Theme allThemes :: Array Theme
allThemes = [ defaultTheme, greysonTheme, monotonyTheme ] allThemes = [ defaultTheme, greysonTheme, monotonyTheme, herbieTheme, darksterTheme]
switchTheme :: Theme -> Effect Unit switchTheme :: Theme -> Effect Unit
switchTheme (Theme { location }) = do switchTheme (Theme { location }) = do
......
...@@ -8,7 +8,6 @@ import Effect.Class (class MonadEffect, liftEffect) ...@@ -8,7 +8,6 @@ import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception (catchException, throwException) import Effect.Exception (catchException, throwException)
import Effect.Unsafe (unsafePerformEffect) import Effect.Unsafe (unsafePerformEffect)
-- | JL: Astonishingly, not in the prelude -- | JL: Astonishingly, not in the prelude
-- AD: recent Preludes in Haskell much prefer identity -- AD: recent Preludes in Haskell much prefer identity
-- then id can be used as a variable name (in records for instance) -- then id can be used as a variable name (in records for instance)
...@@ -40,4 +39,3 @@ xor :: Boolean -> Boolean -> Boolean ...@@ -40,4 +39,3 @@ xor :: Boolean -> Boolean -> Boolean
xor true false = true xor true false = true
xor false true = true xor false true = true
xor _ _ = false xor _ _ = false
...@@ -4,6 +4,7 @@ import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson ...@@ -4,6 +4,7 @@ import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson
import Data.Argonaut.Decode.Error (JsonDecodeError(..)) import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.String as S
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare) import Data.Generic.Rep.Ord (genericCompare)
...@@ -763,3 +764,15 @@ progressPercent (AsyncProgress {log}) = perc ...@@ -763,3 +764,15 @@ progressPercent (AsyncProgress {log}) = perc
where where
nom = toNumber $ failed + succeeded nom = toNumber $ failed + succeeded
denom = toNumber $ failed + succeeded + remaining denom = toNumber $ failed + succeeded + remaining
---------------------------------------------------------------------------
-- | GarganText Internal Sugar
prettyNodeType :: NodeType -> String
prettyNodeType nt = S.replace (S.Pattern "Node") (S.Replacement " ")
$ S.replace (S.Pattern "Folder") (S.Replacement " ")
$ show nt
module Gargantext.Utils.Array (push) where module Gargantext.Utils.Array (max, min, push) where
import Data.Array as A
import Data.Foldable (foldr)
import Data.Maybe (Maybe(..))
import Data.Ord as Ord
import Effect (Effect) import Effect (Effect)
import Data.Unit (Unit)
import Effect.Uncurried (EffectFn2, runEffectFn2) import Effect.Uncurried (EffectFn2, runEffectFn2)
import Gargantext.Prelude
foreign import _push :: forall a. EffectFn2 (Array a) a Unit foreign import _push :: forall a. EffectFn2 (Array a) a Unit
push :: forall a. Array a -> a -> Effect Unit push :: forall a. Array a -> a -> Effect Unit
push = runEffectFn2 _push push = runEffectFn2 _push
max :: forall a. Ord a => Array a -> Maybe a
max xs = foldr reducer (A.head xs) xs
where
reducer _ Nothing = Nothing
reducer v (Just acc) = Just $ Ord.max acc v
min :: forall a. Ord a => Array a -> Maybe a
min xs = foldr reducer (A.head xs) xs
where
reducer _ Nothing = Nothing
reducer v (Just acc) = Just $ Ord.min acc v
...@@ -5,6 +5,7 @@ ...@@ -5,6 +5,7 @@
// Copied from bootstrap's bg-warning, bg-success, bg-danger: // Copied from bootstrap's bg-warning, bg-success, bg-danger:
$annotation-graph-color: #95D29593 $annotation-graph-color: #95D29593
$annotation-candidate-color: #B8B8B876 $annotation-candidate-color: #B8B8B876
// $annotation-candidate-color: #b8daff
$annotation-stop-color: #F5949931 $annotation-stop-color: #F5949931
@mixin lg1($color) @mixin lg1($color)
......
...@@ -19,15 +19,6 @@ ...@@ -19,15 +19,6 @@
white-space: pre-wrap white-space: pre-wrap
word-break: keep-all word-break: keep-all
.code-editor-heading
.renameable
flex-grow: 2
.text
padding-right: 10px
/* .buttons-right
/* display: flex
/* justify-content: flex-end
.code-editor .code-editor
.editor .editor
.code-area .code-area
......
...@@ -54,11 +54,12 @@ ...@@ -54,11 +54,12 @@
/* padding-top: 90px /* padding-top: 90px
#controls-container #controls-container
position: fixed // position: fixed
position: absolute
z-index: 999 // needs to appear above graph elements z-index: 999 // needs to appear above graph elements
backdrop-filter: blur(4px) backdrop-filter: blur(4px)
background: rgba(255,255,255,75%) background: rgba(255,255,255,75%)
overflow: auto // overflow: auto
left: 0 left: 0
right: 0 right: 0
top: 60px top: 60px
...@@ -82,4 +83,4 @@ ...@@ -82,4 +83,4 @@
max-height: 300px max-height: 300px
overflow-y: scroll overflow-y: scroll
width: 300px width: 300px
top: 100px top: 50px
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
.cache-toggle .cache-toggle
cursor: pointer cursor: pointer
.side-panel .side-panel
background-color: white //background-color: $dark
left: 70% left: 70%
padding: 5px padding: 5px
position: fixed position: fixed
top: 60px top: 60px
background-color: #fff
width: 28% width: 28%
.header .header
float: right float: right
...@@ -71,3 +72,11 @@ ul ...@@ -71,3 +72,11 @@ ul
color: #005a9aff color: #005a9aff
li li
color: #005a9aff color: #005a9aff
.frame
iframe
border: 0
.join-button
padding-bottom: 100px
padding-top: 100px
...@@ -12,7 +12,10 @@ li ...@@ -12,7 +12,10 @@ li
cursor: pointer cursor: pointer
.node-link .node-link
cursor: pointer a
cursor: pointer
& > .node-text
color: #000000
a.settings a.settings
cursor: pointer cursor: pointer
......
/*! Themestr.app `Darkster` Bootstrap 4.3.1 theme */
@import url(https://fonts.googleapis.com/css?family=Comfortaa:200,300,400,700);
$headings-font-family:Comfortaa;
/*$enable-grid-classes:false;*/
$primary:#FF550B;
$secondary:#303030;
$success:#015668;
$danger:#FF304F;
$info:#0F81C7;
$warning:#0DE2EA;
$light:#e8e8e8;
$dark:#000000;
/*! Import Bootstrap 4 variables */
@import "../../../node_modules/bootstrap/scss/functions";
@import "../../../node_modules/bootstrap/scss/variables";
$enable-shadows:true;
$gray-300:#000000;
$gray-800:#555555;
$body-bg:$black;
$body-color:#cccccc;
$link-color:#f0f0f0;
$link-hover-color:darken($link-color,20%);
$font-size-base:1.1rem;
$table-accent-bg: rgba($white,.05);
$table-hover-bg:rgba($white,.075);
$table-border-color:rgba($white, 0.3);
$table-dark-border-color: $table-border-color;
$table-dark-color:$white;
$input-bg:$gray-300;
$input-disabled-bg: #ccc;
$dropdown-bg:$gray-800;
$dropdown-divider-bg:rgba($black,.15);
$dropdown-link-color:$body-color;
$dropdown-link-hover-color:$white;
$dropdown-link-hover-bg:$body-bg;
$nav-tabs-border-color:rgba($white, 0.3);
$nav-tabs-link-hover-border-color:$nav-tabs-border-color;
$nav-tabs-link-active-bg:transparent;
$nav-tabs-link-active-border-color:$nav-tabs-border-color;
$navbar-dark-hover-color:$white;
$navbar-light-hover-color:$gray-800;
$navbar-light-active-color:$gray-800;
$pagination-color:$white;
$pagination-bg:transparent;
$pagination-border-color:rgba($black, 0.6);
$pagination-hover-color:$white;
$pagination-hover-bg:transparent;
$pagination-hover-border-color:rgba($black, 0.6);
$pagination-active-bg:transparent;
$pagination-active-border-color:rgba($black, 0.6);
$pagination-disabled-bg:transparent;
$pagination-disabled-border-color:rgba($black, 0.6);
$jumbotron-bg:darken($gray-900, 5%);
$card-border-color:rgba($black, 0.6);
$card-cap-bg:lighten($gray-800, 10%);
$card-bg:lighten($body-bg, 5%);
$modal-content-bg:lighten($body-bg,5%);
$modal-header-border-color:rgba(0,0,0,.2);
$progress-bg:darken($gray-900,5%);
$progress-bar-color:$gray-600;
$list-group-bg:lighten($body-bg,5%);
$list-group-border-color:rgba($black,0.6);
$list-group-hover-bg:lighten($body-bg,10%);
$list-group-active-color:$white;
$list-group-active-bg:$list-group-hover-bg;
$list-group-active-border-color:$list-group-border-color;
$list-group-disabled-color:$gray-800;
$list-group-disabled-bg:$black;
$list-group-action-color:$white;
$breadcrumb-active-color:$gray-500;
@import "../../../node_modules/bootstrap/scss/bootstrap";
// Add SASS theme customizations here..
.navbar-dark.bg-primary {background-color:#111111 !important;}
.table.able {color:#ccccc5}
/*! Themestr.app `Herbie` Bootstrap 4.3.1 theme */
@import url(https://fonts.googleapis.com/css?family=Nunito:200,300,400,700);
$font-family-base:Nunito;
@import url(https://fonts.googleapis.com/css?family=Crete+Round:200,300,400,700);
$headings-font-family:Crete Round;
/*$enable-grid-classes:false;*/
$primary:#083358;
$secondary:#F67280;
$success:#0074E4;
$danger:#FF4057;
$info:#74DBEF;
$warning:#FC3C3C;
$light:#F2F2F0;
$dark:#072247;
@import "../../../node_modules/bootstrap/scss/bootstrap";
// Add SASS theme customizations here..
module Gargantext.Components.NgramsTable.Spec where module Gargantext.Components.NgramsTable.Spec where
import Prelude import Prelude
import Data.List as L
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Map as Map
import Data.Set as Set
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Components.NgramsTable.Core (highlightNgrams, NgramsElement(..), NgramsTable(..))
import Gargantext.Types (TermList(..))
import Test.Spec (Spec, describe, it) import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual) -- import Test.Spec.Assertions (shouldEqual)
-- import Test.Spec.QuickCheck (quickCheck') -- import Test.Spec.QuickCheck (quickCheck')
import Data.Map as Map
import Data.Set as Set
{- import Test.Utils (shouldEqualArray)
import Gargantext.Components.NgramsTable.Core (highlightNgrams, HighlightElement, NgramsElement(..), NgramsRepoElement(..), NgramsTable(..), NgramsTerm, normNgram)
import Gargantext.Types (CTabNgramType(..), TermList(..))
ne :: String -> TermList -> CTabNgramType -> NgramsElement
ne ngrams list ngramType = NgramsElement { ngrams: normed
, size: 1 -- TODO
, list
, occurrences: 0
, parent: Nothing
, root: Nothing
, children: Set.empty
}
where
normed = normNgram ngramType ngrams
tne :: String -> TermList -> CTabNgramType -> Tuple NgramsTerm NgramsElement
tne ngrams list ngramType = Tuple normed (ne ngrams list ngramType)
where
normed = normNgram ngramType ngrams
nre :: String -> TermList -> CTabNgramType -> NgramsRepoElement
nre ngrams list ngramType = NgramsRepoElement { size: 1 -- TODO
, list
, parent: Nothing
, root: Nothing
, children: Set.empty
}
tnre :: String -> TermList -> CTabNgramType -> Tuple NgramsTerm NgramsRepoElement
tnre ngrams list ngramType = Tuple normed (nre ngrams list ngramType)
where
normed = normNgram ngramType ngrams
highlightNil :: String -> HighlightElement
highlightNil s = Tuple s L.Nil
highlightTuple :: String -> CTabNgramType -> TermList -> Tuple NgramsTerm TermList
highlightTuple s ngramType term = Tuple (normNgram ngramType s) term
highlightSingleton :: String -> CTabNgramType -> TermList -> HighlightElement
highlightSingleton s ngramType term = Tuple s (L.singleton $ highlightTuple s ngramType term)
spec :: Spec Unit spec :: Spec Unit
spec = do spec = do
let ne ngrams list =
NgramsElement
{ ngrams
, list
, occurrences: 0
, parent: Nothing
, root: Nothing
, children: Set.empty
}
tne ngrams list = Tuple ngrams (ne ngrams list)
describe "NgramsTable.highlightNgrams" do describe "NgramsTable.highlightNgrams" do
it "works on a simple example" do it "works on a simple example" do
let ngramType = CTabSources
let table = NgramsTable let table = NgramsTable
(Map.fromFoldable [tne "graph" GraphTerm { ngrams_repo_elements: Map.fromFoldable [ tnre "which" StopTerm ngramType
,tne "which" StopTerm , tnre "stops" StopTerm ngramType
,tne "stops" StopTerm , tnre "candidate" CandidateTerm ngramType
,tne "candidate" CandidateTerm ]
]) , ngrams_scores: Map.fromFoldable [] }
input = "this is a graph about a biography which stops at every candidate" input = "this is a graph about a biography which stops at every candidate"
output = [Tuple "this is a " Nothing output = [ highlightNil " this is a graph about a biography "
,Tuple "graph" (Just GraphTerm) , highlightSingleton " which" ngramType StopTerm
,Tuple " about a biography " Nothing , highlightNil " "
,Tuple "which" (Just StopTerm) , highlightSingleton " stops" ngramType StopTerm
,Tuple " " Nothing , highlightNil " at every "
,Tuple "stops" (Just StopTerm) , highlightSingleton " candidate" ngramType CandidateTerm
,Tuple " at every " Nothing , highlightNil " "
,Tuple "candidate" (Just CandidateTerm)
] ]
highlightNgrams CTabTerms table input `shouldEqual` output highlightNgrams CTabTerms table input `shouldEqualArray` output
it "works when pattern overlaps" do it "works when pattern overlaps" do
let ngramType = CTabSources
let table = NgramsTable let table = NgramsTable
(Map.fromFoldable [tne "is" StopTerm { ngrams_repo_elements: Map.fromFoldable [ tnre "is" StopTerm ngramType
,tne "a" StopTerm , tnre "a" StopTerm ngramType
,tne "of" StopTerm , tnre "of" StopTerm ngramType
,tne "new" GraphTerm ]
,tne "the" GraphTerm , ngrams_scores: Map.fromFoldable [] }
,tne "state" GraphTerm
])
input = "This is a new state of the" input = "This is a new state of the"
output = [Tuple "This " Nothing output = [ highlightNil " This "
,Tuple "is" (Just StopTerm) , highlightSingleton " is" ngramType StopTerm
,Tuple " " Nothing , highlightNil " "
,Tuple "a" (Just StopTerm) , highlightSingleton " a" ngramType StopTerm
,Tuple " " Nothing , highlightNil " new state "
,Tuple "new" (Just GraphTerm) , highlightSingleton " of" ngramType StopTerm
,Tuple " " Nothing , highlightNil " the "
,Tuple "state" (Just GraphTerm)
,Tuple " " Nothing
,Tuple "of" (Just StopTerm)
,Tuple " " Nothing
,Tuple "the" (Just GraphTerm)
] ]
highlightNgrams CTabTerms table input `shouldEqual` output highlightNgrams CTabTerms table input `shouldEqualArray` output
it "works when pattern overlaps 2" do it "works when pattern overlaps 2" do
let ngramType = CTabSources
let table = NgramsTable let table = NgramsTable
(Map.fromFoldable [tne "from" GraphTerm { ngrams_repo_elements: Map.fromFoldable [ tnre "from" CandidateTerm ngramType
,tne "i" StopTerm , tnre "i" StopTerm ngramType
,tne "images" GraphTerm , tnre "images" CandidateTerm ngramType
]) ]
, ngrams_scores: Map.fromFoldable [] }
input = "This is from space images" input = "This is from space images"
output = [Tuple "This is " Nothing output = [ highlightNil " This is "
,Tuple "from" (Just GraphTerm) , highlightSingleton " from" ngramType CandidateTerm
,Tuple " space " Nothing , highlightNil " space "
,Tuple "images" (Just GraphTerm) , highlightSingleton " images" ngramType CandidateTerm
, highlightNil " "
]
highlightNgrams CTabTerms table input `shouldEqualArray` output
it "works when pattern overlaps 3" do
let ngramType = CTabSources
let table = NgramsTable
{ ngrams_repo_elements: Map.fromFoldable [ tnre "something" CandidateTerm ngramType
, tnre "something different" MapTerm ngramType
]
, ngrams_scores: Map.fromFoldable [] }
input = "and now for something different"
output = [ highlightNil " and now for "
, Tuple " something" $ L.fromFoldable [
highlightTuple "something different" ngramType MapTerm
, highlightTuple "something" ngramType CandidateTerm
]
, Tuple " different" $ L.singleton $ highlightTuple "something different" ngramType MapTerm
, highlightNil " "
] ]
highlightNgrams CTabTerms table input `shouldEqual` output highlightNgrams CTabTerms table input `shouldEqualArray` output
it "works with punctuation" do it "works with punctuation" do
let ngramType = CTabSources
let table = NgramsTable let table = NgramsTable
(Map.fromFoldable [tne "graph" GraphTerm]) { ngrams_repo_elements: Map.fromFoldable [ tnre "graph" CandidateTerm ngramType ]
, ngrams_scores: Map.fromFoldable [] }
input = "before graph, after" input = "before graph, after"
output = [Tuple "before " Nothing output = [ highlightNil " before "
,Tuple "graph" (Just GraphTerm) , highlightSingleton " graph" ngramType CandidateTerm
,Tuple ", after" Nothing , highlightNil ", after "
] ]
highlightNgrams CTabTerms table input `shouldEqual` output highlightNgrams CTabTerms table input `shouldEqualArray` output
-}
module Test.Utils where
import Prelude
import Control.Monad.Error.Class (class MonadThrow)
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Effect.Exception (Error)
import Test.Spec.Assertions (fail)
-- | This function can be used to compare arrays, it reports the diff in more
-- | detail which can be useful when debuggnign tests
shouldEqualArray
:: forall m t
. MonadThrow Error m
=> Show t
=> Eq t
=> Array t
-> Array t
-> m Unit
shouldEqualArray v1 v2 =
when (v1 /= v2) $
fail $ show v1 <> " ≠ " <> show v2 <> diff
where
diffs = A.filter (\(Tuple a b) -> a /= b) $ A.zip v1 v2
diff = case A.head diffs of
Nothing -> ""
Just (Tuple a1 a2) -> " (first differing element: " <> (show a1 <> " ≠ " <> show a2) <> ")"
This source diff could not be displayed because it is too large. You can view the blob instead.
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