Commit 034ea2e7 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[REST] refactored rest responses to Either RESTError a

This way we can have a handle of the errors in the high-level
components. Before they were implicitly discarded.
parent b2eab45c
module Gargantext.Components.App.Data (App, Boxes, emptyApp) where module Gargantext.Components.App.Data (App, Boxes, emptyApp) where
import Data.Set as Set
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.Prelude
...@@ -15,11 +15,12 @@ import Gargantext.Routes (AppRoute(Home)) ...@@ -15,11 +15,12 @@ import Gargantext.Routes (AppRoute(Home))
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Session, Sessions) import Gargantext.Sessions (Session, 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
-- TODO: this module should be replaced by FacetsTable -- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where module Gargantext.Components.DocsTable where
import Gargantext.Prelude
import Prelude
import Control.Monad.Error.Class (throwError)
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>)) import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
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.Lens ((^.)) import Data.Lens ((^.))
import Data.Lens.At (at) import Data.Lens.At (at)
import Data.Lens.Record (prop) import Data.Lens.Record (prop)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe) import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Ord.Down (Down(..)) import Data.Ord.Down (Down(..))
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.String as Str import Data.String as Str
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.Category (rating) import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..)) import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData) import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData)
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types as TextsT import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Table as TT import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..)) import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Prelude
import Gargantext.Prelude (class Ord, Unit, bind, const, discard, identity, mempty, otherwise, pure, show, unit, ($), (/=), (<$>), (<<<), (<>), (==)) import Gargantext.Prelude (class Ord, Unit, bind, const, discard, identity, mempty, otherwise, pure, show, unit, ($), (/=), (<$>), (<<<), (<>), (==))
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
...@@ -41,7 +46,6 @@ import Gargantext.Utils.CacheAPI as GUC ...@@ -41,7 +46,6 @@ import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS) import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
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 Prelude
import Reactix as R 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
...@@ -221,9 +225,9 @@ type PageParams = { ...@@ -221,9 +225,9 @@ type PageParams = {
, yearFilter :: Maybe Year , yearFilter :: Maybe Year
} }
getPageHash :: Session -> PageParams -> Aff String getPageHash :: Session -> PageParams -> Aff (Either RESTError String)
getPageHash session { nodeId, tabType } = do getPageHash session { nodeId, tabType } =
(get session $ tableHashRoute nodeId tabType) :: Aff String get session $ tableHashRoute nodeId tabType
convOrderBy :: Maybe (TT.OrderByDirection TT.ColumnName) -> Maybe OrderBy convOrderBy :: Maybe (TT.OrderByDirection TT.ColumnName) -> Maybe OrderBy
convOrderBy (Just (TT.ASC (TT.ColumnName "Date"))) = Just DateAsc convOrderBy (Just (TT.ASC (TT.ColumnName "Date"))) = Just DateAsc
...@@ -261,7 +265,6 @@ filterDocsByYear year docs = A.filter filterFunc docs ...@@ -261,7 +265,6 @@ filterDocsByYear year docs = A.filter filterFunc docs
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 where pageLayoutCpt = here.component "pageLayout" cpt where
cpt props@{ cacheState cpt props@{ cacheState
...@@ -318,12 +321,12 @@ pageLayoutCpt = here.component "pageLayout" cpt where ...@@ -318,12 +321,12 @@ pageLayoutCpt = here.component "pageLayout" cpt where
paramsS' <- T.useLive T.unequal paramsS paramsS' <- T.useLive T.unequal paramsS
let loader p = do let loader p = do
let route = tableRouteWithPage (p { params = paramsS', query = query }) let route = tableRouteWithPage (p { params = paramsS', query = query })
res <- get session $ route eRes <- get session $ route
liftEffect $ do liftEffect $ do
here.log2 "table route" route here.log2 "table route" route
here.log2 "table res" res here.log2 "table res" eRes
pure $ handleResponse res pure $ handleResponse <$> eRes
render (Tuple count documents) = pagePaintRaw { documents let render (Tuple count documents) = pagePaintRaw { documents
, layout: props { params = paramsS' , layout: props { params = paramsS'
, totalRecords = count } , totalRecords = count }
, localCategories , localCategories
...@@ -562,7 +565,7 @@ tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchTyp ...@@ -562,7 +565,7 @@ tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchTyp
q = queryParamS "query" query q = queryParamS "query" query
y = mQueryParam "year" yearFilter y = mQueryParam "year" yearFilter
deleteAllDocuments :: Session -> Int -> Aff (Array Int) deleteAllDocuments :: Session -> Int -> Aff (Either RESTError (Array Int))
deleteAllDocuments session = delete session <<< documentsRoute deleteAllDocuments session = delete session <<< documentsRoute
-- TODO: not optimal but Data.Set lacks some function (Set.alter) -- TODO: not optimal but Data.Set lacks some function (Set.alter)
......
...@@ -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,16 +23,12 @@ import Reactix.DOM.HTML as H ...@@ -21,16 +23,12 @@ 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))
...@@ -153,12 +151,6 @@ docViewCpt = here.component "docView" cpt ...@@ -153,12 +151,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
...@@ -221,8 +213,8 @@ type PagePath = { nodeId :: Int ...@@ -221,8 +213,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 +227,15 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc ...@@ -235,12 +227,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
...@@ -417,7 +412,7 @@ derive instance Generic DeleteDocumentQuery _ ...@@ -417,7 +412,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"
module Gargantext.Components.FolderView where module Gargantext.Components.FolderView where
import DOM.Simple.Console (log, log2) import Control.Monad.Error.Class (throwError)
import Data.Array as A import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (null) import Data.Nullable (null)
import Data.Traversable (traverse_) import Data.Traversable (traverse_)
import DOM.Simple.Console (log, log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff, error)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
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.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode) import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
...@@ -23,6 +30,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryFile ...@@ -23,6 +30,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryFile
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView) import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Ordering, Unit, bind, compare, discard, pure, unit, void, ($), (<$>), (<>)) import Gargantext.Prelude (Ordering, Unit, bind, compare, discard, pure, unit, void, ($), (<$>), (<>))
import Gargantext.Routes (AppRoute(Home), SessionRoute(..), appPath, nodeTypeAppRoute) import Gargantext.Routes (AppRoute(Home), SessionRoute(..), appPath, nodeTypeAppRoute)
...@@ -32,10 +40,6 @@ import Gargantext.Types as GT ...@@ -32,10 +40,6 @@ 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 Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
foreign import back :: Effect Unit foreign import back :: Effect Unit
foreign import link :: String -> Effect Unit foreign import link :: String -> Effect Unit
...@@ -246,7 +250,7 @@ type LoadProps = ...@@ -246,7 +250,7 @@ type LoadProps =
reload :: T2.Reload reload :: T2.Reload
) )
loadFolders :: Record LoadProps -> Aff FTree loadFolders :: Record LoadProps -> Aff (Either RESTError FTree)
loadFolders {nodeId, session} = get session $ TreeFirstLevel (Just nodeId) "" loadFolders {nodeId, session} = get session $ TreeFirstLevel (Just nodeId) ""
type PerformActionProps = type PerformActionProps =
...@@ -295,7 +299,7 @@ performAction = performAction' where ...@@ -295,7 +299,7 @@ performAction = performAction' where
_ -> void $ deleteNode p.session nt id _ -> void $ deleteNode p.session nt id
refreshFolders p refreshFolders p
doSearch task p@{ tasks, nodeId: id } = liftEffect $ do doSearch task { tasks, nodeId: id } = liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
log2 "[performAction] DoSearch task:" task log2 "[performAction] DoSearch task:" task
...@@ -323,12 +327,15 @@ performAction = performAction' where ...@@ -323,12 +327,15 @@ performAction = performAction' where
log2 "[performAction] UploadFile, uploaded, task:" task log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ tasks, nodeId: id } = do uploadArbitraryFile' mName blob p@{ tasks, nodeId: id } = do
task <- uploadArbitraryFile p.session id { blob, mName } eTask <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do case eTask of
GAT.insert id task tasks Left _err -> throwError $ error "[uploadArbitraryFile] RESTError"
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task Right task -> do
liftEffect $ do
moveNode params p@{ session } = traverse_ f params where GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out void $ moveNodeReq p.session in' out
refreshFolders p refreshFolders p
......
...@@ -2,12 +2,14 @@ module Gargantext.Components.Forest.Tree where ...@@ -2,12 +2,14 @@ module Gargantext.Components.Forest.Tree where
import Gargantext.Prelude import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Data.Array as A import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Traversable (traverse_, traverse) import Data.Traversable (traverse_, traverse)
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff, error)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -30,6 +32,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest) ...@@ -30,6 +32,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
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 (AppRoute) import Gargantext.Routes (AppRoute)
...@@ -83,10 +86,10 @@ treeLoaderCpt = here.component "treeLoader" cpt where ...@@ -83,10 +86,10 @@ treeLoaderCpt = here.component "treeLoader" cpt where
common = RecordE.pick p :: Record Common common = RecordE.pick p :: Record Common
extra = { tree: tree', reloadTree: p.reload, session } extra = { tree: tree', reloadTree: p.reload, session }
getNodeTree :: Session -> ID -> Aff FTree getNodeTree :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) "" getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
getNodeTreeFirstLevel :: Session -> ID -> Aff FTree getNodeTreeFirstLevel :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) "" getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
type NodeProps = ( reloadTree :: T2.ReloadS, session :: Session | Common ) type NodeProps = ( reloadTree :: T2.ReloadS, session :: Session | Common )
...@@ -244,10 +247,13 @@ uploadFile' nodeType fileType mName contents p@{ tasks, tree: (NTree (LNode { id ...@@ -244,10 +247,13 @@ uploadFile' nodeType fileType mName contents p@{ tasks, tree: (NTree (LNode { id
log2 "[performAction] UploadFile, uploaded, task:" task log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do uploadArbitraryFile' mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadArbitraryFile p.session id { blob, mName } eTask <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do case eTask of
GAT.insert id task tasks Left err -> throwError $ error $ "[uploadArbitraryFile'] RESTError"
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task Right task -> do
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ forestOpen, session } = traverse_ f params where moveNode params p@{ forestOpen, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
......
module Gargantext.Components.Forest.Tree.Node.Action.Add where module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
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)
import Data.String (Pattern(..), indexOf) import Data.String (Pattern(..), indexOf)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Web.HTML (window)
import Web.HTML.Navigator (userAgent)
import Web.HTML.Window (navigator)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
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 (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)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils (nbsp) import Gargantext.Utils (nbsp)
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
import Web.HTML (window)
import Web.HTML.Navigator (userAgent)
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
...@@ -40,9 +45,12 @@ addNodeAsync :: Session ...@@ -40,9 +45,12 @@ addNodeAsync :: Session
-> AddNodeValue -> AddNodeValue
-> Aff GT.AsyncTaskWithType -> Aff 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 -> liftEffect $ throwError $ error "[addNodeAsync] RESTError"
Right task -> pure $ 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 Control.Monad.Error.Class (throwError)
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 Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R 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
...@@ -14,10 +18,10 @@ import Toestand as T ...@@ -14,10 +18,10 @@ 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
here :: R2.Here here :: R2.Here
...@@ -33,9 +37,11 @@ derive newtype instance JSON.WriteForeign LinkNodeReq ...@@ -33,9 +37,11 @@ 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 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 } case eTask of
Left _err -> liftEffect $ throwError $ error "[linkNodeReq] RESTError"
Right task -> pure $ GT.AsyncTaskWithType { task, typ: GT.UpdateNode }
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 +54,7 @@ linkNode = R.createElement linkNodeCpt ...@@ -48,7 +54,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 { dispatch, handed, 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
......
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 {dispatch, subTreeParams, id, nodeType, session, handed} _ = 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
......
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)
......
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.Types where module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Control.Monad.Error.Class (throwError)
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)
...@@ -9,15 +11,17 @@ import Data.Set as Set ...@@ -9,15 +11,17 @@ import Data.Set as Set
import Data.String as String import Data.String as String
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff, error)
import Effect.Class (liftEffect)
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)
...@@ -368,7 +372,9 @@ instance JSON.WriteForeign SearchQuery where ...@@ -368,7 +372,9 @@ instance JSON.WriteForeign SearchQuery where
performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType performSearch :: Session -> Int -> SearchQuery -> Aff 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} case eTask of
Left _err -> liftEffect $ throwError $ error "[performSearch] RESTError"
Right task -> pure $ GT.AsyncTaskWithType { task, typ: GT.Query }
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 { dispatch, handed, 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
......
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 Control.Monad.Error.Class (throwError)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
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
...@@ -11,7 +13,9 @@ import Toestand as T ...@@ -11,7 +13,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)
...@@ -23,8 +27,10 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update" ...@@ -23,8 +27,10 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update"
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
updateRequest updateNodeParams session nodeId = do updateRequest updateNodeParams session nodeId = do
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 -> liftEffect $ throwError $ error "[updateRequest] RESTError"
Right task -> pure $ 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 +43,11 @@ update :: R2.Component UpdateProps ...@@ -37,11 +43,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 +105,7 @@ updateOther :: R2.Component UpdateProps ...@@ -99,7 +105,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
module Gargantext.Components.Forest.Tree.Node.Action.Upload where module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Either (fromRight') import Gargantext.Prelude
import Data.Generic.Rep (class Generic)
import Control.Monad.Error.Class (throwError)
import DOM.Simple.Console (log2)
import Data.Either (Either(..), fromRight')
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromJust, fromMaybe) import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.String.Regex as DSR import Data.String.Regex as DSR
import Data.String.Regex.Flags as DSRF import Data.String.Regex.Flags as DSRF
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
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 Partial.Unsafe (unsafePartial, unsafeCrashWith) import Effect.Exception (error)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import URI.Extra.QueryPairs as QP
-- import Web.File.Blob (Blob)
import Web.File.FileReader.Aff (readAsDataURL)
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..), readUFBAsText) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..), readUFBAsText)
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel) import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
import Gargantext.Components.Lang (Lang(..)) import Gargantext.Components.Lang (Lang(..))
import Gargantext.Routes as GR import Gargantext.Config.REST (RESTError)
import Gargantext.Sessions (Session, postWwwUrlencoded, post) import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID) import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial, unsafeCrashWith)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsDataURL)
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Upload" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Upload"
...@@ -52,7 +53,7 @@ actionUploadCpt :: R.Component ActionUpload ...@@ -52,7 +53,7 @@ actionUploadCpt :: R.Component ActionUpload
actionUploadCpt = here.component "actionUpload" cpt where actionUploadCpt = here.component "actionUpload" cpt where
cpt { nodeType: Corpus, dispatch, id, session } _ = pure $ uploadFileView {dispatch, id, nodeType: GT.Corpus, session} cpt { nodeType: Corpus, dispatch, id, session } _ = pure $ uploadFileView {dispatch, id, nodeType: GT.Corpus, session}
cpt { nodeType: NodeList, dispatch, id, session } _ = pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session} cpt { nodeType: NodeList, dispatch, id, session } _ = pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
cpt props@{ nodeType: _, dispatch, id, session } _ = pure $ actionUploadOther props [] cpt props@{ nodeType: _ } _ = pure $ actionUploadOther props []
{- {-
actionUpload Annuaire id session dispatch = actionUpload Annuaire id session dispatch =
...@@ -139,12 +140,6 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -139,12 +140,6 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
] ]
pure $ panel bodies footer pure $ panel bodies footer
renderOptionFT :: FileType -> R.Element
renderOptionFT opt = H.option {} [ H.text $ show opt ]
renderOptionLang :: Lang -> R.Element
renderOptionLang opt = H.option {} [ H.text $ show opt ]
onChangeContents :: forall e. T.Box (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit onChangeContents :: forall e. T.Box (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents mFile e = do onChangeContents mFile e = do
let mF = R2.inputFileNameWithBlob 0 e let mF = R2.inputFileNameWithBlob 0 e
...@@ -329,8 +324,10 @@ uploadFile session NodeList id JSON { mName, contents } = do ...@@ -329,8 +324,10 @@ uploadFile session NodeList id JSON { mName, contents } = do
-} -}
uploadFile session nodeType id fileType { mName, contents } = do uploadFile session nodeType id fileType { mName, contents } = do
-- contents <- readAsText blob -- contents <- readAsText blob
task <- postWwwUrlencoded session p bodyParams eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p bodyParams
pure $ GT.AsyncTaskWithType {task, typ: GT.Form} case eTask of
Left _err -> liftEffect $ throwError $ error "[uploadFile] RESTError"
Right task -> pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
--postMultipartFormData session p fileContents --postMultipartFormData session p fileContents
where where
p = case nodeType of p = case nodeType of
...@@ -351,7 +348,7 @@ uploadFile session nodeType id fileType { mName, contents } = do ...@@ -351,7 +348,7 @@ uploadFile session nodeType id fileType { mName, contents } = do
uploadArbitraryFile :: Session uploadArbitraryFile :: Session
-> ID -> ID
-> {blob :: UploadFileBlob, mName :: Maybe String} -> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType -> Aff (Either RESTError GT.AsyncTaskWithType)
uploadArbitraryFile session id {mName, blob: UploadFileBlob blob} = do uploadArbitraryFile session id {mName, blob: UploadFileBlob blob} = do
contents <- readAsDataURL blob contents <- readAsDataURL blob
uploadArbitraryDataURL session id mName contents uploadArbitraryDataURL session id mName contents
...@@ -360,12 +357,12 @@ uploadArbitraryDataURL :: Session ...@@ -360,12 +357,12 @@ uploadArbitraryDataURL :: Session
-> ID -> ID
-> Maybe String -> Maybe String
-> String -> String
-> Aff GT.AsyncTaskWithType -> Aff (Either RESTError GT.AsyncTaskWithType)
uploadArbitraryDataURL session id mName contents' = do uploadArbitraryDataURL session id mName contents' = do
let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents' contents = DSR.replace re "" contents'
task <- postWwwUrlencoded session p (bodyParams contents) eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType { task, typ: GT.Form } pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Form }) <$> eTask
where where
p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFile p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFile
...@@ -447,7 +444,6 @@ uploadTermButtonCpt :: R.Component UploadTermButtonProps ...@@ -447,7 +444,6 @@ uploadTermButtonCpt :: R.Component UploadTermButtonProps
uploadTermButtonCpt = here.component "uploadTermButton" cpt uploadTermButtonCpt = here.component "uploadTermButton" cpt
where where
cpt { dispatch cpt { dispatch
, id
, mFile , mFile
, nodeType , nodeType
, uploadType } _ = do , uploadType } _ = do
......
module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
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 Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, error, 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 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 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"
...@@ -34,13 +37,11 @@ type Props = ( ...@@ -34,13 +37,11 @@ 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
, onFinish , onFinish
} _ = do } _ = do
progress <- T.useBox 0.0 progress <- T.useBox 0.0
...@@ -49,16 +50,20 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt ...@@ -49,16 +50,20 @@ 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 case eAsyncProgress of
T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress Left _err -> throwError $ error "[asyncProgressBar] RESTError"
if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do Right asyncProgress -> do
_ <- case R.readRef intervalIdRef of let GT.AsyncProgress { status } = asyncProgress
Nothing -> pure unit liftEffect do
Just iid -> clearInterval iid T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
onFinish unit if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
else _ <- case R.readRef intervalIdRef of
pure unit Nothing -> pure unit
Just iid -> clearInterval iid
onFinish unit
else
pure unit
R.setRef intervalIdRef $ Just intervalId R.setRef intervalIdRef $ Just intervalId
...@@ -104,7 +109,7 @@ progressIndicatorCpt = here.component "progressIndicator" cpt ...@@ -104,7 +109,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 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"
...@@ -42,14 +42,14 @@ subTreeView = R.createElement subTreeViewCpt ...@@ -42,14 +42,14 @@ 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 , dispatch
, handed , handed
, id , id
, nodeType , nodeType
, session , session
, subTreeParams , subTreeParams
} _ = do } _ = do
let let
SubTreeParams {showtypes} = subTreeParams SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action -- (valAction /\ setAction) = action
...@@ -67,12 +67,12 @@ subTreeViewCpt = here.component "subTreeView" cpt ...@@ -67,12 +67,12 @@ subTreeViewCpt = here.component "subTreeView" cpt
, tree , tree
} [] } []
loadSubTree :: Array GT.NodeType -> Session -> Aff FTree 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,7 +88,7 @@ subTreeViewLoaded = R.createElement subTreeViewLoadedCpt ...@@ -88,7 +88,7 @@ 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@{ handed } _ = do
let pRender = Record.merge { render: subTreeTreeView } p let pRender = Record.merge { render: subTreeTreeView } p
pure $ H.div {className:"tree"} pure $ H.div {className:"tree"}
...@@ -108,7 +108,6 @@ subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt ...@@ -108,7 +108,6 @@ 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
, handed , handed
, id , id
, render , render
...@@ -142,7 +141,6 @@ subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where ...@@ -142,7 +141,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
...@@ -105,7 +107,7 @@ explorerCpt = here.component "explorer" cpt ...@@ -105,7 +107,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 +117,7 @@ explorerCpt = here.component "explorer" cpt ...@@ -115,7 +117,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 +287,7 @@ modeGraphType Types.Sources = "star" ...@@ -285,7 +287,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 +307,7 @@ transformGraph graph { edgeConfluence' ...@@ -305,8 +307,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 +326,10 @@ transformGraph graph { edgeConfluence' ...@@ -325,18 +326,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 +345,6 @@ transformGraph graph { edgeConfluence' ...@@ -352,13 +345,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"
} }
...@@ -2,33 +2,28 @@ module Gargantext.Components.GraphExplorer.Sidebar ...@@ -2,33 +2,28 @@ module Gargantext.Components.GraphExplorer.Sidebar
-- (Props, sidebar) -- (Props, sidebar)
where where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Control.Parallel (parTraverse) import Control.Parallel (parTraverse)
import Data.Array (head, last, concat) import Data.Array (head, last, concat)
import Data.Either (Either(..))
import Data.Int (fromString) import Data.Int (fromString)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RX
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Legend as Legend import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words) import Gargantext.Components.RandomText (words)
import Gargantext.Components.Search (SearchType(..), SearchQuery(..)) import Gargantext.Components.Search (SearchType(..), SearchQuery(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Array (mapMaybe) import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
...@@ -36,6 +31,13 @@ import Gargantext.Sessions (Session) ...@@ -36,6 +31,13 @@ import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType) import Gargantext.Types (CTabNgramType, NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
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 Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as RH
import Record as Record
import Record.Extra as RX
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Sidebar" here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
...@@ -318,13 +320,14 @@ type SendPatches = ...@@ -318,13 +320,14 @@ type SendPatches =
) )
sendPatches :: Record SendPatches -> Effect Unit sendPatches :: Record SendPatches -> Effect Unit
sendPatches { graphId, metaData, nodes, session, termList, reloadForest } = do sendPatches { metaData, nodes, session, termList, reloadForest } = do
launchAff_ do launchAff_ do
patches <- (parTraverse (sendPatch termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches) patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array NTC.VersionedNgramsPatches)
let mPatch = last patches let mPatch = last patches
case mPatch of case mPatch of
Nothing -> pure unit Nothing -> pure unit
Just (NTC.Versioned patch) -> do Just (Left _err) -> throwError $ error $ "[sendPatches] RESTError"
Just (Right (NTC.Versioned _patch)) -> do
liftEffect $ T2.reload reloadForest liftEffect $ T2.reload reloadForest
-- Why is this called delete node? -- Why is this called delete node?
...@@ -332,11 +335,14 @@ sendPatch :: TermList ...@@ -332,11 +335,14 @@ sendPatch :: TermList
-> Session -> Session
-> GET.MetaData -> GET.MetaData
-> Record SigmaxT.Node -> Record SigmaxT.Node
-> Aff NTC.VersionedNgramsPatches -> Aff (Either RESTError NTC.VersionedNgramsPatches)
sendPatch termList session (GET.MetaData metaData) node = do sendPatch termList session (GET.MetaData metaData) node = do
ret <- NTC.putNgramsPatches coreParams versioned eRet <- NTC.putNgramsPatches coreParams versioned
task <- NTC.postNgramsChartsAsync coreParams -- TODO add task case eRet of
pure ret Left err -> pure $ Left err
Right ret -> do
task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
pure $ Right ret
where where
nodeId :: NodeID nodeId :: NodeID
nodeId = unsafePartial $ fromJust $ fromString node.id nodeId = unsafePartial $ fromJust $ fromString node.id
......
...@@ -4,7 +4,10 @@ module Gargantext.Components.NgramsTable ...@@ -4,7 +4,10 @@ module Gargantext.Components.NgramsTable
, mainNgramsTable , mainNgramsTable
) where ) where
import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Either (Either(..))
import Data.FunctorWithIndex (mapWithIndex) import Data.FunctorWithIndex (mapWithIndex)
import Data.Lens (Lens', to, (%~), (.~), (^.), (^?), view) import Data.Lens (Lens', to, (%~), (.~), (^.), (^?), view)
import Data.Lens.At (at) import Data.Lens.At (at)
...@@ -28,20 +31,18 @@ import Effect.Aff (Aff) ...@@ -28,20 +31,18 @@ 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 Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Components.NgramsTable.Components as NTC import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Version, Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncResetButtons, toVersioned) import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Version, Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncResetButtons, toVersioned)
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI) import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) as R import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes) import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
...@@ -113,7 +114,6 @@ type TableContainerProps = ...@@ -113,7 +114,6 @@ type TableContainerProps =
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
tableContainer p q = R.createElement (tableContainerCpt p) q [] tableContainer p q = R.createElement (tableContainerCpt p) q []
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
tableContainerCpt { dispatch tableContainerCpt { dispatch
, ngramsChildren , ngramsChildren
...@@ -277,7 +277,6 @@ type Props = ...@@ -277,7 +277,6 @@ type Props =
loadedNgramsTable :: R2.Component Props loadedNgramsTable :: R2.Component Props
loadedNgramsTable = R.createElement loadedNgramsTableCpt loadedNgramsTable = R.createElement loadedNgramsTableCpt
loadedNgramsTableCpt :: R.Component Props loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
cpt props@{ afterSync cpt props@{ afterSync
...@@ -534,7 +533,6 @@ type MainNgramsTableProps = ( ...@@ -534,7 +533,6 @@ type MainNgramsTableProps = (
mainNgramsTable :: R2.Component MainNgramsTableProps mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt mainNgramsTable = R.createElement mainNgramsTableCpt
mainNgramsTableCpt :: R.Component MainNgramsTableProps mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = here.component "mainNgramsTable" cpt mainNgramsTableCpt = here.component "mainNgramsTable" cpt
where where
...@@ -588,7 +586,7 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -588,7 +586,7 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId) versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
-- NOTE With cache off -- NOTE With cache off
loader :: PageParams -> Aff VersionedWithCountNgramsTable loader :: PageParams -> Aff (Either RESTError VersionedWithCountNgramsTable)
loader path@{ listIds loader path@{ listIds
, nodeId , nodeId
, params: { limit, offset, orderBy } , params: { limit, offset, orderBy }
......
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) {}
...@@ -12,7 +12,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -12,7 +12,7 @@ module Gargantext.Components.NgramsTable.Core
, NgramsPatch(..) , NgramsPatch(..)
, NgramsPatches , NgramsPatches
, _NgramsTable , _NgramsTable
, NgramsTerm , NgramsTerm(..)
, normNgram , normNgram
, ngramsTermText , ngramsTermText
, findNgramRoot , findNgramRoot
...@@ -23,7 +23,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -23,7 +23,7 @@ module Gargantext.Components.NgramsTable.Core
, VersionedWithCount(..) , VersionedWithCount(..)
, toVersioned , toVersioned
, VersionedNgramsPatches , VersionedNgramsPatches
, AsyncNgramsChartsUpdate , AsyncNgramsChartsUpdate(..)
, VersionedNgramsTable , VersionedNgramsTable
, VersionedWithCountNgramsTable , VersionedWithCountNgramsTable
, NgramsTablePatch , NgramsTablePatch
...@@ -79,18 +79,18 @@ module Gargantext.Components.NgramsTable.Core ...@@ -79,18 +79,18 @@ module Gargantext.Components.NgramsTable.Core
) )
where where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Control.Monad.State (class MonadState, execState) import Control.Monad.State (class MonadState, execState)
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)
...@@ -103,11 +103,12 @@ import Data.List as L ...@@ -103,11 +103,12 @@ import Data.List as L
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust) import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
import Data.Monoid (class Monoid)
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
...@@ -117,36 +118,34 @@ import Data.Symbol (SProxy(..)) ...@@ -117,36 +118,34 @@ import Data.Symbol (SProxy(..))
import Data.These (These(..)) import Data.These (These(..))
import Data.Traversable (for, traverse_, traverse) import Data.Traversable (for, traverse_, traverse)
import Data.TraversableWithIndex (traverseWithIndex) import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..), snd) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, error, 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 as R
import Reactix.DOM.HTML as H
import Record as Record
import Partial (crashWith) import Partial (crashWith)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Reactix as R
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.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
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.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(..), 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 Gargantext.Utils.Toestand as T2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Core" here = R2.here "Gargantext.Components.NgramsTable.Core"
...@@ -905,7 +904,7 @@ setTermListP ngram patch_list = singletonNgramsTablePatch ngram pe ...@@ -905,7 +904,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)
...@@ -918,22 +917,25 @@ syncPatches props state callback = do ...@@ -918,22 +917,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
{- {-
...@@ -967,7 +969,7 @@ commitPatch tablePatch state = do ...@@ -967,7 +969,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}}
...@@ -986,7 +988,7 @@ loadNgramsTable ...@@ -986,7 +988,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 =
...@@ -997,11 +999,13 @@ loadNgramsTableAll { nodeId, listIds, session, scoreType } = do ...@@ -997,11 +999,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
...@@ -1124,8 +1128,10 @@ chartsAfterSync path'@{ nodeId } tasks _ = do ...@@ -1124,8 +1128,10 @@ chartsAfterSync path'@{ nodeId } tasks _ = do
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType postNgramsChartsAsync :: forall s. CoreParams s -> Aff 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 } case eTask of
Left _err -> liftEffect $ throwError $ error "[postNgramsChartsAsync] RESTError"
Right task -> pure $ AsyncTaskWithType { task, typ: UpdateNgramsCharts }
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 Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe, isJust) import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Tuple (fst)
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
...@@ -26,7 +25,7 @@ clearCache _ = GUC.delete $ GUC.CacheName cacheName ...@@ -26,7 +25,7 @@ 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)
, handleResponse :: Versioned res -> ret , handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
...@@ -49,7 +48,7 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer ...@@ -49,7 +48,7 @@ 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)
, handleResponse :: Versioned res -> ret , handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
...@@ -79,19 +78,22 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -79,19 +78,22 @@ useCachedAPILoaderEffect { cacheEndpoint
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, "data": d }) <- GUC.cachedJson cache req
cacheReal <- cacheEndpoint path eCacheReal <- cacheEndpoint path
val <- if version == cacheReal then case eCacheReal of
pure vr Left err -> throwError $ error $ "[useCachedAPILoaderEffect] RESTError"
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
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
...@@ -120,7 +122,6 @@ annuaireCpt = here.component "annuaire" cpt ...@@ -120,7 +122,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,7 +139,7 @@ pageLayout props = R.createElement pageLayoutCpt props [] ...@@ -138,7 +139,7 @@ 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 pagePath' (loadPage session) $
...@@ -175,8 +176,8 @@ pageCpt = here.component "page" cpt ...@@ -175,8 +176,8 @@ 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 { title: "Annuaire" } -- 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 +195,8 @@ contactCells :: Record ContactCellsProps -> R.Element ...@@ -194,9 +195,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 +224,6 @@ contactCellsCpt = here.component "contactCells" cpt where ...@@ -224,9 +224,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 +231,6 @@ contactCellsCpt = here.component "contactCells" cpt where ...@@ -234,8 +231,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 +273,8 @@ instance JSON.ReadForeign AnnuaireInfo where ...@@ -278,8 +273,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 +286,6 @@ loadPage session {nodeId, params: { offset, limit, orderBy }} = ...@@ -291,6 +286,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,7 +4,7 @@ module Gargantext.Components.Nodes.Annuaire.User ...@@ -4,7 +4,7 @@ module Gargantext.Components.Nodes.Annuaire.User
) )
where where
import Gargantext.Prelude (Unit, bind, discard, pure, show, ($), (<$>), (<<<), (<>)) 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)
...@@ -14,12 +14,15 @@ import Reactix as R ...@@ -14,12 +14,15 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT 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.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types as LT import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT import Gargantext.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
...@@ -91,7 +94,6 @@ type ContactInfoItemProps = ...@@ -91,7 +94,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
...@@ -172,7 +174,6 @@ type KeyLayoutProps = ( ...@@ -172,7 +174,6 @@ 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
...@@ -200,7 +201,6 @@ userLayoutCpt = here.component "userLayout" cpt ...@@ -200,7 +201,6 @@ userLayoutCpt = here.component "userLayout" cpt
userLayoutWithKey :: Record KeyLayoutProps -> R.Element userLayoutWithKey :: Record KeyLayoutProps -> R.Element
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
...@@ -243,9 +243,9 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt ...@@ -243,9 +243,9 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt
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 +253,14 @@ getContact session id = do ...@@ -253,14 +253,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
...@@ -3,11 +3,9 @@ module Gargantext.Components.Nodes.Annuaire.User.Contact ...@@ -3,11 +3,9 @@ module Gargantext.Components.Nodes.Annuaire.User.Contact
, contactLayout , contactLayout
) where ) where
import Gargantext.Prelude import Data.Either (Either)
( Unit, bind, const, discard, pure, show, ($), (<$>), (*>), (<<<), (<>) )
import Data.Lens as L import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
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)
...@@ -15,6 +13,8 @@ import Reactix as R ...@@ -15,6 +13,8 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
...@@ -27,6 +27,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types ...@@ -27,6 +27,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser ) , defaultContactWho, defaultHyperdataContact, defaultHyperdataUser )
import Gargantext.Components.Nodes.Lists.Types as LT import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT import Gargantext.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
...@@ -138,9 +139,6 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt ...@@ -138,9 +139,6 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataContact let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataContact
onUpdateHyperdata newHyperdata onUpdateHyperdata newHyperdata
listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }
type BasicProps = type BasicProps =
( frontends :: Frontends ( frontends :: Frontends
, nodeId :: Int , nodeId :: Int
...@@ -159,7 +157,7 @@ type LayoutProps = ( session :: Session | ReloadProps ) ...@@ -159,7 +157,7 @@ type LayoutProps = ( session :: Session | ReloadProps )
type KeyLayoutProps = ( key :: String, session :: Session | ReloadProps ) type KeyLayoutProps = ( key :: String, session :: Session | ReloadProps )
saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff Int saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff (Either RESTError Int)
saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "") saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")
type AnnuaireLayoutProps = ( annuaireId :: Int, session :: Session | ReloadProps ) type AnnuaireLayoutProps = ( annuaireId :: Int, session :: Session | ReloadProps )
...@@ -234,9 +232,9 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where ...@@ -234,9 +232,9 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
launchAff_ $ launchAff_ $
saveContactHyperdata session nodeId hd *> liftEffect (T2.reload reload) saveContactHyperdata session nodeId hd *> liftEffect (T2.reload reload)
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData' getAnnuaireContact :: Session -> Int -> Int -> Aff (Either RESTError ContactData')
getAnnuaireContact session annuaireId id = do getAnnuaireContact session annuaireId id = do
contactNode :: Contact' <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ show id eContactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ show 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
...@@ -244,4 +242,4 @@ getAnnuaireContact session annuaireId id = do ...@@ -244,4 +242,4 @@ getAnnuaireContact session annuaireId 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
...@@ -2,12 +2,11 @@ module Gargantext.Components.Nodes.Corpus where ...@@ -2,12 +2,11 @@ module Gargantext.Components.Nodes.Corpus where
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow) import Data.Generic.Rep (class Generic)
import Data.List as List import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..)) import Data.Show.Generic (genericShow)
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError) import Effect.Aff (Aff, launchAff_, throwError)
...@@ -25,12 +24,13 @@ import Gargantext.Components.InputWithEnter (inputWithEnter) ...@@ -25,12 +24,13 @@ import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList) import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..)) import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Components.Nodes.Types (FTField, FTFieldList(..), FTFieldWithIndex, FTFieldsWithIndex(..), Field(..), FieldType(..), Hash, Index, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython') import Gargantext.Components.Nodes.Types (FTField, FTFieldList(..), FTFieldWithIndex, FTFieldsWithIndex(..), Field(..), FieldType(..), Hash, Index, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython')
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Array as GDA import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>)) import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>))
import Gargantext.Routes (SessionRoute(Children, NodeAPI)) import Gargantext.Routes (SessionRoute(Children, NodeAPI))
import Gargantext.Sessions (Session, get, put, sessionId) import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (AffTableResult, NodeType(..)) import Gargantext.Types (AffETableResult, NodeType(..))
import Gargantext.Utils.Crypto as Crypto import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
...@@ -172,10 +172,14 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt ...@@ -172,10 +172,14 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
, session :: Session } -> e -> Effect Unit , session :: Session } -> e -> Effect Unit
onClickSave {fields: FTFieldsWithIndex fields, nodeId, reload, session} _ = do onClickSave {fields: FTFieldsWithIndex fields, nodeId, reload, session} _ = do
launchAff_ do launchAff_ do
saveCorpus $ { hyperdata: Hyperdata {fields: FTFieldList $ (_.ftField) <$> fields} res <- saveCorpus $ { hyperdata: Hyperdata {fields: FTFieldList $ (_.ftField) <$> fields}
, nodeId , nodeId
, session } , session }
liftEffect $ T2.reload reload liftEffect $ do
_ <- case res of
Left err -> log2 "[corpusLayoutView] onClickSave RESTError" err
_ -> pure unit
T2.reload reload
onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAdd fieldsS _ = do onClickAdd fieldsS _ = do
...@@ -453,11 +457,11 @@ type LoadProps = ...@@ -453,11 +457,11 @@ type LoadProps =
, session :: Session , session :: Session
) )
loadCorpus' :: Record LoadProps -> Aff (NodePoly Hyperdata) loadCorpus' :: Record LoadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadCorpus' {nodeId, session} = get session $ NodeAPI Corpus (Just nodeId) "" loadCorpus' {nodeId, session} = get session $ NodeAPI Corpus (Just nodeId) ""
-- Just to make reloading effective -- Just to make reloading effective
loadCorpusWithReload :: { reload :: T2.Reload | LoadProps } -> Aff (NodePoly Hyperdata) loadCorpusWithReload :: { reload :: T2.Reload | LoadProps } -> Aff (Either RESTError (NodePoly Hyperdata))
loadCorpusWithReload {nodeId, session} = loadCorpus' {nodeId, session} loadCorpusWithReload {nodeId, session} = loadCorpus' {nodeId, session}
type SaveProps = ( type SaveProps = (
...@@ -465,41 +469,69 @@ type SaveProps = ( ...@@ -465,41 +469,69 @@ type SaveProps = (
| LoadProps | LoadProps
) )
saveCorpus :: Record SaveProps -> Aff Unit saveCorpus :: Record SaveProps -> Aff (Either RESTError Int)
saveCorpus {hyperdata, nodeId, session} = do saveCorpus {hyperdata, nodeId, session} = do
_id <- (put session (NodeAPI Corpus (Just nodeId) "") hyperdata) :: Aff Int put session (NodeAPI Corpus (Just nodeId) "") hyperdata
pure unit
loadCorpus :: Record LoadProps -> Aff CorpusData loadCorpus :: Record LoadProps -> Aff (Either RESTError CorpusData)
loadCorpus {nodeId, session} = do loadCorpus {nodeId, session} = do
-- fetch corpus via lists parentId -- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute res <- get session nodePolyRoute
corpusNode <- get session $ corpusNodeRoute corpusId "" case res of
defaultListIds <- (get session $ defaultListIdsRoute corpusId) Left err -> pure $ Left err
:: forall a. JSON.ReadForeign a => AffTableResult (NodePoly a) Right (NodePoly {parentId: corpusId} :: NodePoly {}) -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of eCorpusNode <- get session $ corpusNodeRoute corpusId ""
Just (NodePoly { id: defaultListId }) -> eDefaultListIds <- (get session $ defaultListIdsRoute corpusId)
pure {corpusId, corpusNode, defaultListId} :: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a)
Nothing -> case eCorpusNode of
throwError $ error "Missing default list" Left err -> pure $ Left err
Right corpusNode -> do
case eDefaultListIds of
Left err -> pure $ Left err
Right defaultListIds -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId }
Nothing ->
throwError $ error "Missing default list"
-- (NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
-- corpusNode <- get session $ corpusNodeRoute corpusId ""
-- defaultListIds <- (get session $ defaultListIdsRoute corpusId)
-- :: forall a. JSON.ReadForeign a => AffTableResult (NodePoly a)
-- case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
-- Just (NodePoly { id: defaultListId }) ->
-- pure {corpusId, corpusNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
where where
nodePolyRoute = NodeAPI Corpus (Just nodeId) "" nodePolyRoute = NodeAPI Corpus (Just nodeId) ""
corpusNodeRoute = NodeAPI Corpus <<< Just corpusNodeRoute = NodeAPI Corpus <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
loadCorpusWithChild :: Record LoadProps -> Aff CorpusData loadCorpusWithChild :: Record LoadProps -> Aff (Either RESTError CorpusData)
loadCorpusWithChild { nodeId: childId, session } = do loadCorpusWithChild { nodeId: childId, session } = do
-- fetch corpus via lists parentId -- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session $ listNodeRoute childId "" eListNode <- get session $ listNodeRoute childId ""
corpusNode <- get session $ corpusNodeRoute corpusId "" case eListNode of
defaultListIds <- (get session $ defaultListIdsRoute corpusId) Left err -> pure $ Left err
:: forall a. JSON.ReadForeign a => AffTableResult (NodePoly a) Right listNode -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of let (NodePoly {parentId: corpusId} :: NodePoly {}) = listNode
Just (NodePoly { id: defaultListId }) -> eCorpusNode <- get session $ corpusNodeRoute corpusId ""
pure { corpusId, corpusNode, defaultListId } case eCorpusNode of
Nothing -> Left err -> pure $ Left err
throwError $ error "Missing default list" Right corpusNode -> do
eDefaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a)
case eDefaultListIds of
Left err -> pure $ Left err
Right defaultListIds -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId }
Nothing ->
throwError $ error "Missing default list"
where where
corpusNodeRoute = NodeAPI Corpus <<< Just corpusNodeRoute = NodeAPI Corpus <<< Just
listNodeRoute = NodeAPI Node <<< Just listNodeRoute = NodeAPI Node <<< Just
...@@ -514,7 +546,7 @@ type LoadWithReloadProps = ...@@ -514,7 +546,7 @@ type LoadWithReloadProps =
-- Just to make reloading effective -- Just to make reloading effective
loadCorpusWithChildAndReload :: Record LoadWithReloadProps -> Aff CorpusData loadCorpusWithChildAndReload :: Record LoadWithReloadProps -> Aff (Either RESTError CorpusData)
loadCorpusWithChildAndReload {nodeId, reload, session} = loadCorpusWithChild {nodeId, session} loadCorpusWithChildAndReload {nodeId, reload, session} = loadCorpusWithChild {nodeId, session}
data ViewType = Code | Folders data ViewType = Code | Folders
......
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) {}
module Gargantext.Components.Nodes.Corpus.Chart.Common where module Gargantext.Components.Nodes.Corpus.Chart.Common where
import Data.Tuple (fst) import Data.Either (Either)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
...@@ -10,6 +10,7 @@ import Toestand as T ...@@ -10,6 +10,7 @@ import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, ReloadPath) import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCacheAPI) import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCacheAPI)
import Gargantext.Utils.Crypto (Hash) import Gargantext.Utils.Crypto (Hash)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
...@@ -20,7 +21,7 @@ here :: R2.Here ...@@ -20,7 +21,7 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Common" here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Common"
type MetricsLoadViewProps a = ( type MetricsLoadViewProps a = (
getMetrics :: Session -> ReloadPath -> Aff a getMetrics :: Session -> ReloadPath -> Aff (Either RESTError a)
, loaded :: Record MetricsProps -> a -> R.Element , loaded :: Record MetricsProps -> a -> R.Element
| MetricsProps | MetricsProps
) )
...@@ -30,7 +31,6 @@ cacheName = "metrics" ...@@ -30,7 +31,6 @@ cacheName = "metrics"
metricsLoadView :: forall a. Eq a => Record (MetricsLoadViewProps a) -> R.Element metricsLoadView :: forall a. Eq a => Record (MetricsLoadViewProps a) -> R.Element
metricsLoadView p = R.createElement metricsLoadViewCpt p [] metricsLoadView p = R.createElement metricsLoadViewCpt p []
metricsLoadViewCpt :: forall a. Eq a => R.Component (MetricsLoadViewProps a) metricsLoadViewCpt :: forall a. Eq a => R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = here.component "metricsLoadView" cpt metricsLoadViewCpt = here.component "metricsLoadView" cpt
where where
...@@ -41,7 +41,7 @@ metricsLoadViewCpt = here.component "metricsLoadView" cpt ...@@ -41,7 +41,7 @@ metricsLoadViewCpt = here.component "metricsLoadView" cpt
loaded { path, reload, session, onClick, onInit } l loaded { path, reload, session, onClick, onInit } l
type MetricsWithCacheLoadViewProps res ret = ( type MetricsWithCacheLoadViewProps res ret = (
getMetricsHash :: Session -> ReloadPath -> Aff Hash getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret , handleResponse :: HashedResponse res -> ret
, loaded :: Record MetricsProps -> ret -> R.Element , loaded :: Record MetricsProps -> ret -> R.Element
, mkRequest :: ReloadPath -> GUC.Request , mkRequest :: ReloadPath -> GUC.Request
...@@ -52,7 +52,6 @@ metricsWithCacheLoadView :: forall res ret. ...@@ -52,7 +52,6 @@ metricsWithCacheLoadView :: forall res ret.
Eq ret => JSON.ReadForeign res => Eq ret => JSON.ReadForeign res =>
Record (MetricsWithCacheLoadViewProps res ret) -> R.Element Record (MetricsWithCacheLoadViewProps res ret) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p [] metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadViewCpt :: forall res ret. metricsWithCacheLoadViewCpt :: forall res ret.
Eq ret => JSON.ReadForeign res => Eq ret => JSON.ReadForeign res =>
R.Component (MetricsWithCacheLoadViewProps res ret) R.Component (MetricsWithCacheLoadViewProps res ret)
......
module Gargantext.Components.Nodes.Corpus.Chart.Histo where module Gargantext.Components.Nodes.Corpus.Chart.Histo where
import Data.Either (Either)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
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)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Charts.Options.Color (grey) import Reactix as R
import Gargantext.Components.Charts.Options.Color (grey, blue, green) import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Components.Charts.Options.Color (grey, blue)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Legend (LegendMode(..), selectedMode)
import Gargantext.Components.Charts.Options.Series (seriesBarD1) import Gargantext.Components.Charts.Options.Series (seriesBarD1)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath) import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..)) import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==)) import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
...@@ -23,10 +28,6 @@ import Gargantext.Types (ChartType(..)) ...@@ -23,10 +28,6 @@ import Gargantext.Types (ChartType(..))
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
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 Simple.JSON as JSON
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Histo" here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Histo"
...@@ -75,8 +76,8 @@ chartOptions { onClick, onInit } (HistoMetrics { dates: dates', count: count'}) ...@@ -75,8 +76,8 @@ chartOptions { onClick, onInit } (HistoMetrics { dates: dates', count: count'})
map mapSeriesBar count' map mapSeriesBar count'
] ]
getMetricsHash :: Session -> ReloadPath -> Aff String getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do getMetricsHash session (_ /\ { corpusId, listId, tabType }) = do
get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId) get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId)
where where
mListId = if listId == 0 then Nothing else (Just listId) mListId = if listId == 0 then Nothing else (Just listId)
...@@ -90,7 +91,7 @@ handleResponse :: HashedResponse ChartMetrics -> HistoMetrics ...@@ -90,7 +91,7 @@ handleResponse :: HashedResponse ChartMetrics -> HistoMetrics
handleResponse (HashedResponse { value: ChartMetrics ms }) = ms."data" handleResponse (HashedResponse { value: ChartMetrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
histo :: Record Props -> R.Element histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props [] histo props = R.createElement histoCpt props []
...@@ -114,7 +115,7 @@ histoCpt = here.component "histo" cpt ...@@ -114,7 +115,7 @@ histoCpt = here.component "histo" cpt
} }
loaded :: Record MetricsProps -> HistoMetrics -> R.Element loaded :: Record MetricsProps -> HistoMetrics -> R.Element
loaded p@{ path, reload, session } l = loaded p l =
H.div {} [ H.div {} [
{- U.reloadButton reload {- U.reloadButton reload
, U.chartUpdateButton { chartType: Histo, path, reload, session } , U.chartUpdateButton { chartType: Histo, path, reload, session }
......
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Either (Either)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Map as Map import Data.Map as Map
import Data.Map (Map) import Data.Map (Map)
...@@ -25,6 +26,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie) ...@@ -25,6 +26,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
(MetricsProps, Path, Props, ReloadPath) (MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..)) import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
...@@ -93,7 +95,7 @@ scatterOptions { onClick, onInit } metrics' = Options ...@@ -93,7 +95,7 @@ scatterOptions { onClick, onInit } metrics' = Options
} }
--} --}
getMetricsHash :: Session -> ReloadPath -> Aff String getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, listId, tabType }) = getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsHash { listId, tabType } (Just corpusId) get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
...@@ -104,7 +106,7 @@ handleResponse :: HashedResponse Metrics -> Loaded ...@@ -104,7 +106,7 @@ handleResponse :: HashedResponse Metrics -> Loaded
handleResponse (HashedResponse { value: Metrics ms }) = ms."data" handleResponse (HashedResponse { value: Metrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
metrics :: Record Props -> R.Element metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props [] metrics props = R.createElement metricsCpt props []
...@@ -129,7 +131,7 @@ metricsCpt = here.component "etrics" cpt ...@@ -129,7 +131,7 @@ metricsCpt = here.component "etrics" cpt
loaded :: Record MetricsProps -> Loaded -> R.Element loaded :: Record MetricsProps -> Loaded -> R.Element
loaded p@{ path, reload, session } loaded' = loaded p loaded' =
H.div {} [ H.div {} [
{- U.reloadButton reload {- U.reloadButton reload
, U.chartUpdateButton { chartType: Scatter, path, reload, session } , U.chartUpdateButton { chartType: Scatter, path, reload, session }
......
...@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Corpus.Chart.Pie where ...@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Data.Array (zip, filter) import Data.Array (zip, filter)
import Data.Array as A import Data.Array as A
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Either (Either)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
...@@ -22,6 +23,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie) ...@@ -22,6 +23,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1) import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Config.REST (RESTError)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
(MetricsProps, Path, Props, ReloadPath) (MetricsProps, Path, Props, ReloadPath)
...@@ -82,7 +84,7 @@ chartOptionsPie { onClick, onInit } (HistoMetrics { dates: dates', count: count' ...@@ -82,7 +84,7 @@ chartOptionsPie { onClick, onInit } (HistoMetrics { dates: dates', count: count'
, onInit , onInit
} }
getMetricsHash :: Session -> ReloadPath -> Aff String getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartHash { chartType: ChartPie, listId: mListId, tabType } (Just corpusId) get session $ ChartHash { chartType: ChartPie, listId: mListId, tabType } (Just corpusId)
where where
......
module Gargantext.Components.Nodes.Corpus.Chart.Tree where module Gargantext.Components.Nodes.Corpus.Chart.Tree 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)
...@@ -17,6 +18,7 @@ import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree) ...@@ -17,6 +18,7 @@ import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath) import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..)) import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
...@@ -54,7 +56,7 @@ scatterOptions { onClick, onInit } nodes = Options ...@@ -54,7 +56,7 @@ scatterOptions { onClick, onInit } nodes = Options
} }
getMetricsHash :: Session -> ReloadPath -> Aff String getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartHash { chartType: ChartTree, listId: mListId, tabType } (Just corpusId) get session $ ChartHash { chartType: ChartTree, listId: mListId, tabType } (Just corpusId)
where where
......
module Gargantext.Components.Nodes.Corpus.Dashboard where module Gargantext.Components.Nodes.Corpus.Dashboard where
import Gargantext.Prelude (Unit, bind, discard, pure, read, show, unit, ($), (<$>), (<>), (==))
import Data.Array as A import Data.Array as A
import Data.Either (Either(..))
import Data.List as List import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import DOM.Simple.Console (log, log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -12,11 +12,13 @@ import Reactix as R ...@@ -12,11 +12,13 @@ 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.Forest.Tree (doSearch)
import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor) import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField) import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, discard, pure, read, show, unit, ($), (<$>), (<>), (==))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (NodeID) import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -65,10 +67,14 @@ dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt ...@@ -65,10 +67,14 @@ dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
, fields :: FTFieldList } -> Effect Unit , fields :: FTFieldList } -> Effect Unit
onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do
launchAff_ do launchAff_ do
DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields } res <- DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields }
, nodeId:nodeId' , nodeId:nodeId'
, session } , session }
liftEffect $ T2.reload reload liftEffect $ do
_ <- case res of
Left err -> log2 "[dashboardLayoutWithKey] onChange RESTError" err
_ -> pure unit
T2.reload reload
type LoadedProps = type LoadedProps =
( charts :: Array P.PredefinedChart ( charts :: Array P.PredefinedChart
......
...@@ -2,6 +2,7 @@ module Gargantext.Components.Nodes.Corpus.Document where ...@@ -2,6 +2,7 @@ module Gargantext.Components.Nodes.Corpus.Document where
--import Data.Argonaut (encodeJson) -- DEBUG --import Data.Argonaut (encodeJson) -- DEBUG
--import Data.Argonaut.Core (stringifyWithIndent) -- DEBUG --import Data.Argonaut.Core (stringifyWithIndent) -- DEBUG
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
...@@ -21,6 +22,7 @@ import Gargantext.Components.NgramsTable.Core ...@@ -21,6 +22,7 @@ import Gargantext.Components.NgramsTable.Core
( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable ( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable
, replace, setTermListA, syncResetButtons, findNgramRoot ) , replace, setTermListA, syncResetButtons, findNgramRoot )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, sessionId) import Gargantext.Sessions (Session, get, sessionId)
...@@ -156,21 +158,24 @@ documentLayoutWithKeyCpt = here.component "documentLayoutWithKey" cpt ...@@ -156,21 +158,24 @@ documentLayoutWithKeyCpt = here.component "documentLayoutWithKey" cpt
------------------------------------------------------------------------ ------------------------------------------------------------------------
loadDocument :: Session -> Int -> Aff NodeDocument loadDocument :: Session -> Int -> Aff (Either RESTError NodeDocument)
loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) "" loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) ""
loadData :: DocPath -> Aff LoadedData loadData :: DocPath -> Aff (Either RESTError LoadedData)
loadData { listIds, nodeId, session, tabType } = do loadData { listIds, nodeId, session, tabType } = do
document <- loadDocument session nodeId eDocument <- loadDocument session nodeId
ngramsTable <- loadNgramsTable case eDocument of
{ listIds Left err -> pure $ Left err
, nodeId Right document -> do
, params: { offset : 0, limit : 100, orderBy: Nothing, searchType: SearchDoc} eNgramsTable <- loadNgramsTable
, scoreType: Occurrences { listIds
, searchQuery: "" , nodeId
, session , params: { offset : 0, limit : 100, orderBy: Nothing, searchType: SearchDoc}
, tabType , scoreType: Occurrences
, termListFilter: Nothing , searchQuery: ""
, termSizeFilter: Nothing , session
} , tabType
pure { document, ngramsTable } , termListFilter: Nothing
, termSizeFilter: Nothing
}
pure $ (\ngramsTable -> { document, ngramsTable }) <$> eNgramsTable
...@@ -2,19 +2,19 @@ module Gargantext.Components.Nodes.Dashboard.Types where ...@@ -2,19 +2,19 @@ module Gargantext.Components.Nodes.Dashboard.Types where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Either (Either)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
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)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Simple.JSON as JSON
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Types (FTFieldList) import Gargantext.Components.Nodes.Types (FTFieldList)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put) import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Simple.JSON as JSON
type Preferences = Maybe String type Preferences = Maybe String
...@@ -40,19 +40,18 @@ instance Eq Hyperdata where ...@@ -40,19 +40,18 @@ instance Eq Hyperdata where
type LoadProps = ( nodeId :: Int, session :: Session ) type LoadProps = ( nodeId :: Int, session :: Session )
loadDashboard' :: Record LoadProps -> Aff DashboardData loadDashboard' :: Record LoadProps -> Aff (Either RESTError DashboardData)
loadDashboard' {nodeId, session} = get session $ NodeAPI Node (Just nodeId) "" loadDashboard' {nodeId, session} = get session $ NodeAPI Node (Just nodeId) ""
-- Just to make reloading effective -- Just to make reloading effective
loadDashboardWithReload :: {reload :: Int | LoadProps} -> Aff DashboardData loadDashboardWithReload :: {reload :: Int | LoadProps} -> Aff (Either RESTError DashboardData)
loadDashboardWithReload {nodeId, session} = loadDashboard' {nodeId, session} loadDashboardWithReload {nodeId, session} = loadDashboard' {nodeId, session}
type SaveProps = ( hyperdata :: Hyperdata | LoadProps ) type SaveProps = ( hyperdata :: Hyperdata | LoadProps )
saveDashboard :: Record SaveProps -> Aff Unit saveDashboard :: Record SaveProps -> Aff (Either RESTError Int)
saveDashboard {hyperdata, nodeId, session} = do saveDashboard {hyperdata, nodeId, session} = do
_id <- (put session (NodeAPI Node (Just nodeId) "") hyperdata) :: Aff Int put session (NodeAPI Node (Just nodeId) "") hyperdata
pure unit
newtype DashboardData = newtype DashboardData =
DashboardData DashboardData
......
module Gargantext.Components.Nodes.File where module Gargantext.Components.Nodes.File where
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
...@@ -10,10 +11,12 @@ import Reactix.DOM.HTML as H ...@@ -10,10 +11,12 @@ import Reactix.DOM.HTML as H
import Simple.JSON as JSON import Simple.JSON as JSON
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (toUrl) import Gargantext.Ends (toUrl)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, sessionId) import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..), NodeID) import Gargantext.Types (NodeType(..), NodeID)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -49,16 +52,14 @@ type FileLayoutProps = ( nodeId :: NodeID, session :: Session ) ...@@ -49,16 +52,14 @@ type FileLayoutProps = ( nodeId :: NodeID, session :: Session )
fileLayout :: R2.Leaf FileLayoutProps fileLayout :: R2.Leaf FileLayoutProps
fileLayout props = R.createElement fileLayoutCpt props [] fileLayout props = R.createElement fileLayoutCpt props []
fileLayoutCpt :: R.Component FileLayoutProps fileLayoutCpt :: R.Component FileLayoutProps
fileLayoutCpt = here.component "fileLayout" cpt where fileLayoutCpt = here.component "fileLayout" cpt where
cpt { nodeId, session } _ = do cpt { nodeId, session } _ = do
useLoader nodeId (loadFile session) onLoad useLoader nodeId (loadFile session) onLoad
where where
onLoad loaded = fileLayoutLoaded { loaded, nodeId, session } onLoad loaded = fileLayoutLoaded { loaded, nodeId, session }
key = show (sessionId session) <> "-" <> show nodeId
loadFile :: Session -> NodeID -> Aff File loadFile :: Session -> NodeID -> Aff (Either RESTError File)
loadFile session nodeId = get session $ NodeAPI Node (Just nodeId) "" loadFile session nodeId = get session $ NodeAPI Node (Just nodeId) ""
type FileLayoutLoadedProps = type FileLayoutLoadedProps =
...@@ -68,7 +69,6 @@ type FileLayoutLoadedProps = ...@@ -68,7 +69,6 @@ type FileLayoutLoadedProps =
fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element
fileLayoutLoaded props = R.createElement fileLayoutLoadedCpt props [] fileLayoutLoaded props = R.createElement fileLayoutLoadedCpt props []
fileLayoutLoadedCpt :: R.Component FileLayoutLoadedProps fileLayoutLoadedCpt :: R.Component FileLayoutLoadedProps
fileLayoutLoadedCpt = here.component "fileLayoutLoaded" cpt where fileLayoutLoadedCpt = here.component "fileLayoutLoaded" cpt where
cpt { loaded: File { hyperdata: HyperdataFile hyperdata }, nodeId, session } _ = do cpt { loaded: File { hyperdata: HyperdataFile hyperdata }, nodeId, session } _ = do
......
...@@ -2,15 +2,14 @@ module Gargantext.Components.Nodes.Frame where ...@@ -2,15 +2,14 @@ module Gargantext.Components.Nodes.Frame where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Argonaut (decodeJson, (.:)) import DOM.Simple as DOM
import Data.Argonaut as Argonaut import Data.Either (Either)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
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)
import Data.Nullable (Nullable, null, toMaybe) import Data.Nullable (Nullable, null, toMaybe)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import DOM.Simple as DOM
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
...@@ -20,6 +19,7 @@ import Web.URL as WURL ...@@ -20,6 +19,7 @@ import Web.URL as WURL
import Gargantext.Components.FolderView as FV import Gargantext.Components.FolderView as FV
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, sessionId) import Gargantext.Sessions (Session, get, sessionId)
...@@ -93,10 +93,8 @@ frameLayoutViewCpt :: R.Component ViewProps ...@@ -93,10 +93,8 @@ frameLayoutViewCpt :: R.Component ViewProps
frameLayoutViewCpt = here.component "frameLayoutView" cpt frameLayoutViewCpt = here.component "frameLayoutView" cpt
where where
cpt { frame: NodePoly { hyperdata: Hyperdata { base, frame_id }} cpt { frame: NodePoly { hyperdata: Hyperdata { base, frame_id }}
, nodeId
, nodeType , nodeType
, reload , reload } _ = do
, session } _ = do
case nodeType of case nodeType of
NodeFrameVisio -> NodeFrameVisio ->
case WURL.fromAbsolute base of case WURL.fromAbsolute base of
...@@ -128,10 +126,7 @@ nodeFrameVisioCpt :: R.Component NodeFrameVisioProps ...@@ -128,10 +126,7 @@ nodeFrameVisioCpt :: R.Component NodeFrameVisioProps
nodeFrameVisioCpt = here.component "nodeFrameVisio" cpt nodeFrameVisioCpt = here.component "nodeFrameVisio" cpt
where where
cpt { frame_id cpt { frame_id
, reload
, url } _ = do , url } _ = do
-- api = new JitsiMeetExternalAPI("visio.gargantext.org", {roomName: frame_id})
api <- T.useBox (Nothing :: Maybe JM.JitsiMeet)
ref <- R.useRef (null :: Nullable DOM.Element) ref <- R.useRef (null :: Nullable DOM.Element)
R.useEffect' $ do R.useEffect' $ do
...@@ -152,9 +147,9 @@ type ReloadProps = ( nodeId :: Int ...@@ -152,9 +147,9 @@ type ReloadProps = ( nodeId :: Int
, reload :: T2.Reload , reload :: T2.Reload
, session :: Session ) , session :: Session )
loadframe' :: Record LoadProps -> Aff (NodePoly Hyperdata) loadframe' :: Record LoadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadframe' { nodeId, session } = get session $ NodeAPI Node (Just nodeId) "" loadframe' { nodeId, session } = get session $ NodeAPI Node (Just nodeId) ""
-- Just to make reloading effective -- Just to make reloading effective
loadframeWithReload :: Record ReloadProps -> Aff (NodePoly Hyperdata) loadframeWithReload :: Record ReloadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadframeWithReload { nodeId, session } = loadframe' { nodeId, session } loadframeWithReload { nodeId, session } = loadframe' { nodeId, session }
module Gargantext.Components.Nodes.Home.Public where module Gargantext.Components.Nodes.Home.Public 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.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.String (take) import Data.String (take)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Config (publicBackend) import Gargantext.Config (publicBackend)
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get, RESTError)
import Gargantext.Ends (backendUrl) import Gargantext.Ends (backendUrl)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude import Gargantext.Prelude
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 Simple.JSON.Generics as JSONG
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Home.Public" here = R2.here "Gargantext.Components.Nodes.Home.Public"
...@@ -44,7 +46,7 @@ type LoadData = () ...@@ -44,7 +46,7 @@ type LoadData = ()
type LoadProps = (reload :: Int) type LoadProps = (reload :: Int)
-- | WIP still finding the right way to chose the default public backend -- | WIP still finding the right way to chose the default public backend
loadPublicData :: Record LoadProps -> Aff (Array PublicData) loadPublicData :: Record LoadProps -> Aff (Either RESTError (Array PublicData))
loadPublicData _l = do loadPublicData _l = do
-- This solution is error prone (url needs to be cleaned) -- This solution is error prone (url needs to be cleaned)
--backend <- liftEffect public --backend <- liftEffect public
...@@ -76,7 +78,6 @@ renderPublicCpt = here.component "renderPublic" cpt where ...@@ -76,7 +78,6 @@ renderPublicCpt = here.component "renderPublic" cpt where
publicLayout :: Record PublicDataProps -> R.Element publicLayout :: Record PublicDataProps -> R.Element
publicLayout props = R.createElement publicLayoutCpt props [] publicLayout props = R.createElement publicLayoutCpt props []
publicLayoutCpt :: R.Component PublicDataProps publicLayoutCpt :: R.Component PublicDataProps
publicLayoutCpt = here.component "publicLayout" cpt publicLayoutCpt = here.component "publicLayout" cpt
where where
......
...@@ -5,6 +5,12 @@ import Gargantext.Prelude ...@@ -5,6 +5,12 @@ import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RE
import Toestand as T
import Gargantext.Components.App.Data (Boxes) import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Footer (footer) import Gargantext.Components.Footer (footer)
import Gargantext.Components.Forest as Forest import Gargantext.Components.Forest as Forest
...@@ -36,11 +42,6 @@ import Gargantext.Sessions (Session, WithSession) ...@@ -36,11 +42,6 @@ import Gargantext.Sessions (Session, WithSession)
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded) import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RE
import Toestand as T
here :: R2.Here here :: R2.Here
......
module Gargantext.Config.REST where module Gargantext.Config.REST where
import Affjax (defaultRequest, printError, request) import Gargantext.Prelude
import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded, string)
import Affjax (defaultRequest, request)
import Affjax as Affjax
import Affjax.RequestBody (formData, formURLEncoded, string)
import Affjax.RequestHeader as ARH import Affjax.RequestHeader as ARH
import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseFormat as ResponseFormat
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log2)
import Data.Argonaut.Core as AC import Data.Argonaut.Core as AC
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.FormURLEncoded as FormURLEncoded import Data.FormURLEncoded as FormURLEncoded
import Data.Generic.Rep (class Generic)
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData) import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple)
import DOM.Simple.Console (log2) import Effect.Aff (Aff)
import Effect.Aff (Aff, throwError)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Foreign as Foreign
import Milkis as Milkis
import Unsafe.Coerce (unsafeCoerce)
import Simple.JSON as JSON import Simple.JSON as JSON
import Web.XHR.FormData as XHRFormData import Web.XHR.FormData as XHRFormData
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type Token = String type Token = String
readJSONOrFail affResp = data RESTError =
SendResponseError Affjax.Error
| ReadJSONError Foreign.MultipleErrors
derive instance Generic RESTError _
instance Eq RESTError where
-- this is crude but we need it only because of useLoader
eq _ _ = false
readJSON :: forall a b. JSON.ReadForeign a =>
Either Affjax.Error
{ body :: AC.Json
| b
} -> Either RESTError a
readJSON affResp =
case affResp of case affResp of
Left err -> do Left err -> do
_ <- liftEffect $ log $ printError err -- _ <- liftEffect $ log $ printError err
throwError $ error $ printError err --throwError $ error $ printError err
Left $ SendResponseError err
Right resp -> do Right resp -> do
--_ <- liftEffect $ log json.status --_ <- liftEffect $ log json.status
--_ <- liftEffect $ log json.headers --_ <- liftEffect $ log json.headers
--_ <- liftEffect $ log json.body --_ <- liftEffect $ log json.body
case JSON.readJSON (AC.stringify resp.body) of case (JSON.readJSON $ AC.stringify resp.body) of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err Left err -> Left $ ReadJSONError err
Right b -> pure b Right r -> Right r
-- readJSONOrFail affResp = do
-- case readJSON affResp of
-- Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
-- Right b -> pure b
-- TODO too much duplicate code in `postWwwUrlencoded` -- TODO too much duplicate code in `postWwwUrlencoded`
send :: forall body res. JSON.WriteForeign body => JSON.ReadForeign res => send :: forall body res. JSON.WriteForeign body => JSON.ReadForeign res =>
Method -> Maybe Token -> String -> Maybe body -> Aff res Method -> Maybe Token -> String -> Maybe body -> Aff (Either RESTError res)
send m mtoken url reqbody = do send m mtoken url reqbody = do
let req = defaultRequest let req = defaultRequest
{ url = url { url = url
...@@ -62,36 +82,37 @@ send m mtoken url reqbody = do ...@@ -62,36 +82,37 @@ send m mtoken url reqbody = do
let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax" let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax"
R2.setCookie cookie R2.setCookie cookie
affResp <- request req affResp <- request req
readJSONOrFail affResp liftEffect $ log2 "affResp" affResp
pure $ readJSON affResp
noReqBody :: Maybe String noReqBody :: Maybe String
noReqBody = Just "" noReqBody = Just ""
--noReqBody = Nothing --noReqBody = Nothing
get :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff a get :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
get mtoken url = send GET mtoken url noReqBody get mtoken url = send GET mtoken url noReqBody
put :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff b put :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
put mtoken url = send PUT mtoken url <<< Just put mtoken url = send PUT mtoken url <<< Just
put_ :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff a put_ :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
put_ mtoken url = send PUT mtoken url noReqBody put_ mtoken url = send PUT mtoken url noReqBody
delete :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff a delete :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
delete mtoken url = send DELETE mtoken url noReqBody delete mtoken url = send DELETE mtoken url noReqBody
-- This might not be a good idea: -- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body -- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff b deleteWithBody :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
deleteWithBody mtoken url = send DELETE mtoken url <<< Just deleteWithBody mtoken url = send DELETE mtoken url <<< Just
post :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff b post :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
post mtoken url = send POST mtoken url <<< Just post mtoken url = send POST mtoken url <<< Just
type FormDataParams = Array (Tuple String (Maybe String)) type FormDataParams = Array (Tuple String (Maybe String))
-- TODO too much duplicate code with `send` -- TODO too much duplicate code with `send`
postWwwUrlencoded :: forall b. JSON.ReadForeign b => Maybe Token -> String -> FormDataParams -> Aff b postWwwUrlencoded :: forall b. JSON.ReadForeign b => Maybe Token -> String -> FormDataParams -> Aff (Either RESTError b)
postWwwUrlencoded mtoken url bodyParams = do postWwwUrlencoded mtoken url bodyParams = do
affResp <- request $ defaultRequest affResp <- request $ defaultRequest
{ url = url { url = url
...@@ -105,11 +126,11 @@ postWwwUrlencoded mtoken url bodyParams = do ...@@ -105,11 +126,11 @@ postWwwUrlencoded mtoken url bodyParams = do
) mtoken ) mtoken
, content = Just $ formURLEncoded urlEncodedBody , content = Just $ formURLEncoded urlEncodedBody
} }
readJSONOrFail affResp pure $ readJSON affResp
where where
urlEncodedBody = FormURLEncoded.fromArray bodyParams urlEncodedBody = FormURLEncoded.fromArray bodyParams
postMultipartFormData :: forall b. JSON.ReadForeign b => Maybe Token -> String -> String -> Aff b postMultipartFormData :: forall b. JSON.ReadForeign b => Maybe Token -> String -> String -> Aff (Either RESTError b)
postMultipartFormData mtoken url body = do postMultipartFormData mtoken url body = do
fd <- liftEffect $ XHRFormData.new fd <- liftEffect $ XHRFormData.new
_ <- liftEffect $ XHRFormData.append (XHRFormData.EntryName "body") body fd _ <- liftEffect $ XHRFormData.append (XHRFormData.EntryName "body") body fd
...@@ -125,4 +146,4 @@ postMultipartFormData mtoken url body = do ...@@ -125,4 +146,4 @@ postMultipartFormData mtoken url body = do
) mtoken ) mtoken
, content = Just $ formData fd , content = Just $ formData fd
} }
readJSONOrFail affResp pure $ readJSON affResp
module Gargantext.Hooks.Loader where module Gargantext.Hooks.Loader where
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), isJust, maybe) import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Tuple (fst)
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)
...@@ -13,6 +12,7 @@ import Simple.JSON as JSON ...@@ -13,6 +12,7 @@ import Simple.JSON as JSON
import Toestand as T import Toestand as T
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Config.REST (RESTError)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.Crypto (Hash) import Gargantext.Utils.Crypto (Hash)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
...@@ -30,7 +30,7 @@ clearCache _ = GUC.delete $ GUC.CacheName cacheName ...@@ -30,7 +30,7 @@ clearCache _ = GUC.delete $ GUC.CacheName cacheName
useLoader :: forall path st. Eq path => Eq st useLoader :: forall path st. Eq path => Eq st
=> path => path
-> (path -> Aff st) -> (path -> Aff (Either RESTError st))
-> (st -> R.Element) -> (st -> R.Element)
-> R.Hooks R.Element -> R.Hooks R.Element
useLoader path loader' render = do useLoader path loader' render = do
...@@ -61,7 +61,7 @@ loaderCpt = here.component "loader" cpt ...@@ -61,7 +61,7 @@ loaderCpt = here.component "loader" cpt
useLoaderEffect :: forall st path. Eq path => Eq st => useLoaderEffect :: forall st path. Eq path => Eq st =>
path path
-> T.Box (Maybe st) -> T.Box (Maybe st)
-> (path -> Aff st) -> (path -> Aff (Either RESTError st))
-> R.Hooks Unit -> R.Hooks Unit
useLoaderEffect path state loader = do useLoaderEffect path state loader = do
state' <- T.useLive T.unequal state state' <- T.useLive T.unequal state
...@@ -75,7 +75,9 @@ useLoaderEffect path state loader = do ...@@ -75,7 +75,9 @@ useLoaderEffect path state loader = do
R.setRef oPath path R.setRef oPath path
R2.affEffect "G.H.Loader.useLoaderEffect" $ do R2.affEffect "G.H.Loader.useLoaderEffect" $ do
l <- loader path l <- loader path
liftEffect $ T.write_ (Just l) state case l of
Left _err -> throwError $ error "[useLoaderEffect] RESTError"
Right l' -> liftEffect $ T.write_ (Just l') state
newtype HashedResponse a = HashedResponse { hash :: Hash, value :: a } newtype HashedResponse a = HashedResponse { hash :: Hash, value :: a }
...@@ -85,7 +87,7 @@ derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a ...@@ -85,7 +87,7 @@ derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a) derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a)
type LoaderWithCacheAPIProps path res ret = ( type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff Hash cacheEndpoint :: path -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret , handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
...@@ -109,7 +111,7 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer ...@@ -109,7 +111,7 @@ 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 Hash cacheEndpoint :: path -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret , handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
...@@ -141,14 +143,17 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -141,14 +143,17 @@ useCachedAPILoaderEffect { cacheEndpoint
-- TODO Parallelize? -- TODO Parallelize?
hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req
cacheReal <- cacheEndpoint path cacheReal <- cacheEndpoint path
val <- if hash == cacheReal then case cacheReal of
pure hr Left _err -> throwError $ error $ "[useCachedAPILoaderEffect] RESTError"
else do Right cacheReal' -> do
_ <- GUC.deleteReq cache req val <- if hash == cacheReal' then
hr'@(HashedResponse { hash: h }) <- GUC.cachedJson cache req pure hr
if h == cacheReal then else do
pure hr' _ <- GUC.deleteReq cache req
else hr'@(HashedResponse { hash: h }) <- GUC.cachedJson cache req
throwError $ error $ "[Hooks.Loader] Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal if h == cacheReal' then
liftEffect $ do pure hr'
T.write_ (Just $ handleResponse val) state else
throwError $ error $ "[Hooks.Loader] Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal'
liftEffect $ do
T.write_ (Just $ handleResponse val) state
...@@ -28,9 +28,6 @@ import Gargantext.Ends (class ToUrl, Backend, toUrl) ...@@ -28,9 +28,6 @@ import Gargantext.Ends (class ToUrl, Backend, toUrl)
import Gargantext.Sessions.Types (Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId, sessionUrl, sessionId, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove) import Gargantext.Sessions.Types (Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId, sessionUrl, sessionId, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Sessions"
type WithSession c = type WithSession c =
( session :: Session ( session :: Session
| c ) | c )
...@@ -113,44 +110,42 @@ saveSessions sessions = effect *> pure sessions where ...@@ -113,44 +110,42 @@ saveSessions sessions = effect *> pure sessions where
| null sessions = rem | null sessions = rem
| otherwise = set (JSON.writeJSON sessions) | otherwise = set (JSON.writeJSON sessions)
updateSession :: Session -> Effect Unit
updateSession s = do
ss <- loadSessions
_ <- saveSessions $ update s ss
pure unit
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session) postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) = postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> REST.post Nothing (toUrl backend "auth") ar decode <$> REST.post Nothing (toUrl backend "auth") ar
where where
decode (AuthResponse ar2) decode (Left _err) = Left "Error when sending REST.post"
decode (Right (AuthResponse ar2))
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message | {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 = | {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username } Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username }
| otherwise = Left "Invalid response from server" | otherwise = Left "Invalid response from server"
get :: forall a p. JSON.ReadForeign a => ToUrl Session p => Session -> p -> Aff a get :: forall a p. JSON.ReadForeign a => ToUrl Session p =>
Session -> p -> Aff (Either REST.RESTError a)
get session@(Session {token}) p = REST.get (Just token) (toUrl session p) get session@(Session {token}) p = REST.get (Just token) (toUrl session p)
put :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b put :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
put session@(Session {token}) p = REST.put (Just token) (toUrl session p) put session@(Session {token}) p = REST.put (Just token) (toUrl session p)
put_ :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> Aff b put_ :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> Aff (Either REST.RESTError b)
put_ session@(Session {token}) p = REST.put_ (Just token) (toUrl session p) put_ session@(Session {token}) p = REST.put_ (Just token) (toUrl session p)
delete :: forall a p. JSON.ReadForeign a => ToUrl Session p => Session -> p -> Aff a delete :: forall a p. JSON.ReadForeign a => ToUrl Session p =>
Session -> p -> Aff (Either REST.RESTError a)
delete session@(Session {token}) p = REST.delete (Just token) (toUrl session p) delete session@(Session {token}) p = REST.delete (Just token) (toUrl session p)
-- This might not be a good idea: -- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body -- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b deleteWithBody :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (toUrl session p) deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (toUrl session p)
post :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b post :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
post session@(Session {token}) p = REST.post (Just token) (toUrl session p) post session@(Session {token}) p = REST.post (Just token) (toUrl session p)
postWwwUrlencoded :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> REST.FormDataParams -> Aff b postWwwUrlencoded :: forall b p. JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> REST.FormDataParams -> Aff (Either REST.RESTError b)
postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p) postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)
postMultipartFormData :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> String -> Aff b
postMultipartFormData session@(Session {token}) p = REST.postMultipartFormData (Just token) (toUrl session p)
module Gargantext.Types where module Gargantext.Types where
import Gargantext.Prelude
import CSS.Cursor (Cursor(..))
import Data.Array as A import Data.Array as A
import Data.Either (Either)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Int (toNumber) import Data.Int (toNumber)
...@@ -11,15 +15,16 @@ import Data.Show.Generic (genericShow) ...@@ -11,15 +15,16 @@ import Data.Show.Generic (genericShow)
import Data.String as S import Data.String as S
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Foreign as F import Foreign as F
import Gargantext.Components.Lang (class Translate, Lang(..))
import Gargantext.Prelude
import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
import Prim.Row (class Union) import Prim.Row (class Union)
import Reactix as R import Reactix as R
import Simple.JSON as JSON import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG import Simple.JSON.Generics as JSONG
import URI.Query (Query) import URI.Query (Query)
import Gargantext.Components.Lang (class Translate, Lang(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
data Handed = LeftHanded | RightHanded data Handed = LeftHanded | RightHanded
switchHanded :: forall a. a -> a -> Handed -> a switchHanded :: forall a. a -> a -> Handed -> a
...@@ -621,6 +626,7 @@ instance DecodeJson TabType where ...@@ -621,6 +626,7 @@ instance DecodeJson TabType where
type TableResult a = {count :: Int, docs :: Array a} type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a) type AffTableResult a = Aff (TableResult a)
type AffETableResult a = Aff (Either RESTError (TableResult a))
data Mode = Authors data Mode = Authors
| Sources | Sources
...@@ -771,3 +777,9 @@ toggleSidePanelState :: SidePanelState -> SidePanelState ...@@ -771,3 +777,9 @@ toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed = Opened toggleSidePanelState Closed = Opened
toggleSidePanelState Opened = Closed toggleSidePanelState Opened = Closed
---------------------------------------------------------------------------
newtype FrontendError = FrontendError
{ error :: String
}
module Gargantext.Version where module Gargantext.Version where
import Prelude
import DOM.Simple.Console (log2)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Prelude
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
...@@ -22,7 +24,7 @@ type Version = String ...@@ -22,7 +24,7 @@ type Version = String
foreign import version :: Version foreign import version :: Version
getBackendVersion :: Session -> Aff Version getBackendVersion :: Session -> Aff (Either REST.RESTError Version)
getBackendVersion (Session { backend }) = REST.get Nothing (toUrl backend "version") getBackendVersion (Session { backend }) = REST.get Nothing (toUrl backend "version")
...@@ -33,7 +35,6 @@ type VersionProps = ...@@ -33,7 +35,6 @@ type VersionProps =
versionView :: R2.Component VersionProps versionView :: R2.Component VersionProps
versionView = R.createElement versionCpt versionView = R.createElement versionCpt
versionCpt :: R.Component VersionProps versionCpt :: R.Component VersionProps
versionCpt = here.component "version" cpt versionCpt = here.component "version" cpt
where where
...@@ -44,7 +45,9 @@ versionCpt = here.component "version" cpt ...@@ -44,7 +45,9 @@ versionCpt = here.component "version" cpt
R.useEffect' $ do R.useEffect' $ do
launchAff_ $ do launchAff_ $ do
v <- getBackendVersion session v <- getBackendVersion session
liftEffect $ T.write_ v versionBack case v of
Right v' -> liftEffect $ T.write_ v' versionBack
Left err -> liftEffect $ log2 "[version] error" err
pure $ case version == versionBack' of pure $ case version == versionBack' of
true -> H.a { className: "fa fa-check-circle-o" true -> H.a { className: "fa fa-check-circle-o"
......
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