move to multiple sessions - still needs route construction fixing

src/Gargantext/Components/App.purs

@@ -73,11 +73,11 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
                 tree $ documentLayout { nodeId, listId, session, corpusId: Nothing }
               PGraphExplorer graphId ->
                 simpleLayout (fst sessions) $
-                  explorerLayout { graphId, mCurrentRoute, session, treeId: Nothing, frontends}
+                  explorerLayout { graphId, mCurrentRoute, session, sessions, treeId: Nothing, frontends}
 
 forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element
 forestLayout frontends sessions route showLogin child =
-  R.fragment [ searchBar sessions, row main, footer {} ]
+  R.fragment [ topBar sessions, row main, footer {} ]
   where
     row child' = H.div {className: "row"} [child']
     main =
@@ -88,8 +88,8 @@ forestLayout frontends sessions route showLogin child =
       ]
 
 -- Simple layout does not accommodate the tree
-simpleLayout :: Sessions -> R.Element -> R.Element
-simpleLayout sessions child = R.fragment [ searchBar sessions, child, footer {}]
+simpleLayout :: R.Element -> R.Element
+simpleLayout child = R.fragment [ topBar {}, child, footer {}]
 
 mainPage :: R.Element -> R.Element
 mainPage child =
@@ -97,20 +97,16 @@ mainPage child =
   [ H.div {id: "page-wrapper"}
     [ H.div {className: "container-fluid"} [ child ] ] ]
 
-searchBar :: Sessions -> R.Element
-searchBar sessions =
+topBar :: {} -> R.Element
+topBar _ =
   H.div { id: "dafixedtop", role: "navigation"
         , className: "navbar navbar-inverse navbar-fixed-top" }
   [ H.div { className: "container-fluid" }
     [ H.div { className: "navbar-inner" }
       [ logo
       , H.div { className: "collapse navbar-collapse" }
-        [ divDropdownLeft
-        , search ] ] ] ]
-  where
-    search = case unSessions sessions of
-      Just session -> SB.searchBar {session, databases: allDatabases}
-      Nothing -> R.fragment []
+        [ divDropdownLeft ] ] ] ]
+      -- SB.searchBar {session, databases: allDatabases}
 
 logo :: R.Element
 logo =

src/Gargantext/Components/Forest.purs

 module Gargantext.Components.Forest where
 
-import Prelude (const)
+import Prelude (const, otherwise, ($), (<>), (<$>))
+import Data.Array as A
 import Data.Maybe (Maybe(..))
+import Data.Sequence as Seq
 import Reactix as R
 import Reactix.DOM.HTML as H
 import Gargantext.Ends (Frontends)
@@ -23,24 +25,16 @@ forest props = R.createElement forestCpt props []
 forestCpt :: R.Component Props
 forestCpt = R.staticComponent "G.C.Forest.forest" cpt where
   cpt {sessions, route, frontends, showLogin} _ =
-    R.fragment [ plus showLogin, trees ]
+    R.fragment $ A.cons (plus showLogin) trees
     where
-      trees =
-        case unSessions sessions of
-          Nothing -> R.fragment []
-          Just s@(Session {treeId}) ->
-            R.fragment
-            [ treeView { root: treeId
-                       , frontends
-                       , mCurrentRoute: Just route
-                       , session: s }
-            ]
+      trees = tree <$> unSessions sessions
+      tree s@(Session {treeId}) =
+        treeView { root: treeId, frontends, mCurrentRoute: Just route, session: s }
 
 plus :: R2.Setter Boolean -> R.Element
-plus showLogin = H.button {on: {click}}
-                          [ H.i { className: "glyphicon glyphicon-log-in"}
-                                []
-                          ]
+plus showLogin =
+  H.button {on: {click}}
+  [ H.i { className: "glyphicon glyphicon-log-in"} [] ]
   where
     click _ = do
       showLogin (const true)

src/Gargantext/Components/GraphExplorer.purs

@@ -35,10 +35,10 @@ type LayoutProps =
   , mCurrentRoute :: AppRoute
   , treeId :: Maybe Int
   , session :: Session
+  , sessions :: Sessions
   , frontends :: Frontends 
   )
 
-
 type Props = ( graph :: Maybe Graph.Graph | LayoutProps )
 
 --------------------------------------------------------------
@@ -51,7 +51,7 @@ explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt
     cpt {graphId, mCurrentRoute, treeId, session, frontends} _ =
       useLoader graphId (getNodes session) handler
       where
-        handler loaded = explorer {graphId, mCurrentRoute, treeId, session, graph, frontends}
+        handler loaded = explorer {graphId, mCurrentRoute, treeId, session, sessions, graph, frontends}
           where graph = Just (convert loaded)
 
 --------------------------------------------------------------
