Skip to content

P
purescript-gargantext
Commit 35e85826 authored by James Laver's avatar James Laver
Browse files
Options

Refactor G.P.Corpus to use Reactix

parent 4e2eb894
Hide whitespace changes
Inline Side-by-side
Showing with 539 additions and 377 deletions
src/Gargantext/Components/Search/Ajax.purs deleted 100644 → 0
View file @ 4e2eb894
module Gargantext.Components.Search.Ajax where
import Prelude
import Effect.Class (liftEffect)
import Effect.Aff (Aff)
import Data.Argonaut (class DecodeJson)
import DOM.Simple.Console (log2)
import Gargantext.Types (toQuery)
import Gargantext.Components.Search.Types (SearchQuery)
import Gargantext.Config.REST (post)
import Gargantext.Config (urlPlease, End(Back))
import URI.Query as Q
searchUrl :: SearchQuery -> String
searchUrl q = urlPlease Back $ "new" <> Q.print (toQuery q)
search :: forall a. DecodeJson a => SearchQuery -> Aff a
search q = do
let url = searchUrl q
liftEffect $ log2 "url:" url
post (searchUrl q) q
src/Gargantext/Components/Search/SearchField.purs
View file @ 35e85826
module Gargantext.Components.Search.SearchField
( Search, Props, searchField, searchFieldComponent )where
import Prelude hiding (div)
import Prelude (bind, const, identity, pure, show, ($), (/=), (<$>), (||))
import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( fst )
import Data.Tuple.Nested ( (/\) )
import Effect ( Effect )
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Reactix as R
import Reactix.DOM.HTML (text, button, div, input, option, form, span, ul, li, a)
import Reactix.DOM.HTML as HTML
import Reactix.DOM.HTML (text, button, div, input, span, ul, li, a)
import Gargantext.Components.Search.Types (Database)
select
:: forall props
. R.IsComponent String props (Array R.Element)
=> Record props -> Array R.Element -> R.Element
select = R.createElement "select"
type Search = { database :: Maybe Database, term :: String }
......
src/Gargantext/Components/Search/Types.purs
View file @ 35e85826
module Gargantext.Components.Search.Types where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>), encodeJson)
import Data.Argonaut (class EncodeJson, class DecodeJson, jsonEmptyObject, (:=), (~>), encodeJson)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
......@@ -9,14 +9,13 @@ import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Types (class ToQuery)
import Gargantext.Config (endConfigStateful, End(..), NodeType(..), Path(..), toUrl)
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Config (Ends, NodeType(..), class Path, PathType(..), BackendRoute(..), url)
import Gargantext.Config.REST (post, put)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP
import URI.Query as Q
allDatabases :: Array Database
allDatabases = [All, PubMed
......@@ -109,6 +108,10 @@ defaultSearchQuery = SearchQuery
, limit: Nothing
, order: Nothing }
instance pathSearchQuery :: Path SearchQuery where
pathType _ = BackendPath
path q = "new" <> Q.print (toQuery q)
instance searchQueryToQuery :: ToQuery SearchQuery where
toQuery (SearchQuery {offset, limit, order}) =
QP.print id id $ QP.QueryPairs $
......@@ -168,7 +171,11 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
~> jsonEmptyObject
categoryUrl :: Ends -> Int -> String
categoryUrl ends nodeId = url ends (NodeAPI Node (Just nodeId)) <> "/category"
categoryUrl ends nodeId = url ends (NodeAPI Node $ Just nodeId) <> "/category"
putCategories :: Ends -> Int -> CategoryQuery -> Aff (Array Int)
putCategories = put <<< categoryUrl
putCategories ends nodeId = put $ categoryUrl ends nodeId
performSearch :: forall a. DecodeJson a => Ends -> SearchQuery -> Aff a
performSearch ends q = post (url ends q) q
src/Gargantext/Pages/Corpus.purs
View file @ 35e85826
......@@ -2,20 +2,16 @@ module Gargantext.Pages.Corpus where
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (Spec)
--------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Loader2 (useLoader)
import Gargantext.Components.Table as Table
import Gargantext.Config.REST (get)
import Gargantext.Pages.Texts.Tabs.Types (CorpusData, CorpusInfo(..))
import Gargantext.Pages.Texts.Tabs.Specs (elt) as Tabs
import Gargantext.Config (Ends)
import Gargantext.Utils.Reactix as R2
------------------------------------------------------------------------
layout :: Spec {} {nodeId :: Int} Void
layout = R2.elSpec $ R.hooksComponent "CorpusLoader" cpt
type Props = ( nodeId :: Int, ends :: Ends )
corpusLayout :: Record Props -> R.Element
corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt
where
cpt {nodeId} _children = do
pure $ H.div {} [ H.h1 {} [H.text "Corpus Description"]
......
src/Gargantext/Pages/Corpus/Dashboard.purs
View file @ 35e85826
......@@ -8,51 +8,52 @@ import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis',
import Gargantext.Components.Charts.Options.Data
import Gargantext.Components.Charts.Options.Series
import Data.Int (toNumber)
import React.DOM (div, h1, text)
import React.DOM.Props (className)
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (Render, Spec, simpleSpec, defaultPerformAction)
render :: Render {} {} Void
render dispatch _ state _ = [
h1 [] [text "IMT DashBoard"]
, div [className "row"] [ div [className "col-md-9 content"] [chart globalPublis]
, div [className "col-md-3 content"] [chart naturePublis]
]
, chart distriBySchool
, div [className "row"] (map (\school -> div [className "col-md-4 content"] [chart $ focus school])
[ "Télécom Bretagne", "Mines Nantes", "Eurecom"]
)
, chart scatterEx
, chart sankeyEx
, chart treeMapEx
, chart treeEx
]
where
myData = [seriesBarD1 {name: "Bar Data"}
[ dataSerie {name: "val1", value: 50.0}
, dataSerie {name: "val2", value: 70.0}
, dataSerie {name: "val3", value: 80.0}
]
]
focus :: String -> Options
focus school = Options
{ mainTitle : "Focus " <> school
, subTitle : "Total scientific publications"
, xAxis : xAxis' ["2015", "2016", "2017"]
, yAxis : yAxis' { position: "left"
, show: false
, min : 0
}
, series : myData
, addZoom : false
, tooltip : tooltipTriggerAxis -- Necessary?
}
dashboardLayout :: {} -> R.Element
dashboardLayout props = R.createElement dashboardLayoutCpt props []
dashboardLayoutCpt :: R.Component ()
dashboardLayoutCpt = R.staticComponent "G.P.Corpus.Dashboard.dashboardLayout" cpt
where
cpt _ _ =
R.fragment
[ H.h1 {} [ H.text "IMT DashBoard" ]
, H.div {className: "row"}
[ H.div {className: "col-md-9 content"} [ chart globalPublis ]
, H.div {className: "col-md-3 content"} [ chart naturePublis ] ]
, chart distriBySchool
, H.div {className: "row"} (aSchool <$> schools)
, chart scatterEx
, chart sankeyEx
, chart treeMapEx
, chart treeEx ]
aSchool school = H.div {className: "col-md-4 content"} [ chart $ focus school ]
schools = [ "Télécom Bretagne", "Mines Nantes", "Eurecom" ]
myData =
[seriesBarD1 {name: "Bar Data"}
[ dataSerie {name: "val1", value: 50.0}
, dataSerie {name: "val2", value: 70.0}
, dataSerie {name: "val3", value: 80.0} ] ]
focus :: String -> Options
focus school =
Options
{ mainTitle : "Focus " <> school
, subTitle : "Total scientific publications"
, xAxis : xAxis' ["2015", "2016", "2017"]
, yAxis : yAxis' { position: "left", show: false, min : 0 }
, series : myData
, addZoom : false
, tooltip : tooltipTriggerAxis } -- Necessary?
-----------------------------------------------------------------------------------------------------------
naturePublis_x :: Array String
naturePublis_x = ["Com","Articles","Thèses","Reports"]
naturePublis_y' :: Array Int
naturePublis_y' = [23901,17417,1188,1176]
......@@ -130,7 +131,7 @@ sankeyEx = Options
[ seriesSankey
{ "data":
[ {name : "a"}, {name : "b"}
, {name:"c"}, {name:"d"} ]
, {name:"c"}, {name:"d"} ]
, links:
[ {source : "a", target : "b", value :2.0}
, {source : "a", target : "c", value :1.0}
......@@ -145,49 +146,46 @@ sankeyEx = Options
}
treeData :: Array TreeNode
treeData = [ treeNode "nodeA" 10 [ treeNode "nodeAa" 4 []
, treeNode "nodeAb" 5 []
, treeNode "nodeAc" 1 [ treeNode "nodeAca" 5 []
, treeNode "nodeAcb" 5 []
]
]
, treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeNode "nodeBa1" 20 [] ]]
, treeNode "nodeC" 20 [ treeNode "nodeCa" 20 [ treeNode "nodeCa1" 10 []
, treeNode "nodeCa2" 10 []
]
]
, treeNode "nodeD" 20 [ treeNode "nodeDa" 20 [ treeNode "nodeDa1" 2 []
, treeNode "nodeDa2" 2 []
, treeNode "nodeDa3" 2 []
, treeNode "nodeDa4" 2 []
, treeNode "nodeDa5" 2 []
, treeNode "nodeDa6" 2 []
, treeNode "nodeDa7" 2 []
, treeNode "nodeDa8" 2 []
, treeNode "nodeDa9" 2 []
, treeNode "nodeDa10" 2 []
]
]
]
treeData =
[ treeNode "nodeA" 10
[ treeNode "nodeAa" 4 []
, treeNode "nodeAb" 5 []
, treeNode "nodeAc" 1
[ treeNode "nodeAca" 5 []
, treeNode "nodeAcb" 5 [] ] ]
, treeNode "nodeB" 20
[ treeNode "nodeBa" 20
[ treeNode "nodeBa1" 20 [] ]]
, treeNode "nodeC" 20
[ treeNode "nodeCa" 20
[ treeNode "nodeCa1" 10 []
, treeNode "nodeCa2" 10 [] ]
, treeNode "nodeD" 20
[ treeNode "nodeDa" 20
[ treeNode "nodeDa1" 2 []
, treeNode "nodeDa2" 2 []
, treeNode "nodeDa3" 2 []
, treeNode "nodeDa4" 2 []
, treeNode "nodeDa5" 2 []
, treeNode "nodeDa6" 2 []
, treeNode "nodeDa7" 2 []
, treeNode "nodeDa8" 2 []
, treeNode "nodeDa9" 2 []
, treeNode "nodeDa10" 2 [] ]]]]
treeData' :: Array TreeNode
treeData' = [ treeNode "nodeA" 10 [ treeLeaf "nodeAa" 4
, treeLeaf "nodeAb" 5
, treeNode "nodeAc" 1 [ treeLeaf "nodeAca" 5
, treeLeaf "nodeAcb" 5
]
, treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeC" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeD" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeE" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeF" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeG" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeH" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
]
]
treeData' =
[ treeNode "nodeA" 10
[ treeLeaf "nodeAa" 4
, treeLeaf "nodeAb" 5
, treeNode "nodeAc" 1 [ treeLeaf "nodeAca" 5, treeLeaf "nodeAcb" 5 ]]
, treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeC" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeD" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeE" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeF" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeG" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeH" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]]
treeMapEx :: Options
treeMapEx = Options
......@@ -211,5 +209,3 @@ treeEx = Options
, tooltip : tooltipTriggerAxis -- Necessary?
}
layoutDashboard :: Spec {} {} Void
layoutDashboard = simpleSpec defaultPerformAction render
src/Gargantext/Pages/Corpus/Document.purs
View file @ 35e85826
......@@ -9,10 +9,11 @@ import React (ReactClass, Children)
import React.DOM (div, h4, li, p, span, text, ul)
import React.DOM.Props (className)
import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, cmapProps, createClass)
import Thermite (PerformAction, Render, Spec, simpleSpec, createClass)
import Gargantext.Prelude
import Gargantext.Config (toUrl, endConfigStateful, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..), CTabNgramType(..))
import Gargantext.Config
( NodeType(..), Ends, TabSubType(..), TabType(..), CTabNgramType(..), BackendRoute(..), url )
import Gargantext.Config.REST (get)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Node (NodePoly(..))
......@@ -28,19 +29,23 @@ type NodeDocument = NodePoly Document
type LoadedData =
{ document :: NodeDocument
, ngramsTable :: VersionedNgramsTable }
, ngramsTable :: VersionedNgramsTable
}
type Props =
{ loaded :: LoadedData
, path :: DocPath
, ends :: Ends
}
-- This is a subpart of NgramsTable.State.
type State = CoreState ()
initialState :: forall props others
. { loaded :: { ngramsTable :: VersionedNgramsTable | others } | props }
-> State
initialState
:: forall props others
. { loaded :: { ngramsTable :: VersionedNgramsTable | others }
| props }
-> State
initialState {loaded: {ngramsTable: Versioned {version}}} =
{ ngramsTablePatch: mempty
, ngramsVersion: version
......@@ -278,15 +283,15 @@ docViewSpec :: Spec State Props Action
docViewSpec = simpleSpec performAction render
where
performAction :: PerformAction State Props Action
performAction Refresh {path: {nodeId, listIds, tabType}} {ngramsVersion} = do
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
performAction Refresh {path: {nodeId, listIds, tabType}, ends} {ngramsVersion} = do
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}, ends} {ngramsVersion} =
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = singletonNgramsTablePatch CTabTerms n pe
performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType},ends} {ngramsVersion} =
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
pt = addNewNgram CTabTerms ngram termList
......@@ -334,32 +339,40 @@ docViewSpec = simpleSpec performAction render
badge s = span [className "badge badge-default badge-pill"] [text s]
NodePoly {hyperdata : Document doc} = document
docViewClass :: ReactClass
{ children :: Children
, loaded :: LoadedData
, path :: DocPath
}
docViewClass
:: ReactClass
{ ends :: Ends
, children :: Children
, loaded :: LoadedData
, path :: DocPath }
docViewClass = createClass "DocumentView" docViewSpec initialState
layout :: Spec {} {nodeId :: Int, listId :: Int, corpusId :: Maybe Int} Void
layout =
cmapProps (\{nodeId, listId, corpusId} -> {nodeId, listIds: [listId], corpusId, tabType}) $
R2.elSpec $ R.hooksComponent "DocumentLoader" \path _ ->
useLoader path loadData $ \props ->
R2.createElement' docViewClass props []
type LayoutProps = ( ends :: Ends, nodeId :: Int, listId :: Int, corpusId :: Maybe Int )
documentLayout :: Record LayoutProps -> R.Element
documentLayout props = R.createElement documentLayoutCpt props []
documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt
where
tabType = TabDocument (TabNgramType CTabTerms)
cpt {ends, nodeId, listId, corpusId} _ = do
useLoader path (loadData ends) $ \loaded ->
R2.createElement' docViewClass {ends, path, loaded} []
where
tabType = TabDocument (TabNgramType CTabTerms)
path = {nodeId, listIds: [listId], corpusId, tabType}
------------------------------------------------------------------------
loadDocument :: Int -> Aff NodeDocument
loadDocument = get <<< toUrl endConfigStateful Back Node <<< Just
loadDocument :: Ends -> Int -> Aff NodeDocument
loadDocument ends = get <<< url ends <<< NodeAPI Node <<< Just
loadData :: DocPath -> Aff LoadedData
loadData {nodeId, listIds, tabType} = do
document <- loadDocument nodeId
ngramsTable <- loadNgramsTable
{ nodeId
loadData :: Ends -> DocPath -> Aff LoadedData
loadData ends {nodeId, listIds, tabType} = do
document <- loadDocument ends nodeId
ngramsTable <- loadNgramsTable ends
{ ends
, nodeId
, listIds: listIds
, params: { offset : 0, limit : 100, orderBy: Nothing}
, tabType
......
src/Gargantext/Pages/Corpus/Graph.purs
View file @ 35e85826
......@@ -15,6 +15,22 @@ import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Traversable (for_)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, setSigmaRef, getSigmaRef, cameras, CameraProps, getCameraProps, goTo, pauseForceAtlas2, sStyle, sigmaOnMouseMove, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), MetaData(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Components.Login.Types (AuthData(..), TreeId)
import Gargantext.Components.RandomText (words)
--import Gargantext.Components.Tree as Tree
import Gargantext.Config as Config
import Gargantext.Config (Ends, NodePath(..), url)
import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.Graph.Tabs as GT
import Gargantext.Types (class Optional)
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent (SyntheticUIEvent, target)
import Unsafe.Coerce (unsafeCoerce)
......@@ -129,48 +145,60 @@ graphSpec :: Spec State {} Action
graphSpec = simpleSpec performAction render
-}
-- performAction :: PerformAction State {} Action
-- 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}
-- performAction (SelectNode selectedNode@(SelectedNode node)) _ (State state) =
-- modifyState_ $ \(State s) ->
-- State s {selectedNodes = toggleSet selectedNode
-- (if s.multiNodeSelection then s.selectedNodes
-- else Set.empty) }
-- performAction (ChangeLabelSize size) _ _ =
-- modifyState_ $ \(State s) ->
-- State $ ((_sigmaSettings <<< _labelSizeRatio) .~ size) s
-- performAction (ChangeNodeSize size) _ _ =
-- modifyState_ $ \(State s) ->
-- s # _sigmaSettings <<< _maxNodeSize .~ (size * 10.0)
-- # _sigmaSettings <<< _minNodeSize .~ size
-- # State
-- performAction DisplayEdges _ _ =
-- modifyState_ $ \(State s) -> do
-- State $ ((_sigmaSettings <<< _drawEdges) %~ not) s
-- performAction ToggleMultiNodeSelection _ _ =
-- modifyState_ $ \(State s) -> do
-- State $ s # _multiNodeSelection %~ not
-- performAction (ChangeCursorSize size) _ _ =
-- modifyState_ $ \(State s) ->
-- State $ s # _cursorSize .~ size
type Props = { ends :: Ends }
performAction :: PerformAction State Props Action
performAction (LoadGraph fp) {ends} _ = void do
_ <- logs fp
_ <- modifyState \(State s) -> State s {corpusId = fp, sigmaGraphData = Nothing}
resp <- lift $ getNodes ends 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}
performAction (SelectNode selectedNode@(SelectedNode node)) _ (State state) =
modifyState_ $ \(State s) ->
State s {selectedNodes = toggleSet selectedNode
(if s.multiNodeSelection then s.selectedNodes
else Set.empty) }
performAction (ShowSidePanel b) _ (State state) = void do
modifyState $ \(State s) -> State s {showSidePanel = b }
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) }
performAction (ChangeLabelSize size) _ _ =
modifyState_ $ \(State s) ->
State $ ((_settings <<< _labelSizeRatio) .~ size) s
performAction (ChangeNodeSize size) _ _ =
modifyState_ $ \(State s) ->
s # _settings <<< _maxNodeSize .~ (size * 10.0)
# _settings <<< _minNodeSize .~ size
# State
performAction DisplayEdges _ _ =
modifyState_ $ \(State s) -> do
State $ ((_settings <<< _drawEdges) %~ not) s
performAction ToggleMultiNodeSelection _ _ =
modifyState_ $ \(State s) -> do
State $ s # _multiNodeSelection %~ not
performAction (ChangeCursorSize size) _ _ =
modifyState_ $ \(State s) ->
State $ s # _cursorSize .~ size
--performAction (Zoom True) _ _ =
......@@ -226,7 +254,6 @@ render d p (State {sigmaGraphData, settings, legendData}) c =
-- modCamera0 :: forall o. Optional o CameraProps =>
-- (Record CameraProps -> Record o) -> Effect Unit
-- modCamera0 f = do
......@@ -335,14 +362,238 @@ render d p (State {sigmaGraphData, settings, legendData}) c =
-- ]
-- ]
-- , li [className "col-md-1"]
-- [ span [] [text "Nodes"],input [_type "range"
-- , _id "nodeSizeRange"
-- , max "15"
-- , defaultValue <<< show $ sigmaSettings ^. _minNodeSize
-- , min "5"
-- , onChange \e -> d $ ChangeNodeSize (numberTargetValue e)
-- ]
specOld :: Spec State Props Action
specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
where
treespec = over _render \frender d p (State s) c ->
graphspec = over _render \frender d p s c -> [
div [ className "col-md-9"] (frender d p s c)
]
treeSpec :: Spec State Props Action
treeSpec = withState \(State st) ->
case st.treeId of
Nothing ->
simpleSpec defaultPerformAction defaultRender
Just treeId ->
--cmapProps (const {root: treeId, mCurrentRoute: Nothing}) $ noState $ Tree.treeview
-- TODO
simpleSpec defaultPerformAction defaultRender
render' :: Render State Props Action
render' d {ends} (State st@{settings, graphData: GraphData {sides,metaData }}) _ =
[ div [className "container-fluid", style {"padding-top" : "90px" }]
[ {-div [ className "row"]
[ h2 [ style {textAlign : "center", position : "relative", top: "-1px"}]
[-- : MetaData {title}
case metaData of
Just( MetaData {title }) ->
text $ "Graph " <> title
Nothing ->
text "Title"
]
]
, -} div [className "row", style {"padding-bottom" : "10px", marginTop : "-24px"}]
[
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"]
]
, div [className "col-md-4"]
[ div [className "pull-right"]
[ button [className "btn btn-primary"
,onClick \_ -> d $ ShowSidePanel $ not st.showSidePanel
] [text $ if st.showSidePanel then "Hide Side Panel" else "Show Side Panel"]
]
]
],
div [className "row"]
[
if (st.showControls) then
div [className "col-md-12", style {"padding-bottom" : "10px"}]
[ menu [_id "toolbar"]
[ ul'
[
-- li' [ button [className "btn btn-success btn-sm"] [text "Change Type"] ]
-- ,
li'
[ button [
className "btn btn-primary btn-sm"
, onClick \_ -> d DisplayEdges
]
[text "Toggle Edges"]
]
-- , li' [ button [className "btn btn-primary btn-sm"] [text "Change Level"] ]
{- ,li [style {display : "inline-block"}]
[ form'
[ input [_type "file"
, name "file"
-- , onChange (\e -> d $ SetFile (getFile e) (unsafeCoerce $ d <<< SetProgress))
, className "btn btn-primary"]
-- , text $ show st.readyState
]
]
-}
{-, li' [ input [_type "button"
, className "btn btn-warning btn-sm"
,value "Run Demo"
-- , onClick \_ -> d SetGraph, disabled (st.readyState /= DONE)
]
]
-}
{-, li'
[ form'
[ div [className "col-lg-2"]
[
div [className "input-group"]
[
span [className "input-group-btn"]
[
button [className "btn btn-primary", _type "button"]
[ span [className "glyphicon glyphicon-search"] []
]
]
, input [_type "text", className "form-control", placeholder "select topics"]
]
]
]
]
-}
, li [className "col-md-1"]
[ span [] [text "Selector"]
, input [ _type "range"
, _id "cursorSizeRange"
, min "0"
, max "100"
, defaultValue (show st.cursorSize)
, onChange \e -> d $ ChangeCursorSize (numberTargetValue e)
]
]
, li [className "col-md-1"]
[ span [] [text "Labels"],input [_type "range"
, _id "labelSizeRange"
, max "4"
, defaultValue <<< show $ settings ^. _labelSizeRatio
, min "1"
, onChange \e -> d $ ChangeLabelSize (numberTargetValue e)
]
]
, li [className "col-md-1"]
[ span [] [text "Nodes"],input [_type "range"
, _id "nodeSizeRange"
, max "15"
, defaultValue <<< show $ settings ^. _minNodeSize
, min "5"
, onChange \e -> d $ ChangeNodeSize (numberTargetValue e)
]
]
{-, li [className "col-md-2"]
[ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"]
]
-}
, li'
[ button [ className "btn btn-primary"
, onClick \_ -> modCamera0 (const {x: 0.0, y: 0.0, ratio: 1.0})
] [text "Center"]
]
, li [className "col-md-1"]
[ span [] [text "Zoom"],input [ _type "range"
, _id "cameraRatio"
, max "100"
, defaultValue "0"
, min "0"
, onChange \e -> do
let ratio = (100.0 - numberTargetValue e) / 100.0
modCamera0 (const {ratio})
]
]
, li [className "col-md-1"]
[ span [] [text "MultiNode"]
, input
[ _type "checkbox"
, className "checkbox"
-- , checked
, onChange $ const $ d ToggleMultiNodeSelection
]
]
, li'
[ button [ className "btn btn-primary"
, onClick \_ -> pauseForceAtlas2
] [text "Spatialization"]
]
{-, li'
[ button [className "btn btn-primary"
, onClick \_ -> do
_ <- log "Hey there" -- $ show st.camera
pure unit
] [text "Save"] -- TODO: Implement Save!
]
-}
]
]
]
else div [] []
]
, div [className "row"]
[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: "95%"}
,onMouseMove (sigmaOnMouseMove {cursorSize: st.cursorSize})] $
[
]
<>
case st.sigmaGraphData of
Nothing -> []
Just graph ->
[ sigma { graph, settings
, renderer : canvas
, style : sStyle { height : "95%"}
, ref: setSigmaRef
, onClickNode : \e ->
unsafePerformEffect $ do
_ <- d $ ShowSidePanel true
let {id, label} = (unsafeCoerce e).data.node
_ <- d $ SelectNode $ SelectedNode {id, label}
pure unit
}
[ sigmaEnableWebGL
, forceAtlas2 forceAtlas2Config
, edgeShapes {"default" : edgeShape.curve}
]
]
<>
if length st.legendData > 0 then [div [style {position : "absolute", bottom : "10px", border: "1px solid black", boxShadow : "rgb(0, 0, 0) 0px 2px 6px", marginLeft : "10px", padding: "16px"}] [dispLegend st.legendData]] else []
]
--, 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 white solid", backgroundColor : "white"}]
[ div [className "row"] $
-- , div [className "col-md-12"]
-- [
-- ul [className "nav nav-tabs"
-- , _id "myTab"
-- , role "tablist"
-- , style {marginBottom : "18px", marginTop : "18px"}
-- ]
-- [
-- li [className "nav-item"]
-- [
-- a [className "nav-link active"
-- , _id "home-tab"
-- , _data {toggle : "tab"}
-- , href "#home"
-- , role "tab"
-- , aria {controls :"home" , selected : "true"}
-- ] [text "Neighbours"]
-- ]
-- {-, li [className "col-md-2"]
-- [ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"]
......@@ -387,135 +638,69 @@ render d p (State {sigmaGraphData, settings, legendData}) c =
-- ]
-- -}
-- ]
-- ]
-- ]
-- else div [] []
-- ]
-- , div [className "row"]
-- [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: "95%"}
-- ,onMouseMove (sigmaOnMouseMove {cursorSize: st.cursorSize})] $
-- [
-- ]
-- <>
-- case st.sigmaGraphData of
-- Nothing -> []
-- Just graph ->
-- let forceAtlas2Settings = Graph.forceAtlas2Settings in
-- let opts = { graph, sigmaSettings, forceAtlas2Settings } in
-- [ scuff $ Graph.graph opts ]
-- -- [ sigma { graph, settings
-- -- , style : sStyle { height : "95%"}
-- -- , onClickNode : \e ->
-- -- unsafePerformEffect $ do
-- -- _ <- d $ ShowSidePanel true
-- -- let {id, label} = (unsafeCoerce e).data.node
-- -- _ <- d $ SelectNode $ SelectedNode {id, label}
-- -- pure unit
-- -- ]
-- <>
-- if length st.legendData > 0 then [div [style {position : "absolute", bottom : "10px", border: "1px solid black", boxShadow : "rgb(0, 0, 0) 0px 2px 6px", marginLeft : "10px", padding: "16px"}] [dispLegend st.legendData]] else []
-- ]
-- --, 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 white solid", backgroundColor : "white"}]
-- [ div [className "row"] $
-- -- , div [className "col-md-12"]
-- -- [a
-- -- ul [className "nav nav-tabs"
-- -- , _id "myTab"
-- -- , role "tablist"
-- -- , style {marginBottom : "18px", marginTop : "18px"}
-- -- ]
-- -- [
-- -- li [className "nav-item"]
-- -- [
-- -- a [className "nav-link active"
-- -- , _id "home-tab"
-- -- , _data {toggle : "tab"}
-- -- , href "#home"
-- -- , role "tab"
-- -- , aria {controls :"home" , selected : "true"}
-- -- ] [text "Neighbours"]
-- -- ]
-- -- ]
-- -- , div [className "tab-content", _id "myTabContent", style {borderBottom : "1px solid black", paddingBottom : "19px"}]
-- -- [ div [ className "", _id "home", role "tabpanel" ]
-- -- [ a [ className "badge badge-light"][text "objects"]
-- -- , a [ className "badge badge-light"][text "evaluation"]
-- -- , a [ className "badge badge-light"][text "dynamics"]
-- -- , a [ className "badge badge-light"][text "virtual environments"]
-- -- , a [ className "badge badge-light"][text "virtual reality"]
-- -- , a [ className "badge badge-light"][text "performance analysis"]
-- -- , a [ className "badge badge-light"][text "software engineering"]
-- -- , a [ className "badge badge-light"][text "complex systems"]
-- -- , a [ className "badge badge-light"][text "wireless communications"]
-- --
-- -- ]
-- -- ]
-- -- ]
-- {-, div [className "col-md-12", _id "horizontal-checkbox"]
-- [ ul [ style {display: "inline",float : "left" }]
-- [ li []
-- [ span [] [text "Pubs"]
-- ,input [ _type "checkbox"
-- , className "checkbox"
-- , checked $ true
-- , title "Mark as completed"
-- -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
-- ]
{-, div [className "col-md-12", _id "horizontal-checkbox"]
[ ul [ style {display: "inline",float : "left" }]
[ li []
[ span [] [text "Pubs"]
,input [ _type "checkbox"
, className "checkbox"
, checked $ true
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
]
]
, li []
[ span [] [text "Projects"]
,input [ _type "checkbox"
, className "checkbox"
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
]
]
, li []
[ span [] [text "Patents"]
,input [ _type "checkbox"
, className "checkbox"
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
]
]
, li []
[ span [] [text "Others"]
,input [ _type "checkbox"
, className "checkbox"
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
]
]
]
] --}
[ div []
[ p [] []
, div [className "col-md-12"]
[ let query = (\(SelectedNode {label}) -> words label) <$> Set.toUnfoldable st.selectedNodes in
if null query then
p [] []
else
R2.scuff $ GT.tabs {query, sides, ends}
, p [] []
]
]
]
]
else
div [] [] -- ends sidepanel column here
]
]
]
-- ]
-- , li []
-- [ span [] [text "Projects"]
-- ,input [ _type "checkbox"
-- , className "checkbox"
-- , checked $ false
-- , title "Mark as completed"
-- -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
-- ]
-- ]
-- , li []
-- [ span [] [text "Patents"]
-- ,input [ _type "checkbox"
-- , className "checkbox"
-- , checked $ false
-- , title "Mark as completed"
-- -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
-- ]
-- ]
-- , li []
-- [ span [] [text "Others"]
-- ,input [ _type "checkbox"
-- , className "checkbox"
-- , checked $ false
-- , title "Mark as completed"
-- -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
-- ]
-- ]
-- ]
-- ] --}
-- [ div []
-- [ p [] []
-- , div [className "col-md-12"]
-- [ let query = (\(SelectedNode {label}) -> words label) <$> Set.toUnfoldable st.selectedNodes in
-- if null query then
-- p [] []
-- else
-- GT.tabsElt {query, sides}
-- , p [] []
-- ]
-- ]
-- ]
-- ]
-- else
-- div [] [] -- ends sidepanel column here
-- ]
-- ]
-- ]
getNodes :: Int -> Aff GraphData
getNodes graphId = get $ Config.toUrl Config.endConfigStateful Config.Back Config.Graph $ Just graphId
getNodes :: Ends -> Int -> Aff GraphData
getNodes ends graphId = get (url ends (NodePath Config.Graph (Just graphId)))
src/Gargantext/Pages/Corpus/Graph/Tabs.purs
View file @ 35e85826
module Gargantext.Pages.Corpus.Graph.Tabs where
import Prelude hiding (div)
import Data.Lens (view)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Data.Array (fromFoldable)
import Data.Tuple (Tuple(..), fst)
import Gargantext.Config (Ends)
import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..))
import Gargantext.Components.FacetsTable (TextQuery, docViewSpec)
import Gargantext.Components.FacetsTable (TextQuery, docView)
import Gargantext.Components.Table as T
import Gargantext.Components.Tab as Tab
import React (ReactElement, ReactClass, Children, createElement)
import Thermite ( Spec, PerformAction, Render, _performAction, _render
, hideState, noState, cmapProps, simpleSpec, createClass
)
import Reactix as R
import Reactix.DOM.HTML as H
type Props = { query :: TextQuery, sides :: Array GraphSideCorpus }
type Props = ( ends :: Ends, query :: TextQuery, sides :: Array GraphSideCorpus )
tabsElt :: Props -> ReactElement
tabsElt props = createElement tabsClass props []
tabs :: Record Props -> R.Element
tabs props = R.createElement tabsCpt props []
-- TODO no need for Children here
tabsClass :: ReactClass { query :: TextQuery, sides :: Array GraphSideCorpus, children :: Children }
tabsClass = createClass "GraphTabs" pureTabs (const {})
pureTabs :: Spec {} Props Void
pureTabs = hideState (const {activeTab: 0}) statefulTabs
tab :: forall props state. TextQuery -> GraphSideCorpus -> Tuple String (Spec state props Tab.Action)
tab query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
Tuple corpusLabel $
cmapProps (const {nodeId, listId, query, chart, totalRecords: 4736, container}) $
noState docViewSpec
tabsCpt :: R.Component Props
tabsCpt = R.hooksComponent "G.P.Corpus.Graph.Tabs.tabs" cpt
where
cpt {ends, query, sides} _ = do
active <- R.useState' 0
pure $ Tab.tabs {tabs: tabs', selected: fst active}
where
tabs' = fromFoldable $ tab ends query <$> sides
tab :: Ends -> TextQuery -> GraphSideCorpus -> Tuple String R.Element
tab ends query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
Tuple corpusLabel (docView dvProps)
where
dvProps = {ends, nodeId, listId, query, chart, totalRecords: 4736, container}
-- TODO totalRecords: probably need to insert a corpusLoader.
chart = mempty
container = T.graphContainer {title: corpusLabel}
statefulTabs :: Spec Tab.State Props Tab.Action
statefulTabs =
withProps (\{query, sides} ->
Tab.tabs identity identity $ fromFoldable $ tab query <$> sides)
-- TODO move to Thermite
-- | This function captures the props of the `Spec` as a function argument.
withProps
:: forall state props action
. (props -> Spec state props action)
-> Spec state props action
withProps f = simpleSpec performAction render
where
performAction :: PerformAction state props action
performAction a p st = view _performAction (f p) a p st
render :: Render state props action
render k p st = view _render (f p) k p st
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