Commit bbb84c58 authored by arturo's avatar arturo

>>> continue

parent feeb4a48
Pipeline #2489 canceled with stage
......@@ -17,7 +17,7 @@ import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeLink)
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList, nodeActionsPhylo)
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
......@@ -304,6 +304,7 @@ nodeActionsCpt = here.component "nodeActions" cpt where
childProps = Record.delete nodeActionsP props
child GT.NodeList = listNodeActions childProps
child GT.Graph = graphNodeActions childProps
child GT.Phylo = phyloNodeActions childProps
child _ = H.div {} []
graphNodeActions :: R2.Leaf NodeActionsCommon
......@@ -318,6 +319,14 @@ graphNodeActionsCpt = here.component "graphNodeActions" cpt where
graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
errorHandler = logRESTError here "[graphNodeActions]"
phyloNodeActions :: R2.Leaf NodeActionsCommon
phyloNodeActions = R2.leafComponent phyloNodeActionsCpt
phyloNodeActionsCpt :: R.Component NodeActionsCommon
phyloNodeActionsCpt = here.component "phyloNodeActions" cpt where
cpt { id, session, refresh } _ = pure $
nodeActionsPhylo { id, session, refresh }
listNodeActions :: R2.Leaf NodeActionsCommon
listNodeActions = R2.leafComponent listNodeActionsCpt
listNodeActionsCpt :: R.Component NodeActionsCommon
......@@ -331,4 +340,3 @@ listNodeActionsCpt = here.component "listNodeActions" cpt where
, nodeType: GT.TabNgramType GT.CTabTerms } }
where
errorHandler = logRESTError here "[listNodeActions]"
module Gargantext.Components.Forest.Tree.Node.Tools.Sync where
import Gargantext.Prelude (Unit, bind, discard, pure, unit, ($), (<>), (==))
import Effect.Aff (Aff, launchAff_)
import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Reactix.DOM.HTML as H
import Reactix as R
import Toestand as T
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Types as GT
import Gargantext.Components.PhyloExplorer.API as PhyloAPI
import Gargantext.Prelude (Unit, bind, discard, pure, unit, ($), (<>), (==))
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Utils ((?))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.Sync"
......@@ -71,6 +75,64 @@ graphUpdateButtonCpt = here.component "graphUpdateButton" cpt
refresh unit
pure unit
-- | Sync Node (Phylo)
type NodeActionsPhyloProps =
( id :: GT.ID
, session :: Session
, refresh :: Unit -> Aff Unit
)
nodeActionsPhylo :: R2.Leaf NodeActionsPhyloProps
nodeActionsPhylo = R2.leaf nodeActionsPhyloCpt
nodeActionsPhyloCpt :: R.Component NodeActionsPhyloProps
nodeActionsPhyloCpt = here.component "nodeActionsPhylo" cpt where
cpt { id, session, refresh } _ = pure $
H.div { className: "node-actions" }
[
phyloUpdateButton
{ id, session, refresh }
]
type PhyloUpdateButtonProps =
( id :: GT.ID
, session :: Session
, refresh :: Unit -> Aff Unit
)
phyloUpdateButton :: R2.Leaf PhyloUpdateButtonProps
phyloUpdateButton = R2.leaf phyloUpdateButtonCpt
phyloUpdateButtonCpt :: R.Component PhyloUpdateButtonProps
phyloUpdateButtonCpt = here.component "phyloUpdateButton" cpt where
cpt { id, session, refresh } _ = do
enabled /\ enabledBox <- R2.useBox' true
let
onClick :: forall e. T.Box (Boolean) -> Boolean -> e -> Effect Unit
onClick box value _ = case value of
false -> pure unit
true -> launchAff_ do
liftEffect $ T.write_ false box
_ <- PhyloAPI.update session id unit
liftEffect $ T.write_ true box
refresh unit
pure $
H.div
{ className: intercalate " "
[ "update-button"
, enabled == true ?
"enabled" $
"disabled text-muted"
]
}
[
H.span
{ className: "fa fa-refresh"
, on: { click: onClick enabledBox enabled }
} []
]
-- | Sync Node (List)
type NodeActionsNodeListProps =
(
......
......@@ -4,44 +4,69 @@ module Gargantext.Components.Nodes.Corpus.Phylo
import Gargantext.Prelude
import Affjax as AX
import Affjax.ResponseFormat as ResponseFormat
import DOM.Simple (document, querySelector)
import DOM.Simple.Console (log2)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import FFI.Simple ((..), (.=))
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.PhyloExplorer.API (get)
import Gargantext.Components.PhyloExplorer.Layout (layout)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet, parsePhyloJSONSet)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet)
import Gargantext.Config.REST (logRESTError)
import Gargantext.Hooks.FirstEffect (useFirstEffect')
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
type Props =
type MainProps =
( nodeId :: NodeID
, session :: Session
, boxes :: Boxes
)
phyloLayout :: R2.Component Props
phyloLayout = R.createElement component
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Phylo"
componentName :: String
componentName = "Gargantext.Components.Nodes.Corpus.Phylo.Main"
phyloLayout :: R2.Leaf MainProps
phyloLayout = R2.leaf phyloLayoutCpt
component :: R.Component Props
component = R.hooksComponent componentName cpt where
cpt { nodeId } _ = do
phyloLayoutCpt :: R.Component MainProps
phyloLayoutCpt = here.component "main" cpt where
cpt { nodeId, session } _ = do
fetchedData /\ fetchedDataBox <- R2.useBox' (Nothing :: Maybe PhyloDataSet)
let
errorHandler = logRESTError here "[phylo]"
handler (dataset :: PhyloDataSet) =
content
{ nodeId
, dataset
}
useLoader
{ errorHandler
, loader: get session
, path: nodeId
, render: handler
}
--------------------------------------------------------
type ContentProps =
( nodeId :: NodeID
, dataset :: PhyloDataSet
)
content :: R2.Leaf ContentProps
content = R2.leaf contentCpt
contentCpt :: R.Component ContentProps
contentCpt = here.component "content" cpt where
cpt { nodeId, dataset } _ = do
-- Hooks
useFirstEffect' do
-- @XXX: inopinent <div> (see Gargantext.Components.Router) (@TODO?)
......@@ -60,33 +85,10 @@ component = R.hooksComponent componentName cpt where
style <- pure $ (el .. "style")
pure $ (style .= "padding") "initial"
useFirstEffect' $ launchAff_ do
result <- fetchPhyloJSON
liftEffect $ case result of
Left err -> log2 "error" err
Right res -> T.write_ (Just res) fetchedDataBox
pure case fetchedData of
Nothing -> mempty
Just phyloDataSet -> layout { phyloDataSet, nodeId } []
-- Render
pure $
fetchPhyloJSON :: Aff (Either String PhyloDataSet)
fetchPhyloJSON =
let
-- @WIP remove dumb data
-- url = "http://localhost:5000/js/knowledge-phylomemy.json"
-- url = "http://localhost:5000/js/vaccines_countries_06_2021.json"
url = "js/vaccines_countries_06_2021.json"
request = AX.defaultRequest
{ url = url
, method = Left GET
, responseFormat = ResponseFormat.string
layout
{ nodeId
, phyloDataSet: dataset
}
in do
result <- request # AX.request
liftEffect $ case result of
Left err -> pure $ Left $ AX.printError err
Right response -> case JSON.readJSON response.body of
Left err -> pure $ Left $ show err
Right (res :: PhyloJSONSet) -> pure $ Right $ parsePhyloJSONSet res
module Gargantext.Components.PhyloExplorer.API
( get, update ) where
import Gargantext.Prelude
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet, parsePhyloJSONSet)
import Gargantext.Config.REST (AffRESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions as S
import Gargantext.Types (NodeID)
get :: S.Session -> NodeID -> AffRESTError (PhyloDataSet)
get session nodeId = request >>= (_ <#> parsePhyloJSONSet) >>> pure
where
request :: AffRESTError (PhyloJSONSet)
request = S.get session $ PhyloAPI nodeId
-- @WIP: change `Unit` to actual Record of options
update :: S.Session -> NodeID -> Unit -> AffRESTError (PhyloDataSet)
update session nodeId _ = request >>= (_ <#> parsePhyloJSONSet) >>> pure
where
request :: AffRESTError (PhyloJSONSet)
request = S.post session (PhyloAPI nodeId) {}
......@@ -38,8 +38,9 @@ type Props =
, nodeId :: NodeID
)
layout :: R2.Component Props
layout = R.createElement layoutCpt
layout :: R2.Leaf Props
layout = R2.leaf layoutCpt
layoutCpt :: R.Component Props
layoutCpt = here.component "layout" cpt where
cpt { phyloDataSet: (PhyloDataSet o)
......
......@@ -27,6 +27,7 @@ import Gargantext.Components.Nodes.Corpus.Code (corpusCodeLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentMainLayout)
import Gargantext.Components.Nodes.Corpus.Phylo (phyloLayout)
import Gargantext.Components.Nodes.Corpus.Phylo as PhyloExplorer
import Gargantext.Components.Nodes.File (fileLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
......@@ -427,25 +428,45 @@ graphExplorerCpt :: R.Component SessionNodeProps
graphExplorerCpt = here.component "graphExplorer" cpt where
cpt props@{ boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
GraphExplorer.explorerLayoutWithKey { boxes
let
sessionProps = RE.pick props :: Record SessionProps
authedProps =
Record.merge
{ content:
\session -> GraphExplorer.explorerLayoutWithKey
{ boxes
, graphId: nodeId
, key: "graphId-" <> show nodeId
, session } [] } sessionProps) []
-- GraphExplorer.explorerLayout { boxes
-- , graphId: nodeId
-- , session } [] } sessionProps) []
, session }
[]
}
sessionProps
pure $ authed authedProps []
phyloExplorer :: R2.Component SessionNodeProps
phyloExplorer = R.createElement phyloExplorerCpt
phyloExplorerCpt :: R.Component SessionNodeProps
phyloExplorerCpt = here.component "phylo" cpt
where
cpt props@{ nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
phyloLayout { nodeId, session } [] } sessionProps) []
phyloExplorerCpt = here.component "phylo" cpt where
cpt props@{ boxes
, nodeId } _ = do
let
sessionProps = (RE.pick props :: Record SessionProps)
authedProps =
Record.merge
{ content:
\session -> PhyloExplorer.phyloLayout
{ boxes
, nodeId
, session
}
}
sessionProps
pure $ authed authedProps []
home :: R2.Component Props
......
......@@ -91,7 +91,6 @@ staticUrl (Frontends {static}) = frontendUrl static
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 $ fromMaybe 0 pId) <> p
sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
......@@ -195,7 +194,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) =
<> "&listType=" <> show MapTerm -- listId
<> defaultListAddMaybe listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe 0 pId) <> p
sessionPath (R.PhyloAPI nId) = "node/" <> show nId
------- misc routing stuff
......
......@@ -58,6 +58,7 @@ data SessionRoute
| Chart ChartOpts (Maybe Id)
| ChartHash { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id)
-- | AnnuaireContact AnnuaireId DocId
| PhyloAPI Id
instance Show AppRoute where
show Home = "Home"
......
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