@@ -61,7 +61,7 @@ explorer props = R.createElement explorerCpt props []
 explorerCpt :: R.Component Props
 explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
   where
-    cpt {session, graphId, mCurrentRoute, treeId, graph, frontends} _ = do
+    cpt {sessions, session, graphId, mCurrentRoute, treeId, graph, frontends} _ = do
       controls <- Controls.useGraphControls
       state <- useExplorerState
       showLogin <- snd <$> R.useState' true
@@ -88,9 +88,9 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
       where
         -- tree {treeId: Nothing} _ _ = RH.div { id: "tree" } []
         tree _ {showTree: false /\ _} _ = RH.div { id: "tree" } []
-        tree {mCurrentRoute: m, treeId: root} _ showLogin= 
+        tree {mCurrentRoute: route, treeId: root} _ showLogin= 
           RH.div {className: "col-md-2", style: {paddingTop: "60px"}}
-                 [forest {sessions: Sessions (Just session), route:m, frontends, showLogin}]
+                 [forest {sessions, route, frontends, showLogin}]
     outer = RH.div { className: "col-md-12" }
     inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } }
     row1  = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } }

src/Gargantext/Components/Login.purs

@@ -83,10 +83,7 @@ chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where
     [ renderSessions sessions, renderBackends backends backend ]
   
 renderSessions :: R2.Reductor Sessions Sessions.Action -> R.Element
-renderSessions sessions =
-  render (unSessions $ fst sessions) where
-  render Nothing = R.fragment []
-  render (Just s) = renderSession s
+renderSessions sessions = R.fragment (renderSession <$> unSessions (fst sessions))
 
 renderSession :: Session -> R.Element
 renderSession session = H.li {} [ H.text $ "Active session: " <> show session ]

src/Gargantext/Router.purs

@@ -3,30 +3,33 @@ module Gargantext.Router where
 import Prelude
 import Data.Foldable (oneOf)
 import Data.Int (floor)
-import Routing.Match (Match, lit, num)
+import Routing.Match (Match, lit, num, str)
 import Gargantext.Routes (AppRoute(..))
+import Gargantext.Types (SessionId(..))
 
 router :: Match AppRoute
 router = oneOf
   [ Login            <$   route "login"
-  , Folder           <$> (route "folder" *> int)
-  , CorpusDocument   <$> (route "corpus" *> int)
+  , Folder           <$> (route "folder"     *> sid) <*> int
+  , CorpusDocument   <$> (route "corpus"     *> sid) <*> int
                         <*> (lit "list" *> int)
                         <*> (lit "document" *> int)
-  , Corpus           <$> (route "corpus" *> int)
-     , Document       <$> (route "list"  *> int) 
+  , Corpus           <$> (route "corpus"     *> sid) <*> int
+     , Document       <$> (route "list"      *> sid) <*> int 
                         <*> (lit "document" *> int)
-     , Dashboard      <$> (route "dashboard" *> int)
-     , PGraphExplorer <$> (route "graph"    *> int)
-     , Texts          <$> (route "texts"    *> int)
-     , Lists          <$> (route "lists"    *> int)
-  , Annuaire          <$> (route "annuaire" *> int)
-    , UserPage        <$> (route "user"     *> int)
-    , ContactPage     <$> (route "contact"  *> int)
+     , Dashboard      <$> (route "dashboard" *> sid) <*> int
+     , PGraphExplorer <$> (route "graph"     *> sid) <*> int
+     , Texts          <$> (route "texts"     *> sid) <*> int
+     , Lists          <$> (route "lists"     *> sid) <*> int
+  , Annuaire          <$> (route "annuaire"  *> sid) <*> int
+    , UserPage        <$> (route "user"      *> sid) <*> int
+    , ContactPage     <$> (route "contact"   *> sid) <*> int
   , Home              <$   lit ""
   ]
  where
     route str      = lit "" *> lit str
     int :: Match Int
     int = floor <$> num
+    sid :: Match SessionId
+    sid = SessionId <$> str
 

src/Gargantext/Routes.purs

@@ -2,22 +2,22 @@ module Gargantext.Routes where
 
 import Prelude
 import Data.Maybe (Maybe)
-import Gargantext.Types (ChartOpts, CorpusMetricOpts, Id, Limit, ListId, NgramsGetOpts, NodeType, Offset, OrderBy, SearchOpts, TabType, TermList)
+import Gargantext.Types (ChartOpts, CorpusMetricOpts, Id, Limit, ListId, NgramsGetOpts, NodeType, Offset, OrderBy, SearchOpts, SessionId, TabType, TermList)
 
 data AppRoute
   = Home
   | Login
-  | Folder Int
-  | Corpus Int
-    | Document       Int Int
-    | CorpusDocument Int Int Int
-    | PGraphExplorer Int
-    | Dashboard      Int
-    | Texts          Int
-    | Lists          Int
-  | Annuaire Int
-    | UserPage       Int
-    | ContactPage    Int
+  | Folder SessionId Int
+  | Corpus SessionId  Int
+    | Document       SessionId Int Int
+    | CorpusDocument SessionId Int Int Int
+    | PGraphExplorer SessionId Int
+    | Dashboard      SessionId Int
+    | Texts          SessionId Int
+    | Lists          SessionId Int
+  | Annuaire SessionId Int
+    | UserPage       SessionId Int
+    | ContactPage    SessionId Int
 
 data SessionRoute
   = Tab TabType (Maybe Id)
@@ -34,29 +34,29 @@ data SessionRoute
 instance showAppRoute :: Show AppRoute where
   show Home                     = "Home"
   show Login                    = "Login"
-  show (Folder i)         = "Folder"   <> show i
-  show (Corpus i)         = "Corpus"   <> show i
-  show (Document _ i)     = "Document" <> show i
-  show (CorpusDocument _ _ i) = "Document" <> show i
-  show (PGraphExplorer i) = "graphExplorer" <> show i
-  show (Dashboard      i) = "Dashboard" <> show i
-  show (Texts i)          = "texts" <> show i
-  show (Lists i)          = "lists" <> show i
-  show (Annuaire i)       = "Annuaire" <> show i
-  show (UserPage i)       = "User"     <> show i
-  show (ContactPage i)    = "Contact"  <> show i
+  show (Folder s i)             = "Folder"   <> show i <> " (" <> show s <> ")"
+  show (Corpus s i)             = "Corpus"   <> show i <> " (" <> show s <> ")"
+  show (Document _ s i)         = "Document" <> show i <> " (" <> show s <> ")"
+  show (CorpusDocument s _ _ i) = "CorpusDocument" <> show i <> " (" <> show s <> ")"
+  show (PGraphExplorer s i)     = "graphExplorer" <> show i <> " (" <> show s <> ")"
+  show (Dashboard      s i)     = "Dashboard" <> show i <> " (" <> show s <> ")"
+  show (Texts s i)              = "texts" <> show i <> " (" <> show s <> ")"
+  show (Lists s i)              = "lists" <> show i <> " (" <> show s <> ")"
+  show (Annuaire s i)           = "Annuaire" <> show i <> " (" <> show s <> ")"
+  show (UserPage s i)           = "User"     <> show i <> " (" <> show s <> ")"
+  show (ContactPage s i)        = "Contact"  <> show i <> " (" <> show s <> ")"
 
 appPath :: AppRoute -> String
 appPath Home       = ""
 appPath Login      = "login"
-appPath (Folder i) = "folder/" <> show i
-appPath (CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i
-appPath (Corpus i)         = "corpus/" <> show i
-appPath (Document l i)     = "list/" <> show l <> "/document/" <> show i
-appPath (Dashboard i)      = "dashboard/" <> show i
-appPath (PGraphExplorer i) = "graph/" <> show i
-appPath (Texts i)    = "texts/" <> show i
-appPath (Lists i)    = "lists/" <> show i
-appPath (Annuaire i) = "annuaire/" <> show i
-appPath (UserPage i) = "user/" <> show i
-appPath (ContactPage i) = "contact/" <> show i
+appPath (Folder s i) = "folder/" <> show s <> "/" <> show i
+appPath (CorpusDocument s c l i) = "corpus/" <> show s <> "/" <> show c <> "/list/" <> show l <> "/document/" <> show i
+appPath (Corpus s i)         = "corpus/" <> show s <> "/" <> show i
+appPath (Document s l i)     = "list/" <> show s <> "/" <> show l <> "/document/" <> show i
+appPath (Dashboard s i)      = "dashboard/" <> show s <> "/" <> show i
+appPath (PGraphExplorer s i) = "graph/" <> show s <> "/" <> show i
+appPath (Texts s i)    = "texts/" <> show s <> "/" <> show i
+appPath (Lists s i)    = "lists/" <> show s <> "/" <> show i
+appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i
+appPath (UserPage s i) = "user/" <> show s <> "/" <> show i
+appPath (ContactPage s i) = "contact/" <> show s <> "/" <> show i

src/Gargantext/Sessions.purs

 -- | A module for authenticating to create sessions and handling them
 module Gargantext.Sessions where
 
-import Prelude (class Eq, class Show, const, otherwise, pure, show, unit, ($), (*>), (<$>), (<>), (==), (>>=))
+import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<))
+import Data.Array as A
+import DOM.Simple.Console (log2)
 import Data.Either (Either(..))
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Eq (genericEq)
 import Data.Maybe (Maybe(..))
