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
, graphVersion :: T2.Reload
, handed :: Handed , handed :: Handed
, reloadForest :: Int , reloadForest :: T2.Reload
, reloadRoot :: Int , reloadMainPage :: T2.Reload
, reloadRoot :: T2.Reload
, route :: AppRoute , route :: AppRoute
, session :: Maybe Session
, sessions :: Sessions , sessions :: Sessions
, showCorpus :: Boolean , showCorpus :: Boolean
, showLogin :: 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 , 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
, graphVersion :: T2.ReloadS
, handed :: T.Box Handed , handed :: T.Box Handed
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, route :: T.Box AppRoute , route :: T.Box AppRoute
, session :: T.Box (Maybe Session)
, sessions :: T.Box Sessions , sessions :: T.Box Sessions
, showCorpus :: T.Box Boolean , showCorpus :: T.Box Boolean
, showLogin :: 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 , tasks :: T.Box GAT.Storage
} }
...@@ -15,11 +15,11 @@ import Data.Set (Set) ...@@ -15,11 +15,11 @@ import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.String as Str import Data.String as Str
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) 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
...@@ -31,14 +31,14 @@ import Gargantext.Components.DocsTable.Types ...@@ -31,14 +31,14 @@ import Gargantext.Components.DocsTable.Types
( DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), sampleData ) ( DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), sampleData )
import Gargantext.Components.Table.Types as TT import Gargantext.Components.Table.Types as TT
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types (SidePanelTriggers) import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Table as TT import Gargantext.Components.Table as TT
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..)) import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, get, delete) import Gargantext.Sessions (Session, sessionId, get, delete)
import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), TableResult, TabSubType, TabType, showTabType') import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TableResult, TabSubType, TabType, showTabType')
import Gargantext.Utils (sortWith) import Gargantext.Utils (sortWith)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParamS, queryParam, queryParamS) import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParamS, queryParam, queryParamS)
...@@ -58,36 +58,35 @@ type Path a = ...@@ -58,36 +58,35 @@ type Path a =
, tabType :: TabSubType a , tabType :: TabSubType a
) )
type LayoutProps = type CommonProps =
( cacheState :: T.Box NT.CacheState ( cacheState :: T.Box NT.CacheState
, frontends :: Frontends , frontends :: Frontends
, chart :: R.Element
, listId :: Int , listId :: Int
, mCorpusId :: Maybe Int , mCorpusId :: Maybe Int
, nodeId :: Int , nodeId :: Int
-- , path :: Record (Path a)
, session :: Session , session :: Session
, showSearch :: Boolean , sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelTriggers :: Record SidePanelTriggers , sidePanelState :: T.Box SidePanelState
, tabType :: TabType , tabType :: TabType
-- ^ tabType is not ideal here since it is too much entangled with tabs and -- ^ tabType is not ideal here since it is too much entangled with tabs and
-- ngramtable. Let's see how this evolves. ) -- ngramtable. Let's see how this evolves. )
, totalRecords :: Int , totalRecords :: Int
) )
type LayoutProps =
(
chart :: R.Element
, showSearch :: Boolean
| CommonProps
-- , path :: Record (Path a)
)
type PageLayoutProps = type PageLayoutProps =
( cacheState :: T.Box NT.CacheState (
, frontends :: Frontends key :: String -- NOTE Necessary to clear the component when cache state changes
, key :: String -- NOTE Necessary to clear the component when cache state changes
, listId :: Int
, mCorpusId :: Maybe Int
, nodeId :: Int
, params :: TT.Params , params :: TT.Params
, query :: Query , query :: Query
, session :: Session | CommonProps
, sidePanelTriggers :: Record SidePanelTriggers
, tabType :: TabType
, totalRecords :: Int
) )
_documentIdsDeleted = prop (SProxy :: SProxy "documentIdsDeleted") _documentIdsDeleted = prop (SProxy :: SProxy "documentIdsDeleted")
...@@ -123,7 +122,8 @@ docViewCpt = here.component "docView" cpt where ...@@ -123,7 +122,8 @@ docViewCpt = here.component "docView" cpt where
, nodeId , nodeId
, session , session
, showSearch , showSearch
, sidePanelTriggers , sidePanel
, sidePanelState
, tabType , tabType
, totalRecords , totalRecords
} }
...@@ -147,10 +147,11 @@ docViewCpt = here.component "docView" cpt where ...@@ -147,10 +147,11 @@ docViewCpt = here.component "docView" cpt where
, params , params
, query: query' , query: query'
, session , session
, sidePanelTriggers , sidePanel
, sidePanelState
, tabType , tabType
, totalRecords , totalRecords
} ] ] ] } [] ] ] ]
type SearchBarProps = type SearchBarProps =
( query :: T.Box Query ) ( query :: T.Box Query )
...@@ -246,8 +247,8 @@ filterDocs query docs = A.filter filterFunc docs ...@@ -246,8 +247,8 @@ filterDocs query docs = A.filter filterFunc docs
filterFunc (Response { hyperdata: Hyperdata { title } }) = filterFunc (Response { hyperdata: Hyperdata { title } }) =
isJust $ Str.indexOf (Str.Pattern $ Str.toLower query) $ Str.toLower title isJust $ Str.indexOf (Str.Pattern $ Str.toLower query) $ Str.toLower title
pageLayout :: Record PageLayoutProps -> R.Element pageLayout :: R2.Component PageLayoutProps
pageLayout props = R.createElement pageLayoutCpt props [] pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt where pageLayoutCpt = here.component "pageLayout" cpt where
...@@ -259,7 +260,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where ...@@ -259,7 +260,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where
, params , params
, query , query
, session , session
, sidePanelTriggers , sidePanel
, tabType } _ = do , tabType } _ = do
cacheState' <- T.useLive T.unequal cacheState cacheState' <- T.useLive T.unequal cacheState
...@@ -373,21 +374,25 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -373,21 +374,25 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
, mCorpusId , mCorpusId
, nodeId , nodeId
, session , session
, sidePanelTriggers: sidePanelTriggers@{ currentDocIdRef } , sidePanel
, sidePanelState
, totalRecords } , totalRecords }
, localCategories , localCategories
, params } _ = do , params } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
mCurrentDocId <- T.useFocused
(maybe Nothing _.mCurrentDocId)
(\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
localCategories' <- T.useLive T.unequal localCategories localCategories' <- T.useLive T.unequal localCategories
pure $ TT.table pure $ TT.table
{ syncResetButton : [ H.div {} [] ] { colNames
, colNames
, container: TT.defaultContainer { title: "Documents" } , container: TT.defaultContainer { title: "Documents" }
, params , params
, rows: rows reload localCategories' , rows: rows reload localCategories' mCurrentDocId'
, syncResetButton : [ H.div {} [] ]
, totalRecords , totalRecords
, wrapColElts , wrapColElts
} }
...@@ -403,13 +408,18 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -403,13 +408,18 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
| otherwise = Routes.Document sid listId | otherwise = Routes.Document sid listId
colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ] colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
wrapColElts = const identity wrapColElts = const identity
rows reload localCategories' = row <$> A.toUnfoldable documents rows reload localCategories' mCurrentDocId' = row <$> A.toUnfoldable documents
where where
row dv@(DocumentsView r@{ _id, category }) = row dv@(DocumentsView r@{ _id, category }) =
{ row: { row:
TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ] TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
H.div { className: "" } H.div { className: "" }
[ docChooser { listId, mCorpusId, nodeId: r._id, selected, sidePanelTriggers, tableReload: reload } [] [ docChooser { listId
, mCorpusId
, nodeId: r._id
, sidePanel
, sidePanelState
, tableReload: reload } []
] ]
--, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ] --, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
, H.div { className: "column-tag flex" } , H.div { className: "column-tag flex" }
...@@ -432,16 +442,16 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -432,16 +442,16 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
where where
cat = fromMaybe category (localCategories' ^. at _id) cat = fromMaybe category (localCategories' ^. at _id)
-- checked = Star_1 == cat -- checked = Star_1 == cat
selected = mCurrentDocId' == Just r._id
tClassName = trashClassName cat selected tClassName = trashClassName cat selected
className = gi cat className = gi cat
selected = R.readRef currentDocIdRef == Just r._id
type DocChooser = ( type DocChooser = (
listId :: ListId listId :: ListId
, mCorpusId :: Maybe NodeID , mCorpusId :: Maybe NodeID
, nodeId :: NodeID , nodeId :: NodeID
, selected :: Boolean , sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelTriggers :: Record SidePanelTriggers , sidePanelState :: T.Box SidePanelState
, tableReload :: T2.ReloadS , tableReload :: T2.ReloadS
) )
...@@ -457,23 +467,38 @@ docChooserCpt = here.component "docChooser" cpt ...@@ -457,23 +467,38 @@ docChooserCpt = here.component "docChooser" cpt
cpt { listId cpt { listId
, mCorpusId: Just corpusId , mCorpusId: Just corpusId
, nodeId , nodeId
, selected , sidePanel
, sidePanelTriggers: { triggerAnnotatedDocIdChange } , sidePanelState
, tableReload } _ = do , tableReload } _ = do
mCurrentDocId <- T.useFocused
(maybe Nothing _.mCurrentDocId)
(\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
let eyeClass = if selected then "fa-eye" else "fa-eye-slash" let selected = mCurrentDocId' == Just nodeId
eyeClass = if selected then "fa-eye" else "fa-eye-slash"
pure $ H.div { className: "btn" } [ pure $ H.div { className: "btn" } [
H.span { className: "fa " <> eyeClass H.span { className: "fa " <> eyeClass
, on: { click: onClick } } [] , on: { click: onClick selected } } []
] ]
where where
onClick _ = do onClick selected _ = do
-- log2 "[docChooser] onClick, listId" listId -- log2 "[docChooser] onClick, listId" listId
-- log2 "[docChooser] onClick, corpusId" corpusId -- log2 "[docChooser] onClick, corpusId" corpusId
-- log2 "[docChooser] onClick, nodeId" nodeId -- log2 "[docChooser] onClick, nodeId" nodeId
R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId } -- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId }
T2.reload tableReload -- T2.reload tableReload
if selected then do
T.write_ Nothing sidePanel
T.write_ Closed sidePanelState
else do
T.write_ (Just { corpusId: corpusId
, listId: listId
, mCurrentDocId: Just nodeId
, nodeId: nodeId }) sidePanel
T.write_ Opened sidePanelState
log2 "[docChooser] sidePanel opened" sidePanelState
newtype SearchQuery = SearchQuery { newtype SearchQuery = SearchQuery {
......
...@@ -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
...@@ -35,23 +34,24 @@ here = R2.here "Gargantext.Components.Forest" ...@@ -35,23 +34,24 @@ here = R2.here "Gargantext.Components.Forest"
type Common = type Common =
( frontends :: Frontends ( frontends :: Frontends
, handed :: T.Box Handed , handed :: T.Box Handed
, reloadRoot :: T.Box T2.Reload , reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, route :: T.Box AppRoute , 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,40 +64,38 @@ forestCpt = here.component "forest" cpt where ...@@ -64,40 +64,38 @@ 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
( frontends /\ sessions' /\ handed' /\ forestOpen' /\ reloadForest' )
(cp handed' sessions')
where where
common = RX.pick props :: Record Common common = RX.pick props :: Record Common
cp handed' sessions' _ =
pure $ H.div { className: "forest" }
(A.cons (plus handed' showLogin) (trees handed' sessions'))
trees handed' sessions' = (tree handed') <$> unSessions sessions' trees handed' sessions' = (tree handed') <$> unSessions sessions'
tree handed' s@(Session {treeId}) = tree handed' s@(Session {treeId}) =
treeLoader { forestOpen treeLoader { forestOpen
, frontends , frontends
, handed: handed' , handed: handed'
, reload: reloadForest , reload: reloadForest
, reloadMainPage
, reloadRoot , reloadRoot
, root: treeId , root: treeId
, route , route
...@@ -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.
...@@ -51,7 +51,9 @@ type NodeMainSpanProps = ...@@ -51,7 +51,9 @@ type NodeMainSpanProps =
, isLeaf :: IsLeaf , isLeaf :: IsLeaf
, name :: Name , name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, reloadRoot :: T.Box T2.Reload , reload :: T2.ReloadS
, reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, route :: T.Box Routes.AppRoute , route :: T.Box Routes.AppRoute
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box GAT.Storage , tasks :: T.Box GAT.Storage
...@@ -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,8 +213,8 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -184,8 +213,8 @@ 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
...@@ -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,22 +60,26 @@ type CreateNodeProps = ...@@ -59,22 +60,26 @@ 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"
nodeName' <- T.useLive T.unequal nodeName
nodeType <- T.useBox $ fromMaybe Folder $ head nodeTypes
nodeType' <- T.useLive T.unequal nodeType
let let
SettingsBox {edit} = settingsBox nt SettingsBox {edit} = settingsBox nodeType'
setNodeType' nt = do setNodeType' nt = do
setNodeName $ const $ GT.prettyNodeType nt T.write_ (GT.prettyNodeType nt) nodeName
setNodeType $ const nt T.write_ nt nodeType
(maybeChoose /\ nt') = if length nodeTypes > 1 (maybeChoose /\ nt') = if length nodeTypes > 1
then ([ formChoiceSafe nodeTypes Error setNodeType' ] /\ nt) then ([ formChoiceSafe nodeTypes Error setNodeType' ] /\ nodeType')
else ([H.div {} [H.text $ "Creating a node of type " else ([H.div {} [H.text $ "Creating a node of type "
<> show defaultNt <> show defaultNt
<> " with name:" <> " with name:"
...@@ -85,19 +90,19 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p [] ...@@ -85,19 +90,19 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
defaultNt = (fromMaybe Error $ head nodeTypes) defaultNt = (fromMaybe Error $ head nodeTypes)
maybeEdit = [ if edit maybeEdit = [ if edit
then inputWithEnter { then inputWithEnter {
onBlur: \val -> setNodeName $ const val onBlur: \val -> T.write_ val nodeName
, onEnter: \_ -> launchAff_ $ dispatch (AddNode name' nt') , onEnter: \_ -> launchAff_ $ dispatch (AddNode nodeName' nt')
, onValueChanged: \val -> setNodeName $ const val , onValueChanged: \val -> T.write_ val nodeName
, autoFocus: true , autoFocus: true
, className: "form-control" , className: "form-control"
, defaultValue: name' -- (prettyNodeType nt') , defaultValue: nodeName' -- (prettyNodeType nt')
, placeholder: name' -- (prettyNodeType nt') , placeholder: nodeName' -- (prettyNodeType nt')
, type: "text" , type: "text"
} }
else H.div {} [] else H.div {} []
] ]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt') dispatch) 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
, nodeType :: NodeType )
actionDelete :: R2.Component Delete
actionDelete = R.createElement actionDeleteCpt
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"}} pure $ panel [ H.div { style: {margin: "10px"}}
[ H.text $ "Yes, we are RGPD compliant!" [ H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet." <> " But you can not delete User Node yet."
<> " We are still on development." <> " We are still on development."
<> " Thanks for your comprehensin." <> " Thanks for your comprehensin."
] ]
] ] (H.div {} [])
(H.div {} [])
actionDelete nt dispatch = do 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]) pure $ panel (map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?" [ "Are your sure you want to delete it ?"
, "If yes, click again below." , "If yes, click again below."
] ]
) ) (submitButton (DeleteNode nodeType) dispatch)
(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 ]
actionDoc :: R2.Component ActionDoc
actionDoc = R.createElement actionDocCpt
actionDocCpt :: R.Component ActionDoc
actionDocCpt = here.component "actionDoc" cpt where
cpt { nodeType } _ = do
pure $ panel ([ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType) <> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
) )
( H.div {} []) (H.div {} [])
where where
infoTitle :: NodeType -> R.Element infoTitle :: NodeType -> R.Element
infoTitle nt = H.div { style: {margin: "10px"}} infoTitle nt = H.div { style: {margin: "10px"}}
......
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
, 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) (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
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) (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
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) (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,7 +88,8 @@ shareNodeCpt = here.component "shareNode" cpt ...@@ -73,7 +88,8 @@ shareNodeCpt = here.component "shareNode" cpt
Nothing -> H.div {} [] Nothing -> H.div {} []
_ -> H.div {} [] _ -> H.div {} []
pure $ Tools.panel [ subTreeView { action pure $ Tools.panel
[ subTreeView { action
, dispatch , dispatch
, handed , handed
, id , id
...@@ -82,4 +98,3 @@ shareNodeCpt = here.component "shareNode" cpt ...@@ -82,4 +98,3 @@ shareNodeCpt = here.component "shareNode" cpt
, subTreeParams , 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.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), ID) import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Sessions (Session, post) import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as GR
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
cpt props@{ dispatch, nodeType: Dashboard } _ = pure $ updateDashboard props []
cpt props@{ dispatch, nodeType: Graph } _ = pure $ updateGraph props []
cpt props@{ dispatch, nodeType: NodeList } _ = pure $ updateNodeList props []
cpt props@{ dispatch, nodeType: Texts } _ = pure $ updateTexts props []
cpt props@{ dispatch, nodeType: _ } _ = pure $ updateOther props []
updateDashboard :: R2.Component UpdateProps
updateDashboard = R.createElement updateDashboardCpt
updateDashboardCpt :: R.Component UpdateProps
updateDashboardCpt = here.component "updateDashboard" cpt where
cpt { dispatch } _ = do
methodBoard <- T.useBox All
methodBoard' <- T.useLive T.unequal methodBoard
pure $ panel [ -- H.text "Update with" pure $ panel [ -- H.text "Update with"
formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod' formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All (\val -> T.write_ val methodBoard)
] ]
(submitButton (UpdateNode $ UpdateNodeParamsList {methodList}) dispatch) (submitButton (UpdateNode $ UpdateNodeParamsBoard { methodBoard: methodBoard' }) dispatch)
update Graph dispatch = do
meth @( methodGraph /\ setMethod ) <- R.useState' Order1
let setMethod' = setMethod <<< const updateGraph :: R2.Component UpdateProps
updateGraph = R.createElement updateGraphCpt
updateGraphCpt :: R.Component UpdateProps
updateGraphCpt = here.component "updateGraph" cpt where
cpt { dispatch } _ = do
methodGraph <- T.useBox Order1
methodGraph' <- T.useLive T.unequal methodGraph
pure $ panel [ -- H.text "Update with" pure $ panel [ -- H.text "Update with"
formChoiceSafe [Order1, Order2] Order1 setMethod' formChoiceSafe [Order1, Order2] Order1 (\val -> T.write_ val methodGraph)
] ]
(submitButton (UpdateNode $ UpdateNodeParamsGraph {methodGraph}) dispatch) (submitButton (UpdateNode $ UpdateNodeParamsGraph { methodGraph: methodGraph' }) dispatch)
update Texts dispatch = do updateNodeList :: R2.Component UpdateProps
meth @( methodTexts /\ setMethod ) <- R.useState' NewNgrams updateNodeList = R.createElement updateNodeListCpt
updateNodeListCpt :: R.Component UpdateProps
let setMethod' = setMethod <<< const 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" pure $ panel [ -- H.text "Update with"
formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams setMethod' formChoiceSafe [Basic, Advanced, WithModel] Basic (\val -> T.write_ val methodList)
] ]
(submitButton (UpdateNode $ UpdateNodeParamsTexts {methodTexts}) dispatch) (submitButton (UpdateNode $ UpdateNodeParamsList { methodList: methodList' }) dispatch)
update Dashboard dispatch = do
meth @( methodBoard /\ setMethod ) <- R.useState' All
let setMethod' = setMethod <<< const 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" pure $ panel [ -- H.text "Update with"
formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All setMethod' formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams (\val -> T.write_ val methodTexts)
] ]
(submitButton (UpdateNode $ UpdateNodeParamsBoard {methodBoard}) dispatch) (submitButton (UpdateNode $ UpdateNodeParamsTexts { methodTexts: methodTexts' }) dispatch)
update _ _ = pure $ H.div {} [] 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,19 +40,30 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Upload" ...@@ -40,19 +40,30 @@ 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
, session :: Session )
actionUpload Corpus id session dispatch = actionUpload :: R2.Component ActionUpload
pure $ uploadFileView {dispatch, id, nodeType: Corpus, session} 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
actionUploadOther = R.createElement actionUploadOtherCpt
actionUploadOtherCpt :: R.Component ActionUpload
actionUploadOtherCpt = here.component "actionUploadOther" cpt where
cpt _ _ = do
pure $ fragmentPT $ "Soon, upload for this NodeType." pure $ fragmentPT $ "Soon, upload for this NodeType."
...@@ -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
mFile' <- T.useLive T.unequal mFile
let disabled = case mFile' of
Nothing -> "1"
Just _ -> ""
pure $ H.button { className: "btn btn-primary"
, "type" : "button" , "type" : "button"
, disabled , disabled
, style : { width: "100%" } , style : { width: "100%" }
, on: {click: onClick} , on: {click: onClick fileType' mFile'}
} [ H.text "Upload" ] } [ 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}
...@@ -367,10 +383,10 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt ...@@ -367,10 +383,10 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
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
where , mFile
disabled = case mFile of , nodeType } _ = do
mFile' <- T.useLive T.unequal mFile
let disabled = case mFile' of
Nothing -> "1" Nothing -> "1"
Just _ -> "" Just _ -> ""
onClick e = do pure $ H.button { className: "btn btn-primary"
let {name, blob} = unsafePartial $ fromJust mFile , disabled
, on: {click: onClick mFile'}
} [ H.text "Upload" ]
where
onClick mFile' 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,24 +79,31 @@ progressIndicator p = R.createElement progressIndicatorCpt p [] ...@@ -83,24 +79,31 @@ 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"
case barType of
Bar -> pure $
H.div { className: "progress" }
[ H.div { className: "progress-bar"
, role: "progressbar" , role: "progressbar"
, style: { width: (show $ progress) <> "%" } , style: { width: (show $ progressInt) <> "%" }
} [ H.text label ] } [ H.text label ]
] ]
Pie -> pure $
cpt { barType: Pie, label, progress } _ = do H.div { className: "progress-pie" }
pure $ [ H.div { className: "progress-pie-segment"
H.div { className: "progress-pie" } [ , style: { "--over50": if progressInt < 50 then "0" else "1"
H.div { className: "progress-pie-segment" , "--value": show $ progressInt } } [
, style: { "--over50": if progress < 50 then "0" else "1"
, "--value": show $ progress } } [
] ]
] ]
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}
, typ , typ
...@@ -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,10 +44,9 @@ sizeButtonCpt = here.component "nodeSearchControl" cpt ...@@ -44,10 +44,9 @@ 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" }
[ H.div { className: "input-group" }
[ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph [ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph
, classes: "mx-2"
, 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 } []
...@@ -56,7 +55,6 @@ sizeButtonCpt = here.component "nodeSearchControl" cpt ...@@ -56,7 +55,6 @@ sizeButtonCpt = here.component "nodeSearchControl" cpt
} }
[ 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
GET.Closed -> pure $ RH.div {} []
GET.InitialClosed -> pure $ RH.div {} []
GET.Opened sideTabT -> do
let sideTab' = case sideTabT of
SideTabLegend -> sideTabLegend sideTabProps []
SideTabData -> sideTabData sideTabProps []
SideTabCommunity -> sideTabCommunity sideTabProps []
pure $ RH.div { id: "sp-container" } pure $ RH.div { id: "sp-container" }
[ sideTabNav { sidePanel: showSidePanel [ sideTabNav { sideTab
, sideTabs: [SideTabLegend, SideTabData, SideTabCommunity] } [] , sideTabs: [GET.SideTabLegend, GET.SideTabData, GET.SideTabCommunity] } []
, sideTab' , case sideTab' of
GET.SideTabLegend -> sideTabLegend sideTabProps []
GET.SideTabData -> sideTabData sideTabProps []
GET.SideTabCommunity -> sideTabCommunity sideTabProps []
] ]
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,23 +88,21 @@ sideTabNav = R.createElement sideTabNavCpt ...@@ -94,23 +88,21 @@ 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,34 +366,55 @@ deleteNode termList session (GET.MetaData metaData) node = do ...@@ -372,34 +366,55 @@ 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
cpt props@{ selectedNodeIds } _ = do
pure $ if Set.isEmpty selectedNodeIds
then RH.div {} []
else query' props []
query' :: R2.Component Query
query' = R.createElement queryCpt'
queryCpt' :: R.Component Query
queryCpt' = here.component "query'" cpt where
cpt { frontends
, metaData: GET.MetaData metaData
, nodesMap
, searchType
, selectedNodeIds
, session } _ = do
pure $ case (head metaData.corpusId) of
Nothing -> RH.div {} []
Just corpusId ->
CGT.tabs { frontends CGT.tabs { frontends
, session , query: SearchQuery { expected: searchType
, query: SearchQuery { query : concat $ toQuery <$> Set.toUnfoldable selectedNodeIds , query : concat $ toQuery <$> Set.toUnfoldable selectedNodeIds
, expected: searchType
} }
, session
, sides: [side corpusId] , sides: [side corpusId]
} }
where
toQuery id = case Map.lookup id nodesMap of toQuery id = case Map.lookup id nodesMap of
Nothing -> [] Nothing -> []
Just n -> words n.label Just n -> words n.label
side corpusId = GET.GraphSideCorpus { corpusId side corpusId = GET.GraphSideCorpus { corpusId
, listId : metaData.list.listId
, corpusLabel: metaData.title , 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
......
...@@ -23,6 +23,7 @@ type Completions = Array String ...@@ -23,6 +23,7 @@ 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
...@@ -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
...@@ -55,10 +56,11 @@ type TabsProps = ...@@ -55,10 +56,11 @@ type TabsProps =
, 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))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage , tasks :: T.Box GAT.Storage
) )
...@@ -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,12 +121,12 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -119,12 +121,12 @@ 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
...@@ -132,9 +134,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -132,9 +134,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where
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
...@@ -153,8 +153,10 @@ listElement = H.li { className: "list-group-item justify-content-between" } ...@@ -153,8 +153,10 @@ 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
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage , tasks :: T.Box GAT.Storage
) )
...@@ -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
...@@ -141,12 +144,14 @@ listElement = H.li { className: "list-group-item justify-content-between" } ...@@ -141,12 +144,14 @@ listElement = H.li { className: "list-group-item justify-content-between" }
type BasicProps = type BasicProps =
( frontends :: Frontends ( frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, sidePanelState :: T.Box SidePanelState
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, tasks :: T.Box GAT.Storage , 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
...@@ -53,10 +53,11 @@ type TabsProps = ( ...@@ -53,10 +53,11 @@ type TabsProps = (
, 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))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage , tasks :: T.Box GAT.Storage
) )
...@@ -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,7 +123,8 @@ tabsCpt = here.component "tabs" cpt ...@@ -124,7 +123,8 @@ 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
} }
...@@ -135,10 +135,9 @@ type NgramsViewTabsProps = ( ...@@ -135,10 +135,9 @@ type NgramsViewTabsProps = (
, 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
) )
...@@ -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
, reloadRoot :: T2.ReloadS
, sessionUpdate :: Session -> Effect Unit , sessionUpdate :: Session -> Effect Unit
, sidePanel :: T.Box (Maybe (Record SidePanel))
, sidePanelState :: T.Box GT.SidePanelState
, tasks :: T.Box GAT.Storage , 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,16 +50,27 @@ listsLayoutCpt :: R.Component Props ...@@ -69,16 +50,27 @@ 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
, reloadForest
, reloadMainPage
, reloadRoot
, session
, sessionUpdate
, sidePanel
, sidePanelState
, tasks } _ = do
activeTab <- T.useBox 0
reloadMainPage' <- T.useLive T.unequal reloadMainPage
let path = { nodeId, session } let path = { nodeId, session }
cacheState <- T.useBox $ getCacheState CacheOn session nodeId cacheState <- T.useBox $ getCacheState CacheOn session nodeId
...@@ -102,14 +94,14 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where ...@@ -102,14 +94,14 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
, title: "Corpus " <> name , title: "Corpus " <> name
, user: authors } [] , user: authors } []
, Tabs.tabs { , Tabs.tabs {
cacheState activeTab
, cacheState
, corpusData , corpusData
, corpusId , corpusId
, key: "listsLayoutWithKey-tabs-" <> (show cacheState') , key: "listsLayoutWithKey-tabs-" <> (show cacheState')
, reloadForest , reloadForest
, reloadRoot , reloadRoot
, session , session
, sidePanelTriggers: controls.triggers
, tasks , tasks
} }
] ]
...@@ -119,8 +111,9 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where ...@@ -119,8 +111,9 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
sessionUpdate $ setCacheState session nodeId cacheState 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,13 +34,13 @@ here :: R2.Here ...@@ -34,13 +34,13 @@ 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
, cacheState :: T.Box CacheState
, corpusData :: CorpusData , corpusData :: CorpusData
, corpusId :: Int , corpusId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T2.ReloadS
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T2.ReloadS
, session :: Session , session :: Session
, sidePanelTriggers :: Record SidePanelTriggers
, tasks :: T.Box GAT.Storage , tasks :: T.Box GAT.Storage
) )
...@@ -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,13 +7,15 @@ import Reactix as R ...@@ -8,13 +7,15 @@ 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)
) )
...@@ -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,23 +23,27 @@ topBar = R.createElement topBarCpt ...@@ -23,23 +23,27 @@ 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' [ }
[ H.div { className: "container-fluid" } $ reverseHanded handed' [
-- NOTE: first (and only) entry in the sorted array should have the "ml-auto class" -- NOTE: first (and only) entry in the sorted array should have the "ml-auto class"
-- https://stackoverflow.com/questions/19733447/bootstrap-navbar-with-left-center-or-right-aligned-items -- https://stackoverflow.com/questions/19733447/bootstrap-navbar-with-left-center-or-right-aligned-items
-- In practice: only apply "ml-auto" to the last element of this list, if handed == LeftHanded -- In practice: only apply "ml-auto" to the last element of this list, if handed == LeftHanded
logo logo
, H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded handed' [ , H.div { className: "collapse navbar-collapse" }
divDropdownLeft {} [] [ H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded handed'
([ divDropdownLeft {} []
, handButton handed' , handButton handed'
, smiley , smiley
, H.li { className: "nav-item" } [ themeSwitcher { theme: defaultTheme , H.li { className: "nav-item" } [ themeSwitcher { theme: defaultTheme
, themes: allThemes } [] ] , themes: allThemes } [] ]
] <> children)
]
] ]
] ]
where where
......
...@@ -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
......
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