Commit 6d3b1fc8 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Graph] initial async graph update endpoint

parent e13b7804
module Gargantext.Components.GraphExplorer.API where
import Gargantext.Prelude
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
type GraphAsyncUpdateParams =
(
graphId :: Int
, listId :: Int
, nodes :: Array (Record SigmaxT.Node)
, session :: Session
, termList :: GT.TermList
, version :: NTC.Version
)
graphAsyncUpdate :: Record GraphAsyncUpdateParams -> Aff GT.AsyncTaskWithType
graphAsyncUpdate {graphId, listId, nodes, session, termList, version} = do
task <- post session p q
pure $ GT.AsyncTaskWithType { task, typ: GT.GraphT }
where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphT
q = { listId
, nodes
, termList
, version
}
......@@ -13,15 +13,18 @@ import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.GraphExplorer.API as GAPI
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words)
import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends, url)
......@@ -29,7 +32,7 @@ import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Types as GT
import Gargantext.Types (NodeType(..)) as GT
import Gargantext.Utils.Reactix as R2
type Props =
......@@ -127,7 +130,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
onClickRemove rType props nodesMap e = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap) $ Set.toUnfoldable $ fst props.selectedNodeIds
deleteNodes rType props.session props.metaData props.graphVersion nodes
deleteNodes rType props.session props.metaData props.graphId props.graphVersion nodes
snd props.removedNodeIds $ const $ fst props.selectedNodeIds
snd props.selectedNodeIds $ const SigmaxT.emptyNodeIds
......@@ -152,15 +155,22 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected
where
selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
deleteNodes :: TermList -> Session -> GET.MetaData -> R.State Int -> Array (Record SigmaxT.Node) -> Effect Unit
deleteNodes termList session metaData (_ /\ setGraphVersion) nodes = do
deleteNodes :: TermList -> Session -> GET.MetaData -> Int -> R.State Int -> Array (Record SigmaxT.Node) -> Effect Unit
deleteNodes termList session (GET.MetaData metaData) graphId _ nodes = do
launchAff_ do
patches <- (parTraverse (deleteNode termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches)
let mPatch = last patches
case mPatch of
Nothing -> pure unit
Just (NTC.Versioned patch) -> pure unit --liftEffect do
--setGraphVersion $ const $ patch.version
task <- GAPI.graphAsyncUpdate { graphId, listId, nodes, termList, session, version }
liftEffect $ log2 "task" task
where
listId = metaData.list.listId
version = metaData.list.version
-- launchAff_ do
-- patches <- (parTraverse (deleteNode termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches)
-- let mPatch = last patches
-- case mPatch of
-- Nothing -> pure unit
-- Just (NTC.Versioned patch) -> pure unit --liftEffect do
-- --setGraphVersion $ const $ patch.version
deleteNode :: TermList -> Session -> GET.MetaData -> Record SigmaxT.Node -> Aff NTC.VersionedNgramsPatches
deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches coreParams versioned
......@@ -170,7 +180,7 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
versioned :: NTC.VersionedNgramsPatches
versioned = NTC.Versioned {version: metaData.list.version, data: np}
coreParams :: NTC.CoreParams ()
coreParams = {session, nodeId: nodeId, listIds: [metaData.list.listId], tabType}
coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
tabNgramType :: CTabNgramType
tabNgramType = modeTabType node.gargType
tabType :: TabType
......@@ -192,7 +202,7 @@ query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _)
where
query' Nothing = RH.div {} []
query' (Just corpusId) =
GT.tabs {frontends, session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]}
CGT.tabs {frontends, session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]}
q id = case Map.lookup id nodesMap of
Nothing -> []
Just n -> words n.label
......
......@@ -117,6 +117,7 @@ sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t))
sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s))
sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId) <> p
sessionPath (R.GraphAPI gId p) = "graph/" <> (show gId) <> "/" <> p
sessionPath (R.GetNgrams opts i) =
base opts.tabType
$ "ngrams?ngramsType="
......
......@@ -37,6 +37,7 @@ data SessionRoute
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST.
| NodeAPI NodeType (Maybe Id) String
| GraphAPI Id String
| ListsRoute ListId
| ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id)
......
......@@ -436,15 +436,6 @@ data Mode = Authors | Sources | Institutes | Terms
derive instance genericMode :: Generic Mode _
decodeMode :: String -> Either String Mode
decodeMode tag =
case tag of
"Authors" -> Right Authors
"Institutes" -> Right Institutes
"Sources" -> Right Sources
"NgramsTerms" -> Right Terms
_ -> Left $ "Error decoding mode: unknown tag '" <> tag <> "'"
instance showMode :: Show Mode where
show = genericShow
......@@ -452,6 +443,9 @@ derive instance eqMode :: Eq Mode
instance ordMode :: Ord Mode where
compare = genericCompare
instance encodeMode :: EncodeJson Mode where
encodeJson x = encodeJson $ show x
modeTabType :: Mode -> CTabNgramType
modeTabType Authors = CTabAuthors
modeTabType Sources = CTabSources
......@@ -468,11 +462,12 @@ modeFromString _ = Nothing
-- Async tasks
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form | Query
data AsyncTaskType = Form | GraphT | Query
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath GraphT = "async/nobody/"
asyncTaskTypePath Query = "add/query/async/"
type AsyncTaskID = String
......
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