Merge branch '274-dev-login-page-advanced' of...

Merge branch '274-dev-login-page-advanced' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge

src/Gargantext/Components/Forest.purs

@@ -8,7 +8,7 @@ module Gargantext.Components.Forest
 import Gargantext.Prelude
 
 import Data.Array as A
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe(..))
 import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree (treeLoader)
 import Gargantext.Ends (Frontends, Backend)
@@ -80,7 +80,7 @@ forestCpt = here.component "forest" cpt where
     -- TODO If `reloadForest` is set, `reload` state should be updated
     -- TODO fix tasks ref
     pure $ H.div { className: "forest " <> if showTree' then "" else "d-none" }
-      (A.cons (plus { handed, showLogin }) (trees handed' sessions'))
+      (A.cons (plus { backend, handed, showLogin }) (trees handed' sessions'))
     where
       common = RX.pick props :: Record Common
       trees handed' sessions' = (tree handed') <$> unSessions sessions'
@@ -97,14 +97,15 @@ forestCpt = here.component "forest" cpt where
                    , tasks } []
 
 type Plus =
-  ( handed    :: T.Box Handed
+  ( backend   :: T.Box (Maybe Backend)
+  , handed    :: T.Box Handed
   , showLogin :: T.Box Boolean )
 
 plus :: R2.Leaf Plus
 plus p = R.createElement plusCpt p []
 plusCpt :: R.Component Plus
 plusCpt = here.component "plus" cpt where
-  cpt { handed, showLogin } _ = do
+  cpt { backend, handed, showLogin } _ = do
     handed' <- T.useLive T.unequal handed
 
     pure $ H.div { className: "row" }
@@ -120,7 +121,9 @@ plusCpt = here.component "plus" cpt where
   -- [ H.i { className: "material-icons md-36"} [] ]
     where
       click _ = do
-        -- _ <- T.write Nothing backend
+        -- NOTE Reset backend in case G.C.N.Home.homeLayout set that to (Just b)
+        -- from current url
+        _ <- T.write Nothing backend
         T.write_ true showLogin
       title = "Add or remove connections to the server(s)."
       divClass = "fa fa-universal-access"

src/Gargantext/Components/Login/Form.purs

@@ -52,7 +52,6 @@ type Props s v =
 form :: forall s v. T.ReadWrite s Sessions => T.ReadWrite v Boolean
      => Record (Props s v) -> R.Element
 form props = R.createElement formCpt props []
-
 formCpt :: forall s v. T.ReadWrite s Sessions => T.ReadWrite v Boolean
         => R.Component (Props s v)
 formCpt = here.component "form" cpt where

src/Gargantext/Components/Nodes/Home.purs

@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Home where
 import Gargantext.Prelude
 
 import Data.Array as Array
+import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
 import Effect (Effect)
 import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
@@ -11,6 +12,7 @@ import Gargantext.Components.Lang (LandingLang(..))
 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)
@@ -51,7 +53,8 @@ langLandingData LL_EN = En.landingData
 ------------------------------------------------------------------------
 
 type HomeProps s l =
-  ( lang      :: LandingLang
+  ( backend :: T.Box (Maybe Backend)
+  , lang      :: LandingLang
   , sessions  :: s
   , showLogin :: l
   )
@@ -59,12 +62,12 @@ type HomeProps s l =
 homeLayout :: forall s l. T.Read s Sessions => T.ReadWrite l Boolean
            => R2.Leaf (HomeProps s l)
 homeLayout props = R.createElement homeLayoutCpt props []
-
 homeLayoutCpt :: forall s l. T.Read s Sessions => T.ReadWrite l Boolean
              => R.Component (HomeProps s l)
 homeLayoutCpt = here.component "homeLayout" cpt
   where
-    cpt { lang, sessions, showLogin } _ = do
+    cpt { backend, lang, sessions, showLogin } _ = do
+      backend' <- T.useLive T.unequal backend
       sessions' <- T.useLive T.unequal sessions
       let landingData = langLandingData lang
       pure $
@@ -72,7 +75,7 @@ homeLayoutCpt = here.component "homeLayout" cpt
         [ H.div { className: "home-title container1" }
           [ jumboTitle landingData ]
         , H.div { className: "home-research-form container1" } [] -- TODO
-        , joinButtonOrTutorial sessions' click
+        , joinButtonOrTutorial sessions' (click backend')
         , H.div { className: "home-public container1" }
           [ renderPublic { }
           , H.div { className:"col-12 d-flex justify-content-center" }
@@ -82,9 +85,16 @@ homeLayoutCpt = here.component "homeLayout" cpt
           , license
           ]
         ] where
-        click _
-          =  T.write true showLogin
-          *> here.log "[homeLayout] Clicked: Join"
+        click mBackend _ =
+          case mBackend of
+            Nothing -> do
+              mLoc <- Config.matchCurrentLocation
+              case mLoc of
+                Nothing -> pure unit
+                Just b -> do
+                  T.write_ (Just b) backend
+                  T.write_ true showLogin
+            Just b -> T.write_ true showLogin
 
 joinButtonOrTutorial :: forall e. Sessions -> (e -> Effect Unit) -> R.Element
 joinButtonOrTutorial sessions click =
@@ -94,6 +104,8 @@ joinButtonOrTutorial sessions click =
      
 joinButton :: forall e. (e -> Effect Unit) -> R.Element
 joinButton click =
+  -- TODO Add G.C.L.F.form -- which backend to use?
+  -- form { backend, sessions, visible }
   H.div { className: divClass
         , style: { paddingTop: "100px", paddingBottom: "100px" } }
   [ H.button { className: buttonClass, title, on: { click } } [ H.text "Join" ] ] where

src/Gargantext/Components/Router.purs

@@ -361,8 +361,8 @@ home = R.createElement homeCpt
 
 homeCpt :: R.Component Props
 homeCpt = here.component "home" cpt where
-  cpt props@{ boxes: boxes@{ sessions, showLogin } } _ = do
-    pure $ homeLayout { lang: LL_EN, sessions, showLogin }
+  cpt props@{ boxes: boxes@{ backend, sessions, showLogin } } _ = do
+    pure $ homeLayout { backend, lang: LL_EN, sessions, showLogin }
 
 lists :: R2.Component SessionNodeProps
 lists = R.createElement listsCpt

src/Gargantext/Config.purs

 module Gargantext.Config where
 
+import Data.Array as A
+import Data.Maybe (Maybe)
+import Data.Array.NonEmpty as AN
+import Data.NonEmpty (NonEmpty, (:|), head)
 import Data.String as S
+import Data.String.Utils as S
+import Data.Tuple.Nested ((/\))
 import Effect (Effect)
-import Data.NonEmpty (NonEmpty, (:|), head)
+
+import Gargantext.Prelude (bind, pure, ($))
+
 import Gargantext.Ends
 import Gargantext.Types (ApiVersion(..))
-import Gargantext.Utils (location)
-import Gargantext.Prelude (bind, pure, ($))
+import Gargantext.Utils (href)
 
 defaultBackends :: NonEmpty Array Backend
 defaultBackends =
  backend_local :| [ backend_prod, backend_partner, backend_demo, backend_dev ]
 
+prodUrl :: String
+prodUrl = "https://v4.gargantext.org"
 backend_prod :: Backend
-backend_prod    = backend V10 "/api/" "https://v4.gargantext.org"    "iscpif.cnrs"
+backend_prod    = backend V10 "/api/" prodUrl    "iscpif.cnrs"
 
+partnerUrl :: String
+partnerUrl = "https://imtv4.gargantext.org"
 backend_partner :: Backend
-backend_partner = backend V10 "/api/" "https://imtv4.gargantext.org" "institut-mines-telecom.imt"
+backend_partner = backend V10 "/api/" partnerUrl "institut-mines-telecom.imt"
 
+demoUrl :: String
+demoUrl = "https://demo.gargantext.org"
 backend_demo :: Backend
-backend_demo    = backend V10 "/api/" "https://demo.gargantext.org"  "demo.inshs.cnrs"
+backend_demo    = backend V10 "/api/" demoUrl    "demo.inshs.cnrs"
 
+devUrl :: String
+devUrl = "https://dev.gargantext.org"
 backend_dev :: Backend
-backend_dev     = backend V10 "/api/" "https://dev.gargantext.org"   "devel.inshs.cnrs"
+backend_dev     = backend V10 "/api/" devUrl     "devel.inshs.cnrs"
 
+localUrl :: String
+localUrl = "http://localhost:8008"
 backend_local :: Backend
-backend_local   = backend V10 "/api/" "http://localhost:8008"        "local.cnrs"
+backend_local   = backend V10 "/api/" localUrl   "local.cnrs"
+
+
+matchCurrentLocation :: Effect (Maybe Backend)
+matchCurrentLocation = do
+  href <- href
+  let starts = AN.filter (\(Backend { baseUrl }) -> S.startsWith baseUrl href) $ AN.fromNonEmpty defaultBackends
+  pure $ A.head starts
 
 
 -- | public Backend
@@ -36,9 +60,9 @@ publicBackend = backend_local
 
 publicBackend' :: Effect Backend
 publicBackend' = do
-  url <- location
+  href <- href
   pure $ Backend { name  : "Public Backend"
-                 , baseUrl : url
+                 , baseUrl : href
                  , prePath : "api/"
                  , version : V10
                  }

src/Gargantext/Utils.purs

 module Gargantext.Utils where
 
-import DOM.Simple.Window (window)
 import Data.Either (Either(..))
 import Data.Foldable (class Foldable, foldr)
 import Data.Lens (Lens', lens)
@@ -11,9 +10,10 @@ import Data.Sequence.Ordered as OSeq
 import Data.String as S
 import Data.Unfoldable (class Unfoldable)
 import Effect (Effect)
-import FFI.Simple ((..))
-import FFI.Simple.Functions (delay)
 import Prelude
+import Web.HTML (window)
+import Web.HTML.Window (location)
+import Web.HTML.Location as WHL
 
 -- | TODO (hard coded)
 csrfMiddlewareToken :: String
@@ -82,10 +82,6 @@ mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
 mapLeft f (Left  l) = Left (f l)
 mapLeft _ (Right r) = Right r
 
--- | Get current Window Location
-location :: Effect String
-location = delay unit $ \_ -> pure $ window .. "location"
-
 data On a b = On a b
 
 instance eqOn :: Eq a => Eq (On a b) where
@@ -101,4 +97,11 @@ sortWith :: forall a b f. Functor f =>
                           Unfoldable f =>
                           Ord b =>
                           (a -> b) -> f a -> f a
-sortWith f = map (\(On _ y) -> y) <<< OSeq.toUnfoldable <<< foldr (\x -> OSeq.insert (On (f x) x)) OSeq.empty
\ No newline at end of file
+sortWith f = map (\(On _ y) -> y) <<< OSeq.toUnfoldable <<< foldr (\x -> OSeq.insert (On (f x) x)) OSeq.empty
+
+
+href :: Effect String
+href = do
+  w <- window
+  loc <- location w
+  WHL.href loc