Commit cd3c671d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-frame-calc-corpus-csv-upload

parents 13c41d60 a849f70e
# Gauge - metadata dir
.gauge
# Gauge - log files dir
logs
# Gauge - reports dir
reports
# Gauge - JavaScript node dependencies
node_modules
.DS_Store
/bower_components/ /bower_components/
/node_modules/ /node_modules/
/.cache/ /.cache/
...@@ -32,3 +45,4 @@ bundle.js ...@@ -32,3 +45,4 @@ bundle.js
/.lesshst /.lesshst
/dist/js/**/*.map /dist/js/**/*.map
/dist/styles/**/*.map /dist/styles/**/*.map
{
"Language": "js",
"Plugins": [
"html-report"
]
}
\ No newline at end of file
{
"name": "js",
"description": "Gauge template for Javascript and Taiko",
"postInstallCmd": "npm install",
"postInstallMsg": "Run specifications with \"npm test\" in project root.",
"version": "1.0.5"
}
...@@ -17,13 +17,14 @@ ...@@ -17,13 +17,14 @@
"clean": "rm -Rf output node_modules", "clean": "rm -Rf output node_modules",
"clean-js": "rm -Rf node_modules", "clean-js": "rm -Rf node_modules",
"clean-ps": "rm -Rf output", "clean-ps": "rm -Rf output",
"test": "pulp test",
"server": "serve dist", "server": "serve dist",
"prod": "yarn prod:compile && yarn prod:dce && yarn prod:bundle && yarn prod:pack", "prod": "yarn prod:compile && yarn prod:dce && yarn prod:bundle && yarn prod:pack",
"prod:compile": "pulp build -- -g corefn", "prod:compile": "pulp build -- -g corefn",
"prod:dce": "zephyr -f Main.main", "prod:dce": "zephyr -f Main.main",
"prod:bundle": "pulp browserify --skip-compile -o dce-output -t app.js", "prod:bundle": "pulp browserify --skip-compile -o dce-output -t app.js",
"prod:pack": "parcel build index.html -d prod --public-url . --no-source-maps" "prod:pack": "parcel build index.html -d prod --public-url . --no-source-maps",
"test-pulp": "pulp test",
"test": "gauge run specs/"
}, },
"dependencies": { "dependencies": {
"@popperjs/core": "^2.9.2", "@popperjs/core": "^2.9.2",
...@@ -47,12 +48,14 @@ ...@@ -47,12 +48,14 @@
"sigma": "git://github.com/poorscript/sigma.js#garg" "sigma": "git://github.com/poorscript/sigma.js#garg"
}, },
"devDependencies": { "devDependencies": {
"@babel/core": "^7.12.9", "@babel/core": "^7.15.0",
"@babel/preset-react": "^7.12.7", "@babel/preset-react": "^7.12.7",
"@getgauge/cli": "^1.4.0",
"parcel": "^2.0.0-beta.2", "parcel": "^2.0.0-beta.2",
"react-testing-library": "^8.0.1", "react-testing-library": "^8.0.1",
"sass": "^1.35.2", "sass": "^1.35.2",
"serve": "^12.0.0", "serve": "^12.0.0",
"taiko": "latest",
"vscode-languageserver": "^7.0.0", "vscode-languageserver": "^7.0.0",
"xhr2": "^0.2.1" "xhr2": "^0.2.1"
}, },
......
# Logged in user specification
Tags: login
* Open gargantext
* User must be logged in as "user1" with password "1resu"
* Expand tree
## Successful list view
* Open the list view
module Gargantext.Components.App.Data (App, Boxes, emptyApp) where module Gargantext.Components.App.Data (App, Boxes, emptyApp) where
import Data.Set as Set import Gargantext.Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Set as Set
import Toestand as T import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.Nodes.Lists.Types as ListsT import Gargantext.Components.Nodes.Lists.Types as ListsT
import Gargantext.Components.Nodes.Texts.Types as TextsT import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Ends (Backend) import Gargantext.Ends (Backend)
import Gargantext.Routes (AppRoute(Home)) import Gargantext.Routes (AppRoute(Home))
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Session, Sessions) import Gargantext.Sessions (Session, Sessions)
import Gargantext.Sessions as Sessions
import Gargantext.Sessions.Types (OpenNodes(..)) import Gargantext.Sessions.Types (OpenNodes(..))
import Gargantext.Types (Handed(RightHanded), SidePanelState(..)) import Gargantext.Types (FrontendError, Handed(RightHanded), SidePanelState(..))
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
type App = type App =
{ backend :: Maybe Backend { backend :: Maybe Backend
, errors :: Array FrontendError
, forestOpen :: OpenNodes , forestOpen :: OpenNodes
, graphVersion :: T2.Reload , graphVersion :: T2.Reload
, handed :: Handed , handed :: Handed
...@@ -42,6 +43,7 @@ type App = ...@@ -42,6 +43,7 @@ type App =
emptyApp :: App emptyApp :: App
emptyApp = emptyApp =
{ backend : Nothing { backend : Nothing
, errors : []
, forestOpen : OpenNodes $ Set.empty , forestOpen : OpenNodes $ Set.empty
, graphVersion : T2.newReload , graphVersion : T2.newReload
, handed : RightHanded , handed : RightHanded
...@@ -63,6 +65,7 @@ emptyApp = ...@@ -63,6 +65,7 @@ emptyApp =
type Boxes = type Boxes =
{ backend :: T.Box (Maybe Backend) { backend :: T.Box (Maybe Backend)
, errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes , forestOpen :: T.Box OpenNodes
, graphVersion :: T2.ReloadS , graphVersion :: T2.ReloadS
, handed :: T.Box Handed , handed :: T.Box Handed
......
-- TODO: this module should be replaced by FacetsTable -- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where module Gargantext.Components.Category where
import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Either (Either)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
...@@ -10,16 +13,13 @@ import Reactix as R ...@@ -10,16 +13,13 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Simple.JSON as JSON import Simple.JSON as JSON
import Gargantext.Prelude import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories, LocalUserScore)
import Gargantext.Components.Category.Types import Gargantext.Config.REST (RESTError)
( Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars )
import Gargantext.Components.DocsTable.Types
( DocumentsView(..), LocalCategories, LocalUserScore )
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, put) import Gargantext.Sessions (Session, put)
import Gargantext.Types (NodeID, NodeType(..)) import Gargantext.Types (NodeID, NodeType(..))
import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Category" here = R2.here "Gargantext.Components.Category"
...@@ -63,7 +63,7 @@ instance JSON.WriteForeign RatingQuery where ...@@ -63,7 +63,7 @@ instance JSON.WriteForeign RatingQuery where
writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
, ntc_category: post.rating } , ntc_category: post.rating }
putRating :: Session -> Int -> RatingQuery -> Aff (Array Int) putRating :: Session -> Int -> RatingQuery -> Aff (Either RESTError (Array Int))
putRating session nodeId = put session $ ratingRoute where putRating session nodeId = put session $ ratingRoute where
ratingRoute = NodeAPI Node (Just nodeId) "category" ratingRoute = NodeAPI Node (Just nodeId) "category"
...@@ -147,5 +147,5 @@ instance JSON.WriteForeign CategoryQuery where ...@@ -147,5 +147,5 @@ instance JSON.WriteForeign CategoryQuery where
categoryRoute :: Int -> SessionRoute categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category" categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int) putCategories :: Session -> Int -> CategoryQuery -> Aff (Either RESTError (Array Int))
putCategories session nodeId = put session $ categoryRoute nodeId putCategories session nodeId = put session $ categoryRoute nodeId
This diff is collapsed.
module Gargantext.Components.ErrorsView where
import Gargantext.Prelude
import Data.Array (deleteAt)
import Data.FunctorWithIndex (mapWithIndex)
import Data.Maybe (Maybe(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Types (FrontendError(..))
import Gargantext.Utils.ReactBootstrap as RB
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.ErrorsView"
type ErrorsProps =
( errors :: T.Box (Array FrontendError) )
errorsView :: R2.Component ErrorsProps
errorsView = R.createElement errorsViewCpt
errorsViewCpt :: R.Component ErrorsProps
errorsViewCpt = here.component "errorsView" cpt
where
cpt { errors } _ = do
errors' <- T.useLive T.unequal errors
pure $ H.div {}
( mapWithIndex (showError errors) errors' )
showError errors i (FStringError { error }) =
RB.alert { dismissible: true
, onClose
, variant: "danger" } [ H.text error ]
where
onClose = do
here.log2 "click!" error
T.modify_ (\es -> case deleteAt i es of
Nothing -> es
Just es' -> es'
) errors
showError errors i (FRESTError { error }) =
RB.alert { dismissible: true
, onClose
, variant: "danger" } [ H.text $ show error ]
where
onClose = do
here.log2 "click!" error
T.modify_ (\es -> case deleteAt i es of
Nothing -> es
Just es' -> es'
) errors
...@@ -3,16 +3,18 @@ ...@@ -3,16 +3,18 @@
-- has not been ported to this module yet. -- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where module Gargantext.Components.FacetsTable where
import Data.Generic.Rep (class Generic) import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow) import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Sequence (Seq) import Data.Sequence (Seq)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd) import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
...@@ -21,22 +23,18 @@ import Reactix.DOM.HTML as H ...@@ -21,22 +23,18 @@ import Reactix.DOM.HTML as H
import Simple.JSON as JSON import Simple.JSON as JSON
import Toestand as T import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Category (CategoryQuery(..), putCategories) import Gargantext.Components.Category (CategoryQuery(..), putCategories)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory) import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
import Gargantext.Components.Search import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
( Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..)
, SearchQuery, SearchResult(..), SearchResultTypes(..) )
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (url, Frontends) import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(Search, NodeAPI)) import Gargantext.Routes (SessionRoute(Search, NodeAPI))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody) import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID) import Gargantext.Types (NodeType(..), OrderBy(..), NodeID)
import Gargantext.Utils (toggleSet, zeroPad) import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -124,7 +122,6 @@ instance Eq Rows where ...@@ -124,7 +122,6 @@ instance Eq Rows where
-- | Main layout of the Documents Tab of a Corpus -- | Main layout of the Documents Tab of a Corpus
docView :: Record Props -> R.Element docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props [] docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component Props docViewCpt :: R.Component Props
docViewCpt = here.component "docView" cpt docViewCpt = here.component "docView" cpt
where where
...@@ -153,12 +150,6 @@ docViewCpt = here.component "docView" cpt ...@@ -153,12 +150,6 @@ docViewCpt = here.component "docView" cpt
] ]
-} ] -} ]
] ]
where
buttonStyle = { backgroundColor: "peru"
, border: "white"
, color: "white"
, float: "right"
, padding: "9px" }
performDeletions :: Session -> Int -> T.Box Deletions -> Deletions -> Effect Unit performDeletions :: Session -> Int -> T.Box Deletions -> Deletions -> Effect Unit
performDeletions session nodeId deletions deletions' = do performDeletions session nodeId deletions deletions' = do
...@@ -180,7 +171,6 @@ togglePendingDeletion (_ /\ setDeletions) nid = setDeletions setter ...@@ -180,7 +171,6 @@ togglePendingDeletion (_ /\ setDeletions) nid = setDeletions setter
docViewGraph :: Record Props -> R.Element docViewGraph :: Record Props -> R.Element
docViewGraph props = R.createElement docViewCpt props [] docViewGraph props = R.createElement docViewCpt props []
docViewGraphCpt :: R.Component Props docViewGraphCpt :: R.Component Props
docViewGraphCpt = here.component "docViewGraph" cpt docViewGraphCpt = here.component "docViewGraph" cpt
where where
...@@ -221,8 +211,8 @@ type PagePath = { nodeId :: Int ...@@ -221,8 +211,8 @@ type PagePath = { nodeId :: Int
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams} initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
loadPage :: PagePath -> Aff Rows loadPage :: PagePath -> Aff (Either RESTError Rows)
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy }} = do
let let
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
...@@ -235,12 +225,15 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc ...@@ -235,12 +225,15 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc
p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId) p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
--SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType} --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
SearchResult {result} <- post session p query eSearchResult <- post session p query
-- $ SearchQuery {query: concat query, expected: SearchDoc} case eSearchResult of
pure $ case result of Left err -> pure $ Left err
SearchResultDoc {docs} -> Docs {docs: doc2view <$> Seq.fromFoldable docs} Right (SearchResult {result}) ->
SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts} -- $ SearchQuery {query: concat query, expected: SearchDoc}
errMessage -> Docs {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view pure $ Right $ case result of
SearchResultDoc {docs} -> Docs {docs: doc2view <$> Seq.fromFoldable docs}
SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
errMessage -> Docs {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
doc2view :: Document -> DocumentsView doc2view :: Document -> DocumentsView
doc2view ( Document { id doc2view ( Document { id
...@@ -271,7 +264,6 @@ doc2view ( Document { id ...@@ -271,7 +264,6 @@ doc2view ( Document { id
contact2view :: Contact -> ContactsView contact2view :: Contact -> ContactsView
contact2view (Contact { c_id contact2view (Contact { c_id
, c_created: date
, c_hyperdata , c_hyperdata
, c_annuaireId , c_annuaireId
, c_score , c_score
...@@ -283,7 +275,8 @@ contact2view (Contact { c_id ...@@ -283,7 +275,8 @@ contact2view (Contact { c_id
, delete: false , delete: false
} }
err2view message = err2view :: forall a. a -> DocumentsView
err2view _message =
DocumentsView { id: 1 DocumentsView { id: 1
, date: "" , date: ""
, title : "SearchNoResult" , title : "SearchNoResult"
...@@ -312,15 +305,17 @@ type PageProps = ( rowsLoaded :: Rows | PageLayoutProps ) ...@@ -312,15 +305,17 @@ type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
-- | Loads and renders a page -- | Loads and renders a page
pageLayout :: R2.Component PageLayoutProps pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt pageLayoutCpt = here.component "pageLayout" cpt
where where
cpt { container, deletions, frontends, path, session, totalRecords } _ = do cpt { container, deletions, frontends, path, session, totalRecords } _ = do
path' <- T.useLive T.unequal path path' <- T.useLive T.unequal path
useLoader path' loadPage $ \rowsLoaded -> useLoader { errorHandler
page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] , loader: loadPage
, path: path'
, render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] }
errorHandler err = here.log2 "[pageLayout] RESTError" err
page :: R2.Component PageProps page :: R2.Component PageProps
page = R.createElement pageCpt page = R.createElement pageCpt
...@@ -335,12 +330,11 @@ pageCpt = here.component "page" cpt ...@@ -335,12 +330,11 @@ pageCpt = here.component "page" cpt
, rowsLoaded , rowsLoaded
, session , session
, totalRecords } _ = do , totalRecords } _ = do
path'@{ nodeId, listId, query } <- T.useLive T.unequal path path' <- T.useLive T.unequal path
params <- T.useFocused (_.params) (\a b -> b { params = a }) path params <- T.useFocused (_.params) (\a b -> b { params = a }) path
deletions' <- T.useLive T.unequal deletions deletions' <- T.useLive T.unequal deletions
let isChecked id = Set.member id deletions'.pending let isDeleted (DocumentsView {id}) = Set.member id deletions'.deleted
isDeleted (DocumentsView {id}) = Set.member id deletions'.deleted
rows path' = case rowsLoaded of rows path' = case rowsLoaded of
Docs {docs} -> docRow path' <$> Seq.filter (not <<< isDeleted) docs Docs {docs} -> docRow path' <$> Seq.filter (not <<< isDeleted) docs
...@@ -367,17 +361,12 @@ pageCpt = here.component "page" cpt ...@@ -367,17 +361,12 @@ pageCpt = here.component "page" cpt
documentUrl id { listId, nodeId } = documentUrl id { listId, nodeId } =
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
pairUrl (Pair {id,label})
| id > 1 = H.a { href, target: "blank" } [ H.text label ]
where href = url session $ NodePath (sessionId session) NodeContact (Just id)
| otherwise = H.text label
contactRow path' (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs } contactRow path' (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs }
, score, annuaireId, delete , annuaireId, delete
}) = }) =
{ row: { row:
T.makeRow [ H.div {} [ H.a { className: gi Favorite, on: {click: markClick path'} } [] ] T.makeRow [ H.div {} [ H.a { className: gi Favorite, on: {click: markClick path'} } [] ]
, maybeStricken delete [ H.a {target: "_blank", href: contactUrl annuaireId id} , maybeStricken delete [ H.a { target: "_blank", href: contactUrl id }
[ H.text $ firstname <> " " <> lastname ] [ H.text $ firstname <> " " <> lastname ]
] ]
, maybeStricken delete [ H.text labs ] , maybeStricken delete [ H.text labs ]
...@@ -386,9 +375,9 @@ pageCpt = here.component "page" cpt ...@@ -386,9 +375,9 @@ pageCpt = here.component "page" cpt
} }
where where
markClick { nodeId } _ = markCategory session nodeId Favorite [id] markClick { nodeId } _ = markCategory session nodeId Favorite [id]
contactUrl aId id' = url frontends $ Routes.ContactPage (sessionId session) annuaireId id' contactUrl id' = url frontends $ Routes.ContactPage (sessionId session) annuaireId id'
docRow path' dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) = docRow path' dv@(DocumentsView {id, title, source, delete, category}) =
{ row: { row:
T.makeRow [ H.div {} [ H.a { className: gi category, on: {click: markClick path'} } [] ] T.makeRow [ H.div {} [ H.a { className: gi category, on: {click: markClick path'} } [] ]
, maybeStricken delete [ H.text $ publicationDate dv ] , maybeStricken delete [ H.text $ publicationDate dv ]
...@@ -405,7 +394,7 @@ pageCpt = here.component "page" cpt ...@@ -405,7 +394,7 @@ pageCpt = here.component "page" cpt
| otherwise = H.div {} | otherwise = H.div {}
publicationDate :: DocumentsView -> String publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) = publicationDate (DocumentsView { publication_year, publication_month }) =
(zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) (zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month)
-- <> "-" <> (zeroPad 2 publication_day) -- <> "-" <> (zeroPad 2 publication_day)
...@@ -417,7 +406,7 @@ derive instance Generic DeleteDocumentQuery _ ...@@ -417,7 +406,7 @@ derive instance Generic DeleteDocumentQuery _
derive instance Newtype DeleteDocumentQuery _ derive instance Newtype DeleteDocumentQuery _
derive newtype instance JSON.WriteForeign DeleteDocumentQuery derive newtype instance JSON.WriteForeign DeleteDocumentQuery
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int) deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Either RESTError (Array Int))
deleteDocuments session nodeId = deleteDocuments session nodeId =
deleteWithBody session $ NodeAPI Node (Just nodeId) "documents" deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
This diff is collapsed.
module Gargantext.Components.Forest module Gargantext.Components.Forest
( forest ( forest
, forestLayout , forestLayout
, Common
, Props , Props
) where ) where
...@@ -9,60 +8,33 @@ import Gargantext.Prelude ...@@ -9,60 +8,33 @@ import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.AsyncTasks as GAT import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree (treeLoader) import Gargantext.Components.Forest.Tree (treeLoader)
import Gargantext.Ends (Frontends, Backend) import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute) import Gargantext.Sessions (Session(..), unSessions)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions) import Gargantext.Types (switchHanded)
import Gargantext.Types (Handed, switchHanded)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record.Extra as RX
import Toestand as T import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest" here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree -- Shared by components here with Tree
type Common =
( frontends :: Frontends
, handed :: T.Box Handed
, reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, route :: T.Box AppRoute
)
type Props = type Props =
( backend :: T.Box (Maybe Backend) ( boxes :: Boxes
, forestOpen :: T.Box OpenNodes , frontends :: Frontends
, reloadForest :: T2.ReloadS
, sessions :: T.Box Sessions
, showLogin :: T.Box Boolean
, tasks :: T.Box GAT.Storage
| Common
)
type TreeExtra = (
forestOpen :: T.Box OpenNodes
) )
forest :: R2.Component Props forest :: R2.Component Props
forest = R.createElement forestCpt forest = R.createElement forestCpt
forestCpt :: R.Component Props forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where forestCpt = here.component "forest" cpt where
cpt props@{ backend cpt { boxes: boxes@{ handed
, forestOpen , reloadForest
, frontends , sessions }
, handed , frontends } _ = do
, reloadForest
, reloadMainPage
, reloadRoot
, route
, sessions
, showLogin
, tasks } _ = do
-- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor -- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
-- tasks' <- GAT.useTasks reloadRoot reloadForest -- tasks' <- GAT.useTasks reloadRoot reloadForest
-- R.useEffect' $ do -- R.useEffect' $ do
...@@ -76,32 +48,24 @@ forestCpt = here.component "forest" cpt where ...@@ -76,32 +48,24 @@ forestCpt = here.component "forest" cpt where
-- TODO If `reloadForest` is set, `reload` state should be updated -- TODO If `reloadForest` is set, `reload` state should be updated
-- TODO fix tasks ref -- TODO fix tasks ref
pure $ H.div { className: "forest-layout-content" } pure $ H.div { className: "forest-layout-content" }
(A.cons (plus { backend, handed, showLogin }) (trees handed' sessions')) (A.cons (plus { boxes }) (trees handed' sessions'))
where where
common = RX.pick props :: Record Common
trees handed' sessions' = (tree handed') <$> unSessions sessions' trees handed' sessions' = (tree handed') <$> unSessions sessions'
tree handed' s@(Session {treeId}) = tree handed' s@(Session { treeId }) =
treeLoader { forestOpen treeLoader { boxes
, frontends , frontends
, handed: handed' , handed: handed'
, reload: reloadForest , reload: reloadForest
, reloadMainPage
, reloadRoot
, root: treeId , root: treeId
, route , session: s } []
, session: s
, tasks } []
type Plus = type Plus = ( boxes :: Boxes )
( backend :: T.Box (Maybe Backend)
, handed :: T.Box Handed
, showLogin :: T.Box Boolean )
plus :: R2.Leaf Plus plus :: R2.Leaf Plus
plus p = R.createElement plusCpt p [] plus p = R.createElement plusCpt p []
plusCpt :: R.Component Plus plusCpt :: R.Component Plus
plusCpt = here.component "plus" cpt where plusCpt = here.component "plus" cpt where
cpt { backend, handed, showLogin } _ = do cpt { boxes: { backend, handed, showLogin } } _ = do
handed' <- T.useLive T.unequal handed handed' <- T.useLive T.unequal handed
pure $ H.div {} pure $ H.div {}
......
This diff is collapsed.
...@@ -8,18 +8,12 @@ import Data.Symbol (SProxy(..)) ...@@ -8,18 +8,12 @@ import Data.Symbol (SProxy(..))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView) import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..)) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView) import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox) import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeLink) import Gargantext.Components.Forest.Tree.Node.Tools (nodeLink)
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..)) import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
...@@ -31,43 +25,46 @@ import Gargantext.Ends (Frontends) ...@@ -31,43 +25,46 @@ import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (Name, ID, reverseHanded) import Gargantext.Types (ID, Name, reverseHanded)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
import Gargantext.Version as GV import Gargantext.Version as GV
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node" here = R2.here "Gargantext.Components.Forest.Tree.Node"
-- Main Node -- Main Node
type NodeMainSpanProps = type NodeMainSpanProps =
( folderOpen :: T.Box Boolean ( boxes :: Boxes
, frontends :: Frontends , dispatch :: Action -> Aff Unit
, id :: ID , folderOpen :: T.Box Boolean
, isLeaf :: IsLeaf , frontends :: Frontends
, name :: Name , id :: ID
, nodeType :: GT.NodeType , isLeaf :: IsLeaf
, reload :: T2.ReloadS , name :: Name
, reloadMainPage :: T2.ReloadS , nodeType :: GT.NodeType
, reloadRoot :: T2.ReloadS , reload :: T2.ReloadS
, route :: T.Box Routes.AppRoute , session :: Session
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box GAT.Storage
| CommonProps
) )
type IsLeaf = Boolean type IsLeaf = Boolean
nodeSpan :: R2.Component NodeMainSpanProps nodeSpan :: R2.Component NodeMainSpanProps
nodeSpan = R.createElement nodeSpanCpt nodeSpan = R.createElement nodeSpanCpt
nodeSpanCpt :: R.Component NodeMainSpanProps nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = here.component "nodeSpan" cpt nodeSpanCpt = here.component "nodeSpan" cpt
where where
cpt props@{ handed } children = do cpt props@{ boxes: { handed } } children = do
let className = case handed of handed' <- T.useLive T.unequal handed
let className = case handed' of
GT.LeftHanded -> "lefthanded" GT.LeftHanded -> "lefthanded"
GT.RightHanded -> "righthanded" GT.RightHanded -> "righthanded"
...@@ -75,26 +72,26 @@ nodeSpanCpt = here.component "nodeSpan" cpt ...@@ -75,26 +72,26 @@ nodeSpanCpt = here.component "nodeSpan" cpt
nodeMainSpan :: R2.Component NodeMainSpanProps nodeMainSpan :: R2.Component NodeMainSpanProps
nodeMainSpan = R.createElement nodeMainSpanCpt nodeMainSpan = R.createElement nodeMainSpanCpt
nodeMainSpanCpt :: R.Component NodeMainSpanProps nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = here.component "nodeMainSpan" cpt nodeMainSpanCpt = here.component "nodeMainSpan" cpt
where where
cpt props@{ dispatch cpt props@{ boxes: boxes@{ errors
, handed
, reloadMainPage
, reloadRoot
, route
, tasks }
, dispatch
, folderOpen , folderOpen
, frontends , frontends
, handed
, id , id
, isLeaf , isLeaf
, name
, nodeType , nodeType
, reload , reload
, reloadMainPage
, reloadRoot
, route
, session , session
, setPopoverRef , setPopoverRef
, tasks
} _ = do } _ = do
handed' <- T.useLive T.unequal handed
route' <- T.useLive T.unequal route route' <- T.useLive T.unequal route
-- only 1 popup at a time is allowed to be opened -- only 1 popup at a time is allowed to be opened
droppedFile <- T.useBox (Nothing :: Maybe DroppedFile) droppedFile <- T.useBox (Nothing :: Maybe DroppedFile)
...@@ -113,12 +110,12 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -113,12 +110,12 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
-- tasks' <- T.read tasks -- tasks' <- T.read tasks
pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver') pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver')
$ reverseHanded handed $ reverseHanded handed'
[ folderIcon { folderOpen, nodeType } [] [ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } [] , chevronIcon { folderOpen, handed, isLeaf, nodeType } []
, nodeLink { frontends , nodeLink { boxes
, handed
, folderOpen , folderOpen
, frontends
, id , id
, isSelected , isSelected
, name: name' props , name: name' props
...@@ -127,10 +124,11 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -127,10 +124,11 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
, fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType } [] , fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType } []
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie , barType: Pie
, nodeId: id , errors
, onFinish: onTaskFinish id t , nodeId: id
, session } [] , onFinish: onTaskFinish id t
, session } []
) currentTasks' ) currentTasks'
) )
, if nodeType == GT.NodeUser , if nodeType == GT.NodeUser
...@@ -185,9 +183,14 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -185,9 +183,14 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
name' {name: n, nodeType: nt} = if nt == GT.NodeUser then show session else n name' {name: n, nodeType: nt} = if nt == GT.NodeUser then show session else n
mNodePopupView props'@{ id: i, nodeType: nt, handed: h } opc = mNodePopupView props'@{ boxes: b, id: i, nodeType: nt } opc =
nodePopupView { dispatch, handed: h, id: i, name: name' props' nodePopupView { boxes: b
, nodeType: nt, onPopoverClose: opc, session } , dispatch
, id: i
, name: name' props'
, nodeType: nt
, onPopoverClose: opc
, session }
popOverIcon = popOverIcon =
H.a { className: "settings fa fa-cog" H.a { className: "settings fa fa-cog"
...@@ -232,7 +235,6 @@ type FolderIconProps = ( ...@@ -232,7 +235,6 @@ type FolderIconProps = (
folderIcon :: R2.Component FolderIconProps folderIcon :: R2.Component FolderIconProps
folderIcon = R.createElement folderIconCpt folderIcon = R.createElement folderIconCpt
folderIconCpt :: R.Component FolderIconProps folderIconCpt :: R.Component FolderIconProps
folderIconCpt = here.component "folderIcon" cpt folderIconCpt = here.component "folderIcon" cpt
where where
...@@ -243,27 +245,27 @@ folderIconCpt = here.component "folderIcon" cpt ...@@ -243,27 +245,27 @@ folderIconCpt = here.component "folderIcon" cpt
type ChevronIconProps = ( type ChevronIconProps = (
folderOpen :: T.Box Boolean folderOpen :: T.Box Boolean
, handed :: GT.Handed , handed :: T.Box GT.Handed
, isLeaf :: Boolean , isLeaf :: Boolean
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
) )
chevronIcon :: R2.Component ChevronIconProps chevronIcon :: R2.Component ChevronIconProps
chevronIcon = R.createElement chevronIconCpt chevronIcon = R.createElement chevronIconCpt
chevronIconCpt :: R.Component ChevronIconProps chevronIconCpt :: R.Component ChevronIconProps
chevronIconCpt = here.component "chevronIcon" cpt chevronIconCpt = here.component "chevronIcon" cpt
where where
cpt { folderOpen, handed, isLeaf: true, nodeType } _ = do cpt { folderOpen, handed, isLeaf: true, nodeType } _ = do
pure $ H.div {} [] pure $ H.div {} []
cpt { folderOpen, handed, isLeaf: false, nodeType } _ = do cpt { folderOpen, handed, isLeaf: false, nodeType } _ = do
handed' <- T.useLive T.unequal handed
open <- T.useLive T.unequal folderOpen open <- T.useLive T.unequal folderOpen
pure $ H.a { className: "chevron-icon" pure $ H.a { className: "chevron-icon"
, on: { click: \_ -> T.modify_ not folderOpen } , on: { click: \_ -> T.modify_ not folderOpen }
} }
[ H.i { className: if open [ H.i { className: if open
then "fa fa-chevron-down" then "fa fa-chevron-down"
else if handed == GT.RightHanded else if handed' == GT.RightHanded
then "fa fa-chevron-right" then "fa fa-chevron-right"
else "fa fa-chevron-left" else "fa fa-chevron-left"
} [] ] } [] ]
...@@ -305,22 +307,27 @@ nodeActionsCpt = here.component "nodeActions" cpt where ...@@ -305,22 +307,27 @@ nodeActionsCpt = here.component "nodeActions" cpt where
graphNodeActions :: R2.Leaf NodeActionsCommon graphNodeActions :: R2.Leaf NodeActionsCommon
graphNodeActions props = R.createElement graphNodeActionsCpt props [] graphNodeActions props = R.createElement graphNodeActionsCpt props []
graphNodeActionsCpt :: R.Component NodeActionsCommon graphNodeActionsCpt :: R.Component NodeActionsCommon
graphNodeActionsCpt = here.component "graphNodeActions" cpt where graphNodeActionsCpt = here.component "graphNodeActions" cpt where
cpt { id, session, refresh } _ = cpt { id, session, refresh } _ =
useLoader id (graphVersions session) $ \gv -> useLoader { errorHandler
nodeActionsGraph { graphVersions: gv, session, id, refresh } [] , loader: graphVersions session
, path: id
, render: \gv -> nodeActionsGraph { graphVersions: gv, session, id, refresh } [] }
graphVersions session graphId = GraphAPI.graphVersions { graphId, session } graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
errorHandler err = here.log2 "[graphNodeActions] RESTError" err
listNodeActions :: R2.Leaf NodeActionsCommon listNodeActions :: R2.Leaf NodeActionsCommon
listNodeActions props = R.createElement listNodeActionsCpt props [] listNodeActions props = R.createElement listNodeActionsCpt props []
listNodeActionsCpt :: R.Component NodeActionsCommon listNodeActionsCpt :: R.Component NodeActionsCommon
listNodeActionsCpt = here.component "listNodeActions" cpt where listNodeActionsCpt = here.component "listNodeActions" cpt where
cpt { id, session, refresh } _ = cpt { id, session, refresh } _ =
useLoader { nodeId: id, session } loadCorpusWithChild $ \{ corpusId } -> useLoader { errorHandler
nodeActionsNodeList , path: { nodeId: id, session }
{ listId: id, nodeId: corpusId, session, refresh: refresh , loader: loadCorpusWithChild
, nodeType: GT.TabNgramType GT.CTabTerms } , render: \{ corpusId } -> nodeActionsNodeList
{ listId: id, nodeId: corpusId, session, refresh: refresh
, nodeType: GT.TabNgramType GT.CTabTerms } }
where
errorHandler err = here.log2 "[listNodeActions] RESTError" err
module Gargantext.Components.Forest.Tree.Node.Action.Add where module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Gargantext.Prelude
import Data.Array (head, length) import Data.Array (head, length)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, isJust) import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
...@@ -13,6 +16,7 @@ import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), setting ...@@ -13,6 +16,7 @@ import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), setting
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, panel, submitButton) import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, panel, submitButton)
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang(..), translate) import Gargantext.Components.Lang (Lang(..), translate)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), charCodeIcon) import Gargantext.Types (NodeType(..), charCodeIcon)
...@@ -27,22 +31,23 @@ import Web.HTML (window) ...@@ -27,22 +31,23 @@ import Web.HTML (window)
import Web.HTML.Navigator (userAgent) import Web.HTML.Navigator (userAgent)
import Web.HTML.Window (navigator) import Web.HTML.Window (navigator)
import Gargantext.Prelude
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Add" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Add"
addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID) addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Either RESTError (Array GT.ID))
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) "" addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session addNodeAsync :: Session
-> GT.ID -> GT.ID
-> AddNodeValue -> AddNodeValue
-> Aff GT.AsyncTaskWithType -> Aff (Either RESTError GT.AsyncTaskWithType)
addNodeAsync session parentId q = do addNodeAsync session parentId q = do
task <- post session p q eTask :: Either RESTError GT.AsyncTask <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode} case eTask of
where p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode) Left err -> pure $ Left err
Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.AddNode }
where
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- TODO AddNodeParams -- TODO AddNodeParams
......
...@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Contact where ...@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude import Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Formula as F import Formula as F
...@@ -11,6 +12,7 @@ import Toestand as T ...@@ -11,6 +12,7 @@ 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.Action.Contact.Types (AddContactParams(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID) import Gargantext.Types (ID)
...@@ -20,7 +22,7 @@ import Gargantext.Utils.Reactix as R2 ...@@ -20,7 +22,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
contactReq :: Session -> ID -> AddContactParams -> Aff ID contactReq :: Session -> ID -> AddContactParams -> Aff (Either RESTError ID)
contactReq session nodeId = contactReq session nodeId =
post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact" post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact"
...@@ -56,8 +58,8 @@ textInputBox :: R2.Leaf TextInputBoxProps ...@@ -56,8 +58,8 @@ textInputBox :: R2.Leaf TextInputBoxProps
textInputBox props = R.createElement textInputBoxCpt props [] textInputBox props = R.createElement textInputBoxCpt props []
textInputBoxCpt :: R.Component TextInputBoxProps textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where textInputBoxCpt = here.component "textInputBox" cpt where
cpt p@{ boxName, boxAction, dispatch, isOpen cpt { boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ = , params: { firstname, lastname } } _ =
content <$> T.useLive T.unequal isOpen content <$> T.useLive T.unequal isOpen
<*> T.useBox firstname <*> T.useBox lastname <*> T.useBox firstname <*> T.useBox lastname
where where
......
module Gargantext.Components.Forest.Tree.Node.Action.Delete module Gargantext.Components.Forest.Tree.Node.Action.Delete
where where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, delete, put_) import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Types as GT
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
...@@ -21,7 +23,7 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Delete" ...@@ -21,7 +23,7 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Delete"
-- TODO Delete with asyncTaskWithType -- TODO Delete with asyncTaskWithType
deleteNode :: Session -> NodeType -> GT.ID -> Aff GT.ID deleteNode :: Session -> NodeType -> GT.ID -> Aff (Either RESTError GT.ID)
deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) "" deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
{- {-
...@@ -32,7 +34,7 @@ deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) "" ...@@ -32,7 +34,7 @@ deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
-} -}
type ParentID = GT.ID type ParentID = GT.ID
unpublishNode :: Session -> Maybe ParentID -> GT.ID -> Aff GT.ID unpublishNode :: Session -> Maybe ParentID -> GT.ID -> Aff (Either RESTError GT.ID)
unpublishNode s p n = put_ s $ NodeAPI GT.Node p ("unpublish/" <> show n) unpublishNode s p n = put_ s $ NodeAPI GT.Node p ("unpublish/" <> show n)
......
module Gargantext.Components.Forest.Tree.Node.Action.Link where module Gargantext.Components.Forest.Tree.Node.Action.Link where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
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.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Link" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Link"
...@@ -31,11 +31,11 @@ derive newtype instance JSON.ReadForeign LinkNodeReq ...@@ -31,11 +31,11 @@ derive newtype instance JSON.ReadForeign LinkNodeReq
derive newtype instance JSON.WriteForeign LinkNodeReq derive newtype instance JSON.WriteForeign LinkNodeReq
linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff GT.AsyncTaskWithType linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff (Either RESTError GT.AsyncTaskWithType)
linkNodeReq session nt fromId toId = do linkNodeReq session nt fromId toId = do
task <- post session (NodeAPI GT.Node (Just fromId) "update") eTask :: Either RESTError GT.AsyncTask <- post session (NodeAPI GT.Node (Just fromId) "update")
(LinkNodeReq { nodeType: linkNodeType nt, id: toId }) (LinkNodeReq { nodeType: linkNodeType nt, id: toId })
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode } pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UpdateNode }) <$> eTask
linkNodeType :: Maybe GT.NodeType -> GT.NodeType linkNodeType :: Maybe GT.NodeType -> GT.NodeType
linkNodeType (Just GT.Corpus) = GT.Annuaire linkNodeType (Just GT.Corpus) = GT.Annuaire
...@@ -48,7 +48,7 @@ linkNode = R.createElement linkNodeCpt ...@@ -48,7 +48,7 @@ linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt linkNodeCpt = here.component "linkNode" cpt
where where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing}) action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing})
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
...@@ -60,8 +60,8 @@ linkNodeCpt = here.component "linkNode" cpt ...@@ -60,8 +60,8 @@ linkNodeCpt = here.component "linkNode" cpt
pure $ panel [ pure $ panel [
subTreeView { action subTreeView { action
, boxes
, dispatch , dispatch
, handed
, id , id
, nodeType , nodeType
, session , session
......
module Gargantext.Components.Forest.Tree.Node.Action.Merge where module Gargantext.Components.Forest.Tree.Node.Action.Merge where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Set as Set import Data.Set as Set
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -10,16 +13,16 @@ import Toestand as T ...@@ -10,16 +13,16 @@ 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.Tools (submitButton, panel, checkbox, checkboxesListGroup) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel, checkbox, checkboxesListGroup)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Merge" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Merge"
mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID) mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Either RESTError (Array GT.ID))
mergeNodeReq session fromId toId = mergeNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("merge/" <> show toId) put_ session $ NodeAPI GT.Node (Just fromId) ("merge/" <> show toId)
...@@ -28,7 +31,7 @@ mergeNode = R.createElement mergeNodeCpt ...@@ -28,7 +31,7 @@ mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt mergeNodeCpt = here.component "mergeNode" cpt
where where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (MergeNode { params: Nothing }) action <- T.useBox (MergeNode { params: Nothing })
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
...@@ -43,8 +46,8 @@ mergeNodeCpt = here.component "mergeNode" cpt ...@@ -43,8 +46,8 @@ mergeNodeCpt = here.component "mergeNode" cpt
pure $ panel pure $ panel
[ subTreeView { action [ subTreeView { action
, boxes
, dispatch , dispatch
, handed
, id , id
, nodeType , nodeType
, session , session
......
module Gargantext.Components.Forest.Tree.Node.Action.Move where module Gargantext.Components.Forest.Tree.Node.Action.Move where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -19,7 +21,7 @@ import Gargantext.Utils.Reactix as R2 ...@@ -19,7 +21,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Move" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Move"
moveNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID) moveNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Either RESTError (Array GT.ID))
moveNodeReq session fromId toId = moveNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("move/" <> show toId) put_ session $ NodeAPI GT.Node (Just fromId) ("move/" <> show toId)
...@@ -28,7 +30,7 @@ moveNode = R.createElement moveNodeCpt ...@@ -28,7 +30,7 @@ moveNode = R.createElement moveNodeCpt
moveNodeCpt :: R.Component SubTreeParamsIn moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = here.component "moveNode" cpt moveNodeCpt = here.component "moveNode" cpt
where where
cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action :: T.Box Action <- T.useBox (MoveNode {params: Nothing}) action :: T.Box Action <- T.useBox (MoveNode {params: Nothing})
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
...@@ -41,11 +43,11 @@ moveNodeCpt = here.component "moveNode" cpt ...@@ -41,11 +43,11 @@ moveNodeCpt = here.component "moveNode" cpt
pure $ pure $
panel [ subTreeView { action panel [ subTreeView { action
, dispatch , boxes
, handed , dispatch
, id , id
, nodeType , nodeType
, session , session
, subTreeParams , subTreeParams
} [] } []
] button ] button
module Gargantext.Components.Forest.Tree.Node.Action.Rename where module Gargantext.Components.Forest.Tree.Node.Action.Rename where
import Data.Either (Either)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
...@@ -8,14 +10,15 @@ import Simple.JSON as JSON ...@@ -8,14 +10,15 @@ import Simple.JSON as JSON
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Types as GT import Gargantext.Config.REST (RESTError)
import Gargantext.Types (ID)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, put) import Gargantext.Sessions (Session, put)
import Gargantext.Types (ID)
import Gargantext.Types as GT
------------------------------------------------------------------------ ------------------------------------------------------------------------
rename :: Session -> ID -> RenameValue -> Aff (Array ID) rename :: Session -> ID -> RenameValue -> Aff (Either RESTError (Array ID))
rename session renameNodeId = rename session renameNodeId =
put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename" put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename"
......
module Gargantext.Components.Forest.Tree.Node.Action.Search where module Gargantext.Components.Forest.Tree.Node.Action.Search where
import Gargantext.Prelude
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Reactix as R import Gargantext.Components.App.Data (Boxes)
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 (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup) import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar) import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
...@@ -18,13 +15,17 @@ import Gargantext.Sessions (Session) ...@@ -18,13 +15,17 @@ import Gargantext.Sessions (Session)
import Gargantext.Types (ID) import Gargantext.Types (ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search"
type Props = type Props =
( dispatch :: Action -> Aff Unit ( boxes :: Boxes
, dispatch :: Action -> Aff Unit
, id :: Maybe ID , id :: Maybe ID
, nodePopup :: Maybe NodePopup , nodePopup :: Maybe NodePopup
, session :: Session ) , session :: Session )
...@@ -35,12 +36,13 @@ actionSearch = R.createElement actionSearchCpt ...@@ -35,12 +36,13 @@ actionSearch = R.createElement actionSearchCpt
actionSearchCpt :: R.Component Props actionSearchCpt :: R.Component Props
actionSearchCpt = here.component "actionSearch" cpt actionSearchCpt = here.component "actionSearch" cpt
where where
cpt { dispatch, id, nodePopup, session } _ = do cpt { boxes: { errors }, dispatch, id, nodePopup, session } _ = do
search <- T.useBox $ defaultSearch { node_id = id } search <- T.useBox $ defaultSearch { node_id = id }
pure $ R.fragment [ H.p { className: "action-search" } pure $ R.fragment [ H.p { className: "action-search" }
[ H.text $ "Search and create a private " [ H.text $ "Search and create a private "
<> "corpus with the search query as corpus name." ] <> "corpus with the search query as corpus name." ]
, searchBar { langs: allLangs , searchBar { errors
, langs: allLangs
, onSearch: searchOn dispatch nodePopup , onSearch: searchOn dispatch nodePopup
, search , search
, session , session
......
...@@ -3,24 +3,24 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar ...@@ -3,24 +3,24 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar
, searchBar , searchBar
) where ) where
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (searchField) import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (searchField)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..)) import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (Search, allDatabases)
import Gargantext.Components.Lang (Lang) import Gargantext.Components.Lang (Lang)
import Gargantext.Prelude (Unit, pure, ($)) import Gargantext.Prelude (Unit, pure, ($))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar"
type Props = ( langs :: Array Lang type Props = ( errors :: T.Box (Array FrontendError)
, langs :: Array Lang
, onSearch :: GT.AsyncTaskWithType -> Effect Unit , onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: T.Box Search , search :: T.Box Search
, session :: Session , session :: Session
...@@ -28,14 +28,14 @@ type Props = ( langs :: Array Lang ...@@ -28,14 +28,14 @@ type Props = ( langs :: Array Lang
searchBar :: R2.Component Props searchBar :: R2.Component Props
searchBar = R.createElement searchBarCpt searchBar = R.createElement searchBarCpt
searchBarCpt :: R.Component Props searchBarCpt :: R.Component Props
searchBarCpt = here.component "searchBar" cpt searchBarCpt = here.component "searchBar" cpt
where where
cpt { langs, onSearch, search, session } _ = do cpt { errors, langs, onSearch, search, session } _ = do
--onSearchChange session s --onSearchChange session s
pure $ H.div { className: "search-bar" } pure $ H.div { className: "search-bar" }
[ searchField { databases:allDatabases [ searchField { databases: allDatabases
, errors
, langs , langs
, onSearch , onSearch
, search , search
......
module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField where module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField where
import Gargantext.Prelude
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Nullable (null)
import Data.Newtype (over) import Data.Newtype (over)
import Data.Nullable (null)
import Data.Set as Set import Data.Set as Set
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Gargantext.Components.Forest.Tree.Node.Action.Search.Frame (searchIframes)
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, datafield2database, Search) import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, datafield2database, Search)
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang) import Gargantext.Components.Lang (Lang)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Frame (searchIframes) import Gargantext.Types (FrontendError)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField"
...@@ -38,6 +39,7 @@ defaultSearch = { databases: Empty ...@@ -38,6 +39,7 @@ defaultSearch = { databases: Empty
type Props = type Props =
-- list of databases to search, or parsers to use on uploads -- list of databases to search, or parsers to use on uploads
( databases :: Array Database ( databases :: Array Database
, errors :: T.Box (Array FrontendError)
, langs :: Array Lang , langs :: Array Lang
-- State hook for a search, how we get data in and out -- State hook for a search, how we get data in and out
, onSearch :: GT.AsyncTaskWithType -> Effect Unit , onSearch :: GT.AsyncTaskWithType -> Effect Unit
...@@ -47,11 +49,10 @@ type Props = ...@@ -47,11 +49,10 @@ type Props =
searchField :: R2.Component Props searchField :: R2.Component Props
searchField = R.createElement searchFieldCpt searchField = R.createElement searchFieldCpt
searchFieldCpt :: R.Component Props searchFieldCpt :: R.Component Props
searchFieldCpt = here.component "searchField" cpt searchFieldCpt = here.component "searchField" cpt
where where
cpt props@{ onSearch, search } _ = do cpt props@{ errors, onSearch, search, session } _ = do
search' <- T.useLive T.unequal search search' <- T.useLive T.unequal search
iframeRef <- R.useRef null iframeRef <- R.useRef null
let params = let params =
...@@ -86,7 +87,7 @@ searchFieldCpt = here.component "searchField" cpt ...@@ -86,7 +87,7 @@ searchFieldCpt = here.component "searchField" cpt
] ]
] ]
let button = submitButton {onSearch, search, session: props.session} [] let button = submitButton { errors, onSearch, search, session } []
pure $ pure $
...@@ -103,7 +104,6 @@ type ComponentProps = ...@@ -103,7 +104,6 @@ type ComponentProps =
componentIMT :: R2.Component ComponentProps componentIMT :: R2.Component ComponentProps
componentIMT = R.createElement componentIMTCpt componentIMT = R.createElement componentIMTCpt
componentIMTCpt :: R.Component ComponentProps componentIMTCpt :: R.Component ComponentProps
componentIMTCpt = here.component "componentIMT" cpt componentIMTCpt = here.component "componentIMT" cpt
where where
...@@ -242,7 +242,6 @@ type LangNavProps = ...@@ -242,7 +242,6 @@ type LangNavProps =
langNav :: R2.Component LangNavProps langNav :: R2.Component LangNavProps
langNav = R.createElement langNavCpt langNav = R.createElement langNavCpt
langNavCpt :: R.Component LangNavProps langNavCpt :: R.Component LangNavProps
langNavCpt = here.component "langNav" cpt langNavCpt = here.component "langNav" cpt
where where
...@@ -267,7 +266,6 @@ type DataFieldNavProps = ...@@ -267,7 +266,6 @@ type DataFieldNavProps =
dataFieldNav :: R2.Component DataFieldNavProps dataFieldNav :: R2.Component DataFieldNavProps
dataFieldNav = R.createElement dataFieldNavCpt dataFieldNav = R.createElement dataFieldNavCpt
dataFieldNavCpt :: R.Component DataFieldNavProps dataFieldNavCpt :: R.Component DataFieldNavProps
dataFieldNavCpt = here.component "dataFieldNav" cpt dataFieldNavCpt = here.component "dataFieldNav" cpt
where where
...@@ -306,7 +304,6 @@ type DatabaseInputProps = ( ...@@ -306,7 +304,6 @@ type DatabaseInputProps = (
databaseInput :: R2.Component DatabaseInputProps databaseInput :: R2.Component DatabaseInputProps
databaseInput = R.createElement databaseInputCpt databaseInput = R.createElement databaseInputCpt
databaseInputCpt :: R.Component DatabaseInputProps databaseInputCpt :: R.Component DatabaseInputProps
databaseInputCpt = here.component "databaseInput" cpt databaseInputCpt = here.component "databaseInput" cpt
where where
...@@ -347,7 +344,6 @@ type OrgInputProps = ...@@ -347,7 +344,6 @@ type OrgInputProps =
orgInput :: R2.Component OrgInputProps orgInput :: R2.Component OrgInputProps
orgInput = R.createElement orgInputCpt orgInput = R.createElement orgInputCpt
orgInputCpt :: R.Component OrgInputProps orgInputCpt :: R.Component OrgInputProps
orgInputCpt = here.component "orgInput" cpt orgInputCpt = here.component "orgInput" cpt
where where
...@@ -390,7 +386,6 @@ type SearchInputProps = ...@@ -390,7 +386,6 @@ type SearchInputProps =
searchInput :: R2.Component SearchInputProps searchInput :: R2.Component SearchInputProps
searchInput = R.createElement searchInputCpt searchInput = R.createElement searchInputCpt
searchInputCpt :: R.Component SearchInputProps searchInputCpt :: R.Component SearchInputProps
searchInputCpt = here.component "searchInput" cpt searchInputCpt = here.component "searchInput" cpt
where where
...@@ -429,39 +424,40 @@ searchInputCpt = here.component "searchInput" cpt ...@@ -429,39 +424,40 @@ searchInputCpt = here.component "searchInput" cpt
-- setSearch $ _ { term = value } -- setSearch $ _ { term = value }
type SubmitButtonProps = type SubmitButtonProps =
( onSearch :: GT.AsyncTaskWithType -> Effect Unit ( errors :: T.Box (Array FrontendError)
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: T.Box Search , search :: T.Box Search
, session :: Session , session :: Session
) )
submitButton :: R2.Component SubmitButtonProps submitButton :: R2.Component SubmitButtonProps
submitButton = R.createElement submitButtonComponent submitButton = R.createElement submitButtonComponent
submitButtonComponent :: R.Component SubmitButtonProps submitButtonComponent :: R.Component SubmitButtonProps
submitButtonComponent = here.component "submitButton" cpt submitButtonComponent = here.component "submitButton" cpt
where where
cpt { onSearch, search, session } _ = do cpt { errors, onSearch, search, session } _ = do
search' <- T.useLive T.unequal search search' <- T.useLive T.unequal search
pure $ pure $
H.button { className: "btn btn-primary" H.button { className: "btn btn-primary"
, "type" : "button" , "type" : "button"
, on : { click: doSearch onSearch session search' } , on : { click: doSearch onSearch errors session search' }
, style : { width: "100%" } , style : { width: "100%" }
} [ H.text "Launch Search" ] } [ H.text "Launch Search" ]
doSearch os s q = \_ -> do doSearch os errors s q = \_ -> do
log2 "[submitButton] searching" q log2 "[submitButton] searching" q
triggerSearch os s q triggerSearch os errors s q
--case search.term of --case search.term of
-- "" -> setSearch $ const defaultSearch -- "" -> setSearch $ const defaultSearch
-- _ -> setSearch $ const q -- _ -> setSearch $ const q
triggerSearch :: (GT.AsyncTaskWithType -> Effect Unit) triggerSearch :: (GT.AsyncTaskWithType -> Effect Unit)
-> T.Box (Array FrontendError)
-> Session -> Session
-> Search -> Search
-> Effect Unit -> Effect Unit
triggerSearch os s q = triggerSearch os errors s q =
launchAff_ $ do launchAff_ $ do
liftEffect $ do liftEffect $ do
let here' = "[triggerSearch] Searching " let here' = "[triggerSearch] Searching "
...@@ -473,8 +469,8 @@ triggerSearch os s q = ...@@ -473,8 +469,8 @@ triggerSearch os s q =
case q.node_id of case q.node_id of
Nothing -> liftEffect $ log "[triggerSearch] node_id is Nothing, don't know what to do" Nothing -> liftEffect $ log "[triggerSearch] node_id is Nothing, don't know what to do"
Just id -> do Just id -> do
task <- performSearch s id $ searchQuery q eTask <- performSearch s id $ searchQuery q
liftEffect $ do handleRESTError errors eTask $ \task -> liftEffect $ do
log2 "[triggerSearch] task" task log2 "[triggerSearch] task" task
os task os task
......
module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Data.Array (concat) import Data.Array (concat)
import Data.Either (Either)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
...@@ -11,13 +12,14 @@ import Data.Tuple (Tuple) ...@@ -11,13 +12,14 @@ import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Simple.JSON as JSON import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
import URI.Query as Q import URI.Query as Q
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Lang import Gargantext.Components.Lang (Lang)
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (class ToUrl, backendUrl) import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post) import Gargantext.Sessions (Session(..), post)
...@@ -359,16 +361,16 @@ instance GT.ToQuery SearchQuery where ...@@ -359,16 +361,16 @@ instance GT.ToQuery SearchQuery where
pair k = maybe [] $ \v -> pair k = maybe [] $ \v ->
[ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ] [ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ]
instance JSON.WriteForeign SearchQuery where instance JSON.WriteForeign SearchQuery where
writeImpl (SearchQuery { datafield, databases, lang, node_id, query }) = writeImpl (SearchQuery { databases, lang, node_id, query }) =
JSON.writeImpl { query: String.replace (String.Pattern "\"") (String.Replacement "\\\"") query JSON.writeImpl { query: String.replace (String.Pattern "\"") (String.Replacement "\\\"") query
, databases: databases , databases: databases
, lang: maybe "EN" show lang , lang: maybe "EN" show lang
, node_id: fromMaybe 0 node_id , node_id: fromMaybe 0 node_id
} }
performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType performSearch :: Session -> Int -> SearchQuery -> Aff (Either RESTError GT.AsyncTaskWithType)
performSearch session nodeId q = do performSearch session nodeId q = do
task <- post session p q eTask :: Either RESTError GT.AsyncTask <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.Query} pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Query }) <$> eTask
where where
p = GR.NodeAPI GT.Corpus (Just nodeId) $ GT.asyncTaskTypePath GT.Query p = GR.NodeAPI GT.Corpus (Just nodeId) $ GT.asyncTaskTypePath GT.Query
module Gargantext.Components.Forest.Tree.Node.Action.Share where module Gargantext.Components.Forest.Tree.Node.Action.Share where
import Data.Either (Either)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -16,7 +17,7 @@ import Gargantext.Components.Forest.Tree.Node.Action (Action) ...@@ -16,7 +17,7 @@ import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Components.Forest.Tree.Node.Tools as Tools import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude (class Eq, class Show, bind, pure, Unit) import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID) import Gargantext.Types (ID)
...@@ -27,7 +28,7 @@ here :: R2.Here ...@@ -27,7 +28,7 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Share" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Share"
------------------------------------------------------------------------ ------------------------------------------------------------------------
shareReq :: Session -> ID -> ShareNodeParams -> Aff ID shareReq :: Session -> ID -> ShareNodeParams -> Aff (Either RESTError ID)
shareReq session nodeId = shareReq session nodeId =
post session $ GR.NodeAPI GT.Node (Just nodeId) "share" post session $ GR.NodeAPI GT.Node (Just nodeId) "share"
...@@ -70,7 +71,7 @@ publishNode = R.createElement publishNodeCpt ...@@ -70,7 +71,7 @@ publishNode = R.createElement publishNodeCpt
publishNodeCpt :: R.Component SubTreeParamsIn publishNodeCpt :: R.Component SubTreeParamsIn
publishNodeCpt = here.component "publishNode" cpt publishNodeCpt = here.component "publishNode" cpt
where where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (Action.SharePublic { params: Nothing }) action <- T.useBox (Action.SharePublic { params: Nothing })
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
...@@ -82,8 +83,8 @@ publishNodeCpt = here.component "publishNode" cpt ...@@ -82,8 +83,8 @@ publishNodeCpt = here.component "publishNode" cpt
pure $ Tools.panel pure $ Tools.panel
[ subTreeView { action [ subTreeView { action
, boxes
, dispatch , dispatch
, handed
, id , id
, nodeType , nodeType
, session , session
......
module Gargantext.Components.Forest.Tree.Node.Action.Update where module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types import Data.Either (Either(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
...@@ -11,7 +10,9 @@ import Toestand as T ...@@ -11,7 +10,9 @@ import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), ID) import Gargantext.Types (NodeType(..), ID)
...@@ -21,10 +22,12 @@ import Gargantext.Utils.Reactix as R2 ...@@ -21,10 +22,12 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update"
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType updateRequest :: UpdateNodeParams -> Session -> ID -> Aff (Either RESTError GT.AsyncTaskWithType)
updateRequest updateNodeParams session nodeId = do updateRequest updateNodeParams session nodeId = do
task <- post session p updateNodeParams eTask :: Either RESTError GT.AsyncTask <- post session p updateNodeParams
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode } case eTask of
Left err -> pure $ Left err
Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.UpdateNode }
where where
p = GR.NodeAPI GT.Node (Just nodeId) "update" p = GR.NodeAPI GT.Node (Just nodeId) "update"
...@@ -37,11 +40,11 @@ update :: R2.Component UpdateProps ...@@ -37,11 +40,11 @@ update :: R2.Component UpdateProps
update = R.createElement updateCpt update = R.createElement updateCpt
updateCpt :: R.Component UpdateProps updateCpt :: R.Component UpdateProps
updateCpt = here.component "update" cpt where updateCpt = here.component "update" cpt where
cpt props@{ dispatch, nodeType: Dashboard } _ = pure $ updateDashboard props [] cpt props@{ nodeType: Dashboard } _ = pure $ updateDashboard props []
cpt props@{ dispatch, nodeType: Graph } _ = pure $ updateGraph props [] cpt props@{ nodeType: Graph } _ = pure $ updateGraph props []
cpt props@{ dispatch, nodeType: NodeList } _ = pure $ updateNodeList props [] cpt props@{ nodeType: NodeList } _ = pure $ updateNodeList props []
cpt props@{ dispatch, nodeType: Texts } _ = pure $ updateTexts props [] cpt props@{ nodeType: Texts } _ = pure $ updateTexts props []
cpt props@{ dispatch, nodeType: _ } _ = pure $ updateOther props [] cpt props@{ nodeType: _ } _ = pure $ updateOther props []
updateDashboard :: R2.Component UpdateProps updateDashboard :: R2.Component UpdateProps
updateDashboard = R.createElement updateDashboardCpt updateDashboard = R.createElement updateDashboardCpt
...@@ -99,7 +102,7 @@ updateOther :: R2.Component UpdateProps ...@@ -99,7 +102,7 @@ updateOther :: R2.Component UpdateProps
updateOther = R.createElement updateOtherCpt updateOther = R.createElement updateOtherCpt
updateOtherCpt :: R.Component UpdateProps updateOtherCpt :: R.Component UpdateProps
updateOtherCpt = here.component "updateOther" cpt where updateOtherCpt = here.component "updateOther" cpt where
cpt { dispatch } _ = do cpt _ _ = do
pure $ H.div {} [] pure $ H.div {} []
-- fragmentPT $ "Update " <> show nodeType -- fragmentPT $ "Update " <> show nodeType
...@@ -9,6 +9,7 @@ import Reactix as R ...@@ -9,6 +9,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action) import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView) import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
...@@ -28,7 +29,7 @@ import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), Settings ...@@ -28,7 +29,7 @@ import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), Settings
import Gargantext.Components.Forest.Tree.Node.Status (Status(..), hasStatus) import Gargantext.Components.Forest.Tree.Node.Status (Status(..), hasStatus)
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, textInputBox) import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, textInputBox)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (Name, ID, prettyNodeType) import Gargantext.Types (FrontendError, ID, Name, prettyNodeType)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Glyphicon (glyphicon, glyphiconActive) import Gargantext.Utils.Glyphicon (glyphicon, glyphiconActive)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -36,11 +37,12 @@ import Gargantext.Utils.Reactix as R2 ...@@ -36,11 +37,12 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Box" here = R2.here "Gargantext.Components.Forest.Tree.Node.Box"
type CommonProps = ( dispatch :: Action -> Aff Unit, session :: Session ) type CommonProps =
( dispatch :: Action -> Aff Unit
, session :: Session )
nodePopupView :: Record NodePopupProps -> R.Element nodePopupView :: Record NodePopupProps -> R.Element
nodePopupView p = R.createElement nodePopupCpt p [] nodePopupView p = R.createElement nodePopupCpt p []
nodePopupCpt :: R.Component NodePopupProps nodePopupCpt :: R.Component NodePopupProps
nodePopupCpt = here.component "nodePopupView" cpt where nodePopupCpt = here.component "nodePopupView" cpt where
cpt p@{ id, name, nodeType } _ = do cpt p@{ id, name, nodeType } _ = do
...@@ -102,9 +104,16 @@ nodePopupCpt = here.component "nodePopupView" cpt where ...@@ -102,9 +104,16 @@ nodePopupCpt = here.component "nodePopupView" cpt where
else [] else []
mPanelAction :: Record NodePopupS -> Record NodePopupProps -> R.Element mPanelAction :: Record NodePopupS -> Record NodePopupProps -> R.Element
mPanelAction { action: Just action } mPanelAction { action: Just action }
{ dispatch, id, name, nodeType, session, handed } = { boxes, dispatch, id, name, nodeType, session } =
panelAction { action, dispatch, id, name, nodeType, session panelAction { action
, handed, nodePopup: Just NodePopup } , boxes
, dispatch
, id
, name
, nodePopup: Just NodePopup
, nodeType
, session
}
mPanelAction { action: Nothing } _ = mPanelAction { action: Nothing } _ =
H.div { className: "card-footer" } H.div { className: "card-footer" }
[ H.div {className:"center fa-hand-pointer-o"} [ H.div {className:"center fa-hand-pointer-o"}
...@@ -160,42 +169,41 @@ type NodeProps = ...@@ -160,42 +169,41 @@ type NodeProps =
type PanelActionProps = type PanelActionProps =
( id :: ID ( action :: NodeAction
, action :: NodeAction , boxes :: Boxes
, id :: ID
, dispatch :: Action -> Aff Unit , dispatch :: Action -> Aff Unit
, name :: Name , name :: Name
, nodePopup :: Maybe NodePopup , nodePopup :: Maybe NodePopup
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, session :: Session , session :: Session
, handed :: GT.Handed
) )
panelAction :: Record PanelActionProps -> R.Element panelAction :: R2.Leaf PanelActionProps
panelAction p = R.createElement panelActionCpt p [] panelAction p = R.createElement panelActionCpt p []
panelActionCpt :: R.Component PanelActionProps panelActionCpt :: R.Component PanelActionProps
panelActionCpt = here.component "panelAction" cpt panelActionCpt = here.component "panelAction" cpt
where where
cpt {action: Documentation nodeType} _ = pure $ actionDoc { nodeType } [] cpt { action: Documentation nodeType } _ = pure $ actionDoc { nodeType } []
cpt {action: Download, id, nodeType, session} _ = pure $ actionDownload { id, nodeType, session } [] 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: Upload, dispatch, id, nodeType, session } _ = pure $ actionUpload { dispatch, id, nodeType, session } []
cpt {action: Delete, nodeType, dispatch} _ = pure $ actionDelete { dispatch, nodeType } [] cpt { action: Delete, dispatch, nodeType } _ = pure $ actionDelete { dispatch, nodeType } []
cpt {action: Add xs, dispatch, id, name, nodeType} _ = cpt { action: Add xs, dispatch, id, name, nodeType } _ =
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} [] pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs } []
cpt {action: Refresh , dispatch, id, nodeType, session} _ = pure $ update { dispatch, nodeType } [] cpt { action: Refresh , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
cpt {action: Config , dispatch, id, nodeType, session} _ = cpt { action: Config, nodeType } _ =
pure $ fragmentPT $ "Config " <> show nodeType pure $ fragmentPT $ "Config " <> show nodeType
-- Functions using SubTree -- Functions using SubTree
cpt {action: Merge {subTreeParams}, dispatch, id, nodeType, session, handed} _ = cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ mergeNode {dispatch, id, nodeType, session, subTreeParams, handed} [] pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action: Move {subTreeParams}, dispatch, id, nodeType, session, handed} _ = cpt { action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ moveNode { dispatch, id, nodeType, session, subTreeParams, handed } [] pure $ moveNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action: Link {subTreeParams}, dispatch, id, nodeType, session, handed} _ = cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed} [] pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action : Share, dispatch, id, name } _ = pure $ Share.shareNode { dispatch, id } [] cpt { action : Share, dispatch, id } _ = pure $ Share.shareNode { dispatch, id } []
cpt {action : AddingContact, dispatch, id, name } _ = pure $ Contact.actionAddContact { dispatch, id } [] cpt { action : AddingContact, dispatch, id } _ = pure $ Contact.actionAddContact { dispatch, id } []
cpt {action : Publish {subTreeParams}, dispatch, id, nodeType, session, handed} _ = cpt { action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ Share.publishNode { dispatch, handed, id, nodeType, session, subTreeParams } [] pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt props@{action: SearchBox, id, session, dispatch, nodePopup} _ = cpt { action: SearchBox, boxes, dispatch, id, nodePopup, session } _ =
pure $ actionSearch { dispatch, id: (Just id), nodePopup, session } [] pure $ actionSearch { boxes, dispatch, id: (Just id), nodePopup, session } []
cpt _ _ = pure $ H.div {} [] cpt _ _ = pure $ H.div {} []
...@@ -4,8 +4,9 @@ import DOM.Simple as DOM ...@@ -4,8 +4,9 @@ import DOM.Simple as DOM
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction) import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action) import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction)
import Gargantext.Prelude (Unit) import Gargantext.Prelude (Unit)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (ID, Name) import Gargantext.Types (ID, Name)
...@@ -14,11 +15,11 @@ import Gargantext.Types as GT ...@@ -14,11 +15,11 @@ import Gargantext.Types as GT
type CommonProps = type CommonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, session :: Session , session :: Session
, handed :: GT.Handed
) )
type NodePopupProps = type NodePopupProps =
( id :: ID ( boxes :: Boxes
, id :: ID
, name :: Name , name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, onPopoverClose :: DOM.Element -> Effect Unit , onPopoverClose :: DOM.Element -> Effect Unit
......
module Gargantext.Components.Forest.Tree.Node.Tools where module Gargantext.Components.Forest.Tree.Node.Tools where
import Gargantext.Prelude
( class Ord, class Read, class Show, Unit
, bind, const, discard, map, not, pure, read, show, when, mempty
, ($), (<), (<<<), (<>), (<$>), (<*>) )
import Data.Maybe (fromMaybe, Maybe(..)) import Data.Maybe (fromMaybe, Maybe(..))
import Data.Nullable (null) import Data.Nullable (null)
import Data.Set (Set) import Data.Set (Set)
...@@ -12,19 +8,20 @@ import Data.String as S ...@@ -12,19 +8,20 @@ import Data.String as S
import Data.String.CodeUnits as DSCU import Data.String.CodeUnits as DSCU
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_) import Effect.Aff (Aff, launchAff, launchAff_)
import Reactix as R import Gargantext.Components.App.Data (Boxes)
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action, icon, text) import Gargantext.Components.Forest.Tree.Node.Action (Action, icon, text)
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Prelude (class Ord, class Read, class Show, Unit, bind, const, discard, map, not, pure, read, show, when, mempty, ($), (<), (<<<), (<>), (<$>), (<*>))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils (toggleSet) import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Glyphicon (glyphicon) import Gargantext.Utils.Glyphicon (glyphicon)
import Gargantext.Utils.ReactTooltip as ReactTooltip import Gargantext.Utils.ReactTooltip as ReactTooltip
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools" here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
...@@ -58,7 +55,6 @@ type TextInputBoxProps = ...@@ -58,7 +55,6 @@ type TextInputBoxProps =
textInputBox :: R2.Component TextInputBoxProps textInputBox :: R2.Component TextInputBoxProps
textInputBox = R.createElement textInputBoxCpt textInputBox = R.createElement textInputBoxCpt
textInputBoxCpt :: R.Component TextInputBoxProps textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where textInputBoxCpt = here.component "textInputBox" cpt where
cpt { boxAction, boxName, dispatch, id, isOpen, text } _ = cpt { boxAction, boxName, dispatch, id, isOpen, text } _ =
...@@ -258,9 +254,9 @@ tooltipId id = "node-link-" <> show id ...@@ -258,9 +254,9 @@ tooltipId id = "node-link-" <> show id
-- START node link -- START node link
type NodeLinkProps = ( type NodeLinkProps = (
frontends :: Frontends boxes :: Boxes
, folderOpen :: T.Box Boolean , folderOpen :: T.Box Boolean
, handed :: GT.Handed , frontends :: Frontends
, id :: Int , id :: Int
, isSelected :: Boolean , isSelected :: Boolean
, name :: GT.Name , name :: GT.Name
...@@ -270,13 +266,12 @@ type NodeLinkProps = ( ...@@ -270,13 +266,12 @@ type NodeLinkProps = (
nodeLink :: R2.Component NodeLinkProps nodeLink :: R2.Component NodeLinkProps
nodeLink = R.createElement nodeLinkCpt nodeLink = R.createElement nodeLinkCpt
nodeLinkCpt :: R.Component NodeLinkProps nodeLinkCpt :: R.Component NodeLinkProps
nodeLinkCpt = here.component "nodeLink" cpt nodeLinkCpt = here.component "nodeLink" cpt
where where
cpt { folderOpen cpt { boxes: { handed }
, folderOpen
, frontends , frontends
, handed
, id , id
, isSelected , isSelected
, name , name
...@@ -310,23 +305,23 @@ nodeLinkCpt = here.component "nodeLink" cpt ...@@ -310,23 +305,23 @@ nodeLinkCpt = here.component "nodeLink" cpt
type NodeTextProps = type NodeTextProps =
( isSelected :: Boolean ( isSelected :: Boolean
, handed :: GT.Handed , handed :: T.Box GT.Handed
, name :: GT.Name , name :: GT.Name
) )
nodeText :: R2.Component NodeTextProps nodeText :: R2.Component NodeTextProps
nodeText = R.createElement nodeTextCpt nodeText = R.createElement nodeTextCpt
nodeTextCpt :: R.Component NodeTextProps nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = here.component "nodeText" cpt where nodeTextCpt = here.component "nodeText" cpt where
cpt { isSelected, handed, name } _ = cpt { isSelected, handed, name } _ = do
handed' <- T.useLive T.unequal handed
pure $ if isSelected then pure $ if isSelected then
H.u { className } H.u { className }
[ H.b {} [ H.b {}
[ H.text ("| " <> name15 name <> " | ") ] [ H.text ("| " <> name15 name <> " | ") ]
] ]
else else
GT.flipHanded l r handed where GT.flipHanded l r handed' where
l = H.text "..." l = H.text "..."
r = H.text (name15 name) r = H.text (name15 name)
name_ len n = name_ len n =
......
module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Int (fromNumber) import Data.Int (fromNumber)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Timer (clearInterval, setInterval) import Effect.Timer (clearInterval, setInterval)
import Reactix as R import Gargantext.Config.REST (RESTError)
import Reactix.DOM.HTML as H import Gargantext.Config.Utils (handleRESTError)
import Toestand as T
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (FrontendError)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar" here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar"
...@@ -26,6 +29,7 @@ data BarType = Bar | Pie ...@@ -26,6 +29,7 @@ data BarType = Bar | Pie
type Props = ( type Props = (
asyncTask :: GT.AsyncTaskWithType asyncTask :: GT.AsyncTaskWithType
, barType :: BarType , barType :: BarType
, errors :: T.Box (Array FrontendError)
, nodeId :: GT.ID , nodeId :: GT.ID
, onFinish :: Unit -> Effect Unit , onFinish :: Unit -> Effect Unit
, session :: Session , session :: Session
...@@ -34,13 +38,12 @@ type Props = ( ...@@ -34,13 +38,12 @@ type Props = (
asyncProgressBar :: R2.Component Props asyncProgressBar :: R2.Component Props
asyncProgressBar = R.createElement asyncProgressBarCpt asyncProgressBar = R.createElement asyncProgressBarCpt
asyncProgressBarCpt :: R.Component Props asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = here.component "asyncProgressBar" cpt asyncProgressBarCpt = here.component "asyncProgressBar" cpt
where where
cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}) cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
, barType , barType
, nodeId , errors
, onFinish , onFinish
} _ = do } _ = do
progress <- T.useBox 0.0 progress <- T.useBox 0.0
...@@ -49,8 +52,9 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt ...@@ -49,8 +52,9 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
R.useEffectOnce' $ do R.useEffectOnce' $ do
intervalId <- setInterval 1000 $ do intervalId <- setInterval 1000 $ do
launchAff_ $ do launchAff_ $ do
asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props eAsyncProgress <- queryProgress props
liftEffect do handleRESTError errors eAsyncProgress $ \asyncProgress -> liftEffect $ do
let GT.AsyncProgress { status } = asyncProgress
T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
_ <- case R.readRef intervalIdRef of _ <- case R.readRef intervalIdRef of
...@@ -104,7 +108,7 @@ progressIndicatorCpt = here.component "progressIndicator" cpt ...@@ -104,7 +108,7 @@ progressIndicatorCpt = here.component "progressIndicator" cpt
Nothing -> 0 Nothing -> 0
Just x -> x Just x -> x
queryProgress :: Record Props -> Aff GT.AsyncProgress queryProgress :: Record Props -> Aff (Either RESTError GT.AsyncProgress)
queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id} queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
, typ , typ
} }
......
module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where
import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Either (Either)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import React.SyntheticEvent as E import Gargantext.Components.App.Data (Boxes)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action, subTreeOut, setTreeOut) import Gargantext.Components.Forest.Tree.Node.Action (Props, Action, subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText) import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), get) import Gargantext.Sessions (Session(..), get)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree" here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree"
type SubTreeParamsIn = type SubTreeParamsIn =
( handed :: GT.Handed ( boxes :: Boxes
, subTreeParams :: SubTreeParams , subTreeParams :: SubTreeParams
| Props | Props
) )
...@@ -42,37 +43,41 @@ subTreeView = R.createElement subTreeViewCpt ...@@ -42,37 +43,41 @@ subTreeView = R.createElement subTreeViewCpt
subTreeViewCpt :: R.Component SubTreeParamsProps subTreeViewCpt :: R.Component SubTreeParamsProps
subTreeViewCpt = here.component "subTreeView" cpt subTreeViewCpt = here.component "subTreeView" cpt
where where
cpt params@{ action cpt { action
, dispatch , boxes
, handed , dispatch
, id , id
, nodeType , nodeType
, session , session
, subTreeParams , subTreeParams
} _ = do } _ = do
let let
SubTreeParams {showtypes} = subTreeParams SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action -- (valAction /\ setAction) = action
-- _ <- pure $ setAction (const $ setTreeOut valAction Nothing) -- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
useLoader session (loadSubTree showtypes) $ useLoader { errorHandler
\tree -> , loader: loadSubTree showtypes
subTreeViewLoaded { action , path: session
, dispatch , render: \tree ->
, handed subTreeViewLoaded { action
, id , boxes
, nodeType , dispatch
, session , id
, subTreeParams , nodeType
, tree , session
} [] , subTreeParams
, tree
loadSubTree :: Array GT.NodeType -> Session -> Aff FTree } [] }
where
errorHandler err = here.log2 "RESTError" err
loadSubTree :: Array GT.NodeType -> Session -> Aff (Either RESTError FTree)
loadSubTree nodetypes session = getSubTree session treeId nodetypes loadSubTree nodetypes session = getSubTree session treeId nodetypes
where where
Session { treeId } = session Session { treeId } = session
getSubTree :: Session -> Int -> Array GT.NodeType -> Aff FTree getSubTree :: Session -> Int -> Array GT.NodeType -> Aff (Either RESTError FTree)
getSubTree session treeId showtypes = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes getSubTree session treeId showtypes = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
where where
nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" showtypes nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" showtypes
...@@ -88,11 +93,12 @@ subTreeViewLoaded = R.createElement subTreeViewLoadedCpt ...@@ -88,11 +93,12 @@ subTreeViewLoaded = R.createElement subTreeViewLoadedCpt
subTreeViewLoadedCpt :: R.Component CorpusTreeProps subTreeViewLoadedCpt :: R.Component CorpusTreeProps
subTreeViewLoadedCpt = here.component "subTreeViewLoaded" cpt subTreeViewLoadedCpt = here.component "subTreeViewLoaded" cpt
where where
cpt p@{ dispatch, handed, id, nodeType, session, tree } _ = do cpt p@{ boxes: { handed } } _ = do
handed' <- T.useLive T.unequal handed
let pRender = Record.merge { render: subTreeTreeView } p let pRender = Record.merge { render: subTreeTreeView } p
pure $ H.div {className:"tree"} pure $ H.div {className:"tree"}
[ H.div { className: if handed == GT.RightHanded [ H.div { className: if handed' == GT.RightHanded
then "righthanded" then "righthanded"
else "lefthanded" else "lefthanded"
} }
...@@ -108,13 +114,13 @@ subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt ...@@ -108,13 +114,13 @@ subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt
subTreeTreeViewCpt :: R2.NTComponent CorpusTreeRenderProps subTreeTreeViewCpt :: R2.NTComponent CorpusTreeRenderProps
subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
cpt (CorpusTreeRenderProps p@{ action cpt (CorpusTreeRenderProps p@{ action
, dispatch , boxes: { handed }
, handed
, id , id
, render , render
, subTreeParams , subTreeParams
, tree: NTree (LNode { id: targetId, name, nodeType }) ary }) _ = do , tree: NTree (LNode { id: targetId, name, nodeType }) ary }) _ = do
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
handed' <- T.useLive T.unequal handed
let click e = do let click e = do
let action'' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId } let action'' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
...@@ -124,7 +130,7 @@ subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where ...@@ -124,7 +130,7 @@ subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
children = (map (\ctree -> render (CorpusTreeRenderProps (p { tree = ctree })) []) sortedAry) :: Array R.Element children = (map (\ctree -> render (CorpusTreeRenderProps (p { tree = ctree })) []) sortedAry) :: Array R.Element
pure $ H.div {} $ GT.reverseHanded handed pure $ H.div {} $ GT.reverseHanded handed'
[ H.div { className: nodeClass validNodeType } [ H.div { className: nodeClass validNodeType }
[ H.span { className: "text" [ H.span { className: "text"
, on: { click } } , on: { click } }
...@@ -142,7 +148,6 @@ subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where ...@@ -142,7 +148,6 @@ subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id') sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id')
$ A.filter (\(NTree (LNode {id:id'}) _) -> id'/= id) ary $ A.filter (\(NTree (LNode {id:id'}) _) -> id'/= id) ary
validNodeType = (A.elem nodeType valitypes) && (id /= targetId) validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
clickable = if validNodeType then "clickable" else ""
isSelected n action' = case (subTreeOut action') of isSelected n action' = case (subTreeOut action') of
Nothing -> false Nothing -> false
(Just (SubTreeOut {out})) -> n == out (Just (SubTreeOut {out})) -> n == out
module Gargantext.Components.GraphExplorer where module Gargantext.Components.GraphExplorer where
import Gargantext.Prelude hiding (max, min)
import Data.Array as A import Data.Array as A
import Data.Either (Either)
import Data.FoldableWithIndex (foldMapWithIndex) import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Map as Map import Data.Map as Map
...@@ -19,13 +22,12 @@ import Record as Record ...@@ -19,13 +22,12 @@ import Record as Record
import Record.Extra as RX import Record.Extra as RX
import Toestand as T import Toestand as T
import Gargantext.Prelude hiding (max,min)
import Gargantext.Components.App.Data (Boxes) import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Louvain as Louvain import Gargantext.Data.Louvain as Louvain
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
...@@ -67,8 +69,12 @@ explorerLayoutCpt = here.component "explorerLayout" cpt where ...@@ -67,8 +69,12 @@ explorerLayoutCpt = here.component "explorerLayout" cpt where
cpt props@{ boxes: { graphVersion }, graphId, session } _ = do cpt props@{ boxes: { graphVersion }, graphId, session } _ = do
graphVersion' <- T.useLive T.unequal graphVersion graphVersion' <- T.useLive T.unequal graphVersion
useLoader graphId (getNodes session graphVersion') handler useLoader { errorHandler
, loader: getNodes session graphVersion'
, path: graphId
, render: handler }
where where
errorHandler err = here.log2 "[explorerLayout] RESTError" err
handler loaded@(GET.HyperdataGraph { graph: hyperdataGraph }) = handler loaded@(GET.HyperdataGraph { graph: hyperdataGraph }) =
explorerWriteGraph (Record.merge props { graph, hyperdataGraph: loaded, mMetaData' }) [] explorerWriteGraph (Record.merge props { graph, hyperdataGraph: loaded, mMetaData' }) []
where where
...@@ -105,7 +111,7 @@ explorerCpt = here.component "explorer" cpt ...@@ -105,7 +111,7 @@ explorerCpt = here.component "explorer" cpt
, session , session
} _ = do } _ = do
{ mMetaData } <- GEST.focusedSidePanel sidePanelGraph { mMetaData } <- GEST.focusedSidePanel sidePanelGraph
graphVersion' <- T.useLive T.unequal graphVersion _graphVersion' <- T.useLive T.unequal graphVersion
handed' <- T.useLive T.unequal handed handed' <- T.useLive T.unequal handed
mMetaData' <- T.useLive T.unequal mMetaData mMetaData' <- T.useLive T.unequal mMetaData
...@@ -115,7 +121,7 @@ explorerCpt = here.component "explorer" cpt ...@@ -115,7 +121,7 @@ explorerCpt = here.component "explorer" cpt
then SigmaxT.InitialRunning then SigmaxT.InitialRunning
else SigmaxT.InitialStopped else SigmaxT.InitialStopped
dataRef <- R.useRef graph _dataRef <- R.useRef graph
graphRef <- R.useRef null graphRef <- R.useRef null
controls <- Controls.useGraphControls { forceAtlasS controls <- Controls.useGraphControls { forceAtlasS
, graph , graph
...@@ -285,7 +291,7 @@ modeGraphType Types.Sources = "star" ...@@ -285,7 +291,7 @@ modeGraphType Types.Sources = "star"
modeGraphType Types.Terms = "def" modeGraphType Types.Terms = "def"
getNodes :: Session -> T2.Reload -> GET.GraphId -> Aff GET.HyperdataGraph getNodes :: Session -> T2.Reload -> GET.GraphId -> Aff (Either RESTError GET.HyperdataGraph)
getNodes session graphVersion graphId = getNodes session graphVersion graphId =
get session $ NodeAPI Types.Graph get session $ NodeAPI Types.Graph
(Just graphId) (Just graphId)
...@@ -305,8 +311,7 @@ transformGraph graph { edgeConfluence' ...@@ -305,8 +311,7 @@ transformGraph graph { edgeConfluence'
, edgeWeight' , edgeWeight'
, nodeSize' , nodeSize'
, removedNodeIds' , removedNodeIds'
, selectedNodeIds' , selectedNodeIds' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
, showEdges' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
where where
edges = SigmaxT.graphEdges graph edges = SigmaxT.graphEdges graph
nodes = SigmaxT.graphNodes graph nodes = SigmaxT.graphNodes graph
...@@ -325,18 +330,10 @@ transformGraph graph { edgeConfluence' ...@@ -325,18 +330,10 @@ transformGraph graph { edgeConfluence'
newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes
newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges' newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
edgeFilter e = true edgeFilter _e = true
nodeFilter n = nodeRemovedFilter n nodeFilter n = nodeRemovedFilter n
nodeSizeFilter :: Record SigmaxT.Node -> Boolean nodeRemovedFilter { id } = not $ Set.member id removedNodeIds'
nodeSizeFilter node@{ size } = Range.within nodeSize' size
nodeRemovedFilter node@{ id } = not $ Set.member id removedNodeIds'
edgeConfluenceFilter :: Record SigmaxT.Edge -> Boolean
edgeConfluenceFilter edge@{ confluence } = Range.within edgeConfluence' confluence
edgeWeightFilter :: Record SigmaxT.Edge -> Boolean
edgeWeightFilter edge@{ weightIdx } = Range.within edgeWeight' $ toNumber weightIdx
edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeHideConfluence edge@{ confluence } = edgeHideConfluence edge@{ confluence } =
...@@ -352,13 +349,6 @@ transformGraph graph { edgeConfluence' ...@@ -352,13 +349,6 @@ transformGraph graph { edgeConfluence'
else else
edge { hidden = true } edge { hidden = true }
edgeShowFilter :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeShowFilter edge =
if SigmaxT.edgeStateHidden showEdges' then
edge { hidden = true }
else
edge
edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds) edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
......
module Gargantext.Components.GraphExplorer.API where module Gargantext.Components.GraphExplorer.API where
import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Prelude
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, post) import Gargantext.Sessions (Session, get, post)
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -20,10 +22,10 @@ type GraphAsyncUpdateParams = ...@@ -20,10 +22,10 @@ type GraphAsyncUpdateParams =
, version :: NTC.Version , version :: NTC.Version
) )
graphAsyncUpdate :: Record GraphAsyncUpdateParams -> Aff GT.AsyncTaskWithType graphAsyncUpdate :: Record GraphAsyncUpdateParams -> Aff (Either RESTError GT.AsyncTaskWithType)
graphAsyncUpdate { graphId, listId, nodes, session, termList, version } = do graphAsyncUpdate { graphId, listId, nodes, session, termList, version } = do
task <- post session p q eTask <- post session p q
pure $ GT.AsyncTaskWithType { task, typ: GT.GraphRecompute } pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
where where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
q = { listId q = { listId
...@@ -37,10 +39,10 @@ type GraphAsyncRecomputeParams = ...@@ -37,10 +39,10 @@ type GraphAsyncRecomputeParams =
, session :: Session , session :: Session
) )
graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> Aff GT.AsyncTaskWithType graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> Aff (Either RESTError GT.AsyncTaskWithType)
graphAsyncRecompute { graphId, session } = do graphAsyncRecompute { graphId, session } = do
task <- post session p q eTask <- post session p q
pure $ GT.AsyncTaskWithType { task, typ: GT.GraphRecompute } pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
where where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
q = {} q = {}
...@@ -51,7 +53,7 @@ type QueryProgressParams = ...@@ -51,7 +53,7 @@ type QueryProgressParams =
, taskId :: String , taskId :: String
) )
queryProgress :: Record QueryProgressParams -> Aff GT.AsyncProgress queryProgress :: Record QueryProgressParams -> Aff (Either RESTError GT.AsyncProgress)
queryProgress { graphId, session, taskId } = do queryProgress { graphId, session, taskId } = do
get session $ GR.GraphAPI graphId $ "async/" <> taskId <> "/poll" get session $ GR.GraphAPI graphId $ "async/" <> taskId <> "/poll"
...@@ -65,7 +67,7 @@ type GraphVersionsParams = ...@@ -65,7 +67,7 @@ type GraphVersionsParams =
, session :: Session , session :: Session
) )
graphVersions :: Record GraphVersionsParams -> Aff (Record GraphVersions) graphVersions :: Record GraphVersionsParams -> Aff (Either RESTError (Record GraphVersions))
graphVersions { graphId, session } = get session $ GR.GraphAPI graphId $ "versions" graphVersions { graphId, session } = get session $ GR.GraphAPI graphId $ "versions"
type UpdateGraphVersionsParams = type UpdateGraphVersionsParams =
...@@ -73,7 +75,7 @@ type UpdateGraphVersionsParams = ...@@ -73,7 +75,7 @@ type UpdateGraphVersionsParams =
, session :: Session , session :: Session
) )
updateGraphVersions :: Record UpdateGraphVersionsParams -> Aff GET.GraphData updateGraphVersions :: Record UpdateGraphVersionsParams -> Aff (Either RESTError GET.GraphData)
updateGraphVersions { graphId, session } = post session (GR.GraphAPI graphId $ "versions") {} updateGraphVersions { graphId, session } = post session (GR.GraphAPI graphId $ "versions") {}
type CloneGraphParams = type CloneGraphParams =
...@@ -82,5 +84,5 @@ type CloneGraphParams = ...@@ -82,5 +84,5 @@ type CloneGraphParams =
, session :: Session , session :: Session
) )
cloneGraph :: Record CloneGraphParams -> Aff Int cloneGraph :: Record CloneGraphParams -> Aff (Either RESTError Int)
cloneGraph { hyperdataGraph, id, session } = post session (GR.GraphAPI id $ "clone") hyperdataGraph cloneGraph { hyperdataGraph, id, session } = post session (GR.GraphAPI id $ "clone") hyperdataGraph
...@@ -3,11 +3,13 @@ module Gargantext.Components.GraphExplorer.Button ...@@ -3,11 +3,13 @@ module Gargantext.Components.GraphExplorer.Button
import Prelude import Prelude
import Data.Either (Either(..))
import Data.Enum (fromEnum) import Data.Enum (fromEnum)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.DateTime as DDT import Data.DateTime as DDT
import Data.DateTime.Instant as DDI import Data.DateTime.Instant as DDI
import Data.String as DS import Data.String as DS
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -19,6 +21,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryData ...@@ -19,6 +21,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryData
import Gargantext.Components.GraphExplorer.API (cloneGraph) import Gargantext.Components.GraphExplorer.API (cloneGraph)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
...@@ -93,9 +96,14 @@ cameraButton { id ...@@ -93,9 +96,14 @@ cameraButton { id
_ -> GET.Camera { ratio: 1.0, x: 0.0, y: 0.0 } _ -> GET.Camera { ratio: 1.0, x: 0.0, y: 0.0 }
let hyperdataGraph' = GET.HyperdataGraph { graph: graphData, mCamera: Just camera } let hyperdataGraph' = GET.HyperdataGraph { graph: graphData, mCamera: Just camera }
launchAff_ $ do launchAff_ $ do
clonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session } eClonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session }
ret <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen case eClonedGraphId of
liftEffect $ T2.reload reloadForest Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
pure ret Right clonedGraphId -> do
eRet <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
case eRet of
Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
Right _ret -> do
liftEffect $ T2.reload reloadForest
, text: "Screenshot" , text: "Screenshot"
} }
This diff is collapsed.
module Gargantext.Components.NgramsTable.API where module Gargantext.Components.NgramsTable.API where
import Data.Either (Either)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -13,5 +16,6 @@ type UpdateNodeListParams = ...@@ -13,5 +16,6 @@ type UpdateNodeListParams =
, session :: Session , session :: Session
) )
updateNodeList :: Record UpdateNodeListParams -> Aff Int updateNodeList :: Record UpdateNodeListParams -> Aff (Either RESTError Int)
updateNodeList { listId, nodeId, nodeType, session } = post session (GR.RecomputeNgrams nodeType nodeId listId) {} updateNodeList { listId, nodeId, nodeType, session } =
post session (GR.RecomputeNgrams nodeType nodeId listId) {}
...@@ -80,17 +80,15 @@ module Gargantext.Components.NgramsTable.Core ...@@ -80,17 +80,15 @@ module Gargantext.Components.NgramsTable.Core
where where
import Control.Monad.State (class MonadState, execState) import Control.Monad.State (class MonadState, execState)
import DOM.Simple.Console (log2)
import Data.Array (head) import Data.Array (head)
import Data.Array as A import Data.Array as A
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
import Data.Foldable (class Foldable, foldMap, foldl, foldr) import Data.Foldable (class Foldable, foldMap, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
--import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?)) import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?))
import Data.Lens.At (class At, at) import Data.Lens.At (class At, at)
import Data.Lens.Common (_Just) import Data.Lens.Common (_Just)
...@@ -105,8 +103,10 @@ import Data.Map as Map ...@@ -105,8 +103,10 @@ import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust) import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
import Data.Monoid.Additive (Additive(..)) import Data.Monoid.Additive (Additive(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Ord.Generic (genericCompare)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Show.Generic (genericShow)
import Data.String as S import Data.String as S
import Data.String.Common as DSC import Data.String.Common as DSC
import Data.String.Regex (Regex, regex, replace) as R import Data.String.Regex (Regex, regex, replace) as R
...@@ -118,32 +118,33 @@ import Data.Traversable (for, traverse_, traverse) ...@@ -118,32 +118,33 @@ import Data.Traversable (for, traverse_, traverse)
import Data.TraversableWithIndex (traverseWithIndex) import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception.Unsafe (unsafeThrow) import Effect.Exception.Unsafe (unsafeThrow)
import FFI.Simple.Functions (delay)
import Foreign as F import Foreign as F
import Foreign.Object as FO import Foreign.Object as FO
import FFI.Simple.Functions (delay)
import Reactix (Component, Element, createElement) as R import Reactix (Component, Element, createElement) as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Partial (crashWith) import Partial (crashWith)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Simple.JSON as JSON
import Toestand (Box, modify_, read, unequal, useBox, useLive, write_) as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Table (initialParams) as T import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types (ColumnName(..), OrderByDirection(..), Params) as T import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, post, put) import Gargantext.Sessions (Session, get, post, put)
import Gargantext.Types (AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..)) import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.Either (eitherMap)
import Gargantext.Utils.KarpRabin (indicesOfAny) import Gargantext.Utils.KarpRabin (indicesOfAny)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Core" here = R2.here "Gargantext.Components.NgramsTable.Core"
...@@ -902,7 +903,7 @@ setTermListP ngram patch_list = singletonNgramsTablePatch ngram pe ...@@ -902,7 +903,7 @@ setTermListP ngram patch_list = singletonNgramsTablePatch ngram pe
setTermListA :: NgramsTerm -> Replace TermList -> CoreAction setTermListA :: NgramsTerm -> Replace TermList -> CoreAction
setTermListA ngram termList = CommitPatch $ setTermListP ngram termList setTermListA ngram termList = CommitPatch $ setTermListP ngram termList
putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff VersionedNgramsPatches putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff (Either RESTError VersionedNgramsPatches)
putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId) where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
...@@ -915,22 +916,25 @@ syncPatches props state callback = do ...@@ -915,22 +916,25 @@ syncPatches props state callback = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
let pt = Versioned { data: ngramsPatches, version: ngramsVersion } let pt = Versioned { data: ngramsPatches, version: ngramsVersion }
launchAff_ $ do launchAff_ $ do
Versioned { data: newPatch, version: newVersion } <- putNgramsPatches props pt ePatches <- putNgramsPatches props pt
callback unit case ePatches of
liftEffect $ do Left err -> liftEffect $ log2 "[syncPatches] RESTError" err
log2 "[syncPatches] setting state, newVersion" newVersion Right (Versioned { data: newPatch, version: newVersion }) -> do
T.modify_ (\s -> callback unit
-- I think that sometimes this setState does not fully go through. liftEffect $ do
-- This is an issue because the version number does not get updated and the subsequent calls log2 "[syncPatches] setting state, newVersion" newVersion
-- can mess up the patches. T.modify_ (\s ->
s { -- I think that sometimes this setState does not fully go through.
ngramsLocalPatch = fromNgramsPatches mempty -- This is an issue because the version number does not get updated and the subsequent calls
, ngramsStagePatch = fromNgramsPatches mempty -- can mess up the patches.
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch s {
ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
-- First the already valid patch, then the local patch, then the newly received newPatch. -- First the already valid patch, then the local patch, then the newly received newPatch.
, ngramsVersion = newVersion , ngramsVersion = newVersion
}) state }) state
log2 "[syncPatches] ngramsVersion" newVersion log2 "[syncPatches] ngramsVersion" newVersion
pure unit pure unit
{- {-
...@@ -964,7 +968,7 @@ commitPatch tablePatch state = do ...@@ -964,7 +968,7 @@ commitPatch tablePatch state = do
T.modify_ (\s -> s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }) state T.modify_ (\s -> s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }) state
-- First we apply the patches we have locally and then the new patch (tablePatch). -- First we apply the patches we have locally and then the new patch (tablePatch).
loadNgramsTable :: PageParams -> Aff VersionedNgramsTable loadNgramsTable :: PageParams -> Aff (Either RESTError VersionedNgramsTable)
loadNgramsTable loadNgramsTable
{ nodeId, listIds, termListFilter, termSizeFilter, session, scoreType { nodeId, listIds, termListFilter, termSizeFilter, session, scoreType
, searchQuery, tabType, params: {offset, limit, orderBy}} , searchQuery, tabType, params: {offset, limit, orderBy}}
...@@ -983,7 +987,7 @@ loadNgramsTable ...@@ -983,7 +987,7 @@ loadNgramsTable
type NgramsListByTabType = Map TabType VersionedNgramsTable type NgramsListByTabType = Map TabType VersionedNgramsTable
loadNgramsTableAll :: PageParams -> Aff NgramsListByTabType loadNgramsTableAll :: PageParams -> Aff (Either RESTError NgramsListByTabType)
loadNgramsTableAll { nodeId, listIds, session, scoreType } = do loadNgramsTableAll { nodeId, listIds, session, scoreType } = do
let let
cTagNgramTypes = cTagNgramTypes =
...@@ -994,11 +998,13 @@ loadNgramsTableAll { nodeId, listIds, session, scoreType } = do ...@@ -994,11 +998,13 @@ loadNgramsTableAll { nodeId, listIds, session, scoreType } = do
] ]
query tabType = GetNgramsTableAll { listIds, tabType } (Just nodeId) query tabType = GetNgramsTableAll { listIds, tabType } (Just nodeId)
Map.fromFoldable <$> for cTagNgramTypes \cTagNgramType -> do ret <- Map.fromFoldable <$> for cTagNgramTypes \cTagNgramType -> do
let tabType = TabCorpus $ TabNgramType cTagNgramType let tabType = TabCorpus $ TabNgramType cTagNgramType
result :: VersionedNgramsTable <- get session $ query tabType result :: Either RESTError VersionedNgramsTable <- get session $ query tabType
pure $ Tuple tabType result pure $ Tuple tabType result
pure $ eitherMap ret
convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy
convOrderBy (T.ASC (T.ColumnName "Score")) = ScoreAsc convOrderBy (T.ASC (T.ColumnName "Score")) = ScoreAsc
convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
...@@ -1110,19 +1116,20 @@ chartsAfterSync :: forall props discard. ...@@ -1110,19 +1116,20 @@ chartsAfterSync :: forall props discard.
, tabType :: TabType , tabType :: TabType
| props | props
} }
-> T.Box (Array FrontendError)
-> T.Box GAT.Storage -> T.Box GAT.Storage
-> discard -> discard
-> Aff Unit -> Aff Unit
chartsAfterSync path'@{ nodeId } tasks _ = do chartsAfterSync path'@{ nodeId } errors tasks _ = do
task <- postNgramsChartsAsync path' eTask <- postNgramsChartsAsync path'
liftEffect $ do handleRESTError errors eTask $ \task -> liftEffect $ do
log2 "[chartsAfterSync] Synchronize task" task log2 "[chartsAfterSync] Synchronize task" task
GAT.insert nodeId task tasks GAT.insert nodeId task tasks
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType postNgramsChartsAsync :: forall s. CoreParams s -> Aff (Either RESTError AsyncTaskWithType)
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
task <- post session putNgramsAsync acu eTask :: Either RESTError AsyncTask <- post session putNgramsAsync acu
pure $ AsyncTaskWithType { task, typ: UpdateNgramsCharts } pure $ (\task -> AsyncTaskWithType { task, typ: UpdateNgramsCharts }) <$> eTask
where where
acu = AsyncNgramsChartsUpdate { listId: head listIds acu = AsyncNgramsChartsUpdate { listId: head listIds
, tabType } , tabType }
......
module Gargantext.Components.NgramsTable.Loader where module Gargantext.Components.NgramsTable.Loader where
import Gargantext.Prelude
import Affjax (Error(..))
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe, isJust) import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Tuple (fst) import Effect (Effect)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_, throwError) import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (Version, Versioned(..)) import Gargantext.Components.NgramsTable.Core (Version, Versioned(..))
import Gargantext.Config.REST (RESTError(..))
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
cacheName :: String cacheName :: String
cacheName = "ngrams-cache-api-loader" cacheName = "ngrams-cache-api-loader"
...@@ -26,22 +26,24 @@ clearCache _ = GUC.delete $ GUC.CacheName cacheName ...@@ -26,22 +26,24 @@ clearCache _ = GUC.delete $ GUC.CacheName cacheName
type LoaderWithCacheAPIProps path res ret = ( type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff Version cacheEndpoint :: path -> Aff (Either RESTError Version)
, errorHandler :: RESTError -> Effect Unit
, handleResponse :: Versioned res -> ret , handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
, renderer :: ret -> R.Element , renderer :: ret -> R.Element
) )
useLoaderWithCacheAPI :: forall path res ret. Eq path => JSON.ReadForeign res => Eq ret => useLoaderWithCacheAPI :: forall path res ret. Eq path => JSON.ReadForeign res => Eq ret =>
Record (LoaderWithCacheAPIProps path res ret) Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element -> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do useLoaderWithCacheAPI { cacheEndpoint, errorHandler, handleResponse, mkRequest, path, renderer } = do
state <- T.useBox Nothing state <- T.useBox Nothing
state' <- T.useLive T.unequal state state' <- T.useLive T.unequal state
useCachedAPILoaderEffect { cacheEndpoint useCachedAPILoaderEffect { cacheEndpoint
, errorHandler
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path
...@@ -49,7 +51,8 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer ...@@ -49,7 +51,8 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer
pure $ maybe (loadingSpinner {}) renderer state' pure $ maybe (loadingSpinner {}) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = ( type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff Version cacheEndpoint :: path -> Aff (Either RESTError Version)
, errorHandler :: RESTError -> Effect Unit
, handleResponse :: Versioned res -> ret , handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
...@@ -60,6 +63,7 @@ useCachedAPILoaderEffect :: forall path res ret. Eq path => JSON.ReadForeign res ...@@ -60,6 +63,7 @@ useCachedAPILoaderEffect :: forall path res ret. Eq path => JSON.ReadForeign res
Record (LoaderWithCacheAPIEffectProps path res ret) Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit -> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint useCachedAPILoaderEffect { cacheEndpoint
, errorHandler
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path
...@@ -78,20 +82,24 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -78,20 +82,24 @@ useCachedAPILoaderEffect { cacheEndpoint
launchAff_ $ do launchAff_ $ do
cache <- GUC.openCache $ GUC.CacheName cacheName cache <- GUC.openCache $ GUC.CacheName cacheName
-- TODO Parallelize? -- TODO Parallelize?
vr@(Versioned { version, "data": d }) <- GUC.cachedJson cache req vr@(Versioned { version }) <- GUC.cachedJson cache req
cacheReal <- cacheEndpoint path eCacheReal <- cacheEndpoint path
val <- if version == cacheReal then case eCacheReal of
pure vr Left err -> liftEffect $ errorHandler err
else do Right cacheReal -> do
-- liftEffect $ do val <- if version == cacheReal then
-- log "[useCachedAPILoaderEffect] versions dont match" pure vr
-- log2 "[useCachedAPILoaderEffect] cached version" version else do
-- log2 "[useCachedAPILoaderEffect] real version" cacheReal -- liftEffect $ do
_ <- GUC.deleteReq cache req -- log "[useCachedAPILoaderEffect] versions dont match"
vr'@(Versioned { version: version', data: _ }) <- GUC.cachedJson cache req -- log2 "[useCachedAPILoaderEffect] cached version" version
if version' == cacheReal then -- log2 "[useCachedAPILoaderEffect] real version" cacheReal
pure vr' _ <- GUC.deleteReq cache req
else vr'@(Versioned { version: version', data: _ }) <- GUC.cachedJson cache req
throwError $ error $ "[NgramsTable.Loader] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal if version' == cacheReal then
liftEffect $ do pure vr'
T.write_ (Just $ handleResponse val) state else do
liftEffect $ errorHandler $ SendResponseError $ RequestContentError $ "[useCachedAPILoaderEffect] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
throwError $ error $"[useCachedAPILoaderEffect] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
liftEffect $ do
T.write_ (Just $ handleResponse val) state
...@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Annuaire ...@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Annuaire
where where
import Data.Array as A import Data.Array as A
import Data.Either (Either)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
...@@ -23,12 +24,13 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT ...@@ -23,12 +24,13 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table (defaultContainer, initialParams, makeRow, table, tableHeaderLayout) as TT import Gargantext.Components.Table (defaultContainer, initialParams, makeRow, table, tableHeaderLayout) as TT
import Gargantext.Components.Table.Types (ColumnName(..), Params) as TT import Gargantext.Components.Table.Types (ColumnName(..), Params) as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (url, Frontends) import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get) import Gargantext.Sessions (Session, sessionId, get)
import Gargantext.Types (NodeType(..), AffTableResult, TableResult) import Gargantext.Types (NodeType(..), AffETableResult, TableResult)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
...@@ -77,8 +79,12 @@ annuaireLayoutWithKeyCpt = here.component "annuaireLayoutWithKey" cpt where ...@@ -77,8 +79,12 @@ annuaireLayoutWithKeyCpt = here.component "annuaireLayoutWithKey" cpt where
path <- T.useBox nodeId path <- T.useBox nodeId
path' <- T.useLive T.unequal path path' <- T.useLive T.unequal path
useLoader path' (getAnnuaireInfo session) $ useLoader { errorHandler
\info -> annuaire { frontends, info, path, session } , loader: getAnnuaireInfo session
, path: path'
, render: \info -> annuaire { frontends, info, path, session } }
where
errorHandler err = here.log2 "[annuaireLayoutWithKey] RESTError" err
type AnnuaireProps = type AnnuaireProps =
( session :: Session ( session :: Session
...@@ -120,7 +126,6 @@ annuaireCpt = here.component "annuaire" cpt ...@@ -120,7 +126,6 @@ annuaireCpt = here.component "annuaire" cpt
, pageLayout { info, session, pagePath, frontends} ] , pageLayout { info, session, pagePath, frontends} ]
where where
date = "Last update: " <> date' date = "Last update: " <> date'
style = {width: "250px", display: "inline-block"}
initialPagePath nodeId = {nodeId, params: TT.initialParams} initialPagePath nodeId = {nodeId, params: TT.initialParams}
type PagePath = { nodeId :: Int, params :: TT.Params } type PagePath = { nodeId :: Int, params :: TT.Params }
...@@ -138,11 +143,15 @@ pageLayout props = R.createElement pageLayoutCpt props [] ...@@ -138,11 +143,15 @@ pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt pageLayoutCpt = here.component "pageLayout" cpt
where where
cpt { info, frontends, pagePath, session } _ = do cpt { frontends, pagePath, session } _ = do
pagePath' <- T.useLive T.unequal pagePath pagePath' <- T.useLive T.unequal pagePath
useLoader pagePath' (loadPage session) $ useLoader { errorHandler
\table -> page { session, table, frontends, pagePath } , loader: loadPage session
, path: pagePath'
, render: \table -> page { session, table, frontends, pagePath } }
where
errorHandler err = here.log2 "[pageLayout] RESTError" err
type PageProps = type PageProps =
( session :: Session ( session :: Session
...@@ -175,9 +184,9 @@ pageCpt = here.component "page" cpt ...@@ -175,9 +184,9 @@ pageCpt = here.component "page" cpt
} }
where where
rows pagePath' = (row pagePath') <$> Seq.fromFoldable docs rows pagePath' = (row pagePath') <$> Seq.fromFoldable docs
row pagePath'@{ nodeId } contact = { row: contactCells { annuaireId: nodeId, frontends, contact, session } row { nodeId } contact = { row: contactCells { annuaireId: nodeId, frontends, contact, session }
, delete: false } , delete: false }
container = TT.defaultContainer { title: "Annuaire" } -- TODO container = TT.defaultContainer -- TODO
colNames = TT.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Role"] colNames = TT.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Role"]
wrapColElts = const identity wrapColElts = const identity
...@@ -194,9 +203,8 @@ contactCells :: Record ContactCellsProps -> R.Element ...@@ -194,9 +203,8 @@ contactCells :: Record ContactCellsProps -> R.Element
contactCells p = R.createElement contactCellsCpt p [] contactCells p = R.createElement contactCellsCpt p []
contactCellsCpt :: R.Component ContactCellsProps contactCellsCpt :: R.Component ContactCellsProps
contactCellsCpt = here.component "contactCells" cpt where contactCellsCpt = here.component "contactCells" cpt where
cpt { annuaireId, frontends, session cpt { contact: CT.NodeContact
, contact: CT.NodeContact { hyperdata: CT.HyperdataContact { who : Nothing } } } _ =
{ id, hyperdata: CT.HyperdataContact { who : Nothing }}} _ =
pure $ TT.makeRow pure $ TT.makeRow
[ H.text "" [ H.text ""
, H.span {} [ H.text "Name" ] , H.span {} [ H.text "Name" ]
...@@ -224,9 +232,6 @@ contactCellsCpt = here.component "contactCells" cpt where ...@@ -224,9 +232,6 @@ contactCellsCpt = here.component "contactCells" cpt where
-- H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou) -- H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
] ]
where where
--nodepath = NodePath (sessionId session) NodeContact (Just id)
nodepath = Routes.ContactPage (sessionId session) annuaireId id
href = url frontends nodepath
contactUrl aId id' = url frontends $ Routes.ContactPage (sessionId session) aId id' contactUrl aId id' = url frontends $ Routes.ContactPage (sessionId session) aId id'
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization" contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) = contactWhereOrg (CT.ContactWhere { organization: orga }) =
...@@ -234,8 +239,6 @@ contactCellsCpt = here.component "contactCells" cpt where ...@@ -234,8 +239,6 @@ contactCellsCpt = here.component "contactCells" cpt where
contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept" contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) = contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
fromMaybe "No Dept (list)" (A.head dept) fromMaybe "No Dept (list)" (A.head dept)
contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
contactWhereRole (CT.ContactWhere { role: Just role }) = role
newtype HyperdataAnnuaire = HyperdataAnnuaire newtype HyperdataAnnuaire = HyperdataAnnuaire
{ title :: Maybe String { title :: Maybe String
...@@ -278,8 +281,8 @@ instance JSON.ReadForeign AnnuaireInfo where ...@@ -278,8 +281,8 @@ instance JSON.ReadForeign AnnuaireInfo where
------------------------------------------------------------------------ ------------------------------------------------------------------------
loadPage :: Session -> PagePath -> AffTableResult CT.NodeContact loadPage :: Session -> PagePath -> AffETableResult CT.NodeContact
loadPage session {nodeId, params: { offset, limit, orderBy }} = loadPage session {nodeId, params: { offset, limit }} =
get session children get session children
-- TODO orderBy -- TODO orderBy
-- where -- where
...@@ -291,6 +294,6 @@ loadPage session {nodeId, params: { offset, limit, orderBy }} = ...@@ -291,6 +294,6 @@ loadPage session {nodeId, params: { offset, limit, orderBy }} =
where where
children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId) children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo getAnnuaireInfo :: Session -> Int -> Aff (Either RESTError AnnuaireInfo)
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "") getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
...@@ -4,26 +4,23 @@ module Gargantext.Components.Nodes.Annuaire.Tabs where ...@@ -4,26 +4,23 @@ module Gargantext.Components.Nodes.Annuaire.Tabs where
import Prelude hiding (div) import Prelude hiding (div)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (fst) import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.AsyncTasks as GAT import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year) import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Components.Nodes.Lists.Types as LTypes import Gargantext.Components.Nodes.Lists.Types as LTypes
import Gargantext.Components.Nodes.Texts.Types as TTypes
import Gargantext.Components.Nodes.Texts.Types as TextsT import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), SidePanelState, TabType(..), TabSubType(..)) import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Record as Record import Record as Record
import Record.Extra as RX import Record.Extra as RX
...@@ -53,21 +50,17 @@ modeTabType' Books = CTabAuthors ...@@ -53,21 +50,17 @@ modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors modeTabType' Communication = CTabAuthors
type TabsProps = type TabsProps =
( cacheState :: T.Box LTypes.CacheState ( boxes :: Boxes
, contactData :: ContactData , cacheState :: T.Box LTypes.CacheState
, frontends :: Frontends , contactData :: ContactData
, nodeId :: Int , frontends :: Frontends
, reloadForest :: T2.ReloadS , nodeId :: Int
, reloadRoot :: T2.ReloadS , session :: Session
, session :: Session , sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
tabs props = R.createElement tabsCpt props [] tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where tabsCpt = here.component "tabs" cpt where
cpt props _ = do cpt props _ = do
...@@ -75,7 +68,7 @@ tabsCpt = here.component "tabs" cpt where ...@@ -75,7 +68,7 @@ tabsCpt = here.component "tabs" cpt where
yearFilter <- T.useBox (Nothing :: Maybe Year) yearFilter <- T.useBox (Nothing :: Maybe Year)
pure $ Tab.tabs { activeTab, tabs: tabs' yearFilter props } pure $ Tab.tabs { activeTab, tabs: tabs' yearFilter props }
tabs' yearFilter props@{ sidePanel, sidePanelState } = tabs' yearFilter props@{ boxes, sidePanel } =
[ "Documents" /\ docs [ "Documents" /\ docs
, "Patents" /\ ngramsView (viewProps Patents) , "Patents" /\ ngramsView (viewProps Patents)
, "Books" /\ ngramsView (viewProps Books) , "Books" /\ ngramsView (viewProps Books)
...@@ -85,7 +78,7 @@ tabsCpt = here.component "tabs" cpt where ...@@ -85,7 +78,7 @@ tabsCpt = here.component "tabs" cpt where
viewProps mode = Record.merge props { defaultListId: props.contactData.defaultListId viewProps mode = Record.merge props { defaultListId: props.contactData.defaultListId
, mode } , mode }
totalRecords = 4736 -- TODO lol totalRecords = 4736 -- TODO lol
docs = DT.docViewLayout (Record.merge { sidePanel, sidePanelState } $ Record.merge dtCommon dtExtra) docs = DT.docViewLayout (Record.merge { boxes, sidePanel } $ Record.merge dtCommon dtExtra)
dtCommon = RX.pick props :: Record DTCommon dtCommon = RX.pick props :: Record DTCommon
dtExtra = dtExtra =
{ chart: mempty { chart: mempty
...@@ -113,7 +106,6 @@ type NgramsViewTabsProps = ...@@ -113,7 +106,6 @@ type NgramsViewTabsProps =
ngramsView :: R2.Leaf NgramsViewTabsProps ngramsView :: R2.Leaf NgramsViewTabsProps
ngramsView props = R.createElement ngramsViewCpt props [] ngramsView props = R.createElement ngramsViewCpt props []
ngramsViewCpt :: R.Component NgramsViewTabsProps ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt where ngramsViewCpt = here.component "ngramsView" cpt where
cpt props@{ defaultListId, mode, nodeId, session } _ = do cpt props@{ defaultListId, mode, nodeId, session } _ = do
...@@ -135,10 +127,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -135,10 +127,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where
afterSync _ = pure unit afterSync _ = pure unit
type NTCommon = type NTCommon =
( cacheState :: T.Box LTypes.CacheState ( boxes :: Boxes
, defaultListId :: Int , cacheState :: T.Box LTypes.CacheState
, reloadForest :: T2.ReloadS , defaultListId :: Int
, reloadRoot :: T2.ReloadS , session :: Session
, session :: Session
, tasks :: T.Box GAT.Storage
) )
...@@ -4,29 +4,31 @@ module Gargantext.Components.Nodes.Annuaire.User ...@@ -4,29 +4,31 @@ module Gargantext.Components.Nodes.Annuaire.User
) )
where where
import Gargantext.Prelude (Unit, bind, discard, pure, show, ($), (<$>), (<<<), (<>)) import Gargantext.Prelude
import Data.Either (Either)
import Data.Lens as L import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Gargantext.Components.App.Data (Boxes)
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.InputWithEnter (inputWithEnter) 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.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Lists.Types as LT import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (WithSession, WithSessionContext, Session, get, put, sessionId) import Gargantext.Sessions (WithSession, WithSessionContext, Session, get, put, sessionId)
import Gargantext.Types (NodeType(..), SidePanelState) import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire.User" here = R2.here "Gargantext.Components.Nodes.Annuaire.User"
...@@ -35,7 +37,6 @@ type DisplayProps = ( title :: String ) ...@@ -35,7 +37,6 @@ type DisplayProps = ( title :: String )
display :: R2.Component DisplayProps display :: R2.Component DisplayProps
display = R.createElement displayCpt display = R.createElement displayCpt
displayCpt :: R.Component DisplayProps displayCpt :: R.Component DisplayProps
displayCpt = here.component "display" cpt displayCpt = here.component "display" cpt
where where
...@@ -91,7 +92,6 @@ type ContactInfoItemProps = ...@@ -91,7 +92,6 @@ type ContactInfoItemProps =
contactInfoItem :: Record ContactInfoItemProps -> R.Element contactInfoItem :: Record ContactInfoItemProps -> R.Element
contactInfoItem props = R.createElement contactInfoItemCpt props [] contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt contactInfoItemCpt = here.component "contactInfoItem" cpt
where where
...@@ -152,13 +152,9 @@ listElement = H.li { className: "list-group-item justify-content-between" } ...@@ -152,13 +152,9 @@ listElement = H.li { className: "list-group-item justify-content-between" }
-} -}
type LayoutNoSessionProps = type LayoutNoSessionProps =
( frontends :: Frontends ( boxes :: Boxes
, nodeId :: Int , frontends :: Frontends
, reloadForest :: T2.ReloadS , nodeId :: Int
, reloadRoot :: T2.ReloadS
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
) )
type LayoutProps = WithSession LayoutNoSessionProps type LayoutProps = WithSession LayoutNoSessionProps
...@@ -172,80 +168,58 @@ type KeyLayoutProps = ( ...@@ -172,80 +168,58 @@ type KeyLayoutProps = (
userLayout :: R2.Component LayoutProps userLayout :: R2.Component LayoutProps
userLayout = R.createElement userLayoutCpt userLayout = R.createElement userLayoutCpt
userLayoutCpt :: R.Component LayoutProps userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = here.component "userLayout" cpt userLayoutCpt = here.component "userLayout" cpt
where where
cpt { frontends cpt props@{ nodeId
, nodeId , session } _ = do
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks } _ = do
let sid = sessionId session let sid = sessionId session
pure $ userLayoutWithKey { pure $ userLayoutWithKey $ Record.merge props { key: show sid <> "-" <> show nodeId }
frontends
, key: show sid <> "-" <> show nodeId
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks
}
userLayoutWithKey :: Record KeyLayoutProps -> R.Element userLayoutWithKey :: R2.Leaf KeyLayoutProps
userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props [] userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
userLayoutWithKeyCpt :: R.Component KeyLayoutProps userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
where cpt { boxes: boxes@{ sidePanelTexts }
cpt { frontends , frontends
, nodeId , nodeId
, reloadForest , session } _ = do
, reloadRoot reload <- T.useBox T2.newReload
, session reload' <- T.useLive T.unequal reload
, sidePanel
, sidePanelState cacheState <- T.useBox LT.CacheOn
, tasks } _ = do
reload <- T.useBox T2.newReload useLoader { errorHandler
reload' <- T.useLive T.unequal reload , loader: getUserWithReload
, path: { nodeId, reload: reload', session }
cacheState <- T.useBox LT.CacheOn , render: \contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
useLoader {nodeId, reload: reload', session} getUserWithReload $ display { title: fromMaybe "no name" name }
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" name }
(contactInfos hyperdata (onUpdateHyperdata reload)) (contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs { , Tabs.tabs {
cacheState boxes
, contactData , cacheState
, frontends , contactData
, nodeId , frontends
, reloadForest , nodeId
, reloadRoot , session
, session , sidePanel: sidePanelTexts
, sidePanel }
, sidePanelState ]
, tasks }
} where
] errorHandler err = here.log2 "[userLayoutWithKey] RESTError" err
where onUpdateHyperdata :: T2.ReloadS -> HyperdataUser -> Effect Unit
onUpdateHyperdata :: T2.ReloadS -> HyperdataUser -> Effect Unit onUpdateHyperdata reload hd = do
onUpdateHyperdata reload hd = do launchAff_ $ do
launchAff_ $ do _ <- saveContactHyperdata session nodeId hd
_ <- saveContactHyperdata session nodeId hd liftEffect $ T2.reload reload
liftEffect $ T2.reload reload
-- | toUrl to get data XXX -- | toUrl to get data XXX
getContact :: Session -> Int -> Aff ContactData getContact :: Session -> Int -> Aff (Either RESTError ContactData)
getContact session id = do getContact session id = do
contactNode :: Contact <- get session $ Routes.NodeAPI Node (Just id) "" eContactNode <- get session $ Routes.NodeAPI Node (Just id) ""
-- TODO: we need a default list for the pairings -- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
...@@ -253,14 +227,14 @@ getContact session id = do ...@@ -253,14 +227,14 @@ getContact session id = do
-- pure {contactNode, defaultListId} -- pure {contactNode, defaultListId}
-- Nothing -> -- Nothing ->
-- throwError $ error "Missing default list" -- throwError $ error "Missing default list"
pure {contactNode, defaultListId: 424242} pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
getUserWithReload :: { nodeId :: Int getUserWithReload :: { nodeId :: Int
, reload :: T2.Reload , reload :: T2.Reload
, session :: Session} -> Aff ContactData , session :: Session} -> Aff (Either RESTError ContactData)
getUserWithReload {nodeId, session} = getContact session nodeId getUserWithReload {nodeId, session} = getContact session nodeId
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff Int saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff (Either RESTError Int)
saveContactHyperdata session id h = do saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h put session (Routes.NodeAPI Node (Just id) "") h
This diff is collapsed.
module Gargantext.Components.Nodes.Corpus.Chart.API where module Gargantext.Components.Nodes.Corpus.Chart.API where
import Data.Either (Either)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types as T import Gargantext.Types as T
recomputeChart :: Session -> T.ChartType -> T.CTabNgramType -> Int -> Int -> Aff (Either RESTError (Array Int))
recomputeChart :: Session -> T.ChartType -> T.CTabNgramType -> Int -> Int -> Aff (Array Int)
recomputeChart session chartType ngramType corpusId listId = recomputeChart session chartType ngramType corpusId listId =
post session (RecomputeListChart chartType ngramType corpusId listId) {} post session (RecomputeListChart chartType ngramType corpusId listId) {}
...@@ -45,4 +45,4 @@ tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, lis ...@@ -45,4 +45,4 @@ tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, lis
where where
dvProps = {frontends, session, nodeId, listId, query, chart, totalRecords: 0, container} dvProps = {frontends, session, nodeId, listId, query, chart, totalRecords: 0, container}
chart = mempty chart = mempty
container = Table.graphContainer {title: corpusLabel} container = Table.graphContainer
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
...@@ -6,9 +6,11 @@ if (typeof window !== 'undefined') { ...@@ -6,9 +6,11 @@ if (typeof window !== 'undefined') {
window.ReactBootstrap = ReactBootstrap; window.ReactBootstrap = ReactBootstrap;
} }
const Alert = require('react-bootstrap/Alert');
const OverlayTrigger = require('react-bootstrap/OverlayTrigger'); const OverlayTrigger = require('react-bootstrap/OverlayTrigger');
const Popover = require('react-bootstrap/Popover'); const Popover = require('react-bootstrap/Popover');
exports.alertCpt = Alert;
exports.overlayTriggerCpt = OverlayTrigger; exports.overlayTriggerCpt = OverlayTrigger;
exports.popoverCpt = Popover; exports.popoverCpt = Popover;
exports.popoverContentCpt = Popover.Content; exports.popoverContentCpt = Popover.Content;
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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