Commit 2c8919d5 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE] fix conflict.

parents 22ba8a84 66b0c8ce
......@@ -88,3 +88,5 @@ t' :: Node -> Legend
t' (Node r) = Legend { id_ : clustDefault, label : r.label}
where
(Cluster {clustDefault}) = r.attributes
module Gargantext.Pages.Corpus.Graph where
import Gargantext.Prelude
import Affjax (defaultRequest, request)
import Affjax.ResponseFormat (printResponseFormatError)
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (decodeJson)
import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Config.REST (get)
import Gargantext.Utils (getter)
import Math (cos, sin)
import Partial.Unsafe (unsafePartial)
import React (ReactElement)
......@@ -15,15 +28,10 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config.REST (get)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter)
data Action
= LoadGraph String
= LoadGraph Int --- need to make it as String
| SelectNode SelectedNode
newtype SelectedNode = SelectedNode {id :: String, label :: String}
......@@ -54,15 +62,15 @@ graphSpec = simpleSpec performAction render
performAction :: PerformAction State {} Action
performAction (LoadGraph fp) _ _ = void do
_ <- logs fp
case fp of
"" -> do
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing}
_ -> do
_ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing}
gd <- lift $ getGraphData fp
_ <- modifyState \(State s) -> State s { sigmaGraphData = Nothing}
gd <- lift $ getNodes fp
-- TODO: here one might `catchError getGraphData` to visually empty the
-- graph.
modifyState \(State s) -> State s {filePath = fp, graphData = gd, sigmaGraphData = Just $ convert gd, legendData = getLegendData gd}
case gd of
Left err -> do
_ <- liftEffect $ log err
modifyState identity
Right resp -> modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp}
performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node}
......@@ -87,18 +95,7 @@ convert (GraphData r) = SigmaGraphData { nodes, edges}
render :: Render State {} Action
render d p (State s) c =
[ select [ onChange $ \e -> d $ LoadGraph (unsafeCoerce e).target.value, value s.filePath]
[ option [value ""] [text ""]
, option [value "example_01_clean.json"] [text "example_01_clean.json"]
, option [value "example_01_conditional.json"] [text "example_01_conditional.json"]
, option [value "example_01_distributional.json"] [text "example_01_distributional.json"]
, option [value "example_02.json"] [text "example_02.json"]
, option [value "example_02_clean.json"] [text "example_02_clean.json"]
, option [value "example_03.json"] [text "example_03.json"]
, option [value "example_03_clean.json"] [text "example_03_clean.json"]
, option [value "imtNew.json"] [text "imtNew.json"]
-- , option [value "exemplePhyloBipartite.gexf"] [text "exemplePhyloBipartite.gexf"]
]
[
]
<>
case s.sigmaGraphData of
......@@ -271,7 +268,7 @@ specOld = simpleSpec performAction render'
render' :: Render State {} Action
render' d _ (State st) _ =
[ div [className "row"] [
div [className "col-md-12", style {marginTop : "21px", marginBottom : "21px"}]
div [className "col-md-12", style {marginTop : "34px", marginBottom : "21px"}]
[ menu [_id "toolbar"]
[ ul'
[
......@@ -341,20 +338,7 @@ specOld = simpleSpec performAction render'
, div [className "row"]
[ div [className "col-md-9"]
[ div [style {border : "1px black solid", height: "90%"}] $
[ select [ onChange $ \e -> d $ LoadGraph (unsafeCoerce e).target.value
, value st.filePath
]
[ option [value ""] [text ""]
, option [value "example_01_clean.json"] [text "example_01_clean.json"]
, option [value "example_01_conditional.json"] [text "example_01_conditional.json"]
, option [value "example_01_distributional.json"] [text "example_01_distributional.json"]
, option [value "example_02.json"] [text "example_02.json"]
, option [value "example_02_clean.json"] [text "example_02_clean.json"]
, option [value "example_03.json"] [text "example_03.json"]
, option [value "example_03_clean.json"] [text "example_03_clean.json"]
, option [value "imtNew.json"] [text "imtNew.json"]
-- , option [value "exemplePhyloBipartite.gexf"] [text "exemplePhyloBipartite.gexf"]
]
[
]
<>
case st.sigmaGraphData of
......@@ -477,3 +461,27 @@ specOld = simpleSpec performAction render'
]
]
]
getNodes :: Int -> Aff (Either String GraphData)
getNodes graphId = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/api/v1.0/graph/"<> show graphId
, responseFormat = ResponseFormat.json
, method = Left GET
, headers = []
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
......@@ -55,9 +55,10 @@ dispatchAction dispatcher _ (Document n) = do
dispatcher $ SetRoute $ Document n
dispatcher $ DocumentViewA $ Document.Load n
dispatchAction dispatcher _ PGraphExplorer = do
dispatcher $ SetRoute PGraphExplorer
dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
dispatchAction dispatcher _ (PGraphExplorer nid) = do
dispatcher $ SetRoute $ PGraphExplorer nid
dispatcher $ GraphExplorerA $ GE.LoadGraph nid
--dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
dispatchAction dispatcher _ Dashboard = do
dispatcher $ SetRoute Dashboard
......@@ -59,7 +59,7 @@ pagesComponent s = case s.currentRoute of
selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec (PGraphExplorer i) = layout0 $ focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout
......
......@@ -20,7 +20,8 @@ data Routes
| Corpus Int
| AddCorpus
| Document Int
| PGraphExplorer
| PGraphExplorer Int
| NGramsTable
| Dashboard
| Annuaire Int
| UserPage Int
......@@ -34,7 +35,7 @@ routing =
<|> Corpus <$> (route "corpus" *> int)
<|> Document <$> (route "document" *> int)
<|> Dashboard <$ route "dashboard"
<|> PGraphExplorer <$ route "graph"
<|> PGraphExplorer <$> (route "graph" *> int )
<|> Annuaire <$> (route "annuaire" *> int)
<|> UserPage <$> (route "user" *> int)
<|> Home <$ lit ""
......@@ -55,7 +56,7 @@ instance showRoutes :: Show Routes where
show (Annuaire i) = "Annuaire" <> show i
show (Folder i) = "Folder" <> show i
show Dashboard = "Dashboard"
show PGraphExplorer = "graphExplorer"
show (PGraphExplorer i) = "graphExplorer" <> show i
show Home = "Home"
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment