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
Pipeline #1705 failed with stage
module Gargantext.Components.App.Data (App, Boxes, emptyApp) where
import Data.Set as Set
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Toestand as T
import Gargantext.Prelude
......@@ -15,11 +15,12 @@ import Gargantext.Routes (AppRoute(Home))
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Session, Sessions)
import Gargantext.Sessions.Types (OpenNodes(..))
import Gargantext.Types (Handed(RightHanded), SidePanelState(..))
import Gargantext.Types (FrontendError, Handed(RightHanded), SidePanelState(..))
import Gargantext.Utils.Toestand as T2
type App =
{ backend :: Maybe Backend
, errors :: Array FrontendError
, forestOpen :: OpenNodes
, graphVersion :: T2.Reload
, handed :: Handed
......@@ -42,6 +43,7 @@ type App =
emptyApp :: App
emptyApp =
{ backend : Nothing
, errors : []
, forestOpen : OpenNodes $ Set.empty
, graphVersion : T2.newReload
, handed : RightHanded
......@@ -63,6 +65,7 @@ emptyApp =
type Boxes =
{ backend :: T.Box (Maybe Backend)
, errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
, graphVersion :: T2.ReloadS
, handed :: T.Box Handed
......
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Map as Map
import Data.Maybe (Maybe(..))
......@@ -10,16 +13,13 @@ import Reactix as R
import Reactix.DOM.HTML as H
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.Utils.Reactix as R2
import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories, LocalUserScore)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, put)
import Gargantext.Types (NodeID, NodeType(..))
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Category"
......@@ -63,7 +63,7 @@ instance JSON.WriteForeign RatingQuery where
writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
, 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
ratingRoute = NodeAPI Node (Just nodeId) "category"
......@@ -147,5 +147,5 @@ instance JSON.WriteForeign CategoryQuery where
categoryRoute :: Int -> SessionRoute
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
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
import Gargantext.Prelude
import Prelude
import Control.Monad.Error.Class (throwError)
import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Map as Map
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Newtype (class Newtype)
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set as Set
import Data.Set as Set
import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends, url)
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.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes as Routes
......@@ -41,7 +46,6 @@ import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
......@@ -221,9 +225,9 @@ type PageParams = {
, yearFilter :: Maybe Year
}
getPageHash :: Session -> PageParams -> Aff String
getPageHash session { nodeId, tabType } = do
(get session $ tableHashRoute nodeId tabType) :: Aff String
getPageHash :: Session -> PageParams -> Aff (Either RESTError String)
getPageHash session { nodeId, tabType } =
get session $ tableHashRoute nodeId tabType
convOrderBy :: Maybe (TT.OrderByDirection TT.ColumnName) -> Maybe OrderBy
convOrderBy (Just (TT.ASC (TT.ColumnName "Date"))) = Just DateAsc
......@@ -261,7 +265,6 @@ filterDocsByYear year docs = A.filter filterFunc docs
pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt where
cpt props@{ cacheState
......@@ -318,12 +321,12 @@ pageLayoutCpt = here.component "pageLayout" cpt where
paramsS' <- T.useLive T.unequal paramsS
let loader p = do
let route = tableRouteWithPage (p { params = paramsS', query = query })
res <- get session $ route
eRes <- get session $ route
liftEffect $ do
here.log2 "table route" route
here.log2 "table res" res
pure $ handleResponse res
render (Tuple count documents) = pagePaintRaw { documents
here.log2 "table res" eRes
pure $ handleResponse <$> eRes
let render (Tuple count documents) = pagePaintRaw { documents
, layout: props { params = paramsS'
, totalRecords = count }
, localCategories
......@@ -562,7 +565,7 @@ tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchTyp
q = queryParamS "query" query
y = mQueryParam "year" yearFilter
deleteAllDocuments :: Session -> Int -> Aff (Array Int)
deleteAllDocuments :: Session -> Int -> Aff (Either RESTError (Array Int))
deleteAllDocuments session = delete session <<< documentsRoute
-- TODO: not optimal but Data.Set lacks some function (Set.alter)
......
......@@ -3,16 +3,18 @@
-- has not been ported to this module yet.
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.Show.Generic (genericShow)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
......@@ -21,16 +23,12 @@ import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Category (CategoryQuery(..), putCategories)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
import Gargantext.Components.Search
( Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..)
, SearchQuery, SearchResult(..), SearchResultTypes(..) )
import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(Search, NodeAPI))
......@@ -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 nodeId deletions deletions' = do
......@@ -221,8 +213,8 @@ type PagePath = { nodeId :: Int
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
loadPage :: PagePath -> Aff Rows
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
loadPage :: PagePath -> Aff (Either RESTError Rows)
loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy }} = do
let
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
......@@ -235,12 +227,15 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc
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 query
-- $ SearchQuery {query: concat query, expected: SearchDoc}
pure $ 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
eSearchResult <- post session p query
case eSearchResult of
Left err -> pure $ Left err
Right (SearchResult {result}) ->
-- $ SearchQuery {query: concat query, expected: SearchDoc}
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 { id
......@@ -417,7 +412,7 @@ derive instance Generic DeleteDocumentQuery _
derive instance Newtype 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 =
deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
module Gargantext.Components.FolderView where
import DOM.Simple.Console (log, log2)
import Control.Monad.Error.Class (throwError)
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (null)
import Data.Traversable (traverse_)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff, error)
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.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
......@@ -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.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Ordering, Unit, bind, compare, discard, pure, unit, void, ($), (<$>), (<>))
import Gargantext.Routes (AppRoute(Home), SessionRoute(..), appPath, nodeTypeAppRoute)
......@@ -32,10 +40,6 @@ import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
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 link :: String -> Effect Unit
......@@ -246,7 +250,7 @@ type LoadProps =
reload :: T2.Reload
)
loadFolders :: Record LoadProps -> Aff FTree
loadFolders :: Record LoadProps -> Aff (Either RESTError FTree)
loadFolders {nodeId, session} = get session $ TreeFirstLevel (Just nodeId) ""
type PerformActionProps =
......@@ -295,7 +299,7 @@ performAction = performAction' where
_ -> void $ deleteNode p.session nt id
refreshFolders p
doSearch task p@{ tasks, nodeId: id } = liftEffect $ do
doSearch task { tasks, nodeId: id } = liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] DoSearch task:" task
......@@ -323,12 +327,15 @@ performAction = performAction' where
log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ tasks, nodeId: id } = do
task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ session } = traverse_ f params where
eTask <- uploadArbitraryFile p.session id { blob, mName }
case eTask of
Left _err -> throwError $ error "[uploadArbitraryFile] RESTError"
Right task -> do
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out
refreshFolders p
......
......@@ -2,12 +2,14 @@ module Gargantext.Components.Forest.Tree where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse_, traverse)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff, error)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -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.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute)
......@@ -83,10 +86,10 @@ treeLoaderCpt = here.component "treeLoader" cpt where
common = RecordE.pick p :: Record Common
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) ""
getNodeTreeFirstLevel :: Session -> ID -> Aff FTree
getNodeTreeFirstLevel :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
type NodeProps = ( reloadTree :: T2.ReloadS, session :: Session | Common )
......@@ -244,10 +247,13 @@ uploadFile' nodeType fileType mName contents p@{ tasks, tree: (NTree (LNode { id
log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
eTask <- uploadArbitraryFile p.session id { blob, mName }
case eTask of
Left err -> throwError $ error $ "[uploadArbitraryFile'] RESTError"
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
f (SubTreeOut { in: in', out }) = do
......
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.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Newtype (class Newtype)
import Data.String (Pattern(..), indexOf)
import Data.Tuple.Nested ((/\))
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.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, panel, submitButton)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang(..), translate)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), charCodeIcon)
import Gargantext.Types as GT
import Gargantext.Utils (nbsp)
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 "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) ""
addNodeAsync :: Session
......@@ -40,9 +45,12 @@ addNodeAsync :: Session
-> AddNodeValue
-> Aff GT.AsyncTaskWithType
addNodeAsync session parentId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
where p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
eTask :: Either RESTError GT.AsyncTask <- post session p q
case eTask of
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
......
......@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff)
import Formula as F
......@@ -11,6 +12,7 @@ import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
......@@ -20,7 +22,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here
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 =
post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact"
......@@ -56,8 +58,8 @@ textInputBox :: R2.Leaf TextInputBoxProps
textInputBox props = R.createElement textInputBoxCpt props []
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt p@{ boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ =
cpt { boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ =
content <$> T.useLive T.unequal isOpen
<*> T.useBox firstname <*> T.useBox lastname
where
......
module Gargantext.Components.Forest.Tree.Node.Action.Delete
where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Types as GT
import Gargantext.Types (NodeType(..))
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
......@@ -21,7 +23,7 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Delete"
-- 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) ""
{-
......@@ -32,7 +34,7 @@ deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
-}
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)
......
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.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Data.Show.Generic (genericShow)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
......@@ -14,10 +18,10 @@ import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
......@@ -33,9 +37,11 @@ derive newtype instance JSON.WriteForeign LinkNodeReq
linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff GT.AsyncTaskWithType
linkNodeReq session nt fromId toId = do
task <- post session (NodeAPI GT.Node (Just fromId) "update")
(LinkNodeReq { nodeType: linkNodeType nt, id: toId })
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
eTask :: Either RESTError GT.AsyncTask <- post session (NodeAPI GT.Node (Just fromId) "update")
(LinkNodeReq { nodeType: linkNodeType nt, id: toId })
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 (Just GT.Corpus) = GT.Annuaire
......@@ -48,7 +54,7 @@ linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt
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.useLive T.unequal action
......
module Gargantext.Components.Forest.Tree.Node.Action.Merge where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Effect.Aff (Aff)
......@@ -10,16 +13,16 @@ import Toestand as T
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.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
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 =
put_ session $ NodeAPI GT.Node (Just fromId) ("merge/" <> show toId)
......@@ -28,7 +31,7 @@ mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt
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.useLive T.unequal action
......
module Gargantext.Components.Forest.Tree.Node.Action.Move where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
......@@ -19,7 +21,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here
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 =
put_ session $ NodeAPI GT.Node (Just fromId) ("move/" <> show toId)
......
module Gargantext.Components.Forest.Tree.Node.Action.Rename where
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
......@@ -8,14 +10,15 @@ import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types as GT
import Gargantext.Types (ID)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
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 =
put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename"
......
module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Control.Monad.Error.Class (throwError)
import Data.Array (concat)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype)
......@@ -9,15 +11,17 @@ import Data.Set as Set
import Data.String as String
import Data.Tuple (Tuple)
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.Generics as JSONG
import URI.Extra.QueryPairs as QP
import URI.Query as Q
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.Routes as GR
import Gargantext.Sessions (Session(..), post)
......@@ -368,7 +372,9 @@ instance JSON.WriteForeign SearchQuery where
performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType
performSearch session nodeId q = do