Commit 78fb0f73 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'feature/toestand-global-state' of...

Merge branch 'feature/toestand-global-state' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 009bd667 219e41a7
...@@ -9,6 +9,8 @@ RUN echo "deb https://dl.yarnpkg.com/debian/ stable main" | tee /etc/apt/sources ...@@ -9,6 +9,8 @@ RUN echo "deb https://dl.yarnpkg.com/debian/ stable main" | tee /etc/apt/sources
RUN apt-get update && apt-get install -y yarn RUN apt-get update && apt-get install -y yarn
RUN curl -L https://github.com/coot/zephyr/releases/download/v0.3.2/Linux.tar.gz | tar zx -C /usr/bin --strip-components=1 zephyr/zephyr RUN curl -L https://github.com/coot/zephyr/releases/download/v0.3.2/Linux.tar.gz | tar zx -C /usr/bin --strip-components=1 zephyr/zephyr
RUN curl -L https://github.com/dhall-lang/dhall-haskell/releases/download/1.38.1/dhall-json-1.7.6-x86_64-linux.tar.bz2 | tar jx -C /usr/bin --strip-components=2 ./bin/dhall-to-json
WORKDIR /opt/app WORKDIR /opt/app
EXPOSE 5000/tcp EXPOSE 5000/tcp
CMD ["bash"] CMD ["bash"]
\ No newline at end of file
...@@ -642,10 +642,11 @@ li .leaf:hover a.settings { ...@@ -642,10 +642,11 @@ li .leaf:hover a.settings {
list-style: decimal !important; list-style: decimal !important;
} }
#page-wrapper .cache-toggle { .cache-toggle {
cursor: pointer; cursor: pointer;
} }
#page-wrapper .side-panel {
.side-panel {
left: 70%; left: 70%;
padding: 5px; padding: 5px;
position: fixed; position: fixed;
...@@ -653,14 +654,14 @@ li .leaf:hover a.settings { ...@@ -653,14 +654,14 @@ li .leaf:hover a.settings {
background-color: #fff; background-color: #fff;
width: 28%; width: 28%;
} }
#page-wrapper .side-panel .header { .side-panel .header {
float: right; float: right;
} }
#page-wrapper .side-panel .corpus-doc-view .annotated-field-wrapper .annotated-field-runs { .side-panel .corpus-doc-view .annotated-field-wrapper .annotated-field-runs {
max-height: 200px; max-height: 200px;
overflow-y: scroll; overflow-y: scroll;
} }
#page-wrapper .side-panel .corpus-doc-view .list-group .list-group-item-heading { .side-panel .corpus-doc-view .list-group .list-group-item-heading {
display: inline-block; display: inline-block;
width: 60px; width: 60px;
} }
......
{"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","../../src/sass/_folder_view.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;;;AAEJ;EACE;;AACA;EACE;;;AAEJ;EACE;EACA;;;AClFF;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;;;ACRxB;EACE;EACA;EACA;EACA","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","../../src/sass/_folder_view.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;EAEE;;;AAQF;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;;;ACzKF;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;;;ACtFZ;EACE;;;AACF;EAEE;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;;AAGE;EACE;EACA;;AAEF;EACE;EACA;;;AAER;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;;;AAEJ;EACE;;AACA;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;;;ACRxB;EACE;EACA;EACA;EACA","file":"sass.css"}
\ No newline at end of file \ No newline at end of file
...@@ -80,6 +80,11 @@ let additions = ...@@ -80,6 +80,11 @@ let additions =
, repo = "https://github.com/nwolverson/purescript-dom-filereader" , repo = "https://github.com/nwolverson/purescript-dom-filereader"
, version = "v5.0.0" , version = "v5.0.0"
} }
, formula =
{ dependencies = [ "effect", "prelude", "reactix", "record", "toestand", "tuples", "typelevel-prelude", "typisch" ]
, repo = "https://github.com/poorscript/purescript-formula"
, version = "v0.2.1"
}
, markdown = , markdown =
{ dependencies = [ "precise" ] { dependencies = [ "precise" ]
, repo = "https://github.com/poorscript/purescript-markdown" , repo = "https://github.com/poorscript/purescript-markdown"
...@@ -107,7 +112,17 @@ let additions = ...@@ -107,7 +112,17 @@ let additions =
, "unsafe-coerce" , "unsafe-coerce"
] ]
, repo = "https://github.com/irresponsible/purescript-reactix" , repo = "https://github.com/irresponsible/purescript-reactix"
, version = "v0.4.6" , version = "v0.4.11"
}
, toestand =
{ dependencies = [ "effect", "reactix", "prelude", "record", "tuples", "typelevel-prelude", "typisch" ]
, repo = "https://github.com/poorscript/purescript-toestand"
, version = "v0.6.1"
}
, typisch =
{ dependencies = [ "prelude" ]
, repo = "https://github.com/poorscript/purescript-typisch"
, version = "v0.2.1"
} }
, tuples-native = , tuples-native =
{ dependencies = { dependencies =
......
...@@ -10,14 +10,13 @@ import Data.Either (Either(..)) ...@@ -10,14 +10,13 @@ import Data.Either (Either(..))
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect (Effect) import Effect (Effect)
import Reactix as R
import Toestand as T
import Web.Storage.Storage as WSS
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils as GU import Gargantext.Utils as GU
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
import Reactix as R
import Toestand as T
import Web.Storage.Storage as WSS
localStorageKey :: String localStorageKey :: String
localStorageKey = "garg-async-tasks" localStorageKey = "garg-async-tasks"
...@@ -56,8 +55,8 @@ removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) ...@@ -56,8 +55,8 @@ removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } })
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = ( type ReductorProps = (
reloadForest :: T.Box T2.Reload reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
, storage :: Storage , storage :: Storage
) )
...@@ -73,3 +72,26 @@ remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit ...@@ -73,3 +72,26 @@ remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
remove id task storage = T.modify_ newStorage storage remove id task storage = T.modify_ newStorage storage
where where
newStorage s = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s newStorage s = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
-- When a task is finished: which tasks cause forest or app reload
asyncTaskTriggersAppReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersAppReload _ = false
asyncTaskTTriggersAppReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersAppReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersAppReload typ
asyncTaskTriggersMainPageReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersMainPageReload GT.UpdateNgramsCharts = true
asyncTaskTriggersMainPageReload _ = false
asyncTaskTTriggersMainPageReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersMainPageReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersMainPageReload typ
asyncTaskTriggersTreeReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersTreeReload GT.Form = true
asyncTaskTriggersTreeReload GT.UploadFile = true
asyncTaskTriggersTreeReload _ = false
asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ
...@@ -2,7 +2,6 @@ module Gargantext.Components.App (app) where ...@@ -2,7 +2,6 @@ module Gargantext.Components.App (app) where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (emptyApp) import Gargantext.Components.App.Data (emptyApp)
import Gargantext.Components.Router (router) import Gargantext.Components.Router (router)
......
...@@ -5,49 +5,76 @@ import Data.Maybe (Maybe(..)) ...@@ -5,49 +5,76 @@ import Data.Maybe (Maybe(..))
import Toestand as T import Toestand as T
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.Nodes.Lists.Types as ListsT
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Ends (Backend) import Gargantext.Ends (Backend)
import Gargantext.Routes (AppRoute(Home)) import Gargantext.Routes (AppRoute(Home))
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Sessions (OpenNodes, Sessions) import Gargantext.Sessions (OpenNodes, Session, Sessions)
import Gargantext.Types (Handed(RightHanded)) import Gargantext.Types (Handed(RightHanded), SidePanelState(..))
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
type App = type App =
{ backend :: Maybe Backend { backend :: Maybe Backend
, forestOpen :: OpenNodes , forestOpen :: OpenNodes
, handed :: Handed , graphVersion :: T2.Reload
, reloadForest :: Int , handed :: Handed
, reloadRoot :: Int , reloadForest :: T2.Reload
, route :: AppRoute , reloadMainPage :: T2.Reload
, sessions :: Sessions , reloadRoot :: T2.Reload
, showCorpus :: Boolean , route :: AppRoute
, showLogin :: Boolean , session :: Maybe Session
, tasks :: GAT.Storage , sessions :: Sessions
, showCorpus :: Boolean
, showLogin :: Boolean
, showTree :: Boolean
, sidePanelGraph :: Maybe (Record GEST.SidePanel)
, sidePanelLists :: Maybe (Record ListsT.SidePanel)
, sidePanelTexts :: Maybe (Record TextsT.SidePanel)
, sidePanelState :: SidePanelState
, tasks :: GAT.Storage
} }
emptyApp :: App emptyApp :: App
emptyApp = emptyApp =
{ backend: Nothing { backend : Nothing
, forestOpen: Set.empty , forestOpen : Set.empty
, handed: RightHanded , graphVersion : T2.newReload
, reloadForest: T2.newReload , handed : RightHanded
, reloadRoot: T2.newReload , reloadForest : T2.newReload
, route: Home , reloadMainPage : T2.newReload
, sessions: Sessions.empty , reloadRoot : T2.newReload
, showCorpus: false , route : Home
, showLogin: false , session : Nothing
, tasks: GAT.empty , sessions : Sessions.empty
, showCorpus : false
, showLogin : false
, showTree : true
, sidePanelGraph : GEST.initialSidePanel
, sidePanelLists : ListsT.initialSidePanel
, sidePanelTexts : TextsT.initialSidePanel
, sidePanelState : InitialClosed
, tasks : GAT.empty
} }
type Boxes = type Boxes =
{ backend :: T.Box (Maybe Backend) { backend :: T.Box (Maybe Backend)
, forestOpen :: T.Box OpenNodes , forestOpen :: T.Box OpenNodes
, handed :: T.Box Handed , graphVersion :: T2.ReloadS
, reloadForest :: T.Box T2.Reload , handed :: T.Box Handed
, reloadRoot :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, route :: T.Box AppRoute , reloadMainPage :: T2.ReloadS
, sessions :: T.Box Sessions , reloadRoot :: T2.ReloadS
, showCorpus :: T.Box Boolean , route :: T.Box AppRoute
, showLogin :: T.Box Boolean , session :: T.Box (Maybe Session)
, tasks :: T.Box GAT.Storage , sessions :: T.Box Sessions
, showCorpus :: T.Box Boolean
, showLogin :: T.Box Boolean
, showTree :: T.Box Boolean
, sidePanelGraph :: T.Box (Maybe (Record GEST.SidePanel))
, sidePanelLists :: T.Box (Maybe (Record ListsT.SidePanel))
, sidePanelTexts :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
} }
This diff is collapsed.
...@@ -9,8 +9,7 @@ module Gargantext.Components.Forest ...@@ -9,8 +9,7 @@ module Gargantext.Components.Forest
) where ) where
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe, fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -33,25 +32,26 @@ here = R2.here "Gargantext.Components.Forest" ...@@ -33,25 +32,26 @@ here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree -- Shared by components here with Tree
type Common = type Common =
( frontends :: Frontends ( frontends :: Frontends
, handed :: T.Box Handed , handed :: T.Box Handed
, reloadRoot :: T.Box T2.Reload , reloadMainPage :: T2.ReloadS
, route :: T.Box AppRoute , reloadRoot :: T2.ReloadS
, route :: T.Box AppRoute
) )
type Props = type Props =
( backend :: T.Box (Maybe Backend) ( backend :: T.Box (Maybe Backend)
, forestOpen :: T.Box OpenNodes , forestOpen :: T.Box OpenNodes
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, sessions :: T.Box Sessions , sessions :: T.Box Sessions
, showLogin :: T.Box Boolean , showLogin :: T.Box Boolean
, showTree :: T.Box Boolean
, tasks :: T.Box GAT.Storage , tasks :: T.Box GAT.Storage
| Common | Common
) )
type TreeExtra = ( type TreeExtra = (
forestOpen :: T.Box OpenNodes forestOpen :: T.Box OpenNodes
, session :: Session
) )
forest :: R2.Component Props forest :: R2.Component Props
...@@ -64,45 +64,43 @@ forestCpt = here.component "forest" cpt where ...@@ -64,45 +64,43 @@ forestCpt = here.component "forest" cpt where
, frontends , frontends
, handed , handed
, reloadForest , reloadForest
, reloadMainPage
, reloadRoot , reloadRoot
, route , route
, sessions , sessions
, showLogin , showLogin
, showTree
, tasks } _ = do , tasks } _ = do
-- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor -- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
-- tasks' <- GAT.useTasks reloadRoot reloadForest -- tasks' <- GAT.useTasks reloadRoot reloadForest
-- R.useEffect' $ do -- R.useEffect' $ do
-- T.write_ (Just tasks') tasks -- T.write_ (Just tasks') tasks
handed' <- T.useLive T.unequal handed handed' <- T.useLive T.unequal handed
reloadForest' <- T.useLive T.unequal reloadForest sessions' <- T.useLive T.unequal sessions
-- forestOpen' <- T.useLive T.unequal forestOpen
-- reloadRoot' <- T.useLive T.unequal reloadRoot -- reloadRoot' <- T.useLive T.unequal reloadRoot
-- route' <- T.useLive T.unequal route -- route' <- T.useLive T.unequal route
forestOpen' <- T.useLive T.unequal forestOpen
sessions' <- T.useLive T.unequal sessions showTree' <- T.useLive T.unequal showTree
-- TODO If `reloadForest` is set, `reload` state should be updated -- TODO If `reloadForest` is set, `reload` state should be updated
-- TODO fix tasks ref -- TODO fix tasks ref
-- R.useEffect' $ do pure $ H.div { className: "forest " <> if showTree' then "" else "d-none" }
-- R.setRef tasks $ Just tasks' (A.cons (plus handed' showLogin) (trees handed' sessions'))
R2.useCache where
( frontends /\ sessions' /\ handed' /\ forestOpen' /\ reloadForest' ) common = RX.pick props :: Record Common
(cp handed' sessions') trees handed' sessions' = (tree handed') <$> unSessions sessions'
where tree handed' s@(Session {treeId}) =
common = RX.pick props :: Record Common treeLoader { forestOpen
cp handed' sessions' _ = , frontends
pure $ H.div { className: "forest" } , handed: handed'
(A.cons (plus handed' showLogin) (trees handed' sessions')) , reload: reloadForest
trees handed' sessions' = (tree handed') <$> unSessions sessions' , reloadMainPage
tree handed' s@(Session {treeId}) = , reloadRoot
treeLoader { forestOpen , root: treeId
, frontends , route
, handed: handed' , session: s
, reload: reloadForest , tasks } []
, reloadRoot
, root: treeId
, route
, session: s
, tasks } []
plus :: Handed -> T.Box Boolean -> R.Element plus :: Handed -> T.Box Boolean -> R.Element
plus handed showLogin = H.div { className: "row" } plus handed showLogin = H.div { className: "row" }
...@@ -155,7 +153,8 @@ forestLayoutMain = R.createElement forestLayoutMainCpt ...@@ -155,7 +153,8 @@ forestLayoutMain = R.createElement forestLayoutMainCpt
forestLayoutMainCpt :: R.Component Props forestLayoutMainCpt :: R.Component Props
forestLayoutMainCpt = here.component "forestLayoutMain" cpt where forestLayoutMainCpt = here.component "forestLayoutMain" cpt where
cpt props children = pure $ forestLayoutRaw props [ mainPage {} children ] cpt props@{ reloadMainPage } children =
pure $ forestLayoutRaw props [ mainPage {} children ]
forestLayoutRaw :: R2.Component Props forestLayoutRaw :: R2.Component Props
forestLayoutRaw = R.createElement forestLayoutRawCpt forestLayoutRaw = R.createElement forestLayoutRawCpt
...@@ -166,9 +165,11 @@ forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where ...@@ -166,9 +165,11 @@ forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where
, forestOpen , forestOpen
, frontends , frontends
, reloadForest , reloadForest
, reloadMainPage
, reloadRoot , reloadRoot
, route , route
, sessions , sessions
, showTree
, showLogin , showLogin
, tasks } children = do , tasks } children = do
handed' <- T.useLive T.unequal p.handed handed' <- T.useLive T.unequal p.handed
...@@ -184,9 +185,11 @@ forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where ...@@ -184,9 +185,11 @@ forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where
, forestOpen , forestOpen
, handed , handed
, reloadForest , reloadForest
, reloadMainPage
, reloadRoot , reloadRoot
, route , route
, sessions , sessions
, showTree
, showLogin , showLogin
, tasks } [] , tasks } []
......
This diff is collapsed.
...@@ -45,16 +45,18 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node" ...@@ -45,16 +45,18 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node"
-- Main Node -- Main Node
type NodeMainSpanProps = type NodeMainSpanProps =
( folderOpen :: T.Box Boolean ( folderOpen :: T.Box Boolean
, frontends :: Frontends , frontends :: Frontends
, id :: ID , id :: ID
, isLeaf :: IsLeaf , isLeaf :: IsLeaf
, name :: Name , name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, reloadRoot :: T.Box T2.Reload , reload :: T2.ReloadS
, route :: T.Box Routes.AppRoute , reloadMainPage :: T2.ReloadS
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) , reloadRoot :: T2.ReloadS
, tasks :: T.Box GAT.Storage , route :: T.Box Routes.AppRoute
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box GAT.Storage
| CommonProps | CommonProps
) )
...@@ -66,8 +68,12 @@ nodeSpan = R.createElement nodeSpanCpt ...@@ -66,8 +68,12 @@ nodeSpan = R.createElement nodeSpanCpt
nodeSpanCpt :: R.Component NodeMainSpanProps nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = here.component "nodeSpan" cpt nodeSpanCpt = here.component "nodeSpan" cpt
where where
cpt props children = do cpt props@{ handed } children = do
pure $ H.div {} ([ nodeMainSpan props [] ] <> children) let className = case handed of
GT.LeftHanded -> "lefthanded"
GT.RightHanded -> "righthanded"
pure $ H.div { className } ([ nodeMainSpan props [] ] <> children)
nodeMainSpan :: R2.Component NodeMainSpanProps nodeMainSpan :: R2.Component NodeMainSpanProps
nodeMainSpan = R.createElement nodeMainSpanCpt nodeMainSpan = R.createElement nodeMainSpanCpt
...@@ -83,6 +89,8 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -83,6 +89,8 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
, isLeaf , isLeaf
, name , name
, nodeType , nodeType
, reload
, reloadMainPage
, reloadRoot , reloadRoot
, route , route
, session , session
...@@ -110,16 +118,21 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -110,16 +118,21 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
$ reverseHanded handed $ reverseHanded handed
[ folderIcon { folderOpen, nodeType } [] [ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } [] , chevronIcon { folderOpen, handed, isLeaf, nodeType } []
, nodeLink { frontends, handed, folderOpen, id, isSelected , nodeLink { frontends
, name: name' props, nodeType, session } [] , handed
, folderOpen
, id
, isSelected
, name: name' props
, nodeType
, session } []
, fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType } , fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType }
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie , barType: Pie
, nodeId: id , nodeId: id
, onFinish: onTaskFinish id t , onFinish: onTaskFinish id t
, session , session } []
}
) currentTasks' ) currentTasks'
) )
, if nodeType == GT.NodeUser , if nodeType == GT.NodeUser
...@@ -146,6 +159,22 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -146,6 +159,22 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
where where
onTaskFinish id' t _ = do onTaskFinish id' t _ = do
GAT.finish id' t tasks GAT.finish id' t tasks
if GAT.asyncTaskTTriggersAppReload t then do
here.log2 "reloading root for task" t
T2.reload reloadRoot
else do
if GAT.asyncTaskTTriggersTreeReload t then do
here.log2 "reloading tree for task" t
T2.reload reload
else do
here.log2 "task doesn't trigger a tree reload" t
pure unit
if GAT.asyncTaskTTriggersMainPageReload t then do
here.log2 "reloading main page for task" t
T2.reload reloadMainPage
else do
here.log2 "task doesn't trigger a main page reload" t
pure unit
-- snd tasks $ GAT.Finish id' t -- snd tasks $ GAT.Finish id' t
-- mT <- T.read tasks -- mT <- T.read tasks
-- case mT of -- case mT of
...@@ -168,9 +197,9 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -168,9 +197,9 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
<> "Click here to execute one of them." } [] <> "Click here to execute one of them." } []
dropProps droppedFile droppedFile' isDragOver isDragOver' = dropProps droppedFile droppedFile' isDragOver isDragOver' =
{ className: "leaf " <> (dropClass droppedFile' isDragOver') { className: "leaf " <> (dropClass droppedFile' isDragOver')
, on: { drop: dropHandler droppedFile , on: { dragLeave: onDragLeave isDragOver
, dragOver: onDragOverHandler isDragOver , dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } , drop: dropHandler droppedFile }
} }
where where
dropClass (Just _) _ = "file-dropped" dropClass (Just _) _ = "file-dropped"
...@@ -184,12 +213,12 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -184,12 +213,12 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
blob <- R2.dataTransferFileBlob e blob <- R2.dataTransferFileBlob e
void $ launchAff do void $ launchAff do
--contents <- readAsText blob --contents <- readAsText blob
liftEffect $ T.write_ liftEffect $ do
(Just T.write_ (Just
$ DroppedFile { blob: (UploadFileBlob blob) $ DroppedFile { blob: (UploadFileBlob blob)
, fileType: Just CSV , fileType: Just CSV
, lang : EN , lang : EN
}) droppedFile }) droppedFile
onDragOverHandler isDragOver e = do onDragOverHandler isDragOver e = do
-- prevent redirection when file is dropped -- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471 -- https://stackoverflow.com/a/6756680/941471
...@@ -283,7 +312,7 @@ graphNodeActionsCpt :: R.Component NodeActionsCommon ...@@ -283,7 +312,7 @@ graphNodeActionsCpt :: R.Component NodeActionsCommon
graphNodeActionsCpt = here.component "graphNodeActions" cpt where graphNodeActionsCpt = here.component "graphNodeActions" cpt where
cpt { id, session, refresh } _ = cpt { id, session, refresh } _ =
useLoader id (graphVersions session) $ \gv -> useLoader id (graphVersions session) $ \gv ->
nodeActionsGraph { graphVersions: gv, session, id, refresh } nodeActionsGraph { graphVersions: gv, session, id, refresh } []
graphVersions session graphId = GraphAPI.graphVersions { graphId, session } graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
listNodeActions :: R2.Leaf NodeActionsCommon listNodeActions :: R2.Leaf NodeActionsCommon
......
...@@ -7,6 +7,7 @@ import Data.Tuple.Nested ((/\)) ...@@ -7,6 +7,7 @@ import Data.Tuple.Nested ((/\))
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 Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
...@@ -59,45 +60,49 @@ type CreateNodeProps = ...@@ -59,45 +60,49 @@ type CreateNodeProps =
, nodeTypes :: Array NodeType , nodeTypes :: Array NodeType
) )
addNodeView :: Record CreateNodeProps addNodeView :: R2.Component CreateNodeProps
-> R.Element addNodeView = R.createElement addNodeViewCpt
addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p [] addNodeViewCpt :: R.Component CreateNodeProps
where addNodeViewCpt = here.component "addNodeView" cpt where
el = here.component "addNodeView" cpt cpt { dispatch
cpt {id, name} _ = do , id
nodeName@(name' /\ setNodeName) <- R.useState' "Name" , name
nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe Folder $ head nodeTypes , nodeTypes } _ = do
nodeName <- T.useBox "Name"
let nodeName' <- T.useLive T.unequal nodeName
SettingsBox {edit} = settingsBox nt nodeType <- T.useBox $ fromMaybe Folder $ head nodeTypes
setNodeType' nt = do nodeType' <- T.useLive T.unequal nodeType
setNodeName $ const $ GT.prettyNodeType nt
setNodeType $ const nt let
(maybeChoose /\ nt') = if length nodeTypes > 1 SettingsBox {edit} = settingsBox nodeType'
then ([ formChoiceSafe nodeTypes Error setNodeType' ] /\ nt) setNodeType' nt = do
else ([H.div {} [H.text $ "Creating a node of type " T.write_ (GT.prettyNodeType nt) nodeName
<> show defaultNt T.write_ nt nodeType
<> " with name:" (maybeChoose /\ nt') = if length nodeTypes > 1
] then ([ formChoiceSafe nodeTypes Error setNodeType' ] /\ nodeType')
] /\ defaultNt else ([H.div {} [H.text $ "Creating a node of type "
) <> show defaultNt
where <> " with name:"
defaultNt = (fromMaybe Error $ head nodeTypes) ]
maybeEdit = [ if edit ] /\ defaultNt
then inputWithEnter { )
onBlur: \val -> setNodeName $ const val where
, onEnter: \_ -> launchAff_ $ dispatch (AddNode name' nt') defaultNt = (fromMaybe Error $ head nodeTypes)
, onValueChanged: \val -> setNodeName $ const val maybeEdit = [ if edit
, autoFocus: true then inputWithEnter {
, className: "form-control" onBlur: \val -> T.write_ val nodeName
, defaultValue: name' -- (prettyNodeType nt') , onEnter: \_ -> launchAff_ $ dispatch (AddNode nodeName' nt')
, placeholder: name' -- (prettyNodeType nt') , onValueChanged: \val -> T.write_ val nodeName
, type: "text" , autoFocus: true
} , className: "form-control"
else H.div {} [] , defaultValue: nodeName' -- (prettyNodeType nt')
] , placeholder: nodeName' -- (prettyNodeType nt')
, type: "text"
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt') dispatch) }
else H.div {} []
]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode nodeName' nt') dispatch)
-- END Create Node -- END Create Node
......
module Gargantext.Components.Forest.Tree.Node.Action.Contact where module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude import Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Formula as F import Formula as F
import Reactix as R import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..)) import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
-- import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID) import Gargantext.Types (ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
...@@ -24,20 +23,36 @@ contactReq :: Session -> ID -> AddContactParams -> Aff ID ...@@ -24,20 +23,36 @@ contactReq :: Session -> ID -> AddContactParams -> Aff ID
contactReq session nodeId = contactReq session nodeId =
post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact" post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact"
type ActionAddContact =
( dispatch :: Action -> Aff Unit
, id :: ID )
actionAddContact :: R2.Component ActionAddContact
actionAddContact = R.createElement actionAddContactCpt
actionAddContactCpt :: R.Component ActionAddContact
actionAddContactCpt = here.component "actionAddContact" cpt where
cpt { dispatch, id } _ = do
isOpen <- T.useBox true
pure $ textInputBox
{ boxAction: \p -> AddContact p
, boxName:"addContact"
, dispatch
, id
, isOpen
, params: {firstname:"First Name", lastname: "Last Name"} }
type TextInputBoxProps = type TextInputBoxProps =
( id :: ID ( boxAction :: AddContactParams -> Action
, boxName :: String
, dispatch :: Action -> Aff Unit , dispatch :: Action -> Aff Unit
, params :: Record AddContactProps , id :: ID
, isOpen :: T.Box Boolean , isOpen :: T.Box Boolean
, boxName :: String , params :: Record AddContactProps )
, boxAction :: AddContactParams -> Action
)
type AddContactProps = ( firstname :: String, lastname :: String) type AddContactProps = ( firstname :: String, lastname :: String )
textInputBox :: R2.Leaf TextInputBoxProps textInputBox :: R2.Leaf TextInputBoxProps
textInputBox props = R.createElement textInputBoxCpt props [] textInputBox props = R.createElement textInputBoxCpt props []
textInputBoxCpt :: R.Component TextInputBoxProps textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where textInputBoxCpt = here.component "textInputBox" cpt where
cpt p@{ boxName, boxAction, dispatch, isOpen cpt p@{ boxName, boxAction, dispatch, isOpen
......
...@@ -2,18 +2,25 @@ module Gargantext.Components.Forest.Tree.Node.Action.Delete ...@@ -2,18 +2,25 @@ module Gargantext.Components.Forest.Tree.Node.Action.Delete
where where
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Prelude
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Types as GT
import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Types (NodeType(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Reactix as R import Reactix as R
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Types as GT
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Delete"
-- TODO Delete with asyncTaskWithType -- TODO Delete with asyncTaskWithType
deleteNode :: Session -> NodeType -> GT.ID -> Aff GT.ID deleteNode :: Session -> NodeType -> GT.ID -> Aff GT.ID
deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) "" deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
...@@ -30,21 +37,37 @@ unpublishNode s p n = put_ s $ NodeAPI GT.Node p ("unpublish/" <> show n) ...@@ -30,21 +37,37 @@ unpublishNode s p n = put_ s $ NodeAPI GT.Node p ("unpublish/" <> show n)
-- | Action : Delete -- | Action : Delete
actionDelete :: NodeType -> (Action -> Aff Unit) -> R.Hooks R.Element type Delete =
actionDelete NodeUser _ = do ( dispatch :: Action -> Aff Unit
pure $ panel [ H.div { style: {margin: "10px"}} , nodeType :: NodeType )
[ H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet." actionDelete :: R2.Component Delete
<> " We are still on development." actionDelete = R.createElement actionDeleteCpt
<> " Thanks for your comprehensin." actionDeleteCpt :: R.Component Delete
actionDeleteCpt = here.component "actionDelete" cpt where
cpt props@{ nodeType: NodeUser } _ = pure $ actionDeleteUser props []
cpt props _ = pure $ actionDeleteOther props []
actionDeleteUser :: R2.Component Delete
actionDeleteUser = R.createElement actionDeleteUserCpt
actionDeleteUserCpt :: R.Component Delete
actionDeleteUserCpt = here.component "actionDeleteUser" cpt where
cpt _ _ = do
pure $ panel [ H.div { style: {margin: "10px"}}
[ H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet."
<> " We are still on development."
<> " Thanks for your comprehensin."
]
] (H.div {} [])
actionDeleteOther :: R2.Component Delete
actionDeleteOther = R.createElement actionDeleteOtherCpt
actionDeleteOtherCpt :: R.Component Delete
actionDeleteOtherCpt = here.component "actionDeleteOther" cpt where
cpt { dispatch, nodeType } _ = do
pure $ panel (map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?"
, "If yes, click again below."
] ]
] ) (submitButton (DeleteNode nodeType) dispatch)
(H.div {} [])
actionDelete nt dispatch = do
pure $ panel (map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?"
, "If yes, click again below."
]
)
(submitButton (DeleteNode nt) dispatch)
module Gargantext.Components.Forest.Tree.Node.Action.Documentation where module Gargantext.Components.Forest.Tree.Node.Action.Documentation where
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Gargantext.Components.Forest.Tree.Node.Tools (panel) import Gargantext.Components.Forest.Tree.Node.Tools (panel)
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Documentation"
-- | Action: Show Documentation -- | Action: Show Documentation
actionDoc :: NodeType -> R.Hooks R.Element type ActionDoc =
actionDoc nodeType = ( nodeType :: NodeType )
pure $ panel ( [ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType) actionDoc :: R2.Component ActionDoc
) actionDoc = R.createElement actionDocCpt
( H.div {} []) actionDocCpt :: R.Component ActionDoc
where actionDocCpt = here.component "actionDoc" cpt where
infoTitle :: NodeType -> R.Element cpt { nodeType } _ = do
infoTitle nt = H.div { style: {margin: "10px"}} pure $ panel ([ infoTitle nodeType ]
[ H.h3 {} [H.text "Documentation about " ] <> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ] )
] (H.div {} [])
where
infoTitle :: NodeType -> R.Element
infoTitle nt = H.div { style: {margin: "10px"}}
[ H.h3 {} [H.text "Documentation about " ]
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ]
]
-- | TODO add documentation of all NodeType -- | TODO add documentation of all NodeType
docOf :: NodeType -> Array String docOf :: NodeType -> Array String
......
module Gargantext.Components.Forest.Tree.Node.Action.Download where module Gargantext.Components.Forest.Tree.Node.Action.Download where
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action (Action(DownloadNode)) import Gargantext.Components.Forest.Tree.Node.Action (Action(DownloadNode))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, panel, submitButtonHref) import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, panel, submitButtonHref)
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Prelude (pure, ($)) import Gargantext.Prelude (pure, ($))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..), ID) import Gargantext.Types (ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Reactix as R import Gargantext.Utils.Reactix as R2
import Reactix.DOM.HTML as H
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Documentation"
-- | Action : Download -- | Action : Download
actionDownload :: NodeType -> ID -> Session -> R.Hooks R.Element type ActionDownload =
actionDownload NodeList id session = pure $ panel [H.div {} [H.text info]] ( id :: ID
(submitButtonHref DownloadNode href) , nodeType :: GT.NodeType
, session :: Session )
actionDownload :: R2.Component ActionDownload
actionDownload = R.createElement actionDownloadCpt
actionDownloadCpt :: R.Component ActionDownload
actionDownloadCpt = here.component "actionDownload" cpt where
cpt props@{ nodeType: GT.Corpus } _ = pure $ actionDownloadCorpus props []
cpt props@{ nodeType: GT.Graph } _ = pure $ actionDownloadGraph props []
cpt props@{ nodeType: GT.NodeList } _ = pure $ actionDownloadNodeList props []
cpt props@{ nodeType: _ } _ = pure $ actionDownloadOther props []
actionDownloadCorpus :: R2.Component ActionDownload
actionDownloadCorpus = R.createElement actionDownloadCorpusCpt
actionDownloadCorpusCpt :: R.Component ActionDownload
actionDownloadCorpusCpt = here.component "actionDownloadCorpus" cpt where
cpt { id, session } _ = do
pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where where
href = url session $ Routes.NodeAPI GT.NodeList (Just id) "" href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
info = "Info about the List as JSON format" info = "Download as JSON"
actionDownload GT.Graph id session = pure $ panel [H.div {} [H.text info]] actionDownloadGraph :: R2.Component ActionDownload
(submitButtonHref DownloadNode href) actionDownloadGraph = R.createElement actionDownloadGraphCpt
actionDownloadGraphCpt :: R.Component ActionDownload
actionDownloadGraphCpt = here.component "actionDownloadGraph" cpt where
cpt { id, session } _ = do
pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where where
href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf" href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
info = "Info about the Graph as GEXF format" info = "Info about the Graph as GEXF format"
actionDownload GT.Corpus id session = pure $ panel [H.div {} [H.text info]] actionDownloadNodeList :: R2.Component ActionDownload
(submitButtonHref DownloadNode href) actionDownloadNodeList = R.createElement actionDownloadNodeListCpt
actionDownloadNodeListCpt :: R.Component ActionDownload
actionDownloadNodeListCpt = here.component "actionDownloadNodeList" cpt where
cpt { id, session } _ = do
pure $ panel [ H.div {} [H.text info] ]
(submitButtonHref DownloadNode href)
where where
href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export" href = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
info = "Download as JSON" info = "Info about the List as JSON format"
{- {-
-- TODO fix the route -- TODO fix the route
...@@ -40,5 +73,9 @@ actionDownload GT.Texts id session = pure $ panel [H.div {} [H.text info]] ...@@ -40,5 +73,9 @@ actionDownload GT.Texts id session = pure $ panel [H.div {} [H.text info]]
href = url session $ Routes.NodeAPI GT.Texts (Just id) "" href = url session $ Routes.NodeAPI GT.Texts (Just id) ""
info = "TODO: fix the backend route. What is the expected result ?" info = "TODO: fix the backend route. What is the expected result ?"
-} -}
actionDownload _ _ _ = pure $ fragmentPT $ "Soon, you will be able to download your file here " actionDownloadOther :: R2.Component ActionDownload
actionDownloadOther = R.createElement actionDownloadOtherCpt
actionDownloadOtherCpt :: R.Component ActionDownload
actionDownloadOtherCpt = here.component "actionDownloadOther" cpt where
cpt { id, session } _ = do
pure $ fragmentPT $ "Soon, you will be able to download your file here "
...@@ -49,7 +49,6 @@ linkNodeType _ = GT.Error ...@@ -49,7 +49,6 @@ linkNodeType _ = GT.Error
linkNode :: R2.Component SubTreeParamsIn linkNode :: R2.Component SubTreeParamsIn
linkNode = R.createElement linkNodeCpt linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt linkNodeCpt = here.component "linkNode" cpt
where where
......
...@@ -2,7 +2,6 @@ module Gargantext.Components.Forest.Tree.Node.Action.Merge where ...@@ -2,7 +2,6 @@ module Gargantext.Components.Forest.Tree.Node.Action.Merge where
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Set as Set import Data.Set as Set
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
...@@ -26,7 +25,6 @@ mergeNodeReq session fromId toId = ...@@ -26,7 +25,6 @@ mergeNodeReq session fromId toId =
mergeNode :: R2.Component SubTreeParamsIn mergeNode :: R2.Component SubTreeParamsIn
mergeNode = R.createElement mergeNodeCpt mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt mergeNodeCpt = here.component "mergeNode" cpt
where where
......
module Gargantext.Components.Forest.Tree.Node.Action.Move where module Gargantext.Components.Forest.Tree.Node.Action.Move where
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
...@@ -26,7 +25,6 @@ moveNodeReq session fromId toId = ...@@ -26,7 +25,6 @@ moveNodeReq session fromId toId =
moveNode :: R2.Component SubTreeParamsIn moveNode :: R2.Component SubTreeParamsIn
moveNode = R.createElement moveNodeCpt moveNode = R.createElement moveNodeCpt
moveNodeCpt :: R.Component SubTreeParamsIn moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = here.component "moveNode" cpt moveNodeCpt = here.component "moveNode" cpt
where where
......
...@@ -32,7 +32,6 @@ type Props = ...@@ -32,7 +32,6 @@ type Props =
-- | Action : Search -- | Action : Search
actionSearch :: R2.Component Props actionSearch :: R2.Component Props
actionSearch = R.createElement actionSearchCpt actionSearch = R.createElement actionSearchCpt
actionSearchCpt :: R.Component Props actionSearchCpt :: R.Component Props
actionSearchCpt = here.component "actionSearch" cpt actionSearchCpt = here.component "actionSearch" cpt
where where
......
...@@ -4,7 +4,6 @@ import Data.Argonaut as Argonaut ...@@ -4,7 +4,6 @@ import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Prelude (($)) import Prelude (($))
import Reactix as R import Reactix as R
...@@ -15,7 +14,7 @@ import Gargantext.Components.Forest.Tree.Node.Action (Action) ...@@ -15,7 +14,7 @@ import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Components.Forest.Tree.Node.Tools as Tools import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude (class Eq, class Show, bind, pure) import Gargantext.Prelude (class Eq, class Show, bind, pure, Unit)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID) import Gargantext.Types (ID)
...@@ -34,9 +33,6 @@ shareReq session nodeId = ...@@ -34,9 +33,6 @@ shareReq session nodeId =
shareAction :: String -> Action shareAction :: String -> Action
shareAction username = Action.ShareTeam username shareAction username = Action.ShareTeam username
------------------------------------------------------------------------
textInputBox :: Record Tools.TextInputBoxProps -> R.Element
textInputBox p = Tools.textInputBox p []
------------------------------------------------------------------------ ------------------------------------------------------------------------
data ShareNodeParams = ShareTeamParams { username :: String } data ShareNodeParams = ShareTeamParams { username :: String }
...@@ -57,11 +53,30 @@ instance encodeJsonShareNodeParams :: Argonaut.EncodeJson ShareNodeParams where ...@@ -57,11 +53,30 @@ instance encodeJsonShareNodeParams :: Argonaut.EncodeJson ShareNodeParams where
------------------------------------------------------------------------ ------------------------------------------------------------------------
shareNode :: Record SubTreeParamsIn -> R.Element type ShareNode =
shareNode p = R.createElement shareNodeCpt p [] ( id :: ID
, dispatch :: Action -> Aff Unit )
shareNodeCpt :: R.Component SubTreeParamsIn shareNode :: R2.Component ShareNode
shareNode = R.createElement shareNodeCpt
shareNodeCpt :: R.Component ShareNode
shareNodeCpt = here.component "shareNode" cpt shareNodeCpt = here.component "shareNode" cpt
where
cpt { dispatch, id } _ = do
isOpen <- T.useBox true
pure $ Tools.panel
[ Tools.textInputBox { boxAction: shareAction
, boxName: "Share"
, dispatch
, id
, isOpen
, text: "username" } []
] (H.div {} [])
------------------------------------------------------------------------
publishNode :: R2.Component SubTreeParamsIn
publishNode = R.createElement publishNodeCpt
publishNodeCpt :: R.Component SubTreeParamsIn
publishNodeCpt = here.component "publishNode" cpt
where where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
action <- T.useBox (Action.SharePublic { params: Nothing }) action <- T.useBox (Action.SharePublic { params: Nothing })
...@@ -73,13 +88,13 @@ shareNodeCpt = here.component "shareNode" cpt ...@@ -73,13 +88,13 @@ shareNodeCpt = here.component "shareNode" cpt
Nothing -> H.div {} [] Nothing -> H.div {} []
_ -> H.div {} [] _ -> H.div {} []
pure $ Tools.panel [ subTreeView { action pure $ Tools.panel
, dispatch [ subTreeView { action
, handed , dispatch
, id , handed
, nodeType , id
, session , nodeType
, subTreeParams , session
} [] , subTreeParams
] button } []
] button
module Gargantext.Components.Forest.Tree.Node.Action.Update where module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Data.Tuple.Nested ((/\)) import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
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 Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude 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.Tools (formChoiceSafe, submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Sessions (Session, post)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update"
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
updateRequest updateNodeParams session nodeId = do updateRequest updateNodeParams session nodeId = do
...@@ -25,49 +29,77 @@ updateRequest updateNodeParams session nodeId = do ...@@ -25,49 +29,77 @@ updateRequest updateNodeParams session nodeId = do
p = GR.NodeAPI GT.Node (Just nodeId) "update" p = GR.NodeAPI GT.Node (Just nodeId) "update"
---------------------------------------------------------------------- ----------------------------------------------------------------------
update :: NodeType type UpdateProps =
-> (Action -> Aff Unit) ( dispatch :: Action -> Aff Unit
-> R.Hooks R.Element , nodeType :: NodeType )
update NodeList dispatch = do
meth @( methodList /\ setMethod ) <- R.useState' Basic update :: R2.Component UpdateProps
update = R.createElement updateCpt
let setMethod' = setMethod <<< const updateCpt :: R.Component UpdateProps
updateCpt = here.component "update" cpt where
pure $ panel [ -- H.text "Update with" cpt props@{ dispatch, nodeType: Dashboard } _ = pure $ updateDashboard props []
formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod' cpt props@{ dispatch, nodeType: Graph } _ = pure $ updateGraph props []
] cpt props@{ dispatch, nodeType: NodeList } _ = pure $ updateNodeList props []
(submitButton (UpdateNode $ UpdateNodeParamsList {methodList}) dispatch) cpt props@{ dispatch, nodeType: Texts } _ = pure $ updateTexts props []
cpt props@{ dispatch, nodeType: _ } _ = pure $ updateOther props []
update Graph dispatch = do
meth @( methodGraph /\ setMethod ) <- R.useState' Order1 updateDashboard :: R2.Component UpdateProps
updateDashboard = R.createElement updateDashboardCpt
let setMethod' = setMethod <<< const updateDashboardCpt :: R.Component UpdateProps
updateDashboardCpt = here.component "updateDashboard" cpt where
pure $ panel [ -- H.text "Update with" cpt { dispatch } _ = do
formChoiceSafe [Order1, Order2] Order1 setMethod' methodBoard <- T.useBox All
] methodBoard' <- T.useLive T.unequal methodBoard
(submitButton (UpdateNode $ UpdateNodeParamsGraph {methodGraph}) dispatch)
pure $ panel [ -- H.text "Update with"
update Texts dispatch = do formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All (\val -> T.write_ val methodBoard)
meth @( methodTexts /\ setMethod ) <- R.useState' NewNgrams ]
(submitButton (UpdateNode $ UpdateNodeParamsBoard { methodBoard: methodBoard' }) dispatch)
let setMethod' = setMethod <<< const
updateGraph :: R2.Component UpdateProps
pure $ panel [ -- H.text "Update with" updateGraph = R.createElement updateGraphCpt
formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams setMethod' updateGraphCpt :: R.Component UpdateProps
] updateGraphCpt = here.component "updateGraph" cpt where
(submitButton (UpdateNode $ UpdateNodeParamsTexts {methodTexts}) dispatch) cpt { dispatch } _ = do
methodGraph <- T.useBox Order1
update Dashboard dispatch = do methodGraph' <- T.useLive T.unequal methodGraph
meth @( methodBoard /\ setMethod ) <- R.useState' All
pure $ panel [ -- H.text "Update with"
let setMethod' = setMethod <<< const formChoiceSafe [Order1, Order2] Order1 (\val -> T.write_ val methodGraph)
]
pure $ panel [ -- H.text "Update with" (submitButton (UpdateNode $ UpdateNodeParamsGraph { methodGraph: methodGraph' }) dispatch)
formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All setMethod'
] updateNodeList :: R2.Component UpdateProps
(submitButton (UpdateNode $ UpdateNodeParamsBoard {methodBoard}) dispatch) updateNodeList = R.createElement updateNodeListCpt
updateNodeListCpt :: R.Component UpdateProps
update _ _ = pure $ H.div {} [] updateNodeListCpt = here.component "updateNodeList" cpt where
cpt { dispatch } _ = do
methodList <- T.useBox Basic
methodList' <- T.useLive T.unequal methodList
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Basic, Advanced, WithModel] Basic (\val -> T.write_ val methodList)
]
(submitButton (UpdateNode $ UpdateNodeParamsList { methodList: methodList' }) dispatch)
updateTexts :: R2.Component UpdateProps
updateTexts = R.createElement updateTextsCpt
updateTextsCpt :: R.Component UpdateProps
updateTextsCpt = here.component "updateTexts" cpt where
cpt { dispatch } _ = do
methodTexts <- T.useBox NewNgrams
methodTexts' <- T.useLive T.unequal methodTexts
pure $ panel [ -- H.text "Update with"
formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams (\val -> T.write_ val methodTexts)
]
(submitButton (UpdateNode $ UpdateNodeParamsTexts { methodTexts: methodTexts' }) dispatch)
updateOther :: R2.Component UpdateProps
updateOther = R.createElement updateOtherCpt
updateOtherCpt :: R.Component UpdateProps
updateOtherCpt = here.component "updateOther" cpt where
cpt { dispatch } _ = do
pure $ H.div {} []
-- fragmentPT $ "Update " <> show nodeType -- fragmentPT $ "Update " <> show nodeType
...@@ -40,20 +40,31 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Upload" ...@@ -40,20 +40,31 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Upload"
-- UploadFile Action -- UploadFile Action
-- | Action : Upload -- | Action : Upload
actionUpload :: NodeType -> ID -> Session -> (Action -> Aff Unit) -> R.Hooks R.Element type ActionUpload =
actionUpload NodeList id session dispatch = ( dispatch :: Action -> Aff Unit
pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session} , id :: ID
, nodeType :: NodeType
actionUpload Corpus id session dispatch = , session :: Session )
pure $ uploadFileView {dispatch, id, nodeType: Corpus, session}
actionUpload :: R2.Component ActionUpload
actionUpload = R.createElement actionUploadCpt
actionUploadCpt :: R.Component ActionUpload
actionUploadCpt = here.component "actionUpload" cpt where
cpt { nodeType: Corpus, dispatch, id, session } _ = pure $ uploadFileView {dispatch, id, nodeType: GT.Corpus, session}
cpt { nodeType: NodeList, dispatch, id, session } _ = pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
cpt props@{ nodeType: _, dispatch, id, session } _ = pure $ actionUploadOther props []
{- {-
actionUpload Annuaire id session dispatch = actionUpload Annuaire id session dispatch =
pure $ uploadFileView {dispatch, id, nodeType: Annuaire, session} pure $ uploadFileView {dispatch, id, nodeType: Annuaire, session}
-} -}
actionUpload _ _ _ _ = actionUploadOther :: R2.Component ActionUpload
pure $ fragmentPT $ "Soon, upload for this NodeType." actionUploadOther = R.createElement actionUploadOtherCpt
actionUploadOtherCpt :: R.Component ActionUpload
actionUploadOtherCpt = here.component "actionUploadOther" cpt where
cpt _ _ = do
pure $ fragmentPT $ "Soon, upload for this NodeType."
-- file upload types -- file upload types
...@@ -82,12 +93,13 @@ uploadFileViewCpt :: R.Component Props ...@@ -82,12 +93,13 @@ uploadFileViewCpt :: R.Component Props
uploadFileViewCpt = here.component "uploadFileView" cpt uploadFileViewCpt = here.component "uploadFileView" cpt
where where
cpt {dispatch, id, nodeType} _ = do cpt {dispatch, id, nodeType} _ = do
mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing -- mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
fileType@(_ /\ setFileType) <- R.useState' CSV mFile <- T.useBox (Nothing :: Maybe UploadFile)
lang@( _chosenLang /\ setLang) <- R.useState' EN fileType <- T.useBox CSV
lang <- T.useBox EN
let setFileType' = setFileType <<< const let setFileType' val = T.write_ val fileType
let setLang' = setLang <<< const let setLang' val = T.write_ val lang
let bodies = let bodies =
[ R2.row [ R2.row
...@@ -133,8 +145,8 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -133,8 +145,8 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
renderOptionLang :: Lang -> R.Element renderOptionLang :: Lang -> R.Element
renderOptionLang opt = H.option {} [ H.text $ show opt ] renderOptionLang opt = H.option {} [ H.text $ show opt ]
onChangeContents :: forall e. R.State (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit onChangeContents :: forall e. T.Box (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents (mFile /\ setMFile) e = do onChangeContents mFile e = do
let mF = R2.inputFileNameWithBlob 0 e let mF = R2.inputFileNameWithBlob 0 e
E.preventDefault e E.preventDefault e
E.stopPropagation e E.stopPropagation e
...@@ -144,15 +156,15 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -144,15 +156,15 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
--contents <- readAsText blob --contents <- readAsText blob
--contents <- readAsDataURL blob --contents <- readAsDataURL blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Just $ {blob: UploadFileBlob blob, name} T.write_ (Just $ {blob: UploadFileBlob blob, name}) mFile
type UploadButtonProps = type UploadButtonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, fileType :: R.State FileType , fileType :: T.Box FileType
, id :: GT.ID , id :: GT.ID
, lang :: R.State Lang , lang :: T.Box Lang
, mFile :: R.State (Maybe UploadFile) , mFile :: T.Box (Maybe UploadFile)
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
) )
...@@ -163,36 +175,39 @@ uploadButtonCpt :: R.Component UploadButtonProps ...@@ -163,36 +175,39 @@ uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt = here.component "uploadButton" cpt uploadButtonCpt = here.component "uploadButton" cpt
where where
cpt { dispatch cpt { dispatch
, fileType: (fileType /\ setFileType) , fileType
, id , id
, lang: (lang /\ setLang) , lang
, mFile: (mFile /\ setMFile) , mFile
, nodeType , nodeType
} _ = pure } _ = do
$ H.button { className: "btn btn-primary" fileType' <- T.useLive T.unequal fileType
, "type" : "button" mFile' <- T.useLive T.unequal mFile
, disabled
, style : { width: "100%" } let disabled = case mFile' of
, on: {click: onClick} Nothing -> "1"
} [ H.text "Upload" ] Just _ -> ""
pure $ H.button { className: "btn btn-primary"
, "type" : "button"
, disabled
, style : { width: "100%" }
, on: {click: onClick fileType' mFile'}
} [ H.text "Upload" ]
where where
disabled = case mFile of onClick fileType' mFile' e = do
Nothing -> "1" let { blob, name } = unsafePartial $ fromJust mFile'
Just _ -> "" log2 "[uploadButton] fileType" fileType'
onClick e = do
let { blob, name } = unsafePartial $ fromJust mFile
log2 "[uploadButton] fileType" fileType
void $ launchAff do void $ launchAff do
case fileType of case fileType' of
Arbitrary -> Arbitrary ->
dispatch $ UploadArbitraryFile (Just name) blob dispatch $ UploadArbitraryFile (Just name) blob
_ -> _ ->
dispatch $ UploadFile nodeType fileType (Just name) blob dispatch $ UploadFile nodeType fileType' (Just name) blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Nothing T.write_ Nothing mFile
setFileType $ const $ CSV T.write_ CSV fileType
setLang $ const $ EN T.write_ EN lang
dispatch ClosePopover dispatch ClosePopover
-- START File Type View -- START File Type View
...@@ -352,7 +367,8 @@ uploadTermListViewCpt :: R.Component Props ...@@ -352,7 +367,8 @@ uploadTermListViewCpt :: R.Component Props
uploadTermListViewCpt = here.component "uploadTermListView" cpt uploadTermListViewCpt = here.component "uploadTermListView" cpt
where where
cpt {dispatch, id, nodeType} _ = do cpt {dispatch, id, nodeType} _ = do
mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing mFile <- T.useBox (Nothing :: Maybe UploadFile)
let body = H.input { type: "file" let body = H.input { type: "file"
, placeholder: "Choose file" , placeholder: "Choose file"
, on: {change: onChangeContents mFile} , on: {change: onChangeContents mFile}
...@@ -362,15 +378,15 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt ...@@ -362,15 +378,15 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
, id , id
, mFile , mFile
, nodeType , nodeType
} }
] ]
pure $ panel [body] footer pure $ panel [body] footer
onChangeContents :: forall e. R.State (Maybe UploadFile) onChangeContents :: forall e. T.Box (Maybe UploadFile)
-> E.SyntheticEvent_ e -> E.SyntheticEvent_ e
-> Effect Unit -> Effect Unit
onChangeContents (mFile /\ setMFile) e = do onChangeContents mFile e = do
let mF = R2.inputFileNameWithBlob 0 e let mF = R2.inputFileNameWithBlob 0 e
E.preventDefault e E.preventDefault e
E.stopPropagation e E.stopPropagation e
...@@ -379,37 +395,41 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt ...@@ -379,37 +395,41 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
Just {blob, name} -> void $ launchAff do Just {blob, name} -> void $ launchAff do
--contents <- readAsText blob --contents <- readAsText blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Just $ { blob: UploadFileBlob blob T.write_ (Just $ { blob: UploadFileBlob blob
, name , name }) mFile
}
type UploadTermButtonProps = type UploadTermButtonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, id :: Int , id :: Int
, mFile :: R.State (Maybe UploadFile) , mFile :: T.Box (Maybe UploadFile)
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
) )
uploadTermButton :: Record UploadTermButtonProps -> R.Element uploadTermButton :: R2.Leaf UploadTermButtonProps
uploadTermButton props = R.createElement uploadTermButtonCpt props [] uploadTermButton props = R.createElement uploadTermButtonCpt props []
uploadTermButtonCpt :: R.Component UploadTermButtonProps uploadTermButtonCpt :: R.Component UploadTermButtonProps
uploadTermButtonCpt = here.component "uploadTermButton" cpt uploadTermButtonCpt = here.component "uploadTermButton" cpt
where where
cpt {dispatch, id, mFile: (mFile /\ setMFile), nodeType} _ = do cpt { dispatch
pure $ H.button {className: "btn btn-primary", disabled, on: {click: onClick}} [ H.text "Upload" ] , id
, mFile
, nodeType } _ = do
mFile' <- T.useLive T.unequal mFile
let disabled = case mFile' of
Nothing -> "1"
Just _ -> ""
pure $ H.button { className: "btn btn-primary"
, disabled
, on: {click: onClick mFile'}
} [ H.text "Upload" ]
where where
disabled = case mFile of onClick mFile' e = do
Nothing -> "1" let {name, blob} = unsafePartial $ fromJust mFile'
Just _ -> ""
onClick e = do
let {name, blob} = unsafePartial $ fromJust mFile
void $ launchAff do void $ launchAff do
_ <- dispatch $ UploadFile nodeType CSV (Just name) blob _ <- dispatch $ UploadFile nodeType CSV (Just name) blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Nothing T.write_ Nothing mFile
...@@ -169,13 +169,13 @@ panelAction p = R.createElement panelActionCpt p [] ...@@ -169,13 +169,13 @@ panelAction p = R.createElement panelActionCpt p []
panelActionCpt :: R.Component PanelActionProps panelActionCpt :: R.Component PanelActionProps
panelActionCpt = here.component "panelAction" cpt panelActionCpt = here.component "panelAction" cpt
where where
cpt {action: Documentation nodeType} _ = actionDoc nodeType cpt {action: Documentation nodeType} _ = pure $ actionDoc { nodeType } []
cpt {action: Download, id, nodeType, session} _ = actionDownload nodeType id session cpt {action: Download, id, nodeType, session} _ = pure $ actionDownload { id, nodeType, session } []
cpt {action: Upload, dispatch, id, nodeType, session} _ = actionUpload nodeType id session dispatch cpt {action: Upload, dispatch, id, nodeType, session} _ = pure $ actionUpload { dispatch, id, nodeType, session } []
cpt {action: Delete, nodeType, dispatch} _ = actionDelete nodeType dispatch cpt {action: Delete, nodeType, dispatch} _ = pure $ actionDelete { dispatch, nodeType } []
cpt {action: Add xs, dispatch, id, name, nodeType} _ = cpt {action: Add xs, dispatch, id, name, nodeType} _ =
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} []
cpt {action: Refresh , dispatch, id, nodeType, session} _ = update nodeType dispatch cpt {action: Refresh , dispatch, id, nodeType, session} _ = pure $ update { dispatch, nodeType } []
cpt {action: Config , dispatch, id, nodeType, session} _ = cpt {action: Config , dispatch, id, nodeType, session} _ =
pure $ fragmentPT $ "Config " <> show nodeType pure $ fragmentPT $ "Config " <> show nodeType
-- Functions using SubTree -- Functions using SubTree
...@@ -185,21 +185,10 @@ panelActionCpt = here.component "panelAction" cpt ...@@ -185,21 +185,10 @@ panelActionCpt = here.component "panelAction" cpt
pure $ moveNode { dispatch, id, nodeType, session, subTreeParams, handed } [] pure $ moveNode { dispatch, id, nodeType, session, subTreeParams, handed } []
cpt {action: Link {subTreeParams}, dispatch, id, nodeType, session, handed} _ = cpt {action: Link {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed} [] pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed} []
cpt {action : Share, dispatch, id, name } _ = do cpt {action : Share, dispatch, id, name } _ = pure $ Share.shareNode { dispatch, id } []
isOpen <- T.useBox true cpt {action : AddingContact, dispatch, id, name } _ = pure $ Contact.actionAddContact { dispatch, id } []
pure $ panel
[ textInputBox
{ boxAction: Share.shareAction, boxName: "Share"
, dispatch, id, text: "username", isOpen } []
] (H.div {} [])
cpt {action : AddingContact, dispatch, id, name } _ = do
isOpen <- T.useBox true
pure $ Contact.textInputBox
{ id, dispatch, isOpen, boxName:"addContact"
, params : {firstname:"First Name", lastname: "Last Name"}
, boxAction: \p -> AddContact p }
cpt {action : Publish {subTreeParams}, dispatch, id, nodeType, session, handed} _ = cpt {action : Publish {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ Share.shareNode {dispatch, id, nodeType, session, subTreeParams, handed} pure $ Share.publishNode { dispatch, handed, id, nodeType, session, subTreeParams } []
cpt props@{action: SearchBox, id, session, dispatch, nodePopup} _ = cpt props@{action: SearchBox, id, session, dispatch, nodePopup} _ =
pure $ actionSearch { dispatch, id: (Just id), nodePopup, session } [] pure $ actionSearch { dispatch, id: (Just id), nodePopup, session } []
cpt _ _ = pure $ H.div {} [] cpt _ _ = pure $ H.div {} []
...@@ -9,6 +9,7 @@ import Effect.Class (liftEffect) ...@@ -9,6 +9,7 @@ import Effect.Class (liftEffect)
import Effect.Timer (clearInterval, setInterval) import Effect.Timer (clearInterval, setInterval)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
...@@ -31,8 +32,8 @@ type Props = ( ...@@ -31,8 +32,8 @@ type Props = (
) )
asyncProgressBar :: Record Props -> R.Element asyncProgressBar :: R2.Component Props
asyncProgressBar p = R.createElement asyncProgressBarCpt p [] asyncProgressBar = R.createElement asyncProgressBarCpt
asyncProgressBarCpt :: R.Component Props asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = here.component "asyncProgressBar" cpt asyncProgressBarCpt = here.component "asyncProgressBar" cpt
...@@ -42,7 +43,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt ...@@ -42,7 +43,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
, nodeId , nodeId
, onFinish , onFinish
} _ = do } _ = do
(progress /\ setProgress) <- R.useState' 0.0 progress <- T.useBox 0.0
intervalIdRef <- R.useRef Nothing intervalIdRef <- R.useRef Nothing
R.useEffectOnce' $ do R.useEffectOnce' $ do
...@@ -50,7 +51,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt ...@@ -50,7 +51,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
launchAff_ $ do launchAff_ $ do
asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props
liftEffect do liftEffect do
setProgress \p -> min 100.0 $ GT.progressPercent asyncProgress T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
if (status == GT.Finished) || (status == GT.Killed) || (status == GT.Failed) then do if (status == GT.Finished) || (status == GT.Killed) || (status == GT.Failed) then do
_ <- case R.readRef intervalIdRef of _ <- case R.readRef intervalIdRef of
Nothing -> pure unit Nothing -> pure unit
...@@ -64,17 +65,12 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt ...@@ -64,17 +65,12 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
pure unit pure unit
pure $ progressIndicator { barType, label: id, progress: toInt progress } pure $ progressIndicator { barType, label: id, progress }
toInt :: Number -> Int
toInt n = case fromNumber n of
Nothing -> 0
Just x -> x
type ProgressIndicatorProps = type ProgressIndicatorProps =
( barType :: BarType ( barType :: BarType
, label :: String , label :: String
, progress :: Int , progress :: T.Box Number
) )
progressIndicator :: Record ProgressIndicatorProps -> R.Element progressIndicator :: Record ProgressIndicatorProps -> R.Element
...@@ -83,23 +79,30 @@ progressIndicator p = R.createElement progressIndicatorCpt p [] ...@@ -83,23 +79,30 @@ progressIndicator p = R.createElement progressIndicatorCpt p []
progressIndicatorCpt :: R.Component ProgressIndicatorProps progressIndicatorCpt :: R.Component ProgressIndicatorProps
progressIndicatorCpt = here.component "progressIndicator" cpt progressIndicatorCpt = here.component "progressIndicator" cpt
where where
cpt { barType: Bar, label, progress } _ = do cpt { barType, label, progress } _ = do
pure $ progress' <- T.useLive T.unequal progress
H.div { className: "progress" } [ let progressInt = toInt progress'
H.div { className: "progress-bar"
, role: "progressbar" case barType of
, style: { width: (show $ progress) <> "%" } Bar -> pure $
} [ H.text label ] H.div { className: "progress" }
] [ H.div { className: "progress-bar"
, role: "progressbar"
cpt { barType: Pie, label, progress } _ = do , style: { width: (show $ progressInt) <> "%" }
pure $ } [ H.text label ]
H.div { className: "progress-pie" } [ ]
H.div { className: "progress-pie-segment" Pie -> pure $
, style: { "--over50": if progress < 50 then "0" else "1" H.div { className: "progress-pie" }
, "--value": show $ progress } } [ [ H.div { className: "progress-pie-segment"
] , style: { "--over50": if progressInt < 50 then "0" else "1"
] , "--value": show $ progressInt } } [
]
]
toInt :: Number -> Int
toInt n = case fromNumber n of
Nothing -> 0
Just x -> x
queryProgress :: Record Props -> Aff GT.AsyncProgress queryProgress :: Record Props -> Aff GT.AsyncProgress
queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id} queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
...@@ -110,8 +113,8 @@ queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id} ...@@ -110,8 +113,8 @@ queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
} = get session (p typ) } = get session (p typ)
where where
-- TODO refactor path -- TODO refactor path
p GT.UpdateNode = NodeAPI GT.Node (Just nodeId) $ path <> id <> "/poll?limit=1"
p GT.UpdateNgramsCharts = NodeAPI GT.Node (Just nodeId) $ path <> id <> "/poll?limit=1" p GT.UpdateNgramsCharts = NodeAPI GT.Node (Just nodeId) $ path <> id <> "/poll?limit=1"
p GT.UpdateNode = NodeAPI GT.Node (Just nodeId) $ path <> id <> "/poll?limit=1"
p _ = NodeAPI GT.Corpus (Just nodeId) $ path <> id <> "/poll?limit=1" p _ = NodeAPI GT.Corpus (Just nodeId) $ path <> id <> "/poll?limit=1"
path = GT.asyncTaskTypePath typ path = GT.asyncTaskTypePath typ
......
...@@ -5,10 +5,11 @@ import Gargantext.Prelude ...@@ -5,10 +5,11 @@ import Gargantext.Prelude
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Class (liftEffect)
import Data.Tuple (fst) import Data.Tuple (fst)
import Effect.Class (liftEffect)
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Reactix as R import Reactix as R
import Toestand as T
import Gargantext.Components.GraphExplorer.API as GraphAPI import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -27,9 +28,8 @@ type NodeActionsGraphProps = ...@@ -27,9 +28,8 @@ type NodeActionsGraphProps =
, refresh :: Unit -> Aff Unit , refresh :: Unit -> Aff Unit
) )
nodeActionsGraph :: Record NodeActionsGraphProps -> R.Element nodeActionsGraph :: R2.Component NodeActionsGraphProps
nodeActionsGraph p = R.createElement nodeActionsGraphCpt p [] nodeActionsGraph = R.createElement nodeActionsGraphCpt
nodeActionsGraphCpt :: R.Component NodeActionsGraphProps nodeActionsGraphCpt :: R.Component NodeActionsGraphProps
nodeActionsGraphCpt = here.component "nodeActionsGraph" cpt nodeActionsGraphCpt = here.component "nodeActionsGraph" cpt
where where
...@@ -54,22 +54,23 @@ graphUpdateButtonCpt :: R.Component GraphUpdateButtonProps ...@@ -54,22 +54,23 @@ graphUpdateButtonCpt :: R.Component GraphUpdateButtonProps
graphUpdateButtonCpt = here.component "graphUpdateButton" cpt graphUpdateButtonCpt = here.component "graphUpdateButton" cpt
where where
cpt { id, session, refresh } _ = do cpt { id, session, refresh } _ = do
enabled <- R.useState' true enabled <- T.useBox true
enabled' <- T.useLive T.unequal enabled
pure $ H.div { className: "update-button " pure $ H.div { className: "update-button "
<> if (fst enabled) <> if enabled'
then "enabled" then "enabled"
else "disabled text-muted" else "disabled text-muted"
} [ H.span { className: "fa fa-refresh" } [ H.span { className: "fa fa-refresh"
, on: { click: onClick enabled } } [] , on: { click: onClick enabled' enabled } } []
] ]
where where
onClick (false /\ _) _ = pure unit onClick false _ = pure unit
onClick (true /\ setEnabled) _ = do onClick true enabled = do
launchAff_ $ do launchAff_ $ do
liftEffect $ setEnabled $ const false liftEffect $ T.write_ false enabled
g <- GraphAPI.updateGraphVersions { graphId: id, session } g <- GraphAPI.updateGraphVersions { graphId: id, session }
liftEffect $ setEnabled $ const true liftEffect $ T.write_ true enabled
refresh unit refresh unit
pure unit pure unit
...@@ -109,7 +110,7 @@ nodeListUpdateButtonCpt :: R.Component NodeListUpdateButtonProps ...@@ -109,7 +110,7 @@ nodeListUpdateButtonCpt :: R.Component NodeListUpdateButtonProps
nodeListUpdateButtonCpt = here.component "nodeListUpdateButton" cpt nodeListUpdateButtonCpt = here.component "nodeListUpdateButton" cpt
where where
cpt { listId, nodeId, nodeType, session, refresh } _ = do cpt { listId, nodeId, nodeType, session, refresh } _ = do
enabled <- R.useState' true -- enabled <- T.useBox true
pure $ H.div {} [] {- { className: "update-button " pure $ H.div {} [] {- { className: "update-button "
<> if (fst enabled) then "enabled" else "disabled text-muted" <> if (fst enabled) then "enabled" else "disabled text-muted"
......
...@@ -23,6 +23,7 @@ import Gargantext.Hooks.Sigmax as Sigmax ...@@ -23,6 +23,7 @@ import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Button" here = R2.here "Gargantext.Components.GraphExplorer.Button"
...@@ -53,12 +54,12 @@ centerButton sigmaRef = simpleButton { ...@@ -53,12 +54,12 @@ centerButton sigmaRef = simpleButton {
} }
type CameraButtonProps = ( type CameraButtonProps =
id :: Int ( id :: Int
, hyperdataGraph :: GET.HyperdataGraph , hyperdataGraph :: GET.HyperdataGraph
, session :: Session , session :: Session
, sigmaRef :: R.Ref Sigmax.Sigma , sigmaRef :: R.Ref Sigmax.Sigma
, reloadForest :: Unit -> Effect Unit , reloadForest :: T2.ReloadS
) )
...@@ -94,7 +95,7 @@ cameraButton { id ...@@ -94,7 +95,7 @@ cameraButton { id
launchAff_ $ do launchAff_ $ do
clonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session } clonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session }
ret <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen ret <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
liftEffect $ reloadForest unit liftEffect $ T2.reload reloadForest
pure ret pure ret
, text: "Screenshot" , text: "Screenshot"
} }
...@@ -44,19 +44,17 @@ sizeButtonCpt = here.component "nodeSearchControl" cpt ...@@ -44,19 +44,17 @@ sizeButtonCpt = here.component "nodeSearchControl" cpt
search' <- T.useLive T.unequal search search' <- T.useLive T.unequal search
multiSelectEnabled' <- T.useLive T.unequal multiSelectEnabled multiSelectEnabled' <- T.useLive T.unequal multiSelectEnabled
pure $ pure $ R.fragment
H.div { className: "form-group" } [ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph
[ H.div { className: "input-group" } , classes: "mx-2"
[ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph , onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds
, onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds , onEnterPress: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds
, onEnterPress: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds , state: search } []
, state: search } [] , H.div { className: "btn input-group-addon"
, H.div { className: "btn input-group-addon" , on: { click: \_ -> triggerSearch graph search' multiSelectEnabled' selectedNodeIds }
, on: { click: \_ -> triggerSearch graph search' multiSelectEnabled' selectedNodeIds } }
} [ H.span { className: "fa fa-search" } [] ]
[ H.span { className: "fa fa-search" } [] ] ]
]
]
autocompleteSearch :: SigmaxT.SGraph -> String -> Array String autocompleteSearch :: SigmaxT.SGraph -> String -> Array String
autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes
......
...@@ -23,13 +23,12 @@ import Toestand as T ...@@ -23,13 +23,12 @@ import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Lang (Lang(..)) import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.Search (SearchType(..), SearchQuery(..)) import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Types (SidePanelState(..), SideTab(..))
import Gargantext.Components.GraphExplorer.Legend as Legend import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words) import Gargantext.Components.RandomText (words)
import Gargantext.Components.Search (SearchType(..), SearchQuery(..))
import Gargantext.Data.Array (mapMaybe) import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
...@@ -44,7 +43,7 @@ here = R2.here "Gargantext.Components.GraphExplorer.Sidebar" ...@@ -44,7 +43,7 @@ here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
type Common = ( type Common = (
graphId :: NodeID graphId :: NodeID
, metaData :: GET.MetaData , metaData :: GET.MetaData
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, removedNodeIds :: T.Box SigmaxT.NodeIds , removedNodeIds :: T.Box SigmaxT.NodeIds
, selectedNodeIds :: T.Box SigmaxT.NodeIds , selectedNodeIds :: T.Box SigmaxT.NodeIds
, session :: Session , session :: Session
...@@ -54,38 +53,33 @@ type Props = ( ...@@ -54,38 +53,33 @@ type Props = (
frontends :: Frontends frontends :: Frontends
, graph :: SigmaxT.SGraph , graph :: SigmaxT.SGraph
, graphVersion :: T2.ReloadS , graphVersion :: T2.ReloadS
, showSidePanel :: T.Box GET.SidePanelState , sideTab :: T.Box GET.SideTab
| Common | Common
) )
sidebar :: Record Props -> R.Element sidebar :: R2.Component Props
sidebar props = R.createElement sidebarCpt props [] sidebar = R.createElement sidebarCpt
sidebarCpt :: R.Component Props sidebarCpt :: R.Component Props
sidebarCpt = here.component "sidebar" cpt sidebarCpt = here.component "sidebar" cpt
where where
cpt props@{ metaData, showSidePanel } _ = do cpt props@{ sideTab } _ = do
showSidePanel' <- T.useLive T.unequal showSidePanel sideTab' <- T.useLive T.unequal sideTab
case showSidePanel' of pure $ RH.div { id: "sp-container" }
GET.Closed -> pure $ RH.div {} [] [ sideTabNav { sideTab
GET.InitialClosed -> pure $ RH.div {} [] , sideTabs: [GET.SideTabLegend, GET.SideTabData, GET.SideTabCommunity] } []
GET.Opened sideTabT -> do , case sideTab' of
let sideTab' = case sideTabT of GET.SideTabLegend -> sideTabLegend sideTabProps []
SideTabLegend -> sideTabLegend sideTabProps [] GET.SideTabData -> sideTabData sideTabProps []
SideTabData -> sideTabData sideTabProps [] GET.SideTabCommunity -> sideTabCommunity sideTabProps []
SideTabCommunity -> sideTabCommunity sideTabProps [] ]
pure $ RH.div { id: "sp-container" }
[ sideTabNav { sidePanel: showSidePanel
, sideTabs: [SideTabLegend, SideTabData, SideTabCommunity] } []
, sideTab'
]
where where
sideTabProps = RX.pick props :: Record SideTabProps sideTabProps = RX.pick props :: Record SideTabProps
type SideTabNavProps = ( type SideTabNavProps = (
sidePanel :: T.Box GET.SidePanelState sideTab :: T.Box GET.SideTab
, sideTabs :: Array SideTab , sideTabs :: Array GET.SideTab
) )
sideTabNav :: R2.Component SideTabNavProps sideTabNav :: R2.Component SideTabNavProps
...@@ -94,24 +88,22 @@ sideTabNav = R.createElement sideTabNavCpt ...@@ -94,24 +88,22 @@ sideTabNav = R.createElement sideTabNavCpt
sideTabNavCpt :: R.Component SideTabNavProps sideTabNavCpt :: R.Component SideTabNavProps
sideTabNavCpt = here.component "sideTabNav" cpt sideTabNavCpt = here.component "sideTabNav" cpt
where where
cpt { sidePanel cpt { sideTab, sideTabs } _ = do
, sideTabs } _ = do sideTab' <- T.useLive T.unequal sideTab
sidePanel' <- T.useLive T.unequal sidePanel
pure $ R.fragment [ H.div { className: "text-primary center"} [H.text ""] pure $ R.fragment [ H.div { className: "text-primary center"} [H.text ""]
, H.div { className: "nav nav-tabs"} (liItem sidePanel' <$> sideTabs) , H.div { className: "nav nav-tabs"} (liItem sideTab' <$> sideTabs)
-- , H.div {className: "center"} [ H.text "Doc sideTabs"] -- , H.div {className: "center"} [ H.text "Doc sideTabs"]
] ]
where where
liItem :: GET.SidePanelState -> SideTab -> R.Element liItem :: GET.SideTab -> GET.SideTab -> R.Element
liItem sidePanel' tab = liItem sideTab' tab =
H.div { className : "nav-item nav-link" H.div { className : "nav-item nav-link"
<> if (Opened tab) == sidePanel' <> if tab == sideTab'
then " active" then " active"
else "" else ""
, on: { click: \_ -> T.write (Opened tab) sidePanel , on: { click: \_ -> T.write_ tab sideTab }
} } [ H.text $ show tab ]
} [ H.text $ show tab ]
type SideTabProps = Props type SideTabProps = Props
...@@ -140,12 +132,13 @@ sideTabDataCpt = here.component "sideTabData" cpt ...@@ -140,12 +132,13 @@ sideTabDataCpt = here.component "sideTabData" cpt
[ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) [] [ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
, neighborhood props [] , neighborhood props []
, RH.div { className: "col-md-12", id: "query" } , RH.div { className: "col-md-12", id: "query" }
[ query SearchDoc [ query { frontends: props.frontends
props.frontends , metaData: props.metaData
props.metaData , nodesMap: SigmaxT.nodesGraphMap props.graph
props.session , searchType: SearchDoc
(SigmaxT.nodesGraphMap props.graph) , selectedNodeIds: selectedNodeIds'
selectedNodeIds' , session: props.session
} []
] ]
] ]
where where
...@@ -169,12 +162,13 @@ sideTabCommunityCpt = here.component "sideTabCommunity" cpt ...@@ -169,12 +162,13 @@ sideTabCommunityCpt = here.component "sideTabCommunity" cpt
pure $ RH.div { className: "col-md-12", id: "query" } pure $ RH.div { className: "col-md-12", id: "query" }
[ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) [] [ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
, neighborhood props [] , neighborhood props []
, query SearchContact , query { frontends: props.frontends
props.frontends , metaData: props.metaData
props.metaData , nodesMap: SigmaxT.nodesGraphMap props.graph
props.session , searchType: SearchContact
(SigmaxT.nodesGraphMap props.graph) , selectedNodeIds: selectedNodeIds'
selectedNodeIds' , session: props.session
} []
] ]
...@@ -319,7 +313,7 @@ type DeleteNodes = ...@@ -319,7 +313,7 @@ type DeleteNodes =
( graphId :: NodeID ( graphId :: NodeID
, metaData :: GET.MetaData , metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node) , nodes :: Array (Record SigmaxT.Node)
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, session :: Session , session :: Session
, termList :: TermList , termList :: TermList
) )
...@@ -372,35 +366,56 @@ deleteNode termList session (GET.MetaData metaData) node = do ...@@ -372,35 +366,56 @@ deleteNode termList session (GET.MetaData metaData) node = do
patch_list :: NTC.Replace TermList patch_list :: NTC.Replace TermList
patch_list = NTC.Replace { new: termList, old: MapTerm } patch_list = NTC.Replace { new: termList, old: MapTerm }
query :: SearchType type Query =
-> Frontends ( frontends :: Frontends
-> GET.MetaData , metaData :: GET.MetaData
-> Session , nodesMap :: SigmaxT.NodesMap
-> SigmaxT.NodesMap , searchType :: SearchType
-> SigmaxT.NodeIds , selectedNodeIds :: SigmaxT.NodeIds
-> R.Element , session :: Session )
query _ _ _ _ _ selectedNodeIds | Set.isEmpty selectedNodeIds = RH.div {} []
query searchType frontends (GET.MetaData metaData) session nodesMap selectedNodeIds = query :: R2.Component Query
query' (head metaData.corpusId) query = R.createElement queryCpt
where
query' Nothing = RH.div {} [] queryCpt :: R.Component Query
query' (Just corpusId) = queryCpt = here.component "query" cpt where
CGT.tabs { frontends cpt props@{ selectedNodeIds } _ = do
, session
, query: SearchQuery { query : concat $ toQuery <$> Set.toUnfoldable selectedNodeIds pure $ if Set.isEmpty selectedNodeIds
, expected: searchType then RH.div {} []
} else query' props []
, sides: [side corpusId]
} query' :: R2.Component Query
query' = R.createElement queryCpt'
toQuery id = case Map.lookup id nodesMap of
Nothing -> [] queryCpt' :: R.Component Query
Just n -> words n.label queryCpt' = here.component "query'" cpt where
cpt { frontends
side corpusId = GET.GraphSideCorpus { corpusId , metaData: GET.MetaData metaData
, listId : metaData.list.listId , nodesMap
, corpusLabel: metaData.title , searchType
} , selectedNodeIds
, session } _ = do
pure $ case (head metaData.corpusId) of
Nothing -> RH.div {} []
Just corpusId ->
CGT.tabs { frontends
, query: SearchQuery { expected: searchType
, query : concat $ toQuery <$> Set.toUnfoldable selectedNodeIds
}
, session
, sides: [side corpusId]
}
where
toQuery id = case Map.lookup id nodesMap of
Nothing -> []
Just n -> words n.label
side corpusId = GET.GraphSideCorpus { corpusId
, corpusLabel: metaData.title
, listId : metaData.list.listId
}
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
module Gargantext.Components.GraphExplorer.Sidebar.Types where
import Data.Maybe (Maybe(..), maybe)
import Data.Set as Set
import Reactix as R
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as SigmaxT
type SidePanel =
(
mGraph :: Maybe SigmaxT.SGraph
, mMetaData :: Maybe GET.MetaData
, multiSelectEnabled :: Boolean
, removedNodeIds :: SigmaxT.NodeIds
, selectedNodeIds :: SigmaxT.NodeIds
, showControls :: Boolean
, sideTab :: GET.SideTab
)
initialSidePanel :: Maybe (Record SidePanel)
initialSidePanel = Nothing
focusedSidePanel :: T.Box (Maybe (Record SidePanel))
-> R.Hooks { mGraph :: T.Box (Maybe SigmaxT.SGraph)
, mMetaData :: T.Box (Maybe GET.MetaData)
, multiSelectEnabled :: T.Box Boolean
, removedNodeIds :: T.Box SigmaxT.NodeIds
, selectedNodeIds :: T.Box SigmaxT.NodeIds
, showControls :: T.Box Boolean
, sideTab :: T.Box GET.SideTab }
focusedSidePanel sidePanel = do
mGraph <- T.useFocused
(maybe Nothing _.mGraph)
(\val -> maybe Nothing (\sp -> Just $ sp { mGraph = val })) sidePanel
mMetaData <- T.useFocused
(maybe Nothing _.mMetaData)
(\val -> maybe Nothing (\sp -> Just $ sp { mMetaData = val })) sidePanel
multiSelectEnabled <- T.useFocused
(maybe false _.multiSelectEnabled)
(\val -> maybe Nothing (\sp -> Just $ sp { multiSelectEnabled = val })) sidePanel
removedNodeIds <- T.useFocused
(maybe Set.empty _.removedNodeIds)
(\val -> maybe Nothing (\sp -> Just $ sp { removedNodeIds = val })) sidePanel
selectedNodeIds <- T.useFocused
(maybe Set.empty _.selectedNodeIds)
(\val -> maybe Nothing (\sp -> Just $ sp { selectedNodeIds = val })) sidePanel
showControls <- T.useFocused
(maybe false _.showControls)
(\val -> maybe Nothing (\sp -> Just $ sp { showControls = val })) sidePanel
sideTab <- T.useFocused
(maybe GET.SideTabLegend _.sideTab)
(\val -> maybe Nothing (\sp -> Just $ sp { sideTab = val })) sidePanel
pure $ {
mGraph
, mMetaData
, multiSelectEnabled
, removedNodeIds
, selectedNodeIds
, showControls
, sideTab
}
...@@ -18,8 +18,8 @@ import Reactix as R ...@@ -18,8 +18,8 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
...@@ -46,8 +46,8 @@ toggleButtonCpt = here.component "toggleButton" cpt ...@@ -46,8 +46,8 @@ toggleButtonCpt = here.component "toggleButton" cpt
, style } _ = do , style } _ = do
state' <- T.useLive T.unequal state state' <- T.useLive T.unequal state
pure $ H.button { className: "btn btn-outline-" <> style <> " " <> cls state' pure $ H.button { className: "btn btn-outline-" <> style <> " " <> cls state' <> " mx-2"
, on: {click: onClick} , on: { click: onClick }
} [ R2.small {} [ H.text (text onMessage offMessage state') ] ] } [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
cls true = "active" cls true = "active"
...@@ -185,7 +185,7 @@ treeToggleButtonCpt = here.component "treeToggleButton" cpt ...@@ -185,7 +185,7 @@ treeToggleButtonCpt = here.component "treeToggleButton" cpt
} [] } []
type SidebarToggleButtonProps = ( type SidebarToggleButtonProps = (
state :: T.Box GET.SidePanelState state :: T.Box GT.SidePanelState
) )
sidebarToggleButton :: R2.Component SidebarToggleButtonProps sidebarToggleButton :: R2.Component SidebarToggleButtonProps
...@@ -201,17 +201,18 @@ sidebarToggleButtonCpt = here.component "sidebarToggleButton" cpt ...@@ -201,17 +201,18 @@ sidebarToggleButtonCpt = here.component "sidebarToggleButton" cpt
, on: { click: onClick state } , on: { click: onClick state }
} [ R2.small {} [ H.text (text onMessage offMessage state') ] ] } [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
cls (GET.Opened _) = "active" cls GT.Opened = "active"
cls _ = "" cls _ = ""
onMessage = "Hide Sidebar" onMessage = "Hide Sidebar"
offMessage = "Show Sidebar" offMessage = "Show Sidebar"
text on _off (GET.Opened _) = on text on _off GT.Opened = on
text _on off GET.InitialClosed = off text _on off GT.InitialClosed = off
text _on off GET.Closed = off text _on off GT.Closed = off
onClick state = \_ -> onClick state = \_ ->
T.modify_ (\s -> case s of T.modify_ GT.toggleSidePanelState state
GET.InitialClosed -> GET.Opened GET.SideTabLegend -- case s of
GET.Closed -> GET.Opened GET.SideTabLegend -- GET.InitialClosed -> GET.Opened GET.SideTabLegend
(GET.Opened _) -> GET.Closed) state -- GET.Closed -> GET.Opened GET.SideTabLegend
-- (GET.Opened _) -> GET.Closed) state
...@@ -114,9 +114,9 @@ type State = ( ...@@ -114,9 +114,9 @@ type State = (
--, legendData :: R.State (Array Legend) --, legendData :: R.State (Array Legend)
--, multiNodeSelection :: R.State Boolean --, multiNodeSelection :: R.State Boolean
--, selectedNodes :: R.State (Set SelectedNode) --, selectedNodes :: R.State (Set SelectedNode)
--, showSidePanel :: R.State Boolean
--, showControls :: T.Box Boolean --, showControls :: T.Box Boolean
--, showTree :: R.State Boolean --, showTree :: R.State Boolean
--, sidePanelState :: R.State Boolean
--, sigmaGraphData :: R.State (Maybe SigmaxTypes.SGraph) --, sigmaGraphData :: R.State (Maybe SigmaxTypes.SGraph)
--, sigmaSettings :: R.State ({|Graph.SigmaSettings}) --, sigmaSettings :: R.State ({|Graph.SigmaSettings})
--treeId :: R.State (Maybe TreeId) --treeId :: R.State (Maybe TreeId)
...@@ -281,10 +281,6 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","# ...@@ -281,10 +281,6 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#
intColor :: Int -> String intColor :: Int -> String
intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaultPalette) intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaultPalette)
data SidePanelState = InitialClosed | Opened SideTab | Closed
derive instance eqSidePanelState :: Eq SidePanelState
data SideTab = SideTabLegend | SideTabData | SideTabCommunity data SideTab = SideTabLegend | SideTabData | SideTabCommunity
derive instance eqSideTab :: Eq SideTab derive instance eqSideTab :: Eq SideTab
......
...@@ -22,10 +22,11 @@ type Completions = Array String ...@@ -22,10 +22,11 @@ type Completions = Array String
type Props = type Props =
( (
autocompleteSearch :: String -> Completions autocompleteSearch :: String -> Completions
, classes :: String
, onAutocompleteClick :: String -> Effect Unit , onAutocompleteClick :: String -> Effect Unit
, onEnterPress :: String -> Effect Unit , onEnterPress :: String -> Effect Unit
, state :: T.Box String , state :: T.Box String
) )
inputWithAutocomplete :: R2.Component Props inputWithAutocomplete :: R2.Component Props
...@@ -35,6 +36,7 @@ inputWithAutocompleteCpt :: R.Component Props ...@@ -35,6 +36,7 @@ inputWithAutocompleteCpt :: R.Component Props
inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt
where where
cpt props@{ autocompleteSearch cpt props@{ autocompleteSearch
, classes
, onAutocompleteClick , onAutocompleteClick
, onEnterPress , onEnterPress
, state } _ = do , state } _ = do
...@@ -45,7 +47,7 @@ inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt ...@@ -45,7 +47,7 @@ inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt
let onFocus completions e = T.write_ (autocompleteSearch state') completions let onFocus completions e = T.write_ (autocompleteSearch state') completions
pure $ pure $
H.span { className: "input-with-autocomplete" } H.span { className: "input-with-autocomplete " <> classes }
[ [
completionsCpt { completions, onAutocompleteClick, state } [] completionsCpt { completions, onAutocompleteClick, state } []
, H.input { type: "text" , H.input { type: "text"
......
...@@ -259,9 +259,8 @@ tableContainerCpt { dispatch ...@@ -259,9 +259,8 @@ tableContainerCpt { dispatch
type CommonProps = ( type CommonProps = (
afterSync :: Unit -> Aff Unit afterSync :: Unit -> Aff Unit
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
, sidePanelTriggers :: Record NT.SidePanelTriggers
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, tasks :: T.Box GAT.Storage , tasks :: T.Box GAT.Storage
, withAutoUpdate :: Boolean , withAutoUpdate :: Boolean
...@@ -287,7 +286,6 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where ...@@ -287,7 +286,6 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, sidePanelTriggers
, state , state
, tabNgramType , tabNgramType
, tasks , tasks
...@@ -300,9 +298,6 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where ...@@ -300,9 +298,6 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
searchQuery' <- T.useLive T.unequal searchQuery searchQuery' <- T.useLive T.unequal searchQuery
-- R.useEffectOnce' $ do
-- T.listen (\_ -> TT.changePage 1 params) searchQuery
let ngramsTable = applyNgramsPatches state' initTable let ngramsTable = applyNgramsPatches state' initTable
roots = rootsOf ngramsTable roots = rootsOf ngramsTable
...@@ -351,8 +346,7 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where ...@@ -351,8 +346,7 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
, ngramsLocalPatch , ngramsLocalPatch
, ngramsParent , ngramsParent
, ngramsSelection , ngramsSelection
, ngramsTable , ngramsTable } []
, sidePanelTriggers } []
, delete: false , delete: false
} }
...@@ -550,7 +544,6 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -550,7 +544,6 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, sidePanelTriggers
, tabNgramType , tabNgramType
, tasks , tasks
, withAutoUpdate } _ = do , withAutoUpdate } _ = do
...@@ -566,7 +559,6 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -566,7 +559,6 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, sidePanelTriggers
, tabNgramType , tabNgramType
, tasks , tasks
, versioned , versioned
...@@ -585,7 +577,6 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -585,7 +577,6 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, sidePanelTriggers
, tabNgramType , tabNgramType
, tasks , tasks
, versionedWithCount , versionedWithCount
...@@ -655,7 +646,6 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt ...@@ -655,7 +646,6 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, sidePanelTriggers
, tabNgramType , tabNgramType
, tasks , tasks
, versioned , versioned
...@@ -668,7 +658,6 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt ...@@ -668,7 +658,6 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, sidePanelTriggers
, state , state
, tabNgramType , tabNgramType
, tasks , tasks
...@@ -694,7 +683,6 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp ...@@ -694,7 +683,6 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
, path , path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, sidePanelTriggers
, tabNgramType , tabNgramType
, tasks , tasks
, versionedWithCount , versionedWithCount
...@@ -710,7 +698,6 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp ...@@ -710,7 +698,6 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
, path: path , path: path
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, sidePanelTriggers
, state , state
, tabNgramType , tabNgramType
, tasks , tasks
......
...@@ -211,7 +211,6 @@ type RenderNgramsItem = ( ...@@ -211,7 +211,6 @@ type RenderNgramsItem = (
, ngramsParent :: Maybe NgramsTerm , ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm , ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
, sidePanelTriggers :: Record NT.SidePanelTriggers
) )
renderNgramsItem :: R2.Component RenderNgramsItem renderNgramsItem :: R2.Component RenderNgramsItem
...@@ -227,7 +226,6 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -227,7 +226,6 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, ngramsParent , ngramsParent
, ngramsSelection , ngramsSelection
, ngramsTable , ngramsTable
, sidePanelTriggers: { toggleSidePanel }
} _ = do } _ = do
pure $ Tbl.makeRow [ pure $ Tbl.makeRow [
H.div { className: "ngrams-selector" } [ H.div { className: "ngrams-selector" } [
...@@ -254,8 +252,9 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -254,8 +252,9 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
a (ngramsStyle <> [DOM.onClick $ const effect]) a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing -> Nothing ->
span ngramsStyle span ngramsStyle
onClick _ = do onClick _ = pure unit :: Effect Unit
R2.callTrigger toggleSidePanel unit -- onClick _ = do
-- R2.callTrigger toggleSidePanel unit
termList = ngramsElement ^. _NgramsElement <<< _list termList = ngramsElement ^. _NgramsElement <<< _list
ngramsStyle = [termStyle termList ngramsOpacity] ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
......
...@@ -1110,7 +1110,7 @@ coreDispatch path state (Synchronize { afterSync }) = ...@@ -1110,7 +1110,7 @@ coreDispatch path state (Synchronize { afterSync }) =
coreDispatch _ state (CommitPatch pt) = coreDispatch _ state (CommitPatch pt) =
commitPatch pt state commitPatch pt state
coreDispatch _ state ResetPatches = coreDispatch _ state ResetPatches =
T.modify_ (\s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }) state T.modify_ (_ { ngramsLocalPatch = { ngramsPatches: mempty } }) state
isSingleNgramsTerm :: NgramsTerm -> Boolean isSingleNgramsTerm :: NgramsTerm -> Boolean
isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt
...@@ -1141,32 +1141,34 @@ syncResetButtonsCpt :: R.Component SyncResetButtonsProps ...@@ -1141,32 +1141,34 @@ syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = here.component "syncResetButtons" cpt syncResetButtonsCpt = here.component "syncResetButtons" cpt
where where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do cpt { afterSync, ngramsLocalPatch, performAction } _ = do
-- synchronizing <- T.useBox false synchronizing <- T.useBox false
-- synchronizing' <- T.useLive T.unequal synchronizing synchronizing' <- T.useLive T.unequal synchronizing
let let
hasChanges = ngramsLocalPatch /= mempty hasChanges = ngramsLocalPatch /= mempty
hasChangesClass = if hasChanges then "" else " disabled" hasChangesClass = if hasChanges then "" else " disabled"
synchronizingClass = if synchronizing' then " disabled" else ""
resetClick _ = do resetClick _ = do
performAction ResetPatches performAction ResetPatches
synchronizeClick _ = delay unit $ \_ -> do synchronizeClick _ = delay unit $ \_ -> do
-- T.write_ true synchronizing T.write_ true synchronizing
performAction $ Synchronize { afterSync: newAfterSync } performAction $ Synchronize { afterSync: newAfterSync }
newAfterSync x = do newAfterSync x = do
afterSync x afterSync x
-- liftEffect $ T.write_ false synchronizing liftEffect $ T.write_ false synchronizing
pure $ H.div { className: "btn-toolbar" } pure $ H.div { className: "btn-toolbar" }
[ H.div { className: "btn-group mr-2" } [ H.div { className: "btn-group mr-2" }
[ H.button { className: "btn btn-danger " <> hasChangesClass [ H.button { className: "btn btn-danger " <> hasChangesClass <> synchronizingClass
, on: { click: resetClick } , on: { click: resetClick }
} [ H.text "Reset" ] } [ H.text "Reset" ]
] ]
, H.div { className: "btn-group mr-2" } , H.div { className: "btn-group mr-2" }
[ H.button { className: "btn btn-primary " <> hasChangesClass [ H.button { className: "btn btn-primary " <> hasChangesClass <> synchronizingClass
, on: { click: synchronizeClick } , on: { click: synchronizeClick }
} [ H.text "Sync" ] } [ H.text "Sync" ]
] ]
......
...@@ -88,10 +88,10 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -88,10 +88,10 @@ useCachedAPILoaderEffect { cacheEndpoint
-- log2 "[useCachedAPILoaderEffect] cached version" version -- log2 "[useCachedAPILoaderEffect] cached version" version
-- log2 "[useCachedAPILoaderEffect] real version" cacheReal -- log2 "[useCachedAPILoaderEffect] real version" cacheReal
_ <- GUC.deleteReq cache req _ <- GUC.deleteReq cache req
vr'@(Versioned { version: _, data: _ }) <- GUC.cachedJson cache req vr'@(Versioned { version: version', data: _ }) <- GUC.cachedJson cache req
if version == cacheReal then if version' == cacheReal then
pure vr' pure vr'
else else
throwError $ error $ "Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal throwError $ error $ "[NgramsTable.Loader] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
liftEffect $ do liftEffect $ do
T.write_ (Just $ handleResponse val) state T.write_ (Just $ handleResponse val) state
...@@ -49,7 +49,7 @@ newtype IndividuView = ...@@ -49,7 +49,7 @@ newtype IndividuView =
type LayoutProps = type LayoutProps =
( frontends :: Frontends ( frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, session :: R.Context Session , session :: Session
) )
annuaireLayout :: R2.Leaf LayoutProps annuaireLayout :: R2.Leaf LayoutProps
...@@ -57,15 +57,14 @@ annuaireLayout props = R.createElement annuaireLayoutCpt props [] ...@@ -57,15 +57,14 @@ annuaireLayout props = R.createElement annuaireLayoutCpt props []
annuaireLayoutCpt :: R.Component LayoutProps annuaireLayoutCpt :: R.Component LayoutProps
annuaireLayoutCpt = here.component "annuaireLayout" cpt where annuaireLayoutCpt = here.component "annuaireLayout" cpt where
cpt { frontends, nodeId, session } _ = cp <$> R.useContext session where cpt { frontends, nodeId, session } _ = do
cp s = annuaireLayoutWithKey { frontends, key, nodeId, session: s } where pure $ annuaireLayoutWithKey { frontends, key, nodeId, session }
key = show (sessionId s) <> "-" <> show nodeId where
key = show (sessionId session) <> "-" <> show nodeId
type KeyLayoutProps = type KeyLayoutProps =
( frontends :: Frontends ( key :: String
, nodeId :: Int | LayoutProps
, session :: Session
, key :: String
) )
annuaireLayoutWithKey :: R2.Leaf KeyLayoutProps annuaireLayoutWithKey :: R2.Leaf KeyLayoutProps
......
...@@ -17,13 +17,14 @@ import Gargantext.AsyncTasks as GAT ...@@ -17,13 +17,14 @@ import Gargantext.AsyncTasks as GAT
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Components.Nodes.Lists.Types as LTypes import Gargantext.Components.Nodes.Lists.Types as LTypes
import Gargantext.Components.Nodes.Texts.Types as TTypes import Gargantext.Components.Nodes.Texts.Types as TTypes
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), TabType(..), TabSubType(..)) import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), SidePanelState, TabType(..), TabSubType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
...@@ -51,15 +52,16 @@ modeTabType' Books = CTabAuthors ...@@ -51,15 +52,16 @@ modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors modeTabType' Communication = CTabAuthors
type TabsProps = type TabsProps =
( cacheState :: T.Box LTypes.CacheState ( cacheState :: T.Box LTypes.CacheState
, contactData :: ContactData , contactData :: ContactData
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, tasks :: T.Box GAT.Storage , sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
...@@ -68,20 +70,20 @@ tabs props = R.createElement tabsCpt props [] ...@@ -68,20 +70,20 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where tabsCpt = here.component "tabs" cpt where
cpt props _ = do cpt props _ = do
active <- R.useState' 0 activeTab <- T.useBox 0
triggers <- TTypes.emptySidePanelTriggers
pure $ Tab.tabs { selected: fst active, tabs: tabs' props triggers } pure $ Tab.tabs { activeTab, tabs: tabs' props }
tabs' props trg = tabs' props@{ sidePanel, sidePanelState } =
[ "Documents" /\ docs trg [ "Documents" /\ docs
, "Patents" /\ ngramsView (viewProps Patents) , "Patents" /\ ngramsView (viewProps Patents)
, "Books" /\ ngramsView (viewProps Books) , "Books" /\ ngramsView (viewProps Books)
, "Communication" /\ ngramsView (viewProps Communication) , "Communication" /\ ngramsView (viewProps Communication)
, "Trash" /\ docs trg -- TODO pass-in trash mode , "Trash" /\ docs -- TODO pass-in trash mode
] where ] where
viewProps mode = Record.merge props { defaultListId: props.contactData.defaultListId viewProps mode = Record.merge props { defaultListId: props.contactData.defaultListId
, mode } , mode }
totalRecords = 4736 -- TODO lol totalRecords = 4736 -- TODO lol
docs sidePanelTriggers = DT.docViewLayout (Record.merge { sidePanelTriggers } $ Record.merge dtCommon dtExtra) docs = DT.docViewLayout (Record.merge { sidePanel, sidePanelState } $ Record.merge dtCommon dtExtra)
dtCommon = RX.pick props :: Record DTCommon dtCommon = RX.pick props :: Record DTCommon
dtExtra = dtExtra =
{ chart: mempty { chart: mempty
...@@ -98,7 +100,7 @@ type DTCommon = ...@@ -98,7 +100,7 @@ type DTCommon =
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
-- , sidePanelTriggers :: Record LTypes.SidePanelTriggers -- , sidePanel :: T.Box (Record SidePanel)
) )
type NgramsViewTabsProps = type NgramsViewTabsProps =
...@@ -119,22 +121,21 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -119,22 +121,21 @@ ngramsViewCpt = here.component "ngramsView" cpt where
pure $ NT.mainNgramsTable (props' path) [] where pure $ NT.mainNgramsTable (props' path) [] where
most = RX.pick props :: Record NTCommon most = RX.pick props :: Record NTCommon
props' path = props' path =
Record.merge most (Record.merge most
{ afterSync { afterSync
, path , path
, tabType: TabPairing (TabNgramType $ modeTabType mode) , tabType: TabPairing (TabNgramType $ modeTabType mode)
, tabNgramType: modeTabType' mode , tabNgramType: modeTabType' mode
, withAutoUpdate: false } , withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
where where
afterSync :: Unit -> Aff Unit afterSync :: Unit -> Aff Unit
afterSync _ = pure unit afterSync _ = pure unit
type NTCommon = type NTCommon =
( cacheState :: T.Box LTypes.CacheState ( cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int , defaultListId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , tasks :: T.Box GAT.Storage
, tasks :: T.Box GAT.Storage
) )
module Gargantext.Components.Nodes.Annuaire.User module Gargantext.Components.Nodes.Annuaire.User
( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types ( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, userLayout , userLayout
, userLayoutSessionContext
) )
where where
...@@ -14,8 +13,6 @@ import Effect.Aff (Aff, launchAff_) ...@@ -14,8 +13,6 @@ import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as REX
import Toestand as T import Toestand as T
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
...@@ -23,11 +20,12 @@ import Gargantext.Components.InputWithEnter (inputWithEnter) ...@@ -23,11 +20,12 @@ import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types as LT import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (WithSession, WithSessionContext, Session, get, put, sessionId) import Gargantext.Sessions (WithSession, WithSessionContext, Session, get, put, sessionId)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..), SidePanelState)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
...@@ -99,18 +97,20 @@ contactInfoItemCpt :: R.Component ContactInfoItemProps ...@@ -99,18 +97,20 @@ contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt contactInfoItemCpt = here.component "contactInfoItem" cpt
where where
cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do
isEditing <- R.useState' false isEditing <- T.useBox false
isEditing' <- T.useLive T.unequal isEditing
let value = (L.view cLens hyperdata) :: String let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value valueRef <- R.useRef value
pure $ H.div { className: "form-group row" } [ pure $ H.div { className: "form-group row" } [
H.span { className: "col-sm-2 col-form-label" } [ H.text label ] H.span { className: "col-sm-2 col-form-label" } [ H.text label ]
, item isEditing valueRef , item isEditing' isEditing valueRef
] ]
where where
cLens = L.cloneLens lens cLens = L.cloneLens lens
item (false /\ setIsEditing) valueRef = item false isEditing valueRef =
H.div { className: "input-group col-sm-6" } [ H.div { className: "input-group col-sm-6" } [
H.input { className: "form-control" H.input { className: "form-control"
, defaultValue: placeholder' , defaultValue: placeholder'
...@@ -123,8 +123,8 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt ...@@ -123,8 +123,8 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
] ]
where where
placeholder' = R.readRef valueRef placeholder' = R.readRef valueRef
onClick _ = setIsEditing $ const true onClick _ = T.write_ true isEditing
item (true /\ setIsEditing) valueRef = item true isEditing valueRef =
H.div { className: "input-group col-sm-6" } [ H.div { className: "input-group col-sm-6" } [
inputWithEnter { inputWithEnter {
autoFocus: true autoFocus: true
...@@ -143,7 +143,7 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt ...@@ -143,7 +143,7 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
] ]
where where
onClick _ = do onClick _ = do
setIsEditing $ const false T.write_ true isEditing
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
onUpdateHyperdata newHyperdata onUpdateHyperdata newHyperdata
...@@ -151,11 +151,13 @@ listElement :: Array R.Element -> R.Element ...@@ -151,11 +151,13 @@ listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" } listElement = H.li { className: "list-group-item justify-content-between" }
type LayoutNoSessionProps = type LayoutNoSessionProps =
( frontends :: Frontends ( frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
, tasks :: T.Box GAT.Storage , sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
) )
type LayoutProps = WithSession LayoutNoSessionProps type LayoutProps = WithSession LayoutNoSessionProps
...@@ -167,24 +169,20 @@ type KeyLayoutProps = ( ...@@ -167,24 +169,20 @@ type KeyLayoutProps = (
| LayoutProps | LayoutProps
) )
userLayoutSessionContext :: R2.Component LayoutSessionContextProps
userLayoutSessionContext = R.createElement userLayoutSessionContextCpt
userLayoutSessionContextCpt :: R.Component LayoutSessionContextProps
userLayoutSessionContextCpt = here.component "userLayoutSessionContext" cpt
where
cpt props@{ session } _ = do
session' <- R.useContext session
pure $ userLayout (Record.merge { session: session' } $ (REX.pick props :: Record LayoutNoSessionProps)) []
userLayout :: R2.Component LayoutProps userLayout :: R2.Component LayoutProps
userLayout = R.createElement userLayoutCpt userLayout = R.createElement userLayoutCpt
userLayoutCpt :: R.Component LayoutProps userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = here.component "userLayout" cpt userLayoutCpt = here.component "userLayout" cpt
where where
cpt { frontends, nodeId, reloadForest, reloadRoot, session, tasks } _ = do cpt { frontends
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks } _ = do
let sid = sessionId session let sid = sessionId session
pure $ userLayoutWithKey { pure $ userLayoutWithKey {
...@@ -194,6 +192,8 @@ userLayoutCpt = here.component "userLayout" cpt ...@@ -194,6 +192,8 @@ userLayoutCpt = here.component "userLayout" cpt
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, session , session
, sidePanel
, sidePanelState
, tasks , tasks
} }
...@@ -203,14 +203,19 @@ userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props [] ...@@ -203,14 +203,19 @@ userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
userLayoutWithKeyCpt :: R.Component KeyLayoutProps userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt
where where
cpt { frontends, nodeId, reloadForest, reloadRoot, session, tasks } _ = do cpt { frontends
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload reload' <- T.useLive T.unequal reload
cacheState <- T.useBox LT.CacheOn cacheState <- T.useBox LT.CacheOn
sidePanelTriggers <- LT.emptySidePanelTriggers
useLoader {nodeId, reload: reload', session} getUserWithReload $ useLoader {nodeId, reload: reload', session} getUserWithReload $
\contactData@{contactNode: Contact {name, hyperdata}} -> \contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [ H.ul { className: "col-md-12 list-group" } [
...@@ -224,7 +229,8 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt ...@@ -224,7 +229,8 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, session , session
, sidePanelTriggers , sidePanel
, sidePanelState
, tasks , tasks
} }
] ]
......
...@@ -26,11 +26,12 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types ...@@ -26,11 +26,12 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, _shared, _touch, _who, defaultContactTouch, defaultContactWhere , _shared, _touch, _who, defaultContactTouch, defaultContactWhere
, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser ) , defaultContactWho, defaultHyperdataContact, defaultHyperdataUser )
import Gargantext.Components.Nodes.Lists.Types as LT import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId) import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..), SidePanelState)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
...@@ -90,23 +91,25 @@ type ContactInfoItemProps = ...@@ -90,23 +91,25 @@ type ContactInfoItemProps =
, placeholder :: String , placeholder :: String
) )
contactInfoItem :: Record ContactInfoItemProps -> R.Element contactInfoItem :: R2.Leaf ContactInfoItemProps
contactInfoItem props = R.createElement contactInfoItemCpt props [] contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt contactInfoItemCpt = here.component "contactInfoItem" cpt
where where
cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do cpt { hyperdata, label, lens, onUpdateHyperdata, placeholder } _ = do
isEditing <- R.useState' false isEditing <- T.useBox false
isEditing' <- T.useLive T.unequal isEditing
let value = (L.view cLens hyperdata) :: String let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value valueRef <- R.useRef value
pure $ pure $
H.div { className: "form-group row" } H.div { className: "form-group row" }
[ H.span { className: "col-sm-2 col-form-label" } [ H.text label ] [ H.span { className: "col-sm-2 col-form-label" } [ H.text label ]
, item isEditing valueRef ] , item isEditing' isEditing valueRef ]
where where
cLens = L.cloneLens lens cLens = L.cloneLens lens
item (false /\ setIsEditing) valueRef = item false isEditing valueRef =
H.div { className: "input-group col-sm-6" } H.div { className: "input-group col-sm-6" }
[ H.input [ H.input
{ className: "form-control", type: "text" { className: "form-control", type: "text"
...@@ -115,8 +118,8 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt ...@@ -115,8 +118,8 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
[ H.div { className: "input-group-text fa fa-pencil" } [] ]] [ H.div { className: "input-group-text fa fa-pencil" } [] ]]
where where
placeholder' = R.readRef valueRef placeholder' = R.readRef valueRef
click _ = setIsEditing $ const true click _ = T.write_ true isEditing
item (true /\ setIsEditing) valueRef = item true isEditing valueRef =
H.div { className: "input-group col-sm-6" } H.div { className: "input-group col-sm-6" }
[ inputWithEnter [ inputWithEnter
{ autoFocus: true { autoFocus: true
...@@ -131,7 +134,7 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt ...@@ -131,7 +134,7 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
[ H.div { className: "input-group-text fa fa-floppy-o" } [] ]] [ H.div { className: "input-group-text fa fa-floppy-o" } [] ]]
where where
click _ = do click _ = do
setIsEditing $ const false T.write_ false isEditing
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataContact let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataContact
onUpdateHyperdata newHyperdata onUpdateHyperdata newHyperdata
...@@ -139,14 +142,16 @@ listElement :: Array R.Element -> R.Element ...@@ -139,14 +142,16 @@ listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" } listElement = H.li { className: "list-group-item justify-content-between" }
type BasicProps = type BasicProps =
( frontends :: Frontends ( frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, tasks :: T.Box GAT.Storage , sidePanelState :: T.Box SidePanelState
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, tasks :: T.Box GAT.Storage
) )
type ReloadProps = type ReloadProps =
( reloadForest :: T.Box T2.Reload ( reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
| BasicProps | BasicProps
) )
...@@ -157,7 +162,7 @@ type KeyLayoutProps = ( key :: String, session :: Session | ReloadProps ) ...@@ -157,7 +162,7 @@ type KeyLayoutProps = ( key :: String, session :: Session | ReloadProps )
saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff Int saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff Int
saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "") saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")
type AnnuaireLayoutProps = ( annuaireId :: Int, session :: R.Context Session | ReloadProps ) type AnnuaireLayoutProps = ( annuaireId :: Int, session :: Session | ReloadProps )
type AnnuaireKeyLayoutProps = ( annuaireId :: Int | KeyLayoutProps ) type AnnuaireKeyLayoutProps = ( annuaireId :: Int | KeyLayoutProps )
...@@ -166,13 +171,29 @@ contactLayout = R.createElement contactLayoutCpt ...@@ -166,13 +171,29 @@ contactLayout = R.createElement contactLayoutCpt
contactLayoutCpt :: R.Component AnnuaireLayoutProps contactLayoutCpt :: R.Component AnnuaireLayoutProps
contactLayoutCpt = here.component "contactLayout" cpt where contactLayoutCpt = here.component "contactLayout" cpt where
cpt { annuaireId, frontends, nodeId, reloadForest, reloadRoot, session, tasks } _ = do cpt { annuaireId
s <- R.useContext session , frontends
let key = show (sessionId s) <> "-" <> show nodeId , nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks } _ = do
let key = show (sessionId session) <> "-" <> show nodeId
pure $ pure $
contactLayoutWithKey contactLayoutWithKey
{ annuaireId, tasks, frontends, key, nodeId { annuaireId
, session: s, reloadForest, reloadRoot } , frontends
, key
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks
}
contactLayoutWithKey :: R2.Leaf AnnuaireKeyLayoutProps contactLayoutWithKey :: R2.Leaf AnnuaireKeyLayoutProps
contactLayoutWithKey props = R.createElement contactLayoutWithKeyCpt props [] contactLayoutWithKey props = R.createElement contactLayoutWithKeyCpt props []
...@@ -185,11 +206,12 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where ...@@ -185,11 +206,12 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
, reloadRoot , reloadRoot
, nodeId , nodeId
, session , session
, sidePanel
, sidePanelState
, tasks } _ = do , tasks } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
_ <- T.useLive T.unequal reload _ <- T.useLive T.unequal reload
cacheState <- T.useBox LT.CacheOn cacheState <- T.useBox LT.CacheOn
sidePanelTriggers <- LT.emptySidePanelTriggers
useLoader nodeId (getAnnuaireContact session annuaireId) $ useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact' {name, hyperdata}} -> \contactData@{contactNode: Contact' {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } H.ul { className: "col-md-12 list-group" }
...@@ -201,12 +223,13 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where ...@@ -201,12 +223,13 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
, frontends , frontends
, nodeId , nodeId
, session , session
, sidePanelTriggers , sidePanel
, sidePanelState
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, tasks } ] , tasks } ]
where where
onUpdateHyperdata :: T.Box T2.Reload -> HyperdataContact -> Effect Unit onUpdateHyperdata :: T2.ReloadS -> HyperdataContact -> Effect Unit
onUpdateHyperdata reload hd = onUpdateHyperdata reload hd =
launchAff_ $ launchAff_ $
saveContactHyperdata session nodeId hd *> liftEffect (T2.reload reload) saveContactHyperdata session nodeId hd *> liftEffect (T2.reload reload)
......
...@@ -20,7 +20,7 @@ import Gargantext.Components.Nodes.Lists.Types as LTypes ...@@ -20,7 +20,7 @@ import Gargantext.Components.Nodes.Lists.Types as LTypes
import Gargantext.Components.Nodes.Texts.Types as TTypes import Gargantext.Components.Nodes.Texts.Types as TTypes
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), TabType(..), TabSubType(..)) import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), SidePanelState, TabType(..), TabSubType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
...@@ -49,15 +49,16 @@ modeTabType' Books = CTabAuthors ...@@ -49,15 +49,16 @@ modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors modeTabType' Communication = CTabAuthors
type TabsProps = ( type TabsProps = (
cacheState :: T.Box LTypes.CacheState cacheState :: T.Box LTypes.CacheState
, contactData :: ContactData' , contactData :: ContactData'
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanel :: T.Box (Maybe (Record TTypes.SidePanel))
, tasks :: T.Box GAT.Storage , sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
) )
tabs :: Record TabsProps -> R.Element tabs :: Record TabsProps -> R.Element
...@@ -73,13 +74,14 @@ tabsCpt = here.component "tabs" cpt ...@@ -73,13 +74,14 @@ tabsCpt = here.component "tabs" cpt
, frontends , frontends
, nodeId , nodeId
, session , session
, sidePanelTriggers , sidePanel
, sidePanelState
, reloadForest } _ = do , reloadForest } _ = do
active <- R.useState' 0 activeTab <- T.useBox 0
textsSidePanelTriggers <- TTypes.emptySidePanelTriggers
pure $ Tab.tabs { selected: fst active, tabs: tabs' textsSidePanelTriggers } pure $ Tab.tabs { activeTab, tabs: tabs' }
where where
tabs' trg = tabs' =
[ "Documents" /\ docs [ "Documents" /\ docs
, "Patents" /\ ngramsView patentsView [] , "Patents" /\ ngramsView patentsView []
, "Books" /\ ngramsView booksView [] , "Books" /\ ngramsView booksView []
...@@ -93,26 +95,23 @@ tabsCpt = here.component "tabs" cpt ...@@ -93,26 +95,23 @@ tabsCpt = here.component "tabs" cpt
, defaultListId , defaultListId
, mode: Patents , mode: Patents
, nodeId , nodeId
, session , reloadForest
, sidePanelTriggers , session }
, reloadForest }
booksView = { reloadRoot booksView = { reloadRoot
, tasks , tasks
, cacheState , cacheState
, defaultListId , defaultListId
, mode: Books , mode: Books
, nodeId , nodeId
, session , reloadForest
, sidePanelTriggers , session }
, reloadForest }
commView = { reloadRoot, tasks commView = { reloadRoot, tasks
, cacheState , cacheState
, defaultListId , defaultListId
, mode: Communication , mode: Communication
, nodeId , nodeId
, session , reloadForest
, sidePanelTriggers , session }
, reloadForest }
chart = mempty chart = mempty
totalRecords = 4736 -- TODO totalRecords = 4736 -- TODO
docs = DT.docViewLayout docs = DT.docViewLayout
...@@ -124,22 +123,22 @@ tabsCpt = here.component "tabs" cpt ...@@ -124,22 +123,22 @@ tabsCpt = here.component "tabs" cpt
, nodeId , nodeId
, session , session
, showSearch: true , showSearch: true
, sidePanelTriggers: trg , sidePanel
, sidePanelState
, tabType: TabPairing TabDocs , tabType: TabPairing TabDocs
, totalRecords , totalRecords
} }
type NgramsViewTabsProps = ( type NgramsViewTabsProps = (
cacheState :: T.Box LTypes.CacheState cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int , defaultListId :: Int
, mode :: Mode , mode :: Mode
, nodeId :: Int , nodeId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , tasks :: T.Box GAT.Storage
, tasks :: T.Box GAT.Storage
) )
ngramsView :: R2.Component NgramsViewTabsProps ngramsView :: R2.Component NgramsViewTabsProps
...@@ -155,7 +154,6 @@ ngramsViewCpt = here.component "ngramsView" cpt ...@@ -155,7 +154,6 @@ ngramsViewCpt = here.component "ngramsView" cpt
, mode , mode
, nodeId , nodeId
, session , session
, sidePanelTriggers
, tasks } _ = do , tasks } _ = do
path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs) path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
...@@ -167,7 +165,6 @@ ngramsViewCpt = here.component "ngramsView" cpt ...@@ -167,7 +165,6 @@ ngramsViewCpt = here.component "ngramsView" cpt
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, session , session
, sidePanelTriggers
, tabNgramType , tabNgramType
, tabType , tabType
, tasks , tasks
......
module Gargantext.Components.Nodes.Corpus where module Gargantext.Components.Nodes.Corpus where
import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>)) import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, decodeJson, encodeJson) import Data.Argonaut (class DecodeJson, decodeJson, encodeJson)
import Data.Argonaut.Parser (jsonParser) import Data.Argonaut.Parser (jsonParser)
import Data.Array as A import Data.Array as A
...@@ -11,46 +11,44 @@ import Data.Generic.Rep.Show (genericShow) ...@@ -11,46 +11,44 @@ import Data.Generic.Rep.Show (genericShow)
import Data.List as List import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError) import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.FolderView as FV
import Gargantext.Components.CodeEditor as CE import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.FolderView as FV
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (doc)
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList) import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Types
( FTField, FTFieldWithIndex, FTFieldsWithIndex, Field(..), FieldType(..), Hash, Index
, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython' )
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..)) import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Components.Nodes.Types (FTField, FTFieldWithIndex, FTFieldsWithIndex, Field(..), FieldType(..), Hash, Index, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython')
import Gargantext.Data.Array as GDA import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>))
import Gargantext.Routes (SessionRoute(Children, NodeAPI)) import Gargantext.Routes (SessionRoute(Children, NodeAPI))
import Gargantext.Sessions (Session, get, put, sessionId) import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (AffTableResult, NodeType(..)) import Gargantext.Types (AffTableResult, NodeType(..))
import Gargantext.Utils.Crypto as Crypto import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus" here = R2.here "Gargantext.Components.Nodes.Corpus"
type Props = ( nodeId :: Int, session :: R.Context Session ) type Props = ( nodeId :: Int, session :: Session )
corpusLayout :: R2.Leaf Props corpusLayout :: R2.Leaf Props
corpusLayout props = R.createElement corpusLayoutCpt props [] corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component Props corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = here.component "corpusLayout" cpt where corpusLayoutCpt = here.component "corpusLayout" cpt where
cpt { nodeId, session } _ = cp <$> R.useContext session where cpt { nodeId, session } _ = do
cp s = corpusLayoutMain { key, nodeId, session: s } where pure $ corpusLayoutMain { key, nodeId, session }
key = show (sessionId s) <> "-" <> show nodeId where
key = show (sessionId session) <> "-" <> show nodeId
type KeyProps = type KeyProps =
( nodeId :: Int ( nodeId :: Int
......
...@@ -28,21 +28,21 @@ import Gargantext.Utils.Toestand as T2 ...@@ -28,21 +28,21 @@ import Gargantext.Utils.Toestand as T2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Dashboard" here = R2.here "Gargantext.Components.Nodes.Corpus.Dashboard"
type Props = ( nodeId :: NodeID, session :: R.Context Session ) type Props = ( nodeId :: NodeID, session :: Session )
dashboardLayout :: R2.Component Props dashboardLayout :: R2.Component Props
dashboardLayout = R.createElement dashboardLayoutCpt dashboardLayout = R.createElement dashboardLayoutCpt
dashboardLayoutCpt :: R.Component Props dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt = here.component "dashboardLayout" cpt where dashboardLayoutCpt = here.component "dashboardLayout" cpt where
cpt { nodeId, session } content = cp <$> R.useContext session where cpt { nodeId, session } content = do
cp s = dashboardLayoutWithKey { key, nodeId, session: s } content where pure $ dashboardLayoutWithKey { key, nodeId, session } content
key = show (sessionId s) <> "-" <> show nodeId where
key = show (sessionId session) <> "-" <> show nodeId
type KeyProps = type KeyProps =
( key :: String ( key :: String
, nodeId :: NodeID | Props
, session :: Session
) )
dashboardLayoutWithKey :: R2.Component KeyProps dashboardLayoutWithKey :: R2.Component KeyProps
......
...@@ -118,7 +118,7 @@ type LayoutProps = ...@@ -118,7 +118,7 @@ type LayoutProps =
( listId :: ListId ( listId :: ListId
, mCorpusId :: Maybe NodeID , mCorpusId :: Maybe NodeID
, nodeId :: NodeID , nodeId :: NodeID
, session :: R.Context Session , session :: Session
) )
documentMainLayout :: R2.Component LayoutProps documentMainLayout :: R2.Component LayoutProps
...@@ -133,9 +133,10 @@ documentLayout = R.createElement documentLayoutCpt ...@@ -133,9 +133,10 @@ documentLayout = R.createElement documentLayoutCpt
documentLayoutCpt :: R.Component LayoutProps documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = here.component "documentLayout" cpt where documentLayoutCpt = here.component "documentLayout" cpt where
cpt { listId, mCorpusId, nodeId, session } children = cp <$> R.useContext session where cpt { listId, mCorpusId, nodeId, session } children = do
cp s = documentLayoutWithKey { key, listId, mCorpusId, nodeId, session: s } children where pure $ documentLayoutWithKey { key, listId, mCorpusId, nodeId, session } children
key = show (sessionId s) <> "-" <> show nodeId where
key = show (sessionId session) <> "-" <> show nodeId
type KeyLayoutProps = type KeyLayoutProps =
( key :: String ( key :: String
......
...@@ -2,12 +2,14 @@ module Gargantext.Components.Nodes.Corpus.Graph.Tabs where ...@@ -2,12 +2,14 @@ module Gargantext.Components.Nodes.Corpus.Graph.Tabs where
import Prelude hiding (div) import Prelude hiding (div)
import Data.Array (fromFoldable) import Data.Array (fromFoldable)
import Data.Tuple (Tuple(..), fst) import Data.Tuple (Tuple(..))
import Reactix as R import Reactix as R
import Toestand as T
import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..)) import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..))
import Gargantext.Components.FacetsTable (docView) import Gargantext.Components.FacetsTable (docView)
import Gargantext.Components.Search (SearchQuery) import Gargantext.Components.Search (SearchQuery)
import Gargantext.Components.Table as T import Gargantext.Components.Table as Table
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
...@@ -31,8 +33,9 @@ tabsCpt :: R.Component Props ...@@ -31,8 +33,9 @@ tabsCpt :: R.Component Props
tabsCpt = here.component "tabs" cpt tabsCpt = here.component "tabs" cpt
where where
cpt {frontends, query, session, sides} _ = do cpt {frontends, query, session, sides} _ = do
active <- R.useState' 0 activeTab <- T.useBox 0
pure $ Tab.tabs {tabs: tabs', selected: fst active}
pure $ Tab.tabs { activeTab, tabs: tabs' }
where where
tabs' = fromFoldable $ tab frontends session query <$> sides tabs' = fromFoldable $ tab frontends session query <$> sides
...@@ -42,5 +45,4 @@ tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, lis ...@@ -42,5 +45,4 @@ tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, lis
where where
dvProps = {frontends, session, nodeId, listId, query, chart, totalRecords: 0, container} dvProps = {frontends, session, nodeId, listId, query, chart, totalRecords: 0, container}
chart = mempty chart = mempty
container = T.graphContainer {title: corpusLabel} container = Table.graphContainer {title: corpusLabel}
...@@ -55,25 +55,25 @@ instance decodeFile :: DecodeJson File where ...@@ -55,25 +55,25 @@ instance decodeFile :: DecodeJson File where
hyperdata <- (obj .: "hyperdata") >>= decodeJson hyperdata <- (obj .: "hyperdata") >>= decodeJson
pure $ File { id, date, hyperdata, name } pure $ File { id, date, hyperdata, name }
type FileLayoutProps = ( nodeId :: NodeID, session :: R.Context Session ) type FileLayoutProps = ( nodeId :: NodeID, session :: Session )
fileLayout :: R2.Leaf FileLayoutProps fileLayout :: R2.Leaf FileLayoutProps
fileLayout props = R.createElement fileLayoutCpt props [] fileLayout props = R.createElement fileLayoutCpt props []
fileLayoutCpt :: R.Component FileLayoutProps fileLayoutCpt :: R.Component FileLayoutProps
fileLayoutCpt = here.component "fileLayout" cpt where fileLayoutCpt = here.component "fileLayout" cpt where
cpt { nodeId, session } _ = R.useContext session >>= cp where cpt { nodeId, session } _ = do
cp s = useLoader nodeId (loadFile s) onLoad where useLoader nodeId (loadFile session) onLoad
onLoad loaded = fileLayoutLoaded { loaded, nodeId, session: s } where where
key = show (sessionId s) <> "-" <> show nodeId onLoad loaded = fileLayoutLoaded { loaded, nodeId, session }
key = show (sessionId session) <> "-" <> show nodeId
loadFile :: Session -> NodeID -> Aff File loadFile :: Session -> NodeID -> Aff File
loadFile session nodeId = get session $ NodeAPI Node (Just nodeId) "" loadFile session nodeId = get session $ NodeAPI Node (Just nodeId) ""
type FileLayoutLoadedProps = type FileLayoutLoadedProps =
( loaded :: File ( loaded :: File
, nodeId :: Int | FileLayoutProps
, session :: Session
) )
fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element
......
...@@ -46,15 +46,13 @@ instance encodeJsonHyperdata :: Argonaut.EncodeJson Hyperdata where ...@@ -46,15 +46,13 @@ instance encodeJsonHyperdata :: Argonaut.EncodeJson Hyperdata where
type Props = type Props =
( nodeId :: Int ( nodeId :: Int
, session :: R.Context Session
, nodeType :: NodeType , nodeType :: NodeType
, session :: Session
) )
type KeyProps = type KeyProps =
( key :: String ( key :: String
, nodeId :: Int | Props
, session :: Session
, nodeType :: NodeType
) )
frameLayout :: R2.Leaf Props frameLayout :: R2.Leaf Props
...@@ -62,9 +60,10 @@ frameLayout props = R.createElement frameLayoutCpt props [] ...@@ -62,9 +60,10 @@ frameLayout props = R.createElement frameLayoutCpt props []
frameLayoutCpt :: R.Component Props frameLayoutCpt :: R.Component Props
frameLayoutCpt = here.component "frameLayout" cpt where frameLayoutCpt = here.component "frameLayout" cpt where
cpt { nodeId, nodeType, session } _ = cp <$> R.useContext session where cpt { nodeId, nodeType, session } _ = do
cp s = frameLayoutWithKey { key, nodeId, nodeType, session: s } where pure $ frameLayoutWithKey { key, nodeId, nodeType, session }
key = show (sessionId s) <> "-" <> show nodeId where
key = show (sessionId session) <> "-" <> show nodeId
frameLayoutWithKey :: R2.Leaf KeyProps frameLayoutWithKey :: R2.Leaf KeyProps
frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props [] frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props []
......
...@@ -75,12 +75,10 @@ loadPublicData _l = do ...@@ -75,12 +75,10 @@ loadPublicData _l = do
renderPublic :: R2.Leaf () renderPublic :: R2.Leaf ()
renderPublic props = R.createElement renderPublicCpt props [] renderPublic props = R.createElement renderPublicCpt props []
renderPublicCpt :: R.Component () renderPublicCpt :: R.Component ()
renderPublicCpt = here.component "renderPublic" cpt where renderPublicCpt = here.component "renderPublic" cpt where
cpt _ _ = do cpt _ _ = do
reload <- R.useState' 0 useLoader { reload: 0 } loadPublicData loaded where
useLoader { reload: fst reload } loadPublicData loaded where
loaded publicData = publicLayout { publicData } loaded publicData = publicLayout { publicData }
publicLayout :: Record PublicDataProps -> R.Element publicLayout :: Record PublicDataProps -> R.Element
......
module Gargantext.Components.Nodes.Lists where module Gargantext.Components.Nodes.Lists where
import DOM.Simple.Console (log, log2)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest as Forest
import Gargantext.Components.NgramsTable.Loader (clearCache) import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild) import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..)) import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Lists.Tabs as Tabs import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types (CacheState(..), ListsLayoutControls, SidePanelState(..), initialControls, toggleSidePanelState) import Gargantext.Components.Nodes.Lists.Types (CacheState(..), SidePanel)
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (<>)) import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (<>))
...@@ -24,42 +20,27 @@ import Gargantext.Utils.Toestand as T2 ...@@ -24,42 +20,27 @@ import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record as Record import Record as Record
import Record.Extra as REX
import Toestand as T import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists" here = R2.here "Gargantext.Components.Nodes.Lists"
listsWithSessionContext :: R2.Component CommonPropsSessionContext
listsWithSessionContext = R.createElement listsWithSessionContextCpt
listsWithSessionContextCpt :: R.Component CommonPropsSessionContext
listsWithSessionContextCpt = here.component "listsWithSessionContext" cpt where
cpt props@{ session } _ = do
session' <- R.useContext session
controls <- initialControls
pure $ R.fragment [
-- topBar { controls } []
listsLayout (Record.merge { controls, session: session' } props) []
, H.div { className: "side-panel" } [ sidePanel { controls, session: session' } [] ]
]
-------------------------------------------------------- --------------------------------------------------------
type CommonPropsNoSession = type CommonPropsNoSession =
( nodeId :: Int ( nodeId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadMainPage :: T2.ReloadS
, sessionUpdate :: Session -> Effect Unit , reloadRoot :: T2.ReloadS
, tasks :: T.Box GAT.Storage , sessionUpdate :: Session -> Effect Unit
, sidePanel :: T.Box (Maybe (Record SidePanel))
, sidePanelState :: T.Box GT.SidePanelState
, tasks :: T.Box GAT.Storage
) )
type CommonProps = WithSession CommonPropsNoSession type Props = WithSession CommonPropsNoSession
type CommonPropsSessionContext = WithSessionContext CommonPropsNoSession type CommonPropsSessionContext = WithSessionContext CommonPropsNoSession
type Props = ( controls :: Record ListsLayoutControls | CommonProps )
type WithTreeProps = ( handed :: GT.Handed | Props ) type WithTreeProps = ( handed :: GT.Handed | Props )
listsLayout :: R2.Component Props listsLayout :: R2.Component Props
...@@ -69,58 +50,70 @@ listsLayoutCpt :: R.Component Props ...@@ -69,58 +50,70 @@ listsLayoutCpt :: R.Component Props
listsLayoutCpt = here.component "listsLayout" cpt where listsLayoutCpt = here.component "listsLayout" cpt where
cpt props@{ nodeId, session } _ = do cpt props@{ nodeId, session } _ = do
let sid = sessionId session let sid = sessionId session
pure $ listsLayoutWithKey $ Record.merge props { key: show sid <> "-" <> show nodeId } pure $ listsLayoutWithKey (Record.merge props { key: show sid <> "-" <> show nodeId }) []
type KeyProps = ( key :: String | Props ) type KeyProps = ( key :: String | Props )
listsLayoutWithKey :: Record KeyProps -> R.Element listsLayoutWithKey :: R2.Component KeyProps
listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props [] listsLayoutWithKey = R.createElement listsLayoutWithKeyCpt
listsLayoutWithKeyCpt :: R.Component KeyProps listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
cpt { controls, nodeId, reloadForest, reloadRoot, session, sessionUpdate, tasks } _ = do cpt { nodeId
let path = { nodeId, session } , reloadForest
, reloadMainPage
cacheState <- T.useBox $ getCacheState CacheOn session nodeId , reloadRoot
cacheState' <- T.useLive T.unequal cacheState , session
, sessionUpdate
R.useEffectOnce' $ do , sidePanel
T.listen (\{ new } -> afterCacheStateChange new) cacheState , sidePanelState
, tasks } _ = do
useLoader path loadCorpusWithChild $ activeTab <- T.useBox 0
\corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } -> reloadMainPage' <- T.useLive T.unequal reloadMainPage
let { date, hyperdata : Hyperdata h, name } = poly
CorpusInfo { authors, desc, query } = getCorpusInfo h.fields let path = { nodeId, session }
in
R.fragment [ cacheState <- T.useBox $ getCacheState CacheOn session nodeId
Table.tableHeaderLayout { cacheState' <- T.useLive T.unequal cacheState
cacheState
, date R.useEffectOnce' $ do
, desc T.listen (\{ new } -> afterCacheStateChange new) cacheState
, key: "listsLayoutWithKey-header-" <> (show cacheState')
, query useLoader path loadCorpusWithChild $
, title: "Corpus " <> name \corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } ->
, user: authors } [] let { date, hyperdata : Hyperdata h, name } = poly
, Tabs.tabs { CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
cacheState in
, corpusData R.fragment [
, corpusId Table.tableHeaderLayout {
, key: "listsLayoutWithKey-tabs-" <> (show cacheState') cacheState
, reloadForest , date
, reloadRoot , desc
, session , key: "listsLayoutWithKey-header-" <> (show cacheState')
, sidePanelTriggers: controls.triggers , query
, tasks , title: "Corpus " <> name
} , user: authors } []
] , Tabs.tabs {
where activeTab
afterCacheStateChange cacheState = do , cacheState
launchAff_ $ clearCache unit , corpusData
sessionUpdate $ setCacheState session nodeId cacheState , corpusId
, key: "listsLayoutWithKey-tabs-" <> (show cacheState')
, reloadForest
, reloadRoot
, session
, tasks
}
]
where
afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState
type SidePanelProps = type SidePanelProps =
( controls :: Record ListsLayoutControls ( session :: Session
, session :: Session , sidePanel :: T.Box (Maybe (Record SidePanel))
, sidePanelState :: T.Box GT.SidePanelState
) )
sidePanel :: R2.Component SidePanelProps sidePanel :: R2.Component SidePanelProps
...@@ -129,29 +122,17 @@ sidePanel = R.createElement sidePanelCpt ...@@ -129,29 +122,17 @@ sidePanel = R.createElement sidePanelCpt
sidePanelCpt :: R.Component SidePanelProps sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = here.component "sidePanel" cpt sidePanelCpt = here.component "sidePanel" cpt
where where
cpt { controls: { triggers: { toggleSidePanel cpt { session
, triggerSidePanel , sidePanel
} } , sidePanelState } _ = do
, session } _ = do
showSidePanel <- R.useState' InitialClosed
R.useEffect' $ do
let toggleSidePanel' _ = snd showSidePanel toggleSidePanelState
triggerSidePanel' _ = snd showSidePanel $ const Opened
R2.setTrigger toggleSidePanel toggleSidePanel'
R2.setTrigger triggerSidePanel triggerSidePanel'
(mCorpusId /\ setMCorpusId) <- R.useState' Nothing sidePanelState' <- T.useLive T.unequal sidePanelState
(mListId /\ setMListId ) <- R.useState' Nothing
(mNodeId /\ setMNodeId ) <- R.useState' Nothing
let mainStyle = case fst showSidePanel of let mainStyle = case sidePanelState' of
Opened -> { display: "block" } GT.Opened -> { display: "block" }
_ -> { display: "none" } _ -> { display: "none" }
let closeSidePanel _ = do let closeSidePanel _ = T.write_ GT.Closed sidePanelState
snd showSidePanel $ const Closed
pure $ H.div { style: mainStyle } [ pure $ H.div { style: mainStyle } [
H.div { className: "header" } [ H.div { className: "header" } [
......
...@@ -34,14 +34,14 @@ here :: R2.Here ...@@ -34,14 +34,14 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists.Tabs" here = R2.here "Gargantext.Components.Nodes.Lists.Tabs"
type Props = ( type Props = (
cacheState :: T.Box CacheState activeTab :: T.Box Int
, corpusData :: CorpusData , cacheState :: T.Box CacheState
, corpusId :: Int , corpusData :: CorpusData
, reloadForest :: T.Box T2.Reload , corpusId :: Int
, reloadRoot :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, session :: Session , reloadRoot :: T2.ReloadS
, sidePanelTriggers :: Record SidePanelTriggers , session :: Session
, tasks :: T.Box GAT.Storage , tasks :: T.Box GAT.Storage
) )
type PropsWithKey = ( key :: String | Props ) type PropsWithKey = ( key :: String | Props )
...@@ -51,9 +51,9 @@ tabs props = R.createElement tabsCpt props [] ...@@ -51,9 +51,9 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component PropsWithKey tabsCpt :: R.Component PropsWithKey
tabsCpt = here.component "tabs" cpt where tabsCpt = here.component "tabs" cpt where
cpt props _ = do cpt props@{ activeTab } _ = do
(selected /\ setSelected) <- R.useState' 0 pure $ Tab.tabs { activeTab
pure $ Tab.tabs { selected, tabs: tabs' } where , tabs: tabs' } where
tabs' = [ "Terms" /\ view Terms [] tabs' = [ "Terms" /\ view Terms []
, "Authors" /\ view Authors [] , "Authors" /\ view Authors []
, "Institutes" /\ view Institutes [] , "Institutes" /\ view Institutes []
...@@ -76,7 +76,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -76,7 +76,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, reloadRoot , reloadRoot
, mode , mode
, session , session
, sidePanelTriggers
, tasks } _ = do , tasks } _ = do
chartsReload <- T.useBox T2.newReload chartsReload <- T.useBox T2.newReload
...@@ -104,7 +103,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -104,7 +103,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, session , session
, sidePanelTriggers
, tabNgramType , tabNgramType
, tabType , tabType
, tasks , tasks
......
module Gargantext.Components.Nodes.Lists.Types where module Gargantext.Components.Nodes.Lists.Types where
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (~>), (:=)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
import Data.Argonaut.Decode.Error (JsonDecodeError(..)) import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Maybe (Maybe(..))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Reactix as R
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Types (ListId, NodeID) import Gargantext.Types (ListId, NodeID)
...@@ -34,45 +33,7 @@ instance encodeJsonCacheState :: EncodeJson CacheState where ...@@ -34,45 +33,7 @@ instance encodeJsonCacheState :: EncodeJson CacheState where
instance showCacheState :: Show CacheState where instance showCacheState :: Show CacheState where
show = genericShow show = genericShow
type SidePanel = ()
data SidePanelState = InitialClosed | Opened | Closed initialSidePanel :: Maybe (Record SidePanel)
derive instance eqSidePanelState :: Eq SidePanelState initialSidePanel = Nothing
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed = Opened
toggleSidePanelState Opened = Closed
type TriggerAnnotatedDocIdChangeParams = (
corpusId :: NodeID
, listId :: ListId
, nodeId :: NodeID
)
type SidePanelTriggers = (
toggleSidePanel :: R2.Trigger Unit -- toggles side panel
, triggerSidePanel :: R2.Trigger Unit -- opens side panel
)
emptySidePanelTriggers :: R.Hooks (Record SidePanelTriggers)
emptySidePanelTriggers = do
toggleSidePanel <- R.useRef Nothing
triggerSidePanel <- R.useRef Nothing
pure $ {
toggleSidePanel
, triggerSidePanel
}
type ListsLayoutControls = (
triggers :: Record SidePanelTriggers
)
initialControls :: R.Hooks (Record ListsLayoutControls)
initialControls = do
triggers <- emptySidePanelTriggers
pure $ {
triggers
}
This diff is collapsed.
module Gargantext.Components.Nodes.Texts.Types where module Gargantext.Components.Nodes.Texts.Types where
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect (Effect)
import Reactix as R import Reactix as R
import Gargantext.Prelude import Gargantext.Prelude
...@@ -56,3 +55,15 @@ initialControls = do ...@@ -56,3 +55,15 @@ initialControls = do
pure $ { pure $ {
triggers triggers
} }
type SidePanel =
(
corpusId :: NodeID
, listId :: ListId
, mCurrentDocId :: Maybe Int
, nodeId :: NodeID
)
initialSidePanel :: Maybe (Record SidePanel)
initialSidePanel = Nothing
This diff is collapsed.
...@@ -20,8 +20,8 @@ here = R2.here "Gargantext.Components.SessionWrapper" ...@@ -20,8 +20,8 @@ here = R2.here "Gargantext.Components.SessionWrapper"
type Props = type Props =
( (
fallback :: R.Element context :: R.Context Session
, context :: R.Context Session , fallback :: R.Element
, sessionId :: SessionId , sessionId :: SessionId
, sessions :: T.Box Sessions , sessions :: T.Box Sessions
) )
......
module Gargantext.Components.Tab where module Gargantext.Components.Tab where
import Prelude hiding (div)
import Data.FunctorWithIndex (mapWithIndex) import Data.FunctorWithIndex (mapWithIndex)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
...@@ -8,14 +7,16 @@ import Reactix as R ...@@ -8,14 +7,16 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Tab" here = R2.here "Gargantext.Components.Tab"
type TabsProps = ( type TabsProps = (
selected :: Int activeTab :: T.Box Int
, tabs :: Array (Tuple String R.Element) , tabs :: Array (Tuple String R.Element)
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
...@@ -24,18 +25,17 @@ tabs props = R.createElement tabsCpt props [] ...@@ -24,18 +25,17 @@ tabs props = R.createElement tabsCpt props []
-- this is actually just the list of tabs, not the tab contents itself -- this is actually just the list of tabs, not the tab contents itself
tabsCpt :: R.Component TabsProps tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where tabsCpt = here.component "tabs" cpt where
cpt props _ = do cpt props@{ activeTab, tabs } _ = do
activeTab <- T.useBox props.selected
activeTab' <- T.useLive T.unequal activeTab activeTab' <- T.useLive T.unequal activeTab
pure $ H.div {} pure $ H.div {}
[ H.nav {} [ H.nav {}
[ H.br {} [ H.br {}
, H.div { className: "nav nav-tabs", title: "Search result" } , H.div { className: "nav nav-tabs", title: "Search result" }
(mapWithIndex (button activeTab activeTab') props.tabs) (mapWithIndex (button activeTab activeTab') tabs)
] ]
, H.div { className: "tab-content" } , H.div { className: "tab-content" }
(mapWithIndex (item activeTab') props.tabs) (mapWithIndex (item activeTab') tabs)
] ]
button activeTab selected index (name /\ _) = button activeTab selected index (name /\ _) =
H.a { className, on: { click } } [ H.text name ] where H.a { className, on: { click } } [ H.text name ] where
...@@ -52,9 +52,9 @@ tab = R.createElement tabCpt ...@@ -52,9 +52,9 @@ tab = R.createElement tabCpt
-- | A tab only shows its contents if it is currently selected -- | A tab only shows its contents if it is currently selected
tabCpt :: R.Component TabProps tabCpt :: R.Component TabProps
tabCpt = R.staticComponent "G.C.Tab.tab" cpt tabCpt = here.component "tab" cpt
where where
cpt { selected, index } children = H.div { className } children' cpt { selected, index } children = pure $ H.div { className } children'
where where
same = selected == index same = selected == index
className = "tab-pane" <> (if same then "show active" else "fade") className = "tab-pane" <> (if same then "show active" else "fade")
......
...@@ -142,10 +142,10 @@ tableCpt = here.component "table" cpt ...@@ -142,10 +142,10 @@ tableCpt = here.component "table" cpt
Just (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (columnName c)] Just (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (columnName c)]
_ -> [lnk (Just (ASC c)) (columnName c)] _ -> [lnk (Just (ASC c)) (columnName c)]
pure $ container pure $ container
{ syncResetButton { pageSizeControl: sizeDD { params }
, pageSizeControl: sizeDD { params }
, pageSizeDescription: textDescription state.page state.pageSize totalRecords , pageSizeDescription: textDescription state.page state.pageSize totalRecords
, paginationLinks: pagination { params, totalPages } , paginationLinks: pagination { params, totalPages }
, syncResetButton
, tableBody: map _.row $ A.fromFoldable rows , tableBody: map _.row $ A.fromFoldable rows
, tableHead: H.tr {} (colHeader <$> colNames) , tableHead: H.tr {} (colHeader <$> colNames)
} }
......
...@@ -23,25 +23,29 @@ topBar = R.createElement topBarCpt ...@@ -23,25 +23,29 @@ topBar = R.createElement topBarCpt
topBarCpt :: R.Component TopBarProps topBarCpt :: R.Component TopBarProps
topBarCpt = here.component "topBar" cpt topBarCpt = here.component "topBar" cpt
where where
cpt { handed } _children = do cpt { handed } children = do
handed' <- T.useLive T.unequal handed handed' <- T.useLive T.unequal handed
pure $ H.div { className: "navbar navbar-expand-lg navbar-dark bg-dark fixed-top" pure $ H.div { className: "navbar navbar-expand-lg navbar-dark bg-dark fixed-top"
, id: "dafixedtop" , id: "dafixedtop"
, role: "navigation" , role: "navigation"
} $ reverseHanded handed' [ }
-- NOTE: first (and only) entry in the sorted array should have the "ml-auto class" [ H.div { className: "container-fluid" } $ reverseHanded handed' [
-- https://stackoverflow.com/questions/19733447/bootstrap-navbar-with-left-center-or-right-aligned-items -- NOTE: first (and only) entry in the sorted array should have the "ml-auto class"
-- In practice: only apply "ml-auto" to the last element of this list, if handed == LeftHanded -- https://stackoverflow.com/questions/19733447/bootstrap-navbar-with-left-center-or-right-aligned-items
logo -- In practice: only apply "ml-auto" to the last element of this list, if handed == LeftHanded
, H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded handed' [ logo
divDropdownLeft {} [] , H.div { className: "collapse navbar-collapse" }
, handButton handed' [ H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded handed'
, smiley ([ divDropdownLeft {} []
, H.li { className: "nav-item" } [ themeSwitcher { theme: defaultTheme , handButton handed'
, themes: allThemes } [] ] , smiley
] , H.li { className: "nav-item" } [ themeSwitcher { theme: defaultTheme
] , themes: allThemes } [] ]
] <> children)
]
]
]
where where
handButton handed' = H.li { title: "If you are Left Handed you can change\n" handButton handed' = H.li { title: "If you are Left Handed you can change\n"
<> "the interface by clicking on me. Click\n" <> "the interface by clicking on me. Click\n"
......
...@@ -157,6 +157,6 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -157,6 +157,6 @@ useCachedAPILoaderEffect { cacheEndpoint
if h == cacheReal then if h == cacheReal then
pure hr' pure hr'
else else
throwError $ error $ "Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal throwError $ error $ "[Hooks.Loader] Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal
liftEffect $ do liftEffect $ do
T.write_ (Just $ handleResponse val) state T.write_ (Just $ handleResponse val) state
...@@ -19,7 +19,10 @@ import Gargantext.Types as GT ...@@ -19,7 +19,10 @@ import Gargantext.Types as GT
newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} } newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
--derive instance eqGraph :: Eq Graph derive instance genericGraph :: Generic (Graph n e) _
instance eqGraphInst :: (Eq (Record n), Eq (Record e)) => Eq (Graph n e) where
eq = genericEq
--instance eqGraph :: Eq Graph where --instance eqGraph :: Eq Graph where
-- eq (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = n1 == n2 && e1 == e2 -- eq (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = n1 == n2 && e1 == e2
......
...@@ -644,14 +644,6 @@ asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/" ...@@ -644,14 +644,6 @@ asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
asyncTaskTypePath UpdateNode = "update/" asyncTaskTypePath UpdateNode = "update/"
asyncTaskTypePath UploadFile = "async/file/add/" asyncTaskTypePath UploadFile = "async/file/add/"
asyncTaskTriggersAppReload :: AsyncTaskType -> Boolean
asyncTaskTriggersAppReload _ = true
asyncTaskTriggersTreeReload :: AsyncTaskType -> Boolean
asyncTaskTriggersTreeReload Form = true
asyncTaskTriggersTreeReload UploadFile = true
asyncTaskTriggersTreeReload _ = false
type AsyncTaskID = String type AsyncTaskID = String
...@@ -773,6 +765,14 @@ prettyNodeType nt = S.replace (S.Pattern "Node") (S.Replacement " ") ...@@ -773,6 +765,14 @@ prettyNodeType nt = S.replace (S.Pattern "Node") (S.Replacement " ")
$ S.replace (S.Pattern "Folder") (S.Replacement " ") $ S.replace (S.Pattern "Folder") (S.Replacement " ")
$ show nt $ show nt
---------------------------------------------------------------------------
data SidePanelState = InitialClosed | Opened | Closed
derive instance genericSidePanelState :: Generic SidePanelState _
instance eqSidePanelState :: Eq SidePanelState where
eq = genericEq
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed = Opened
toggleSidePanelState Opened = Closed
#dafixedtop #dafixedtop
z-index: 999 // correction for the popover // correction for the popover
z-index: 999
// height: 60px
//.logoSmall //.logoSmall
// line-height: 15px // line-height: 15px
......
#page-wrapper .cache-toggle
.cache-toggle cursor: pointer
cursor: pointer .side-panel
.side-panel //background-color: $dark
//background-color: $dark left: 70%
left: 70% padding: 5px
padding: 5px position: fixed
position: fixed top: 60px
top: 60px background-color: #fff
background-color: #fff width: 28%
width: 28% .header
.header float: right
float: right .corpus-doc-view
.corpus-doc-view .annotated-field-wrapper
.annotated-field-wrapper .annotated-field-runs
.annotated-field-runs max-height: 200px
max-height: 200px overflow-y: scroll
overflow-y: scroll .list-group
.list-group .list-group-item-heading
.list-group-item-heading display: inline-block
display: inline-block width: 60px
width: 60px
.simple-layout .simple-layout
height: 100% height: 100%
......
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