Commit 97833e3c authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Ecosystem explorer and workspace manager

parent 8dd19489
Pipeline #1855 canceled with stage
...@@ -18,7 +18,7 @@ import Gargantext.Components.Login.Form (form) ...@@ -18,7 +18,7 @@ import Gargantext.Components.Login.Form (form)
import Gargantext.Components.NgramsTable.Loader as NTL import Gargantext.Components.NgramsTable.Loader as NTL
import Gargantext.Ends (Backend(..)) import Gargantext.Ends (Backend(..))
import Gargantext.Hooks.Loader as GHL import Gargantext.Hooks.Loader as GHL
import Gargantext.Sessions (Session, Sessions, Action(Logout), unSessions) import Gargantext.Sessions (Session(..), Sessions, Action(Logout), unSessions)
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -57,16 +57,17 @@ chooserCpt = here.component "chooser" cpt where ...@@ -57,16 +57,17 @@ chooserCpt = here.component "chooser" cpt where
sessions' <- T.useLive T.unequal sessions sessions' <- T.useLive T.unequal sessions
pure $ pure $
R.fragment $ R.fragment $
{- [ H.h2 { className: "mx-auto" } [ H.text "Workspace manager" ]] [ H.h2 { className: "mx-auto" } [ H.text "Workspace manager" ]]
<> -} activeConnections sessions sessions' <> <> activeConnections sessions sessions' <>
[ H.h3 {} [ H.text "Existing places" ] [ H.h3 {} [ H.text "Existing places (click to login)" ]
, H.table { className : "table" } , H.table { className : "table" }
[ H.thead { className: "thead-light" } [ H.thead { className: "thead-light" }
[ H.tr {} (map header headers) ] [ H.tr {} (map header headers) ]
, H.tbody {} (map (renderBackend backend) backends) ] , H.tbody {} (map (renderBackend backend) backends)
]
, H.input { className: "form-control", type:"text", placeholder } ] , H.input { className: "form-control", type:"text", placeholder } ]
placeholder = "Search for your institute" placeholder = "Search for your institute"
headers = [ "", "GarganText places", "Garg protocol url" ] headers = [ "", "GarganText places", "Fonction", "Garg protocol url" ]
header label = H.th {} [ H.text label ] header label = H.th {} [ H.text label ]
-- Shown in the chooser -- Shown in the chooser
...@@ -74,16 +75,31 @@ activeConnections :: forall s. T.ReadWrite s Sessions => s -> Sessions -> Array ...@@ -74,16 +75,31 @@ activeConnections :: forall s. T.ReadWrite s Sessions => s -> Sessions -> Array
activeConnections _ sessions' | Sessions.null sessions' = [] activeConnections _ sessions' | Sessions.null sessions' = []
activeConnections sessions sessions' = activeConnections sessions sessions' =
[ H.h3 {} [ H.text "Active place(s)" ] [ H.h3 {} [ H.text "Active place(s)" ]
, H.ul {} [ renderSessions sessions sessions' ] ] , H.table { className : "table" }
[ H.thead { className: "thead-light" }
[ H.tr {} (map header headers) ]
, H.tbody {} [renderSessions sessions sessions']
]
]
where
headers = [ "", "Active(s) connection(s)", "Fonction", "Clear data/Logout"]
header label = H.th {} [ H.text label ]
renderSessions :: forall s. T.ReadWrite s Sessions => s -> Sessions -> R.Element renderSessions :: forall s. T.ReadWrite s Sessions => s -> Sessions -> R.Element
renderSessions sessions sessions' = renderSessions sessions sessions' =
R.fragment (map renderSession $ unSessions sessions') where R.fragment (map renderSession $ unSessions sessions')
renderSession session = where
H.li {} renderSession session@(Session {backend}) =
[ H.text $ show session H.tr {}
, signOutButton sessions session [ H.td {} [H.text ""]
, clearCacheButton ] , H.td {} [H.text $ show session]
, H.td {} [H.text backendType]
, H.td {} [signOutButton sessions session, clearCacheButton]
]
where
Backend {backendType} = backend
signOutButton :: forall c. T.ReadWrite c Sessions => c -> Session -> R.Element signOutButton :: forall c. T.ReadWrite c Sessions => c -> Session -> R.Element
signOutButton sessions session = signOutButton sessions session =
...@@ -94,7 +110,7 @@ signOutButton sessions session = ...@@ -94,7 +110,7 @@ signOutButton sessions session =
clearCacheButton :: R.Element clearCacheButton :: R.Element
clearCacheButton = clearCacheButton =
H.a { className, on: { click }, id: "log-out", title: "Clear cache" } [] where H.a { className, on: { click }, id: "log-out", title: "Clear cache" } [] where
className = "glyphitem fa fa-eraser" className = "glyphitem fa fa-eraser"
click _ = click _ =
launchAff_ launchAff_
$ GHL.clearCache unit $ GHL.clearCache unit
...@@ -102,13 +118,16 @@ clearCacheButton = ...@@ -102,13 +118,16 @@ clearCacheButton =
*> liftEffect (here.log "cache cleared") *> liftEffect (here.log "cache cleared")
renderBackend :: forall b. T.Write b (Maybe Backend) => b -> Backend -> R.Element renderBackend :: forall b. T.Write b (Maybe Backend) => b -> Backend -> R.Element
renderBackend cursor backend@(Backend {name, baseUrl}) = renderBackend cursor backend@(Backend {name, baseUrl, backendType}) =
H.tr {} H.tr {}
[ H.td {} [ H.a { on: { click }, title: "Log In", className } [] ] [ H.td {} [ H.a { on: { click }, title: "Log In", className } [] ]
, H.td {} [ H.a { on: { click }} [ H.text (backendLabel name) ]] , H.td {} [ H.a { on: { click }} [ H.text (backendLabel name) ]]
, H.td {} [ H.text $ DST.replace (DST.Pattern "http") (DST.Replacement "garg") $ baseUrl ]] where , H.td {} [ H.a { on: { click }} [ H.text backendType ]]
className = "fa fa-hand-o-right" -- "glyphitem fa fa-log-in" , H.td {} [ H.text $ DST.replace (DST.Pattern "http") (DST.Replacement "garg") $ baseUrl ]
click _ = T.write_ (Just backend) cursor ]
where
className = "fa fa-hand-o-right" -- "glyphitem fa fa-log-in"
click _ = T.write_ (Just backend) cursor
backendLabel :: String -> String backendLabel :: String -> String
backendLabel = backendLabel =
......
...@@ -31,7 +31,7 @@ modalCpt = here.component "modal" cpt where ...@@ -31,7 +31,7 @@ modalCpt = here.component "modal" cpt where
[ H.h2 { className: "text-primary center m-a-2" } [ H.h2 { className: "text-primary center m-a-2" }
-- H.i {className: "material-icons md-36"} -- H.i {className: "material-icons md-36"}
-- [ H.text "control_point" ] -- [ H.text "control_point" ]
[ H.span {className: "center icon-text"} [ H.text "Exploring the eco-system with the workspace manager" ]]] [ H.span {className: "center icon-text"} [ H.text "GarganText ecosystem explorer" ]]]
, H.button -- TODO , font-size : "50px" , H.button -- TODO , font-size : "50px"
{ type: "button", className: "close" { type: "button", className: "close"
, data: { dismiss: "modal" }} , data: { dismiss: "modal" }}
......
...@@ -13,11 +13,10 @@ import Gargantext.Components.Lang.Landing.EnUS as En ...@@ -13,11 +13,10 @@ 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.Nodes.Home.Public (renderPublic) import Gargantext.Components.Nodes.Home.Public (renderPublic)
import Gargantext.Config as Config import Gargantext.Config as Config
import Gargantext.Ends (Backend(..))
import Gargantext.License (license) import Gargantext.License (license)
import Gargantext.Sessions (Sessions) import Gargantext.Sessions (Sessions)
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Sessions.Types (Session(..)) import Gargantext.Sessions.Types (Session(..), cleanBackendUrl)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -66,7 +65,7 @@ homeLayoutCpt = here.component "homeLayout" cpt ...@@ -66,7 +65,7 @@ homeLayoutCpt = here.component "homeLayout" cpt
, sessions , sessions
, showLogin } , showLogin }
, lang } _ = do , lang } _ = do
backend' <- T.useLive T.unequal backend backend' <- T.useLive T.unequal backend
sessions' <- T.useLive T.unequal sessions sessions' <- T.useLive T.unequal sessions
let landingData = langLandingData lang let landingData = langLandingData lang
pure $ pure $
...@@ -179,14 +178,15 @@ tutorialCpt = here.component "tutorial" cpt where ...@@ -179,14 +178,15 @@ tutorialCpt = here.component "tutorial" cpt where
-} -}
makeFolders :: Array Session -> Array R.Element makeFolders :: Array Session -> Array R.Element
makeFolders s = sessionToFolder <$> s where makeFolders s = sessionToFolder <$> s
sessionToFolder session@(Session {treeId, username, backend: (Backend {name})}) = where
H.span { className: "folder" } [ sessionToFolder session@(Session {treeId, username, backend}) =
H.div { className: "d-flex justify-content-center" } [ H.text (username <> "@" <> name) ] H.span { className: "folder" } [
, H.div {} [ FV.folderView { backFolder: false H.div { className: "d-flex justify-content-center" } [ H.text (username <> "@" <> (cleanBackendUrl backend)) ]
, boxes , H.div {} [ FV.folderView { backFolder: false
, nodeId: treeId , boxes
, session } ] ] , nodeId: treeId
, session } ] ]
startTutos :: Array Tuto startTutos :: Array Tuto
startTutos = startTutos =
......
...@@ -15,20 +15,20 @@ import Gargantext.Utils (href) ...@@ -15,20 +15,20 @@ import Gargantext.Utils (href)
defaultBackends :: NonEmpty Array Backend defaultBackends :: NonEmpty Array Backend
defaultBackends = backend' "Show Room (Demo)" "https://demo.gargantext.org" defaultBackends = backend' "Demo" "Show room" "https://demo.gargantext.org"
:| [ backend' "Laboratory Room (CNRS/ISCPIF)" "https://cnrs.gargantext.org" :| [ backend' "Organization" "CNRS/ISCPIF Unit" "https://cnrs.gargantext.org"
, backend' "Class Room" "https://learn.gargantext.org" , backend' "Education" "Class Rooms" "https://formation.gargantext.org"
, backend' "Funding Partner (IMT)" "https://imtv5.gargantext.org" , backend' "Funding partner" "Mines Telecom Institute" "https://imt.sub.gargantext.org"
, backend' "Scientific Community (Complex Systems)" "https://community.gargantext.org" , backend' "Networking" "Complex Systems Community" "https://complexsystems.gargantext.org"
, backend' "European Project (VIGIE)" "https://europa.gargantext.org" , backend' "Networking" "Digeing European Project" "https://europa.gargantext.org"
, backend' "Dev SandBox" "https://dev.gargantext.org" , backend' "Development" "Main SandBox" "https://dev.gargantext.org"
, backend' "Private Bunker (Local Only)" "http://localhost:8008" , backend' "Private" "Offline Bunker" "http://localhost:8008"
, backend' "Business Room (Hello Word)" "https://garg.helloword.io" , backend' "Business" "Hello Word Company" "https://helloword.gargantext.org"
] ]
where where
backend' n u = backend n V10 "/api/" u backend' t n u = backend t n V10 "/api/" u
matchCurrentLocation :: Effect (Maybe Backend) matchCurrentLocation :: Effect (Maybe Backend)
...@@ -41,7 +41,7 @@ matchCurrentLocation = do ...@@ -41,7 +41,7 @@ matchCurrentLocation = do
-- | public Backend -- | public Backend
-- When user is not logged, use the location of the window -- When user is not logged, use the location of the window
publicBackend :: Backend publicBackend :: Backend
publicBackend = backend "local" V10 "/api/" "http://localhost:8008" publicBackend = backend "Private" "local" V10 "/api/" "http://localhost:8008"
publicBackend' :: Effect Backend publicBackend' :: Effect Backend
publicBackend' = do publicBackend' = do
...@@ -50,6 +50,7 @@ publicBackend' = do ...@@ -50,6 +50,7 @@ publicBackend' = do
, baseUrl : href , baseUrl : href
, prePath : "api/" , prePath : "api/"
, version : V10 , version : V10
, backendType : "Public home"
} }
defaultApps :: NonEmpty Array Frontend defaultApps :: NonEmpty Array Frontend
......
...@@ -21,12 +21,14 @@ class ToUrl conf p where ...@@ -21,12 +21,14 @@ class ToUrl conf p where
url :: forall conf p. ToUrl conf p => conf -> p -> String url :: forall conf p. ToUrl conf p => conf -> p -> String
url = toUrl url = toUrl
-- | Encapsulates the data we need to talk to a backend server -- | Encapsulates the data we need to talk to a backend server
newtype Backend = Backend newtype Backend = Backend
{ name :: String { name :: String
, baseUrl :: String , baseUrl :: String
, prePath :: String , prePath :: String
, version :: ApiVersion , version :: ApiVersion
, backendType :: String
} }
derive instance Generic Backend _ derive instance Generic Backend _
derive instance Newtype Backend _ derive instance Newtype Backend _
...@@ -39,8 +41,10 @@ instance ToUrl Backend String where toUrl = backendUrl ...@@ -39,8 +41,10 @@ instance ToUrl Backend String where toUrl = backendUrl
type BaseUrl = String type BaseUrl = String
type PrePath = String type PrePath = String
type Name = String type Name = String
backend :: Name -> ApiVersion -> PrePath -> BaseUrl -> Backend type BackendType = String
backend name version prePath baseUrl = Backend { name, version, prePath, baseUrl }
backend :: BackendType -> Name -> ApiVersion -> PrePath -> BaseUrl -> Backend
backend backendType name version prePath baseUrl = Backend { name, version, prePath, baseUrl, backendType}
-- | Creates a backend url from a backend and the path as a string -- | Creates a backend url from a backend and the path as a string
backendUrl :: Backend -> String -> String backendUrl :: Backend -> String -> String
...@@ -51,7 +55,8 @@ backendUrl (Backend b) path = b.baseUrl <> b.prePath <> show b.version <> "/" <> ...@@ -51,7 +55,8 @@ backendUrl (Backend b) path = b.baseUrl <> b.prePath <> show b.version <> "/" <>
newtype Frontend = Frontend newtype Frontend = Frontend
{ name :: String { name :: String
, baseUrl :: String , baseUrl :: String
, prePath :: String } , prePath :: String
}
derive instance Generic Frontend _ derive instance Generic Frontend _
instance Eq Frontend where eq = genericEq instance Eq Frontend where eq = genericEq
......
...@@ -3,6 +3,7 @@ module Gargantext.Sessions.Types ...@@ -3,6 +3,7 @@ module Gargantext.Sessions.Types
, sessionUrl, sessionId , sessionUrl, sessionId
, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove , empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove
, useOpenNodesMemberBox, openNodesInsert, openNodesDelete , useOpenNodesMemberBox, openNodesInsert, openNodesDelete
, cleanBackendUrl
) where ) where
import Data.Array as A import Data.Array as A
...@@ -64,11 +65,12 @@ instance JSON.WriteForeign Session where ...@@ -64,11 +65,12 @@ instance JSON.WriteForeign Session where
instance Eq Session where eq = genericEq instance Eq Session where eq = genericEq
instance Show Session where instance Show Session where
show (Session {backend, username}) = username <> "@" <> url show (Session {backend, username}) = username <> "@" <> (cleanBackendUrl backend)
where
Backend {baseUrl} = backend cleanBackendUrl :: Backend -> String
url = DST.replace (DST.Pattern "http://") (DST.Replacement "") cleanBackendUrl (Backend {baseUrl}) =
$ DST.replace (DST.Pattern "https://") (DST.Replacement "") baseUrl DST.replace (DST.Pattern "http://") (DST.Replacement "")
$ DST.replace (DST.Pattern "https://") (DST.Replacement "") baseUrl
instance ToUrl Session SessionRoute where toUrl (Session {backend}) r = backendUrl backend (sessionPath r) instance ToUrl Session SessionRoute where toUrl (Session {backend}) r = backendUrl backend (sessionPath r)
......
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