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

[MERGE] fix conflict.

parents 22ba8a84 66b0c8ce
...@@ -88,3 +88,5 @@ t' :: Node -> Legend ...@@ -88,3 +88,5 @@ t' :: Node -> Legend
t' (Node r) = Legend { id_ : clustDefault, label : r.label} t' (Node r) = Legend { id_ : clustDefault, label : r.label}
where where
(Cluster {clustDefault}) = r.attributes (Cluster {clustDefault}) = r.attributes
module Gargantext.Pages.Corpus.Graph where 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 Control.Monad.Cont.Trans (lift)
import Data.Argonaut (decodeJson)
import Data.Array (length, mapWithIndex, (!!)) import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Effect.Aff (Aff) 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 Math (cos, sin)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (ReactElement) import React (ReactElement)
...@@ -15,15 +28,10 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl ...@@ -15,15 +28,10 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) 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 data Action
= LoadGraph String = LoadGraph Int --- need to make it as String
| SelectNode SelectedNode | SelectNode SelectedNode
newtype SelectedNode = SelectedNode {id :: String, label :: String} newtype SelectedNode = SelectedNode {id :: String, label :: String}
...@@ -54,15 +62,15 @@ graphSpec = simpleSpec performAction render ...@@ -54,15 +62,15 @@ graphSpec = simpleSpec performAction render
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (LoadGraph fp) _ _ = void do performAction (LoadGraph fp) _ _ = void do
_ <- logs fp _ <- logs fp
case fp of _ <- modifyState \(State s) -> State s { sigmaGraphData = Nothing}
"" -> do gd <- lift $ getNodes fp
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
-- TODO: here one might `catchError getGraphData` to visually empty the -- TODO: here one might `catchError getGraphData` to visually empty the
-- graph. -- 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 performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node} modifyState $ \(State s) -> State s {selectedNode = pure node}
...@@ -87,18 +95,7 @@ convert (GraphData r) = SigmaGraphData { nodes, edges} ...@@ -87,18 +95,7 @@ convert (GraphData r) = SigmaGraphData { nodes, edges}
render :: Render State {} Action render :: Render State {} Action
render d p (State s) c = 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 case s.sigmaGraphData of
...@@ -271,7 +268,7 @@ specOld = simpleSpec performAction render' ...@@ -271,7 +268,7 @@ specOld = simpleSpec performAction render'
render' :: Render State {} Action render' :: Render State {} Action
render' d _ (State st) _ = render' d _ (State st) _ =
[ div [className "row"] [ [ 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"] [ menu [_id "toolbar"]
[ ul' [ ul'
[ [
...@@ -341,20 +338,7 @@ specOld = simpleSpec performAction render' ...@@ -341,20 +338,7 @@ specOld = simpleSpec performAction render'
, div [className "row"] , div [className "row"]
[ div [className "col-md-9"] [ div [className "col-md-9"]
[ div [style {border : "1px black solid", height: "90%"}] $ [ 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 case st.sigmaGraphData of
...@@ -477,3 +461,27 @@ specOld = simpleSpec performAction render' ...@@ -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 ...@@ -55,9 +55,10 @@ dispatchAction dispatcher _ (Document n) = do
dispatcher $ SetRoute $ Document n dispatcher $ SetRoute $ Document n
dispatcher $ DocumentViewA $ Document.Load n dispatcher $ DocumentViewA $ Document.Load n
dispatchAction dispatcher _ PGraphExplorer = do dispatchAction dispatcher _ (PGraphExplorer nid) = do
dispatcher $ SetRoute PGraphExplorer dispatcher $ SetRoute $ PGraphExplorer nid
dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json" dispatcher $ GraphExplorerA $ GE.LoadGraph nid
--dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
dispatchAction dispatcher _ Dashboard = do dispatchAction dispatcher _ Dashboard = do
dispatcher $ SetRoute Dashboard dispatcher $ SetRoute Dashboard
...@@ -59,7 +59,7 @@ pagesComponent s = case s.currentRoute of ...@@ -59,7 +59,7 @@ pagesComponent s = case s.currentRoute of
selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview 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 Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout
......
...@@ -20,7 +20,8 @@ data Routes ...@@ -20,7 +20,8 @@ data Routes
| Corpus Int | Corpus Int
| AddCorpus | AddCorpus
| Document Int | Document Int
| PGraphExplorer | PGraphExplorer Int
| NGramsTable
| Dashboard | Dashboard
| Annuaire Int | Annuaire Int
| UserPage Int | UserPage Int
...@@ -34,7 +35,7 @@ routing = ...@@ -34,7 +35,7 @@ routing =
<|> Corpus <$> (route "corpus" *> int) <|> Corpus <$> (route "corpus" *> int)
<|> Document <$> (route "document" *> int) <|> Document <$> (route "document" *> int)
<|> Dashboard <$ route "dashboard" <|> Dashboard <$ route "dashboard"
<|> PGraphExplorer <$ route "graph" <|> PGraphExplorer <$> (route "graph" *> int )
<|> Annuaire <$> (route "annuaire" *> int) <|> Annuaire <$> (route "annuaire" *> int)
<|> UserPage <$> (route "user" *> int) <|> UserPage <$> (route "user" *> int)
<|> Home <$ lit "" <|> Home <$ lit ""
...@@ -55,7 +56,7 @@ instance showRoutes :: Show Routes where ...@@ -55,7 +56,7 @@ instance showRoutes :: Show Routes where
show (Annuaire i) = "Annuaire" <> show i show (Annuaire i) = "Annuaire" <> show i
show (Folder i) = "Folder" <> show i show (Folder i) = "Folder" <> show i
show Dashboard = "Dashboard" show Dashboard = "Dashboard"
show PGraphExplorer = "graphExplorer" show (PGraphExplorer i) = "graphExplorer" <> show i
show Home = "Home" 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