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