Commit 901de239 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] merge graph-layout.

parents 48c44695 fb6cd457
......@@ -177,3 +177,7 @@ text-align: center;
overflow: visible;
height: auto;
}
#graph-tree .tree {
margin-top: 27px;
}
......@@ -9,19 +9,24 @@ import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (.??), (:=), (~>))
import Data.Argonaut (decodeJson)
import Data.Array (length, mapWithIndex, (!!))
import Data.Array (fold, length, mapWithIndex, (!!))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (fromString, toNumber)
import Data.Int as Int
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype)
import Data.String (joinWith)
import Data.Lens (over)
import Effect (Effect)
import Effect.Aff (Aff, attempt)
import Effect.Aff.Class (liftAff)
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.Components.Login.Types (AuthData(..), TreeId)
import Gargantext.Components.Tree as Tree
import Gargantext.Config as Config
import Gargantext.Config.REST (get, post)
import Gargantext.Utils (getter)
......@@ -30,15 +35,19 @@ import Partial.Unsafe (unsafePartial)
import React (ReactElement)
import React.DOM (a, br', button, div, form', input, li, li', menu, option, p, select, span, text, ul, ul')
import React.DOM.Props (_id, _type, checked, className, href, name, onChange, onClick, placeholder, style, title, value)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Thermite (PerformAction, Render, Spec, _render,cmapProps, createClass, defaultPerformAction, defaultRender, modifyState, noState, simpleSpec, withState)
import Unsafe.Coerce (unsafeCoerce)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem)
data Action
= LoadGraph Int
| SelectNode SelectedNode
| ShowSidePanel Boolean
| ShowControls
| ToggleControls
| ToggleTree
newtype SelectedNode = SelectedNode {id :: String, label :: String}
......@@ -53,8 +62,10 @@ newtype State = State
, selectedNode :: Maybe SelectedNode
, showSidePanel :: Boolean
, showControls :: Boolean
, showTree :: Boolean
, nodeResults :: Array NodeResults
, corpusId :: Int
, treeId :: Maybe TreeId
}
newtype NodeQuery = NodeQuery
......@@ -78,8 +89,10 @@ initialState = State
, selectedNode : Nothing
, showSidePanel : false
, showControls : false
, showTree : false
, nodeResults : []
, corpusId : 0
, treeId : Nothing
}
graphSpec :: Spec State {} Action
......@@ -90,9 +103,16 @@ performAction (LoadGraph fp) _ _ = void do
_ <- logs fp
_ <- modifyState \(State s) -> State s {corpusId = fp, sigmaGraphData = Nothing}
resp <- lift $ getNodes fp
treeResp <- liftEffect $ getAuthData
case treeResp of
Just (AuthData {token,tree_id }) ->
modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Just tree_id}
Nothing ->
modifyState \(State s) -> State s { graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Nothing}
-- TODO: here one might `catchError getNodes` to visually empty the
-- graph.
modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp}
--modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp}
performAction (SelectNode (SelectedNode node)) _ (State state) = void do
_ <- modifyState $ \(State s) -> State s {selectedNode = pure $ SelectedNode node}
......@@ -108,9 +128,13 @@ performAction (ShowSidePanel b) _ (State state) = void do
modifyState $ \(State s) -> State s {showSidePanel = b }
performAction (ShowControls) _ (State state) = void do
performAction (ToggleControls) _ (State state) = void do
modifyState $ \(State s) -> State s {showControls = not (state.showControls) }
performAction (ToggleTree) _ (State state) = void do
modifyState $ \(State s) -> State s {showTree = not (state.showTree) }
convert :: GraphData -> SigmaGraphData
convert (GraphData r) = SigmaGraphData { nodes, edges}
where
......@@ -131,9 +155,6 @@ convert (GraphData r) = SigmaGraphData { nodes, edges}
render :: Render State {} Action
render d p (State s) c =
[
]
<>
case s.sigmaGraphData of
Nothing -> []
Just gData ->
......@@ -296,25 +317,59 @@ dispLegend ary = div [] $ map dl ary
specOld :: Spec State {} Action
specOld = simpleSpec performAction render'
specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
where
treespec = over _render \frender d p (State s) c ->
[ div [ className "col-md-2", _id "graph-tree", style {marginTop:"104px"}] $
[
button [className "btn btn-primary" , onClick \_ -> d ToggleTree]
[text $ if s.showTree then "Hide Tree" else "Show Tree"]
]
<>
if s.showTree then (frender d p (State s) c) else []
]
graphspec = over _render \frender d p s c -> [
div [ className "col-md-10"] (frender d p s c)
]
treeSpec :: Spec State {} Action
treeSpec = withState \(State st) ->
case st.treeId of
Nothing ->
simpleSpec defaultPerformAction defaultRender
Just treeId ->
(cmapProps (const {root: treeId}) (noState Tree.treeview))
render' :: Render State {} Action
render' d _ (State st) _ =
[ div [className "row"]
[ div [className "container-fluid", style {"padding-top" : "100px"}]
[ div [className "row", style {"padding-bottom" : "10px"}]
[
div [className "col-md-12"]
[ button [className "btn btn-primary"
, onClick \_ -> d ShowControls
,style {position:"relative",top:"-25px",left: "737px"}
div [className "col-md-4"]
[
]
, div [className "col-md-4"]
[
button [className "btn btn-primary center-block"
, onClick \_ -> d ToggleControls
]
[text $ if st.showControls then "Hide Controls" else "Show Controls"]
]
[text "Show Controls"]
, button [className "btn btn-primary"
, style {position:"relative",top:"-25px",left: "1380px"}
, div [className "col-md-4"]
[ div [className "pull-right"]
[ button [className "btn btn-primary"
,onClick \_ -> d $ ShowSidePanel $ not st.showSidePanel
] [text "Show SidePanel"]
] [text $ if st.showSidePanel then "Hide Side Panel" else "Show Side Panel"]
]
]
, if (st.showControls) then
div [className "col-md-12", style {marginBottom : "21px"}]
],
div [className "row"]
[
if (st.showControls) then
div [className "col-md-12", style {"padding-bottom" : "10px"}]
[ menu [_id "toolbar"]
[ ul'
[
......@@ -384,7 +439,7 @@ specOld = simpleSpec performAction render'
else div [] []
]
, div [className "row"]
[ div [if (st.showSidePanel) then className "col-md-10" else className "col-md-11"]
[ div [if (st.showSidePanel && st.showTree) then className "col-md-10" else if (st.showSidePanel || st.showTree) then className "col-md-10" else className "col-md-12"]
[ div [style {height: "90%"}] $
[
]
......@@ -414,7 +469,7 @@ specOld = simpleSpec performAction render'
]
--, button [onClick \_ -> d ShowSidePanel, className "btn btn-primary", style {right:"39px",position : "relative",zIndex:"1000", top: "-59px"}] [text "Show SidePanel"]
, if (st.showSidePanel) then
div [_id "sp-container",className "col-md-2", style {border : "1px black solid", backgroundColor : "beige", position:"absolute",right: "0px",top:"265px"}]
div [_id "sp-container", className "col-md-2", style {border : "1px black solid", backgroundColor : "beige"}]
[ div [className "row"]
[ div [_id "sidepanel" , style {borderBottom : "1px solid black"}]
[ case st.selectedNode of
......@@ -518,6 +573,7 @@ specOld = simpleSpec performAction render'
div [] [] -- ends sidepanel column here
]
]
]
getTitle :: Array NodeResults -> Array String
getTitle ary = map (\(NodeResults s)-> s.title) ary
......@@ -552,3 +608,16 @@ getUrl :: String
getUrl = back.baseUrl <> back.prePath
where
back = Config.endConfig.back
getAuthData :: Effect (Maybe AuthData)
getAuthData = do
w <- window
ls <- localStorage w
mto <- getItem "token" ls
mti <- getItem "tree_id" ls
pure do
token <- mto
tree_id <- Int.fromString =<< mti
pure $ AuthData {token, tree_id}
......@@ -35,7 +35,7 @@ data Action
| ShowLogin
| Logout
| ShowAddcorpus
| ShowTree
| ToggleTree
performAction :: PerformAction AppState {} Action
......@@ -44,7 +44,7 @@ performAction (SetRoute route) _ _ = void do
performAction (Search s) _ _ = void do
modifyState $ _ {search = s}
performAction (ShowTree) _ (state) = void do -- TODO
performAction (ToggleTree) _ (state) = void do -- TODO
modifyState $ _ {showTree = not (state.showTree)}
performAction (ShowLogin) _ _ = void do
......
......@@ -123,7 +123,8 @@ layout1 :: Spec AppState {} Action
layout1 layout =
fold
[ layoutSidebar divSearchBar
, outerLayout
, layout
-- , outerLayout
, layoutFooter
]
where
......@@ -141,7 +142,7 @@ layout1 layout =
]
ls = over _render \render d p s c -> [
button [onClick $ \e -> d ShowTree, className "btn btn-primary",style {position:"relative", top: "99px",left:"-264px",zIndex : "1000"}] [text "ShowTree"]
button [onClick $ \e -> d ToggleTree, className "btn btn-primary",style {position:"relative", top: "99px",left:"-264px",zIndex : "1000"}] [text "ShowTree"]
, div [if (s.showTree) then className "col-md-2" else className "col-md-2"] if (s.showTree) then (render d p s c) else []
]
......
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