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 module Gargantext.Components.Search.SearchField
( Search, Props, searchField, searchFieldComponent )where ( Search, Props, searchField, searchFieldComponent )where
import Prelude hiding (div) import Prelude (bind, const, identity, pure, show, ($), (/=), (<$>), (||))
import Data.Maybe ( Maybe(..), maybe ) import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( fst ) import Data.Tuple ( fst )
import Data.Tuple.Nested ( (/\) ) import Data.Tuple.Nested ( (/\) )
import Effect ( Effect )
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..)) import FFI.Simple ((..))
import Reactix as R 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) 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" select = R.createElement "select"
type Search = { database :: Maybe Database, term :: String } type Search = { database :: Maybe Database, term :: String }
......
src/Gargantext/Components/Search/Types.purs
View file @ 35e85826
module Gargantext.Components.Search.Types where 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 (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
...@@ -9,14 +9,13 @@ import Data.Newtype (class Newtype) ...@@ -9,14 +9,13 @@ import Data.Newtype (class Newtype)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Types (class ToQuery) import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Config (endConfigStateful, End(..), NodeType(..), Path(..), toUrl) import Gargantext.Config (Ends, NodeType(..), class Path, PathType(..), BackendRoute(..), url)
import Gargantext.Config.REST (post, put) import Gargantext.Config.REST (post, put)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Utils (id) import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
import URI.Query as Q
allDatabases :: Array Database allDatabases :: Array Database
allDatabases = [All, PubMed allDatabases = [All, PubMed
...@@ -109,6 +108,10 @@ defaultSearchQuery = SearchQuery ...@@ -109,6 +108,10 @@ defaultSearchQuery = SearchQuery
, limit: Nothing , limit: Nothing
, order: Nothing } , order: Nothing }
instance pathSearchQuery :: Path SearchQuery where
pathType _ = BackendPath
path q = "new" <> Q.print (toQuery q)
instance searchQueryToQuery :: ToQuery SearchQuery where instance searchQueryToQuery :: ToQuery SearchQuery where
toQuery (SearchQuery {offset, limit, order}) = toQuery (SearchQuery {offset, limit, order}) =
QP.print id id $ QP.QueryPairs $ QP.print id id $ QP.QueryPairs $
...@@ -168,7 +171,11 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where ...@@ -168,7 +171,11 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
~> jsonEmptyObject ~> jsonEmptyObject
categoryUrl :: Ends -> Int -> String 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 :: 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 ...@@ -2,20 +2,16 @@ module Gargantext.Pages.Corpus where
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Thermite (Spec) import Gargantext.Config (Ends)
--------------------------------------------------------
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.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
------------------------------------------------------------------------ type Props = ( nodeId :: Int, ends :: Ends )
layout :: Spec {} {nodeId :: Int} Void
layout = R2.elSpec $ R.hooksComponent "CorpusLoader" cpt corpusLayout :: Record Props -> R.Element
corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt
where where
cpt {nodeId} _children = do cpt {nodeId} _children = do
pure $ H.div {} [ H.h1 {} [H.text "Corpus Description"] 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', ...@@ -8,51 +8,52 @@ import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis',
import Gargantext.Components.Charts.Options.Data import Gargantext.Components.Charts.Options.Data
import Gargantext.Components.Charts.Options.Series import Gargantext.Components.Charts.Options.Series
import Data.Int (toNumber) import Data.Int (toNumber)
import React.DOM (div, h1, text)
import React.DOM.Props (className) import React.DOM.Props (className)
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (Render, Spec, simpleSpec, defaultPerformAction) import Thermite (Render, Spec, simpleSpec, defaultPerformAction)
render :: Render {} {} Void dashboardLayout :: {} -> R.Element
render dispatch _ state _ = [ dashboardLayout props = R.createElement dashboardLayoutCpt props []
h1 [] [text "IMT DashBoard"]
, div [className "row"] [ div [className "col-md-9 content"] [chart globalPublis] dashboardLayoutCpt :: R.Component ()
, div [className "col-md-3 content"] [chart naturePublis] dashboardLayoutCpt = R.staticComponent "G.P.Corpus.Dashboard.dashboardLayout" cpt
] where
, chart distriBySchool cpt _ _ =
, div [className "row"] (map (\school -> div [className "col-md-4 content"] [chart $ focus school]) R.fragment
[ "Télécom Bretagne", "Mines Nantes", "Eurecom"] [ H.h1 {} [ H.text "IMT DashBoard" ]
) , H.div {className: "row"}
, chart scatterEx [ H.div {className: "col-md-9 content"} [ chart globalPublis ]
, chart sankeyEx , H.div {className: "col-md-3 content"} [ chart naturePublis ] ]
, chart treeMapEx , chart distriBySchool
, chart treeEx , H.div {className: "row"} (aSchool <$> schools)
] , chart scatterEx
where , chart sankeyEx
myData = [seriesBarD1 {name: "Bar Data"} , chart treeMapEx
[ dataSerie {name: "val1", value: 50.0} , chart treeEx ]
, dataSerie {name: "val2", value: 70.0} aSchool school = H.div {className: "col-md-4 content"} [ chart $ focus school ]
, dataSerie {name: "val3", value: 80.0} schools = [ "Télécom Bretagne", "Mines Nantes", "Eurecom" ]
] myData =
] [seriesBarD1 {name: "Bar Data"}
[ dataSerie {name: "val1", value: 50.0}
focus :: String -> Options , dataSerie {name: "val2", value: 70.0}
focus school = Options , dataSerie {name: "val3", value: 80.0} ] ]
{ mainTitle : "Focus " <> school focus :: String -> Options
, subTitle : "Total scientific publications" focus school =
, xAxis : xAxis' ["2015", "2016", "2017"] Options
, yAxis : yAxis' { position: "left" { mainTitle : "Focus " <> school
, show: false , subTitle : "Total scientific publications"
, min : 0 , xAxis : xAxis' ["2015", "2016", "2017"]
} , yAxis : yAxis' { position: "left", show: false, min : 0 }
, series : myData , series : myData
, addZoom : false , addZoom : false
, tooltip : tooltipTriggerAxis -- Necessary? , tooltip : tooltipTriggerAxis } -- Necessary?
}
----------------------------------------------------------------------------------------------------------- -----------------------------------------------------------------------------------------------------------
naturePublis_x :: Array String naturePublis_x :: Array String
naturePublis_x = ["Com","Articles","Thèses","Reports"] naturePublis_x = ["Com","Articles","Thèses","Reports"]
naturePublis_y' :: Array Int naturePublis_y' :: Array Int
naturePublis_y' = [23901,17417,1188,1176] naturePublis_y' = [23901,17417,1188,1176]
...@@ -130,7 +131,7 @@ sankeyEx = Options ...@@ -130,7 +131,7 @@ sankeyEx = Options
[ seriesSankey [ seriesSankey
{ "data": { "data":
[ {name : "a"}, {name : "b"} [ {name : "a"}, {name : "b"}
, {name:"c"}, {name:"d"} ] , {name:"c"}, {name:"d"} ]
, links: , links:
[ {source : "a", target : "b", value :2.0} [ {source : "a", target : "b", value :2.0}
, {source : "a", target : "c", value :1.0} , {source : "a", target : "c", value :1.0}
...@@ -145,49 +146,46 @@ sankeyEx = Options ...@@ -145,49 +146,46 @@ sankeyEx = Options
} }
treeData :: Array TreeNode treeData :: Array TreeNode
treeData = [ treeNode "nodeA" 10 [ treeNode "nodeAa" 4 [] treeData =
, treeNode "nodeAb" 5 [] [ treeNode "nodeA" 10
, treeNode "nodeAc" 1 [ treeNode "nodeAca" 5 [] [ treeNode "nodeAa" 4 []
, treeNode "nodeAcb" 5 [] , treeNode "nodeAb" 5 []
] , treeNode "nodeAc" 1
] [ treeNode "nodeAca" 5 []
, treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeNode "nodeBa1" 20 [] ]] , treeNode "nodeAcb" 5 [] ] ]
, treeNode "nodeC" 20 [ treeNode "nodeCa" 20 [ treeNode "nodeCa1" 10 [] , treeNode "nodeB" 20
, treeNode "nodeCa2" 10 [] [ treeNode "nodeBa" 20
] [ treeNode "nodeBa1" 20 [] ]]
] , treeNode "nodeC" 20
, treeNode "nodeD" 20 [ treeNode "nodeDa" 20 [ treeNode "nodeDa1" 2 [] [ treeNode "nodeCa" 20
, treeNode "nodeDa2" 2 [] [ treeNode "nodeCa1" 10 []
, treeNode "nodeDa3" 2 [] , treeNode "nodeCa2" 10 [] ]
, treeNode "nodeDa4" 2 [] , treeNode "nodeD" 20
, treeNode "nodeDa5" 2 [] [ treeNode "nodeDa" 20
, treeNode "nodeDa6" 2 [] [ treeNode "nodeDa1" 2 []
, treeNode "nodeDa7" 2 [] , treeNode "nodeDa2" 2 []
, treeNode "nodeDa8" 2 [] , treeNode "nodeDa3" 2 []
, treeNode "nodeDa9" 2 [] , treeNode "nodeDa4" 2 []
, treeNode "nodeDa10" 2 [] , treeNode "nodeDa5" 2 []
] , treeNode "nodeDa6" 2 []
] , treeNode "nodeDa7" 2 []
] , treeNode "nodeDa8" 2 []
, treeNode "nodeDa9" 2 []
, treeNode "nodeDa10" 2 [] ]]]]
treeData' :: Array TreeNode treeData' :: Array TreeNode
treeData' = [ treeNode "nodeA" 10 [ treeLeaf "nodeAa" 4 treeData' =
, treeLeaf "nodeAb" 5 [ treeNode "nodeA" 10
, treeNode "nodeAc" 1 [ treeLeaf "nodeAca" 5 [ treeLeaf "nodeAa" 4
, treeLeaf "nodeAcb" 5 , treeLeaf "nodeAb" 5
] , treeNode "nodeAc" 1 [ treeLeaf "nodeAca" 5, treeLeaf "nodeAcb" 5 ]]
, treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]] , treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeC" 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 "nodeD" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeE" 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 "nodeF" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeG" 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]] , treeNode "nodeH" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]]
]
]
treeMapEx :: Options treeMapEx :: Options
treeMapEx = Options treeMapEx = Options
...@@ -211,5 +209,3 @@ treeEx = Options ...@@ -211,5 +209,3 @@ treeEx = Options
, tooltip : tooltipTriggerAxis -- Necessary? , 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) ...@@ -9,10 +9,11 @@ import React (ReactClass, Children)
import React.DOM (div, h4, li, p, span, text, ul) import React.DOM (div, h4, li, p, span, text, ul)
import React.DOM.Props (className) import React.DOM.Props (className)
import Reactix as R import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, cmapProps, createClass) import Thermite (PerformAction, Render, Spec, simpleSpec, createClass)
import Gargantext.Prelude 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.Config.REST (get)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
...@@ -28,19 +29,23 @@ type NodeDocument = NodePoly Document ...@@ -28,19 +29,23 @@ type NodeDocument = NodePoly Document
type LoadedData = type LoadedData =
{ document :: NodeDocument { document :: NodeDocument
, ngramsTable :: VersionedNgramsTable } , ngramsTable :: VersionedNgramsTable
}
type Props = type Props =
{ loaded :: LoadedData { loaded :: LoadedData
, path :: DocPath , path :: DocPath
, ends :: Ends
} }
-- This is a subpart of NgramsTable.State. -- This is a subpart of NgramsTable.State.
type State = CoreState () type State = CoreState ()
initialState :: forall props others initialState
. { loaded :: { ngramsTable :: VersionedNgramsTable | others } | props } :: forall props others
-> State . { loaded :: { ngramsTable :: VersionedNgramsTable | others }
| props }
-> State
initialState {loaded: {ngramsTable: Versioned {version}}} = initialState {loaded: {ngramsTable: Versioned {version}}} =
{ ngramsTablePatch: mempty { ngramsTablePatch: mempty
, ngramsVersion: version , ngramsVersion: version
...@@ -278,15 +283,15 @@ docViewSpec :: Spec State Props Action ...@@ -278,15 +283,15 @@ docViewSpec :: Spec State Props Action
docViewSpec = simpleSpec performAction render docViewSpec = simpleSpec performAction render
where where
performAction :: PerformAction State Props Action performAction :: PerformAction State Props Action
performAction Refresh {path: {nodeId, listIds, tabType}} {ngramsVersion} = do performAction Refresh {path: {nodeId, listIds, tabType}, ends} {ngramsVersion} = do
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty}) commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} = performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}, ends} {ngramsVersion} =
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where where
pe = NgramsPatch { patch_list: pl, patch_children: mempty } pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = singletonNgramsTablePatch CTabTerms n pe pt = singletonNgramsTablePatch CTabTerms n pe
performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType}} {ngramsVersion} = performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType},ends} {ngramsVersion} =
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where where
pt = addNewNgram CTabTerms ngram termList pt = addNewNgram CTabTerms ngram termList
...@@ -334,32 +339,40 @@ docViewSpec = simpleSpec performAction render ...@@ -334,32 +339,40 @@ docViewSpec = simpleSpec performAction render
badge s = span [className "badge badge-default badge-pill"] [text s] badge s = span [className "badge badge-default badge-pill"] [text s]
NodePoly {hyperdata : Document doc} = document NodePoly {hyperdata : Document doc} = document
docViewClass :: ReactClass docViewClass
{ children :: Children :: ReactClass
, loaded :: LoadedData { ends :: Ends
, path :: DocPath , children :: Children
} , loaded :: LoadedData
, path :: DocPath }
docViewClass = createClass "DocumentView" docViewSpec initialState docViewClass = createClass "DocumentView" docViewSpec initialState
layout :: Spec {} {nodeId :: Int, listId :: Int, corpusId :: Maybe Int} Void type LayoutProps = ( ends :: Ends, nodeId :: Int, listId :: Int, corpusId :: Maybe Int )
layout =
cmapProps (\{nodeId, listId, corpusId} -> {nodeId, listIds: [listId], corpusId, tabType}) $ documentLayout :: Record LayoutProps -> R.Element
R2.elSpec $ R.hooksComponent "DocumentLoader" \path _ -> documentLayout props = R.createElement documentLayoutCpt props []
useLoader path loadData $ \props ->
R2.createElement' docViewClass props [] documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt
where 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 :: Ends -> Int -> Aff NodeDocument
loadDocument = get <<< toUrl endConfigStateful Back Node <<< Just loadDocument ends = get <<< url ends <<< NodeAPI Node <<< Just
loadData :: DocPath -> Aff LoadedData loadData :: Ends -> DocPath -> Aff LoadedData
loadData {nodeId, listIds, tabType} = do loadData ends {nodeId, listIds, tabType} = do
document <- loadDocument nodeId document <- loadDocument ends nodeId
ngramsTable <- loadNgramsTable ngramsTable <- loadNgramsTable ends
{ nodeId { ends
, nodeId
, listIds: listIds , listIds: listIds
, params: { offset : 0, limit : 100, orderBy: Nothing} , params: { offset : 0, limit : 100, orderBy: Nothing}
, tabType , tabType
......
src/Gargantext/Pages/Corpus/Graph.purs
View file @ 35e85826
...@@ -15,6 +15,22 @@ import Data.Sequence as Seq ...@@ -15,6 +15,22 @@ import Data.Sequence as Seq
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Symbol (SProxy(..)) 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 Partial.Unsafe (unsafePartial)
import React.SyntheticEvent (SyntheticUIEvent, target) import React.SyntheticEvent (SyntheticUIEvent, target)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
...@@ -129,48 +145,60 @@ graphSpec :: Spec State {} Action ...@@ -129,48 +145,60 @@ graphSpec :: Spec State {} Action
graphSpec = simpleSpec performAction render graphSpec = simpleSpec performAction render
-} -}
-- performAction :: PerformAction State {} Action type Props = { ends :: Ends }
-- performAction (LoadGraph fp) _ _ = void do
-- _ <- logs fp performAction :: PerformAction State Props Action
-- _ <- modifyState \(State s) -> State s {corpusId = fp, sigmaGraphData = Nothing} performAction (LoadGraph fp) {ends} _ = void do
-- resp <- lift $ getNodes fp _ <- logs fp
-- treeResp <- liftEffect $ getAuthData _ <- modifyState \(State s) -> State s {corpusId = fp, sigmaGraphData = Nothing}
-- case treeResp of resp <- lift $ getNodes ends fp
-- Just (AuthData {token,tree_id }) -> treeResp <- liftEffect $ getAuthData
-- modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Just tree_id} case treeResp of
-- Nothing -> Just (AuthData {token,tree_id }) ->
-- modifyState \(State s) -> State s { graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Nothing} modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Just tree_id}
-- -- TODO: here one might `catchError getNodes` to visually empty the Nothing ->
-- -- graph. modifyState \(State s) -> State s { graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Nothing}
-- --modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp} -- TODO: here one might `catchError getNodes` to visually empty the
-- graph.
-- performAction (SelectNode selectedNode@(SelectedNode node)) _ (State state) = --modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp}
-- modifyState_ $ \(State s) ->
-- State s {selectedNodes = toggleSet selectedNode performAction (SelectNode selectedNode@(SelectedNode node)) _ (State state) =
-- (if s.multiNodeSelection then s.selectedNodes modifyState_ $ \(State s) ->
-- else Set.empty) } State s {selectedNodes = toggleSet selectedNode
(if s.multiNodeSelection then s.selectedNodes
-- performAction (ChangeLabelSize size) _ _ = else Set.empty) }
-- modifyState_ $ \(State s) ->
-- State $ ((_sigmaSettings <<< _labelSizeRatio) .~ size) s performAction (ShowSidePanel b) _ (State state) = void do
modifyState $ \(State s) -> State s {showSidePanel = b }
-- performAction (ChangeNodeSize size) _ _ =
-- modifyState_ $ \(State s) ->
-- s # _sigmaSettings <<< _maxNodeSize .~ (size * 10.0) performAction (ToggleControls) _ (State state) = void do
-- # _sigmaSettings <<< _minNodeSize .~ size modifyState $ \(State s) -> State s {showControls = not (state.showControls) }
-- # State
performAction (ToggleTree) _ (State state) = void do
-- performAction DisplayEdges _ _ = modifyState $ \(State s) -> State s {showTree = not (state.showTree) }
-- modifyState_ $ \(State s) -> do
-- State $ ((_sigmaSettings <<< _drawEdges) %~ not) s performAction (ChangeLabelSize size) _ _ =
modifyState_ $ \(State s) ->
-- performAction ToggleMultiNodeSelection _ _ = State $ ((_settings <<< _labelSizeRatio) .~ size) s
-- modifyState_ $ \(State s) -> do
-- State $ s # _multiNodeSelection %~ not performAction (ChangeNodeSize size) _ _ =
modifyState_ $ \(State s) ->
-- performAction (ChangeCursorSize size) _ _ = s # _settings <<< _maxNodeSize .~ (size * 10.0)
-- modifyState_ $ \(State s) -> # _settings <<< _minNodeSize .~ size
-- State $ s # _cursorSize .~ 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) _ _ = --performAction (Zoom True) _ _ =
...@@ -226,7 +254,6 @@ render d p (State {sigmaGraphData, settings, legendData}) c = ...@@ -226,7 +254,6 @@ render d p (State {sigmaGraphData, settings, legendData}) c =
-- modCamera0 :: forall o. Optional o CameraProps => -- modCamera0 :: forall o. Optional o CameraProps =>
-- (Record CameraProps -> Record o) -> Effect Unit -- (Record CameraProps -> Record o) -> Effect Unit
-- modCamera0 f = do -- modCamera0 f = do
...@@ -335,14 +362,238 @@ render d p (State {sigmaGraphData, settings, legendData}) c = ...@@ -335,14 +362,238 @@ render d p (State {sigmaGraphData, settings, legendData}) c =
-- ] -- ]
-- ] -- ]
-- , li [className "col-md-1"] specOld :: Spec State Props Action
-- [ span [] [text "Nodes"],input [_type "range" specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
-- , _id "nodeSizeRange" where
-- , max "15" treespec = over _render \frender d p (State s) c ->
-- , defaultValue <<< show $ sigmaSettings ^. _minNodeSize graphspec = over _render \frender d p s c -> [
-- , min "5" div [ className "col-md-9"] (frender d p s c)
-- , onChange \e -> d $ ChangeNodeSize (numberTargetValue e) ]
-- ] 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"] -- {-, li [className "col-md-2"]
-- [ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"] -- [ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"]
...@@ -387,135 +638,69 @@ render d p (State {sigmaGraphData, settings, legendData}) c = ...@@ -387,135 +638,69 @@ render d p (State {sigmaGraphData, settings, legendData}) c =
-- ] -- ]
-- -} -- -}
-- ] -- ]
-- ] {-, div [className "col-md-12", _id "horizontal-checkbox"]
-- ] [ ul [ style {display: "inline",float : "left" }]
-- else div [] [] [ li []
-- ] [ span [] [text "Pubs"]
-- , div [className "row"] ,input [ _type "checkbox"
-- [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"] , className "checkbox"
-- [ div [style {height: "95%"} , checked $ true
-- ,onMouseMove (sigmaOnMouseMove {cursorSize: st.cursorSize})] $ , title "Mark as completed"
-- [ -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
-- ] ]
-- <>
-- case st.sigmaGraphData of ]
-- Nothing -> [] , li []
-- Just graph -> [ span [] [text "Projects"]
-- let forceAtlas2Settings = Graph.forceAtlas2Settings in ,input [ _type "checkbox"
-- let opts = { graph, sigmaSettings, forceAtlas2Settings } in , className "checkbox"
-- [ scuff $ Graph.graph opts ] , checked $ false
, title "Mark as completed"
-- -- [ sigma { graph, settings -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
-- -- , style : sStyle { height : "95%"} ]
-- -- , onClickNode : \e -> ]
-- -- unsafePerformEffect $ do , li []
-- -- _ <- d $ ShowSidePanel true [ span [] [text "Patents"]
-- -- let {id, label} = (unsafeCoerce e).data.node ,input [ _type "checkbox"
-- -- _ <- d $ SelectNode $ SelectedNode {id, label} , className "checkbox"
-- -- pure unit , checked $ false
-- -- ] , title "Mark as completed"
-- <> -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
-- 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"] , li []
-- , if (st.showSidePanel) then [ span [] [text "Others"]
-- div [_id "sp-container", className "col-md-2", style {border : "1px white solid", backgroundColor : "white"}] ,input [ _type "checkbox"
-- [ div [className "row"] $ , className "checkbox"
-- -- , div [className "col-md-12"] , checked $ false
-- -- [a , title "Mark as completed"
-- -- ul [className "nav nav-tabs" -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
-- -- , _id "myTab" ]
-- -- , role "tablist" ]
-- -- , style {marginBottom : "18px", marginTop : "18px"} ]
-- -- ]
-- -- [ ] --}
-- -- li [className "nav-item"]
-- -- [ [ div []
-- -- a [className "nav-link active" [ p [] []
-- -- , _id "home-tab" , div [className "col-md-12"]
-- -- , _data {toggle : "tab"} [ let query = (\(SelectedNode {label}) -> words label) <$> Set.toUnfoldable st.selectedNodes in
-- -- , href "#home" if null query then
-- -- , role "tab" p [] []
-- -- , aria {controls :"home" , selected : "true"} else
-- -- ] [text "Neighbours"] R2.scuff $ GT.tabs {query, sides, ends}
-- -- ] , p [] []
-- -- ] ]
-- -- , 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"] else
-- -- , a [ className "badge badge-light"][text "dynamics"] div [] [] -- ends sidepanel column here
-- -- , 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))
-- ]
-- ]
-- , li [] getNodes :: Ends -> Int -> Aff GraphData
-- [ span [] [text "Projects"] getNodes ends graphId = get (url ends (NodePath Config.Graph (Just graphId)))
-- ,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
src/Gargantext/Pages/Corpus/Graph/Tabs.purs
View file @ 35e85826
module Gargantext.Pages.Corpus.Graph.Tabs where module Gargantext.Pages.Corpus.Graph.Tabs where
import Prelude hiding (div) import Prelude hiding (div)
import Data.Lens (view) import Data.Array (fromFoldable)
import Data.List (fromFoldable) import Data.Tuple (Tuple(..), fst)
import Data.Tuple (Tuple(..)) import Gargantext.Config (Ends)
import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..)) 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.Table as T
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import React (ReactElement, ReactClass, Children, createElement) import Reactix as R
import Thermite ( Spec, PerformAction, Render, _performAction, _render import Reactix.DOM.HTML as H
, hideState, noState, cmapProps, simpleSpec, createClass
)
type Props = { query :: TextQuery, sides :: Array GraphSideCorpus } type Props = ( ends :: Ends, query :: TextQuery, sides :: Array GraphSideCorpus )
tabsElt :: Props -> ReactElement tabs :: Record Props -> R.Element
tabsElt props = createElement tabsClass props [] tabs props = R.createElement tabsCpt props []
-- TODO no need for Children here -- TODO no need for Children here
tabsClass :: ReactClass { query :: TextQuery, sides :: Array GraphSideCorpus, children :: Children } tabsCpt :: R.Component Props
tabsClass = createClass "GraphTabs" pureTabs (const {}) tabsCpt = R.hooksComponent "G.P.Corpus.Graph.Tabs.tabs" cpt
where
pureTabs :: Spec {} Props Void cpt {ends, query, sides} _ = do
pureTabs = hideState (const {activeTab: 0}) statefulTabs active <- R.useState' 0
pure $ Tab.tabs {tabs: tabs', selected: fst active}
tab :: forall props state. TextQuery -> GraphSideCorpus -> Tuple String (Spec state props Tab.Action) where
tab query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) = tabs' = fromFoldable $ tab ends query <$> sides
Tuple corpusLabel $
cmapProps (const {nodeId, listId, query, chart, totalRecords: 4736, container}) $ tab :: Ends -> TextQuery -> GraphSideCorpus -> Tuple String R.Element
noState docViewSpec tab ends query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
Tuple corpusLabel (docView dvProps)
where where
dvProps = {ends, nodeId, listId, query, chart, totalRecords: 4736, container}
-- TODO totalRecords: probably need to insert a corpusLoader. -- TODO totalRecords: probably need to insert a corpusLoader.
chart = mempty chart = mempty
container = T.graphContainer {title: corpusLabel} 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