-import DOM.Simple.Console (log, log2)
+import Data.Sequence as Seq
+import Data.Sequence (Seq)
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Reactix as R
@@ -18,9 +21,10 @@ import Gargantext.Components.Login.Types
 import Gargantext.Config.REST (post)
 import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath)
 import Gargantext.Routes (SessionRoute)
-import Gargantext.Types (NodePath, nodePath)
+import Gargantext.Types (NodePath, SessionId(..), nodePath)
 import Gargantext.Utils.Reactix as R2
 
+
 -- | A Session represents an authenticated session for a user at a
 -- | backend. It contains a token and root tree id.
 newtype Session = Session
@@ -46,13 +50,21 @@ instance toUrlSessionNodePath :: ToUrl Session NodePath where
 sessionUrl :: Session -> String -> String
 sessionUrl (Session {backend}) = backendUrl backend
 
+sessionId :: Session -> SessionId
+sessionId = SessionId <<< show
+
 instance toUrlSessionString :: ToUrl Session String where
   toUrl = sessionUrl
 
-newtype Sessions = Sessions (Maybe Session)
+newtype Sessions = Sessions (Seq Session)
+
+derive instance genericSessions :: Generic Sessions _
 
-unSessions :: Sessions -> Maybe Session
-unSessions (Sessions s) = s
+instance eqSessions :: Eq Sessions where
+  eq = genericEq
+
+unSessions :: Sessions -> Array Session
+unSessions (Sessions s) = A.fromFoldable s
 
 useSessions :: R.Hooks (R2.Reductor Sessions Action)
 useSessions = R2.useReductor actAndSave (const loadSessions) unit
@@ -60,28 +72,55 @@ useSessions = R2.useReductor actAndSave (const loadSessions) unit
     actAndSave :: R2.Actor Sessions Action
     actAndSave s a = act s a >>= saveSessions
 
+lookup :: SessionId -> Sessions -> Maybe Session
+lookup sid (Sessions ss) = Seq.head (Seq.filter f ss) where
+  f s = sid == sessionId s
+
+cons :: Session -> Sessions -> Sessions
+cons s (Sessions ss) = Sessions (Seq.cons s ss)
+
+tryCons :: Session -> Sessions -> Either Unit Sessions
+tryCons s ss = try (lookup sid ss) where
+  sid = sessionId s
+  try Nothing = Right (cons s ss)
+  try _ = Left unit
+
+delete :: SessionId -> Sessions -> Sessions
+delete sid (Sessions ss) = Sessions (Seq.filter f ss) where
+  f s = sid /= sessionId s
+
+tryDelete :: SessionId -> Sessions -> Either Unit Sessions
+tryDelete sid old@(Sessions ss) = ret where
+  new = delete sid old
+  ret
+    | new == old = Left unit
+    | otherwise =  Right new
+
 data Action
   = Login Session
   | Logout Session
 
 act :: Sessions -> Action -> Effect Sessions
-act _ (Login session) = pure $ Sessions (Just session)
-act (Sessions s) (Logout session)
-  | Just session == s = 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)
+act ss (Login s) =
+  case tryCons s ss of
+    Right new -> pure new
+    _ -> pure ss <* log2 "Cannot overwrite existing session: " (sessionId s)
+act old@(Sessions ss) (Logout s) =
+  case tryDelete (sessionId s) old of
+    Right new -> pure $ new
+    _ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
+       
 
 -- Key we will store the data under
 localStorageKey :: String
 localStorageKey = "garg-sessions"
 
 empty :: Sessions
-empty = Sessions Nothing
+empty = Sessions Seq.empty
 
 -- True if there are no sessions stored
 null :: Sessions -> Boolean
-null (Sessions Nothing) = true
-null _ = false
+null (Sessions seq) = Seq.null seq
 
 -- | Will attempt to load saved sessions from localstorage. should log if decoding fails
 loadSessions :: Effect Sessions

src/Gargantext/Types.purs

@@ -7,8 +7,19 @@ import Data.Either (Either(..))
 import Prim.Row (class Union)
 import URI.Query (Query)
 import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
 import Data.Generic.Rep.Show (genericShow)
 
+newtype SessionId = SessionId String
+
+derive instance genericSessionId :: Generic SessionId _
+
+instance eqSessionId :: Eq SessionId where
+  eq = genericEq
+
+instance showSessionId :: Show SessionId where
+  show (SessionId s) = s
+
 data TermSize = MonoTerm | MultiTerm
 
 data Term = Term String TermList