Commit 8e0b5f8d authored by Alexandre Delanoë's avatar Alexandre Delanoë

[READING+FEAT] Forest in Graph Explorer.

parent b7e624dc
...@@ -41,13 +41,15 @@ appCpt :: R.Component () ...@@ -41,13 +41,15 @@ appCpt :: R.Component ()
appCpt = R.hooksComponent "G.C.App.app" cpt where appCpt = R.hooksComponent "G.C.App.app" cpt where
frontends = defaultFrontends frontends = defaultFrontends
cpt _ _ = do cpt _ _ = do
sessions <- useSessions sessions <- useSessions
route <- useHashRouter router Home route <- useHashRouter router Home
showLogin <- R.useState' false
showLogin <- R.useState' false
showCorpus <- R.useState' false showCorpus <- R.useState' false
let tree = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
let mCurrentRoute = Just $ fst route let tree = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
let backends = fromFoldable defaultBackends let mCurrentRoute = fst route
let backends = fromFoldable defaultBackends
pure $ case fst showLogin of pure $ case fst showLogin of
true -> tree $ login { sessions, backends, visible: showLogin } true -> tree $ login { sessions, backends, visible: showLogin }
false -> false ->
...@@ -55,15 +57,15 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -55,15 +57,15 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
Nothing -> tree $ homeLayout EN Nothing -> tree $ homeLayout EN
Just session -> Just session ->
case (fst route) of case (fst route) of
Home -> tree $ homeLayout EN Home -> tree $ homeLayout EN
Login -> login { sessions, backends, visible: showLogin } Login -> login { sessions, backends, visible: showLogin }
Folder _ -> tree $ folder {} Folder _ -> tree $ folder {}
Corpus nodeId -> tree $ corpusLayout { nodeId } Corpus nodeId -> tree $ corpusLayout { nodeId }
Texts nodeId -> tree $ textsLayout { nodeId, session } Texts nodeId -> tree $ textsLayout { nodeId, session }
Lists nodeId -> tree $ listsLayout { nodeId, session } Lists nodeId -> tree $ listsLayout { nodeId, session }
Dashboard -> tree $ dashboardLayout {} Dashboard _nodeId -> tree $ dashboardLayout {}
Annuaire annuaireId -> tree $ annuaireLayout { annuaireId, session } Annuaire nodeId -> tree $ annuaireLayout { nodeId, session }
UserPage nodeId -> tree $ userLayout { nodeId, session } UserPage nodeId -> tree $ userLayout { nodeId, session }
ContactPage nodeId -> tree $ userLayout { nodeId, session } ContactPage nodeId -> tree $ userLayout { nodeId, session }
CorpusDocument corpusId listId nodeId -> CorpusDocument corpusId listId nodeId ->
tree $ documentLayout { nodeId, listId, session, corpusId: Just corpusId } tree $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
...@@ -71,7 +73,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -71,7 +73,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
tree $ documentLayout { nodeId, listId, session, corpusId: Nothing } tree $ documentLayout { nodeId, listId, session, corpusId: Nothing }
PGraphExplorer graphId -> PGraphExplorer graphId ->
simpleLayout (fst sessions) $ simpleLayout (fst sessions) $
explorerLayout { graphId, mCurrentRoute, session, treeId: Nothing, frontends } explorerLayout { graphId, mCurrentRoute, session, treeId: Nothing, frontends}
forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element
forestLayout frontends sessions route showLogin child = forestLayout frontends sessions route showLogin child =
...@@ -81,8 +83,9 @@ forestLayout frontends sessions route showLogin child = ...@@ -81,8 +83,9 @@ forestLayout frontends sessions route showLogin child =
main = main =
R.fragment R.fragment
[ H.div {className: "col-md-2", style: {paddingTop: "60px"}} [ H.div {className: "col-md-2", style: {paddingTop: "60px"}}
[ forest {sessions, route, frontends, showLogin} ] [ forest {sessions, route, frontends, showLogin} ]
, mainPage child ] , mainPage child
]
-- Simple layout does not accommodate the tree -- Simple layout does not accommodate the tree
simpleLayout :: Sessions -> R.Element -> R.Element simpleLayout :: Sessions -> R.Element -> R.Element
...@@ -218,7 +221,7 @@ liNav (LiNav { title : title' ...@@ -218,7 +221,7 @@ liNav (LiNav { title : title'
footer :: {} -> R.Element footer :: {} -> R.Element
footer props = R.createElement footerCpt props [] footer props = R.createElement footerCpt props []
footerCpt :: R.Component () footerCpt :: R.Component ()
footerCpt = R.staticComponent "G.C.Layout.footer" cpt footerCpt = R.staticComponent "G.C.Layout.footer" cpt
where where
cpt _ _ = cpt _ _ =
......
module Gargantext.Components.Forest where module Gargantext.Components.Forest where
import Prelude (const, show, discard) import Prelude (const, show)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
...@@ -12,8 +11,8 @@ import Gargantext.Components.Tree (treeView) ...@@ -12,8 +11,8 @@ import Gargantext.Components.Tree (treeView)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type Props = type Props =
( sessions :: Sessions ( sessions :: Sessions
, route :: AppRoute , route :: AppRoute
, frontends :: Frontends , frontends :: Frontends
, showLogin :: R2.Setter Boolean ) , showLogin :: R2.Setter Boolean )
...@@ -31,8 +30,12 @@ forestCpt = R.staticComponent "G.C.Forest.forest" cpt where ...@@ -31,8 +30,12 @@ forestCpt = R.staticComponent "G.C.Forest.forest" cpt where
Just s@(Session {treeId}) -> Just s@(Session {treeId}) ->
R.fragment R.fragment
[ H.text (show s) [ H.text (show s)
, treeView { root: treeId, frontends, mCurrentRoute: Just route, session: s } ] , treeView { root: treeId
, frontends
, mCurrentRoute: Just route
, session: s }
]
plus :: R2.Setter Boolean -> R.Element plus :: R2.Setter Boolean -> R.Element
plus showLogin = H.button {on: {click}} [ H.text "+" ] plus showLogin = H.button {on: {click}} [ H.text "+" ]
where where
......
...@@ -7,7 +7,7 @@ import Data.Foldable (foldMap) ...@@ -7,7 +7,7 @@ import Data.Foldable (foldMap)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Tuple (fst) import Data.Tuple (fst,snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
...@@ -21,25 +21,27 @@ import Gargantext.Components.GraphExplorer.Sidebar as Sidebar ...@@ -21,25 +21,27 @@ import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.Tree as Tree import Gargantext.Components.Forest (forest)
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute) import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, Sessions(..))
import Gargantext.Types (NodeType(Graph)) import Gargantext.Types (NodeType(Graph))
type GraphId = Int type GraphId = Int
type LayoutProps = type LayoutProps =
( graphId :: GraphId ( graphId :: GraphId
, mCurrentRoute :: Maybe AppRoute , mCurrentRoute :: AppRoute
, treeId :: Maybe Int , treeId :: Maybe Int
, session :: Session , session :: Session
, frontends :: Frontends ) , frontends :: Frontends
)
type Props = ( graph :: Maybe Graph.Graph | LayoutProps ) type Props = ( graph :: Maybe Graph.Graph | LayoutProps )
--------------------------------------------------------------
explorerLayout :: Record LayoutProps -> R.Element explorerLayout :: Record LayoutProps -> R.Element
explorerLayout props = R.createElement explorerLayoutCpt props [] explorerLayout props = R.createElement explorerLayoutCpt props []
...@@ -52,6 +54,7 @@ explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt ...@@ -52,6 +54,7 @@ explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt
handler loaded = explorer {graphId, mCurrentRoute, treeId, session, graph, frontends} handler loaded = explorer {graphId, mCurrentRoute, treeId, session, graph, frontends}
where graph = Just (convert loaded) where graph = Just (convert loaded)
--------------------------------------------------------------
explorer :: Record Props -> R.Element explorer :: Record Props -> R.Element
explorer props = R.createElement explorerCpt props [] explorer props = R.createElement explorerCpt props []
...@@ -61,13 +64,12 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -61,13 +64,12 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
cpt {session, graphId, mCurrentRoute, treeId, graph, frontends} _ = do cpt {session, graphId, mCurrentRoute, treeId, graph, frontends} _ = do
controls <- Controls.useGraphControls controls <- Controls.useGraphControls
state <- useExplorerState state <- useExplorerState
showLogin <- snd <$> R.useState' true
pure $ pure $
RH.div RH.div
{ id: "graph-explorer" } { id: "graph-explorer" }
[ [ row
row [ outer
[
outer
[ inner [ inner
[ row1 [ row1
[ col [ pullLeft [ Toggle.treeToggleButton controls.showTree ] ] [ col [ pullLeft [ Toggle.treeToggleButton controls.showTree ] ]
...@@ -75,7 +77,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -75,7 +77,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ] , col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ]
] ]
, row [ Controls.controls controls ] , row [ Controls.controls controls ]
, row [ tree {mCurrentRoute, treeId} controls , row [ tree {mCurrentRoute, treeId} controls showLogin
, mGraph controls.sigmaRef {graphId, graph} , mGraph controls.sigmaRef {graphId, graph}
, Sidebar.sidebar {showSidePanel: fst controls.showSidePanel} ] , Sidebar.sidebar {showSidePanel: fst controls.showSidePanel} ]
, row [ ] , row [ ]
...@@ -84,17 +86,17 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -84,17 +86,17 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
] ]
] ]
where where
tree {treeId: Nothing} _ = RH.div { id: "tree" } [] -- tree {treeId: Nothing} _ _ = RH.div { id: "tree" } []
tree _ {showTree: false /\ _} = RH.div { id: "tree" } [] tree _ {showTree: false /\ _} _ = RH.div { id: "tree" } []
tree {mCurrentRoute: m, treeId: Just root} _ = tree {mCurrentRoute: m, treeId: root} _ showLogin=
RH.div { id: "tree", className: "col-md-2" } RH.div {className: "col-md-2", style: {paddingTop: "60px"}}
[ Tree.treeView {frontends, root, mCurrentRoute: m, session: session} ] [forest {sessions: Sessions (Just session), route:m, frontends, showLogin}]
outer = RH.div { className: "col-md-12" } outer = RH.div { className: "col-md-12" }
inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } } inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } }
row1 = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } } row1 = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } }
row = RH.div { className: "row" } row = RH.div { className: "row" }
col = RH.div { className: "col-md-4" } col = RH.div { className: "col-md-4" }
pullLeft = RH.div { className: "pull-left" } pullLeft = RH.div { className: "pull-left" }
pullRight = RH.div { className: "pull-right" } pullRight = RH.div { className: "pull-right" }
......
...@@ -29,12 +29,12 @@ import Gargantext.Utils.Reactix as R2 ...@@ -29,12 +29,12 @@ import Gargantext.Utils.Reactix as R2
type Controls = type Controls =
( cursorSize :: R.State Number ( cursorSize :: R.State Number
, multiNodeSelect :: R.Ref Boolean , multiNodeSelect :: R.Ref Boolean
, showControls :: R.State Boolean , showControls :: R.State Boolean
, showSidePanel :: R.State Boolean , showSidePanel :: R.State Boolean
, showTree :: R.State Boolean , showTree :: R.State Boolean
, sigmaRef :: R.Ref (Maybe Sigmax.Sigma) , sigmaRef :: R.Ref (Maybe Sigmax.Sigma)
) )
controlsToSigmaSettings :: Record Controls -> Record Graph.SigmaSettings controlsToSigmaSettings :: Record Controls -> Record Graph.SigmaSettings
...@@ -100,21 +100,20 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -100,21 +100,20 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
useGraphControls :: R.Hooks (Record Controls) useGraphControls :: R.Hooks (Record Controls)
useGraphControls = do useGraphControls = do
cursorSize <- R.useState' 10.0 cursorSize <- R.useState' 10.0
multiNodeSelect <- R.useRef false multiNodeSelect <- R.useRef false
showControls <- R.useState' false showControls <- R.useState' false
showSidePanel <- R.useState' false showSidePanel <- R.useState' false
showTree <- R.useState' false showTree <- R.useState' false
sigmaRef <- R2.nothingRef sigmaRef <- R2.nothingRef
pure { pure { cursorSize
cursorSize , multiNodeSelect
, multiNodeSelect , showControls
, showControls , showSidePanel
, showSidePanel , showTree
, showTree , sigmaRef
, sigmaRef }
}
getShowControls :: Record Controls -> Boolean getShowControls :: Record Controls -> Boolean
getShowControls { showControls: ( should /\ _ ) } = should getShowControls { showControls: ( should /\ _ ) } = should
...@@ -138,7 +137,7 @@ setShowSidePanel :: Record Controls -> Boolean -> Effect Unit ...@@ -138,7 +137,7 @@ setShowSidePanel :: Record Controls -> Boolean -> Effect Unit
setShowSidePanel { showSidePanel: ( _ /\ set ) } v = set $ const v setShowSidePanel { showSidePanel: ( _ /\ set ) } v = set $ const v
setShowTree :: Record Controls -> Boolean -> Effect Unit setShowTree :: Record Controls -> Boolean -> Effect Unit
setShowTree { showTree: ( _ /\ set ) } v = set $ const v setShowTree { showTree: ( _ /\ set ) } v = set $ not <<< const v
setCursorSize :: Record Controls -> Number -> Effect Unit setCursorSize :: Record Controls -> Number -> Effect Unit
setCursorSize { cursorSize: ( _ /\ setSize ) } v = setSize $ const v setCursorSize { cursorSize: ( _ /\ setSize ) } v = setSize $ const v
......
...@@ -80,12 +80,12 @@ data Action ...@@ -80,12 +80,12 @@ data Action
type Dispatch = Action -> Effect Unit type Dispatch = Action -> Effect Unit
tableContainer :: { pageParams :: PageParams tableContainer :: { pageParams :: PageParams
, dispatch :: Dispatch , dispatch :: Dispatch
, setPath :: R2.Setter PageParams , setPath :: R2.Setter PageParams
, ngramsParent :: Maybe NgramsTerm , ngramsParent :: Maybe NgramsTerm
, ngramsChildren :: Map NgramsTerm Boolean , ngramsChildren :: Map NgramsTerm Boolean
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
} }
-> Record T.TableContainerProps -> R.Element -> Record T.TableContainerProps -> R.Element
tableContainer { pageParams tableContainer { pageParams
...@@ -185,10 +185,10 @@ useNgramsReducer :: State -> R.Hooks (R.Reducer State Action') ...@@ -185,10 +185,10 @@ useNgramsReducer :: State -> R.Hooks (R.Reducer State Action')
useNgramsReducer init = R.useReducer' performNgramsAction init useNgramsReducer init = R.useReducer' performNgramsAction init
type Props = type Props =
( session :: Session ( session :: Session
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, path :: R.State PageParams , path :: R.State PageParams
, versioned :: VersionedNgramsTable ) , versioned :: VersionedNgramsTable )
ngramsTable :: Record Props -> R.Element ngramsTable :: Record Props -> R.Element
ngramsTable props = R.createElement ngramsTableCpt props [] ngramsTable props = R.createElement ngramsTableCpt props []
......
...@@ -104,11 +104,11 @@ type CoreParams s = ...@@ -104,11 +104,11 @@ type CoreParams s =
type PageParams = type PageParams =
CoreParams CoreParams
( params :: T.Params ( params :: T.Params
, searchQuery :: String , searchQuery :: String
, termListFilter :: Maybe TermList -- Nothing means all , termListFilter :: Maybe TermList -- Nothing means all
, termSizeFilter :: Maybe TermSize -- Nothing means all , termSizeFilter :: Maybe TermSize -- Nothing means all
, session :: Session , session :: Session
) )
initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams
......
...@@ -7,7 +7,7 @@ Maintainer : alexandre.delanoe@iscpif.fr ...@@ -7,7 +7,7 @@ Maintainer : alexandre.delanoe@iscpif.fr
Stability : experimental Stability : experimental
Portability : POSIX Portability : POSIX
How semantic emerge from contextualized randomness can be experimented How semantic emerges from contextualized randomness can be experimented
with these simple functions; with these simple functions;
randomSentences: randomizes sentences in a paragraph. randomSentences: randomizes sentences in a paragraph.
......
...@@ -44,13 +44,17 @@ type Reload = Int ...@@ -44,13 +44,17 @@ type Reload = Int
data NodePopup = CreatePopup | NodePopup data NodePopup = CreatePopup | NodePopup
type Props = ( root :: ID, mCurrentRoute :: Maybe AppRoute, session :: Session, frontends :: Frontends ) type Props = ( root :: ID
, mCurrentRoute :: Maybe AppRoute
type TreeViewProps = , session :: Session
( tree :: FTree , frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute )
, frontends :: Frontends
, session :: Session ) type TreeViewProps = ( tree :: FTree
, mCurrentRoute :: Maybe AppRoute
, frontends :: Frontends
, session :: Session
)
data NTree a = NTree a (Array (NTree a)) data NTree a = NTree a (Array (NTree a))
...@@ -203,7 +207,8 @@ type NodeMainSpanProps = ...@@ -203,7 +207,8 @@ type NodeMainSpanProps =
( id :: ID ( id :: ID
, name :: Name , name :: Name
, nodeType :: NodeType , nodeType :: NodeType
, mCurrentRoute :: Maybe AppRoute) , mCurrentRoute :: Maybe AppRoute
)
nodeMainSpan :: (Action -> Aff Unit) nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps -> Record NodeMainSpanProps
...@@ -216,9 +221,9 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p [] ...@@ -216,9 +221,9 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p []
el = R.hooksComponent "NodeMainSpan" cpt el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do cpt {id, name, nodeType, mCurrentRoute} _ = do
-- only 1 popup at a time is allowed to be opened -- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup) popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile) droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false isDragOver <- R.useState' false
pure $ H.span (dropProps droppedFile isDragOver) pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen [ folderIcon folderOpen
...@@ -270,10 +275,14 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p [] ...@@ -270,10 +275,14 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p []
fldr :: Boolean -> String fldr :: Boolean -> String
fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close" fldr open = if open
then "glyphicon glyphicon-folder-open"
else "glyphicon glyphicon-folder-close"
childNodes :: Session -> Frontends -> R.State Reload -> R.State Boolean -> Maybe AppRoute -> Array FTree -> Array R.Element
childNodes :: Session -> Frontends
-> R.State Reload -> R.State Boolean
-> Maybe AppRoute -> Array FTree
-> Array R.Element
childNodes _ _ _ _ _ [] = [] childNodes _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ = [] childNodes _ _ _ (false /\ _) _ _ = []
childNodes session frontends reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary childNodes session frontends reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary
......
...@@ -5,21 +5,21 @@ import Gargantext.Ends ...@@ -5,21 +5,21 @@ import Gargantext.Ends
import Gargantext.Types (ApiVersion(..)) import Gargantext.Types (ApiVersion(..))
defaultBackends :: NonEmpty Array Backend defaultBackends :: NonEmpty Array Backend
defaultBackends = prod :| [dev, demo, local] defaultBackends = local :| [dev, demo]
where where
prod = backend V10 "/api/" "https://gargantext.org" "gargantext.org" -- prod = backend V10 "/api/" "https://gargantext.org" "gargantext.org"
dev = backend V10 "/api/" "https://dev.gargantext.org" "dev.gargantext.org" dev = backend V10 "/api/" "https://dev.gargantext.org" "dev.gargantext.org"
demo = backend V10 "/api/" "https://demo.gargantext.org" "demo.gargantext.org" demo = backend V10 "/api/" "https://demo.gargantext.org" "demo.gargantext.org"
local = backend V10 "/api/" "http://localhost:8008" "localhost" local = backend V10 "/api/" "http://localhost:8008" "localhost"
defaultApps :: NonEmpty Array Frontend defaultApps :: NonEmpty Array Frontend
defaultApps = relative :| [prod, dev, demo, haskell, caddy] defaultApps = relative :| [dev, demo, haskell, caddy]
where where
relative = frontend "/#/" "" "Relative" relative = frontend "/#/" "" "Relative"
prod = frontend "/#/" "https://gargantext.org" "gargantext.org" -- prod = frontend "/#/" "https://gargantext.org" "gargantext.org"
dev = frontend "/#/" "https://dev.gargantext.org" "gargantext.org (dev)" dev = frontend "/#/" "https://dev.gargantext.org" "gargantext.org (dev)"
demo = frontend "/#/" "https://demo.gargantext.org" "gargantext.org (demo)" demo = frontend "/#/" "https://demo.gargantext.org" "gargantext.org (demo)"
haskell = frontend "/#/" "http://localhost:8008" "localhost.gargantext)" haskell = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
python = frontend "/#/" "http://localhost:8000" "localhost.python" python = frontend "/#/" "http://localhost:8000" "localhost.python"
caddy = frontend "/#/" "http://localhost:2015" "localhost.caddy" caddy = frontend "/#/" "http://localhost:2015" "localhost.caddy"
......
...@@ -95,11 +95,11 @@ staticUrl :: Frontends -> String -> String ...@@ -95,11 +95,11 @@ staticUrl :: Frontends -> String -> String
staticUrl (Frontends {static}) = frontendUrl static staticUrl (Frontends {static}) = frontendUrl static
sessionPath :: R.SessionRoute -> String sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i) <> "/" <> showTabType' t sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i) <> "/" <> showTabType' t
sessionPath (R.Children n o l s i) = root <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s sessionPath (R.Children n o l s i) = root <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s
where root = sessionPath (R.NodeAPI Node i) <> "/" where root = sessionPath (R.NodeAPI Node i) <> "/"
sessionPath (R.NodeAPI Phylo pId) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId) sessionPath (R.NodeAPI Phylo pId) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId)
sessionPath (R.GetNgrams opts i) = sessionPath (R.GetNgrams opts i) =
base opts.tabType base opts.tabType
<> "/ngrams?ngramsType=" <> "/ngrams?ngramsType="
<> showTabType' opts.tabType <> showTabType' opts.tabType
......
...@@ -10,7 +10,8 @@ import Reactix as R ...@@ -10,7 +10,8 @@ import Reactix as R
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
useAff :: forall st. Aff st -> R.Hooks (Maybe st) useAff :: forall st.
Aff st -> R.Hooks (Maybe st)
useAff loader = do useAff loader = do
(loaded /\ setLoaded) <- R.useState' Nothing (loaded /\ setLoaded) <- R.useState' Nothing
R.useEffect1 loader $ do R.useEffect1 loader $ do
...@@ -20,36 +21,44 @@ useAff loader = do ...@@ -20,36 +21,44 @@ useAff loader = do
else pure R.nothing else pure R.nothing
pure loaded pure loaded
useLoader :: forall path st. path -> (path -> Aff st) -> (st -> R.Element) -> R.Hooks R.Element useLoader :: forall path st.
path -> (path -> Aff st) -> (st -> R.Element) -> R.Hooks R.Element
useLoader path loader render useLoader path loader render
= maybe' (\_ -> loadingSpinner {}) render = maybe' (\_ -> loadingSpinner {}) render
<$> (useAff =<< R.useMemo2 path loader (\_ -> loader path)) <$> (useAff =<< R.useMemo2 path loader (\_ -> loader path))
useLoader2 :: forall path st. R.State path -> (path -> Aff st) -> (st -> R.Element) -> R.Hooks R.Element useLoader2 :: forall path st.
R.State path -> (path -> Aff st)
-> (st -> R.Element) -> R.Hooks R.Element
useLoader2 path loader render = do useLoader2 path loader render = do
state <- R.useState' Nothing state <- R.useState' Nothing
useLoaderEffect2 path state loader useLoaderEffect2 path state loader
pure $ maybe (loadingSpinner {}) render (fst state) pure $ maybe (loadingSpinner {}) render (fst state)
useLoaderEffect :: forall state. Aff state -> R.State (Maybe state) -> R.Hooks Unit useLoaderEffect :: forall state.
Aff state -> R.State (Maybe state) -> R.Hooks Unit
useLoaderEffect loader (state /\ setState) = do useLoaderEffect loader (state /\ setState) = do
R.useEffect2 state loader $ do R.useEffect2 state loader $ do
if isNothing state then if isNothing state then
R2.affEffect "G.H.Loader.useLoader" $ loader >>= (liftEffect <<< setState <<< const <<< Just) R2.affEffect "G.H.Loader.useLoader" $ loader >>= (liftEffect <<< setState <<< const <<< Just)
else pure R.nothing else pure R.nothing
useLoaderEffect' :: forall state. Aff state -> R.Hooks (R.State (Maybe state)) useLoaderEffect' :: forall state.
Aff state -> R.Hooks (R.State (Maybe state))
useLoaderEffect' aff = do useLoaderEffect' aff = do
state <- R.useState' Nothing state <- R.useState' Nothing
useLoaderEffect aff state useLoaderEffect aff state
pure state pure state
useLoaderEffect2 :: forall st path. R.State path -> R.State (Maybe st) -> (path -> Aff st) -> R.Hooks Unit useLoaderEffect2 :: forall st path.
R.State path -> R.State (Maybe st)
-> (path -> Aff st) -> R.Hooks Unit
useLoaderEffect2 path state loader = do useLoaderEffect2 path state loader = do
aff <- useRepointer path loader aff <- useRepointer path loader
useLoaderEffect aff state useLoaderEffect aff state
useRepointer :: forall path st. R.State path -> (path -> Aff st) -> R.Hooks (Aff st) useRepointer :: forall path st.
R.State path -> (path -> Aff st) -> R.Hooks (Aff st)
useRepointer path@(path' /\ _) loader = R.useMemo2 loader path' (\_ -> loader path') useRepointer path@(path' /\ _) loader = R.useMemo2 loader path' (\_ -> loader path')
module Gargantext.Pages.Annuaire where module Gargantext.Pages.Annuaire where
import Prelude (bind, const, identity, pure, ($), (<$>), (<>)) import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array (head) import Data.Array (head)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
...@@ -29,7 +29,7 @@ toRows (AnnuaireTable a) = a.annuaireTable ...@@ -29,7 +29,7 @@ toRows (AnnuaireTable a) = a.annuaireTable
-- | Top level layout component. Loads an annuaire by id and renders -- | Top level layout component. Loads an annuaire by id and renders
-- | the annuaire using the result -- | the annuaire using the result
type LayoutProps = ( annuaireId :: Int, session :: Session ) type LayoutProps = ( nodeId :: Int, session :: Session )
annuaireLayout :: Record LayoutProps -> R.Element annuaireLayout :: Record LayoutProps -> R.Element
annuaireLayout props = R.createElement annuaireLayoutCpt props [] annuaireLayout props = R.createElement annuaireLayoutCpt props []
...@@ -37,8 +37,8 @@ annuaireLayout props = R.createElement annuaireLayoutCpt props [] ...@@ -37,8 +37,8 @@ annuaireLayout props = R.createElement annuaireLayoutCpt props []
annuaireLayoutCpt :: R.Component LayoutProps annuaireLayoutCpt :: R.Component LayoutProps
annuaireLayoutCpt = R.hooksComponent "G.P.Annuaire.annuaireLayout" cpt annuaireLayoutCpt = R.hooksComponent "G.P.Annuaire.annuaireLayout" cpt
where where
cpt {annuaireId, session} _ = do cpt {nodeId, session} _ = do
path <- R.useState' annuaireId path <- R.useState' nodeId
useLoader (fst path) (getAnnuaireInfo session) $ useLoader (fst path) (getAnnuaireInfo session) $
\info -> annuaire {session, path, info} \info -> annuaire {session, path, info}
...@@ -138,8 +138,8 @@ data HyperdataAnnuaire = HyperdataAnnuaire ...@@ -138,8 +138,8 @@ data HyperdataAnnuaire = HyperdataAnnuaire
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
title <- obj .?? "title" title <- obj .:? "title"
desc <- obj .?? "desc" desc <- obj .:? "desc"
pure $ HyperdataAnnuaire { title, desc } pure $ HyperdataAnnuaire { title, desc }
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
......
module Gargantext.Pages.Corpus.Document where module Gargantext.Pages.Corpus.Document where
import Prelude (class Show, bind, identity, mempty, pure, ($), (<<<)) import Prelude (class Show, bind, identity, mempty, pure, ($), (<<<))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
...@@ -203,7 +203,7 @@ instance decodeDocumentV3 :: DecodeJson DocumentV3 ...@@ -203,7 +203,7 @@ instance decodeDocumentV3 :: DecodeJson DocumentV3
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
abstract <- obj .?? "abstract" abstract <- obj .:? "abstract"
authors <- obj .: "authors" authors <- obj .: "authors"
--error <- obj .: "error" --error <- obj .: "error"
language_iso2 <- obj .: "language_iso2" language_iso2 <- obj .: "language_iso2"
...@@ -243,23 +243,23 @@ instance decodeDocument :: DecodeJson Document ...@@ -243,23 +243,23 @@ instance decodeDocument :: DecodeJson Document
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
abstract <- obj .?? "abstract" abstract <- obj .:? "abstract"
authors <- obj .?? "authors" authors <- obj .:? "authors"
bdd <- obj .?? "bdd" bdd <- obj .:? "bdd"
doi <- obj .?? "doi" doi <- obj .:? "doi"
language_iso2 <- obj .?? "language_iso2" language_iso2 <- obj .:? "language_iso2"
-- page <- obj .?? "page" -- page <- obj .:? "page"
publication_date <- obj .?? "publication_date" publication_date <- obj .:? "publication_date"
--publication_second <- obj .?? "publication_second" --publication_second <- obj .:? "publication_second"
--publication_minute <- obj .?? "publication_minute" --publication_minute <- obj .:? "publication_minute"
--publication_hour <- obj .?? "publication_hour" --publication_hour <- obj .:? "publication_hour"
publication_day <- obj .?? "publication_day" publication_day <- obj .:? "publication_day"
publication_month <- obj .?? "publication_month" publication_month <- obj .:? "publication_month"
publication_year <- obj .?? "publication_year" publication_year <- obj .:? "publication_year"
source <- obj .?? "sources" source <- obj .:? "sources"
institutes <- obj .?? "institutes" institutes <- obj .:? "institutes"
title <- obj .?? "title" title <- obj .:? "title"
uniqId <- obj .?? "uniqId" uniqId <- obj .:? "uniqId"
--url <- obj .: "url" --url <- obj .: "url"
--text <- obj .: "text" --text <- obj .: "text"
pure $ Document { abstract pure $ Document { abstract
......
...@@ -8,7 +8,8 @@ import Reactix.DOM.HTML as H ...@@ -8,7 +8,8 @@ import Reactix.DOM.HTML as H
import Routing.Hash (setHash) import Routing.Hash (setHash)
import Gargantext.Components.Lang.Landing.EnUS as En import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..)) import Gargantext.Components.Data.Landing
(BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..)) import Gargantext.Components.Data.Lang (Lang(..))
type Props = () type Props = ()
......
...@@ -43,7 +43,7 @@ getCorpus :: Session -> Int -> Aff Tabs.CorpusData ...@@ -43,7 +43,7 @@ getCorpus :: Session -> Int -> Aff Tabs.CorpusData
getCorpus session listId = do getCorpus session listId = do
-- fetch corpus via lists parentId -- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get nodePolyUrl (NodePoly {parentId: corpusId} :: NodePoly {}) <- get nodePolyUrl
corpusNode <- get $ corpusNodeUrl corpusId corpusNode <- get $ corpusNodeUrl corpusId
defaultListIds <- get $ defaultListIdsUrl corpusId defaultListIds <- get $ defaultListIdsUrl corpusId
case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) -> Just (NodePoly { id: defaultListId }) ->
...@@ -51,6 +51,6 @@ getCorpus session listId = do ...@@ -51,6 +51,6 @@ getCorpus session listId = do
Nothing -> Nothing ->
throwError $ error "Missing default list" throwError $ error "Missing default list"
where where
nodePolyUrl = url session (NodeAPI Corpus (Just listId)) nodePolyUrl = url session (NodeAPI Corpus (Just listId))
corpusNodeUrl = url session <<< NodeAPI Corpus <<< Just corpusNodeUrl = url session <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url session <<< Children NodeList 0 1 Nothing <<< Just defaultListIdsUrl = url session <<< Children NodeList 0 1 Nothing <<< Just
...@@ -30,7 +30,7 @@ textsLayout props = R.createElement textsLayoutCpt props [] ...@@ -30,7 +30,7 @@ textsLayout props = R.createElement textsLayoutCpt props []
textsLayoutCpt :: R.Component Props textsLayoutCpt :: R.Component Props
textsLayoutCpt = R.hooksComponent "TextsLoader" cpt textsLayoutCpt = R.hooksComponent "TextsLoader" cpt
where where
cpt {nodeId,session} _ = cpt {session,nodeId} _ =
useLoader nodeId (getCorpus session) $ useLoader nodeId (getCorpus session) $
\corpusData@{corpusId, corpusNode, defaultListId} -> \corpusData@{corpusId, corpusNode, defaultListId} ->
let let
......
...@@ -9,18 +9,21 @@ import Gargantext.Routes (AppRoute(..)) ...@@ -9,18 +9,21 @@ import Gargantext.Routes (AppRoute(..))
router :: Match AppRoute router :: Match AppRoute
router = oneOf router = oneOf
[ Login <$ route "login" [ Login <$ route "login"
, Folder <$> (route "folder" *> int) , Folder <$> (route "folder" *> int)
, CorpusDocument <$> (route "corpus" *> int) <*> (lit "list" *> int) <*> (lit "document" *> int) , CorpusDocument <$> (route "corpus" *> int)
, Corpus <$> (route "corpus" *> int) <*> (lit "list" *> int)
, Document <$> (route "list" *> int) <*> (lit "document" *> int) <*> (lit "document" *> int)
, Dashboard <$ route "dashboard" , Corpus <$> (route "corpus" *> int)
, PGraphExplorer <$> (route "graph" *> int) , Document <$> (route "list" *> int)
, Texts <$> (route "texts" *> int) <*> (lit "document" *> int)
, Lists <$> (route "lists" *> int) , Dashboard <$> (route "dashboard" *> int)
, Annuaire <$> (route "annuaire" *> int) , PGraphExplorer <$> (route "graph" *> int)
, UserPage <$> (route "user" *> int) , Texts <$> (route "texts" *> int)
, ContactPage <$> (route "contact" *> int) , Lists <$> (route "lists" *> int)
, Home <$ lit "" , Annuaire <$> (route "annuaire" *> int)
, UserPage <$> (route "user" *> int)
, ContactPage <$> (route "contact" *> int)
, Home <$ lit ""
] ]
where where
route str = lit "" *> lit str route str = lit "" *> lit str
......
...@@ -12,7 +12,7 @@ data AppRoute ...@@ -12,7 +12,7 @@ data AppRoute
| Document Int Int | Document Int Int
| CorpusDocument Int Int Int | CorpusDocument Int Int Int
| PGraphExplorer Int | PGraphExplorer Int
| Dashboard | Dashboard Int
| Texts Int | Texts Int
| Lists Int | Lists Int
| Annuaire Int | Annuaire Int
...@@ -32,31 +32,31 @@ data SessionRoute ...@@ -32,31 +32,31 @@ data SessionRoute
| Chart ChartOpts (Maybe Id) | Chart ChartOpts (Maybe Id)
instance showAppRoute :: Show AppRoute where instance showAppRoute :: Show AppRoute where
show Home = "Home" show Home = "Home"
show Login = "Login" show Login = "Login"
show (Folder i) = "Folder" <> show i show (Folder i) = "Folder" <> show i
show (Corpus i) = "Corpus" <> show i show (Corpus i) = "Corpus" <> show i
show (Document _ i) = "Document" <> show i show (Document _ i) = "Document" <> show i
show (CorpusDocument _ _ i) = "Document" <> show i show (CorpusDocument _ _ i) = "Document" <> show i
show (PGraphExplorer i) = "graphExplorer" <> show i show (PGraphExplorer i) = "graphExplorer" <> show i
show Dashboard = "Dashboard" show (Dashboard i) = "Dashboard" <> show i
show (Texts i) = "texts" <> show i show (Texts i) = "texts" <> show i
show (Lists i) = "lists" <> show i show (Lists i) = "lists" <> show i
show (Annuaire i) = "Annuaire" <> show i show (Annuaire i) = "Annuaire" <> show i
show (UserPage i) = "User" <> show i show (UserPage i) = "User" <> show i
show (ContactPage i) = "Contact" <> show i show (ContactPage i) = "Contact" <> show i
appPath :: AppRoute -> String appPath :: AppRoute -> String
appPath Home = "" appPath Home = ""
appPath Login = "login" appPath Login = "login"
appPath (Folder i) = "folder/" <> show i appPath (Folder i) = "folder/" <> show i
appPath (CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i appPath (CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i
appPath (Corpus i) = "corpus/" <> show i appPath (Corpus i) = "corpus/" <> show i
appPath (Document l i) = "list/" <> show l <> "/document/" <> show i appPath (Document l i) = "list/" <> show l <> "/document/" <> show i
appPath Dashboard = "dashboard" appPath (Dashboard i) = "dashboard/" <> show i
appPath (PGraphExplorer i) = "graph/" <> show i appPath (PGraphExplorer i) = "graph/" <> show i
appPath (Texts i) = "texts/" <> show i appPath (Texts i) = "texts/" <> show i
appPath (Lists i) = "lists/" <> show i appPath (Lists i) = "lists/" <> show i
appPath (Annuaire i) = "annuaire/" <> show i appPath (Annuaire i) = "annuaire/" <> show i
appPath (UserPage i) = "user/" <> show i appPath (UserPage i) = "user/" <> show i
appPath (ContactPage i) = "contact/" <> show i appPath (ContactPage i) = "contact/" <> show i
...@@ -68,8 +68,8 @@ act :: Sessions -> Action -> Effect Sessions ...@@ -68,8 +68,8 @@ act :: Sessions -> Action -> Effect Sessions
act _ (Login session) = pure $ Sessions (Just session) act _ (Login session) = pure $ Sessions (Just session)
act (Sessions s) (Logout session) act (Sessions s) (Logout session)
| Just session == s = pure (Sessions Nothing) | Just session == s = pure (Sessions Nothing)
| Just s2 <- s = log2 "Alien session:" s2 *> pure (Sessions Nothing) | Just s2 <- s = log2 "Alien session:" s2 *> pure (Sessions Nothing)
| otherwise = log "Can't log out of nonexistent session" *> pure (Sessions Nothing) | otherwise = log "Can't log out of nonexistent session" *> pure (Sessions Nothing)
-- Key we will store the data under -- Key we will store the data under
localStorageKey :: String localStorageKey :: String
...@@ -106,7 +106,7 @@ postAuthRequest backend ar@(AuthRequest {username}) = ...@@ -106,7 +106,7 @@ postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> post (toUrl backend "auth") ar decode <$> post (toUrl backend "auth") ar
where where
decode (AuthResponse ar2) decode (AuthResponse ar2)
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message | {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 = | {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend, username, token, treeId: tree_id } Right $ Session { backend, username, token, treeId: tree_id }
| otherwise = Left "Invalid response from server" | otherwise = Left "Invalid response from server"
module Gargantext.Components.NgramsTable.Spec where module Gargantext.Components.NgramsTable.Spec where
import Prelude import Prelude
import Gargantext.Config (CTabNgramType(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Components.NgramsTable.Core (highlightNgrams, NgramsElement(..), NgramsTable(..)) import Gargantext.Components.NgramsTable.Core (highlightNgrams, NgramsElement(..), NgramsTable(..))
import Gargantext.Config (CTabNgramType(..))
import Gargantext.Types (TermList(..)) import Gargantext.Types (TermList(..))
import Test.Spec (Spec, describe, it) import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual) import Test.Spec.Assertions (shouldEqual)
...@@ -13,6 +11,7 @@ import Test.Spec.Assertions (shouldEqual) ...@@ -13,6 +11,7 @@ import Test.Spec.Assertions (shouldEqual)
import Data.Map as Map import Data.Map as Map
import Data.Set as Set import Data.Set as Set
{-
spec :: Spec Unit spec :: Spec Unit
spec = do spec = do
let ne ngrams list = let ne ngrams list =
...@@ -93,3 +92,4 @@ spec = do ...@@ -93,3 +92,4 @@ spec = do
,Tuple ", after" Nothing ,Tuple ", after" Nothing
] ]
highlightNgrams CTabTerms table input `shouldEqual` output highlightNgrams CTabTerms table input `shouldEqual` output
-}
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