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

[FIX] EcoSystem Explorer (WIP) and migrations

parent 8a629d69
...@@ -57,24 +57,23 @@ chooserCpt = here.component "chooser" cpt where ...@@ -57,24 +57,23 @@ 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: "center modal-title" } {- [ H.h2 { className: "mx-auto" } [ H.text "Workspace manager" ]]
[ H.text "Instances manager" ]] <> -} activeConnections sessions sessions' <>
<> activeConnections sessions sessions' <> [ H.h3 {} [ H.text "Existing places" ]
[ H.h3 {} [ H.text "Existing connections" ]
, 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 = [ "", "Label of instance", "Gargurl" ] headers = [ "", "GarganText places", "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
activeConnections :: forall s. T.ReadWrite s Sessions => s -> Sessions -> Array R.Element activeConnections :: forall s. T.ReadWrite s Sessions => s -> Sessions -> Array R.Element
activeConnections _ sessions' | Sessions.null sessions' = [] activeConnections _ sessions' | Sessions.null sessions' = []
activeConnections sessions sessions' = activeConnections sessions sessions' =
[ H.h3 {} [ H.text "Active connection(s)" ] [ H.h3 {} [ H.text "Active place(s)" ]
, H.ul {} [ renderSessions sessions sessions' ] ] , H.ul {} [ renderSessions sessions sessions' ] ]
renderSessions :: forall s. T.ReadWrite s Sessions => s -> Sessions -> R.Element renderSessions :: forall s. T.ReadWrite s Sessions => s -> Sessions -> R.Element
...@@ -103,11 +102,11 @@ clearCacheButton = ...@@ -103,11 +102,11 @@ 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}) = renderBackend cursor backend@(Backend {name, baseUrl}) =
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 $ "garg://" <> name ]] where , 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" className = "fa fa-hand-o-right" -- "glyphitem fa fa-log-in"
click _ = T.write_ (Just backend) cursor click _ = T.write_ (Just backend) cursor
......
...@@ -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: "icon-text"} [ H.text "GarganText" ]]] [ H.span {className: "center icon-text"} [ H.text "Exploring the eco-system with the workspace manager" ]]]
, 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" }}
......
...@@ -12,34 +12,24 @@ import Gargantext.Prelude (bind, pure, ($)) ...@@ -12,34 +12,24 @@ import Gargantext.Prelude (bind, pure, ($))
import Gargantext.Types (ApiVersion(..)) import Gargantext.Types (ApiVersion(..))
import Gargantext.Utils (href) import Gargantext.Utils (href)
defaultBackends :: NonEmpty Array Backend defaultBackends :: NonEmpty Array Backend
defaultBackends = defaultBackends = backend' "Show Room (Demo)" "https://demo.gargantext.org"
backend_local :| [ backend_prod, backend_partner, backend_demo, backend_dev ] :| [ backend' "Laboratory Room (CNRS/ISCPIF)" "https://cnrs.gargantext.org"
, backend' "Class Room" "https://learn.gargantext.org"
prodUrl :: String , backend' "Funding Partner (IMT)" "https://imtv5.gargantext.org"
prodUrl = "https://v4.gargantext.org" , backend' "Scientific Community (Complex Systems)" "https://community.gargantext.org"
backend_prod :: Backend , backend' "European Project (VIGIE)" "https://europa.gargantext.org"
backend_prod = backend V10 "/api/" prodUrl "iscpif.cnrs" , backend' "Dev SandBox" "https://dev.gargantext.org"
, backend' "Private Bunker (Local Only)" "http://localhost:8008"
partnerUrl :: String , backend' "Business Room (Hello Word)" "https://garg.helloword.io"
partnerUrl = "https://imtv4.gargantext.org" ]
backend_partner :: Backend
backend_partner = backend V10 "/api/" partnerUrl "institut-mines-telecom.imt"
where
demoUrl :: String backend' n u = backend n V10 "/api/" u
demoUrl = "https://demo.gargantext.org"
backend_demo :: Backend
backend_demo = backend V10 "/api/" demoUrl "demo.inshs.cnrs"
devUrl :: String
devUrl = "https://dev.gargantext.org"
backend_dev :: Backend
backend_dev = backend V10 "/api/" devUrl "devel.inshs.cnrs"
localUrl :: String
localUrl = "http://localhost:8008"
backend_local :: Backend
backend_local = backend V10 "/api/" localUrl "local.cnrs"
matchCurrentLocation :: Effect (Maybe Backend) matchCurrentLocation :: Effect (Maybe Backend)
matchCurrentLocation = do matchCurrentLocation = do
...@@ -51,7 +41,7 @@ matchCurrentLocation = do ...@@ -51,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 publicBackend = backend "local" V10 "/api/" "http://localhost:8008"
publicBackend' :: Effect Backend publicBackend' :: Effect Backend
publicBackend' = do publicBackend' = do
......
...@@ -36,8 +36,11 @@ instance Eq Backend where eq = genericEq ...@@ -36,8 +36,11 @@ instance Eq Backend where eq = genericEq
instance Show Backend where show (Backend {name}) = name instance Show Backend where show (Backend {name}) = name
instance ToUrl Backend String where toUrl = backendUrl instance ToUrl Backend String where toUrl = backendUrl
backend :: ApiVersion -> String -> String -> String -> Backend type BaseUrl = String
backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl } type PrePath = String
type Name = String
backend :: Name -> ApiVersion -> PrePath -> BaseUrl -> Backend
backend name version prePath baseUrl = Backend { name, version, prePath, baseUrl }
-- | 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
......
...@@ -7,8 +7,8 @@ module Gargantext.Sessions.Types ...@@ -7,8 +7,8 @@ module Gargantext.Sessions.Types
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Int as Int import Data.Int as Int
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
...@@ -19,21 +19,20 @@ import Data.Sequence as Seq ...@@ -19,21 +19,20 @@ 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.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.String as DST
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Foreign.Object as Object import Foreign.Object as Object
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Login.Types (TreeId) import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath) import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute) import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath) import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Utils.JSON as GJSON import Gargantext.Utils.JSON as GJSON
import Gargantext.Utils.Tuple as GUT import Gargantext.Utils.Tuple as GUT
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
-- | A Session represents an authenticated session for a user at a -- | A Session represents an authenticated session for a user at a
-- | backend. It contains a token and root tree id. -- | backend. It contains a token and root tree id.
...@@ -61,9 +60,18 @@ instance JSON.WriteForeign Session where ...@@ -61,9 +60,18 @@ instance JSON.WriteForeign Session where
JSON.writeImpl { backend, caches: caches', token, treeId, username } JSON.writeImpl { backend, caches: caches', token, treeId, username }
where where
caches' = JSON.writeImpl $ Object.fromFoldable (GUT.mapFst show <$> Map.toUnfoldable caches :: Array (Tuple String NT.CacheState)) caches' = JSON.writeImpl $ Object.fromFoldable (GUT.mapFst show <$> Map.toUnfoldable caches :: Array (Tuple String NT.CacheState))
instance Eq Session where eq = genericEq instance Eq Session where eq = genericEq
instance Show Session where show (Session {backend, username}) = username <> "@" <> show backend
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
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)
instance ToUrl Session NodePath where toUrl (Session {backend}) np = backendUrl backend (nodePath np) instance ToUrl Session NodePath where toUrl (Session {backend}) np = backendUrl backend (nodePath np)
instance ToUrl Session String where toUrl = sessionUrl instance ToUrl Session String where toUrl = sessionUrl
......
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