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

[FIX] Ecosystem explorer and workspace manager

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