fix: groups and tabs should be properly restored now

Unsupported case: opening a session on top of an existing session. I
have not tested it, not idea how it will do.

src/Background.purs

@@ -10,13 +10,13 @@ import Browser.Tabs.OnDetached as OnDetached
 import Browser.Tabs.OnMoved as OnMoved
 import Browser.Tabs.OnRemoved as OnRemoved
 import Browser.Tabs.OnUpdated as OnUpdated
-import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
+import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit, unsafeLog)
 import Browser.Windows (Window)
 import Browser.Windows.OnCreated as WinOnCreated
 import Browser.Windows.OnRemoved as WinOnRemoved
 import Control.Alt ((<#>))
 import Control.Alternative ((*>))
-import Control.Bind (map, (=<<), (>>=))
+import Control.Bind ((=<<), (>>=))
 import Control.Category ((>>>))
 import Data.Array as A
 import Data.CommutativeRing ((+))
@@ -25,13 +25,12 @@ import Data.Lens (_Just, set, view)
 import Data.Lens.At (at)
 import Data.List (List, foldMap)
 import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Maybe (Maybe(..), maybe)
 import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
 import Data.Set as Set
 import Data.Show (show)
-import Data.Traversable (sequence, traverse_)
-import Data.Tuple (Tuple(..))
+import Data.Traversable (traverse)
 import Data.Unit (unit)
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
@@ -58,37 +57,8 @@ main = do
   log "[bg] starting"
   launchAff_ do
      allTabs <- BT.browserQuery {}
-     groups <- M.fromFoldable <$> setWindowsGroups allTabs
-     setTabsGroups groups allTabs
-     liftEffect $ log "[bg] done initializing groups"
      liftEffect $ initializeBackground =<< (Ref.new $ GS.initialTabsToGlobalState allTabs)
 
-  where
-        -- | For each window found, set a default group if it doesn't exist
-        setWindowsGroups :: Array Tab -> Aff (Array (Tuple WindowId (Array GroupData)))
-        setWindowsGroups tabs = sequence $ tabs # 
-           map (unwrap >>> _.windowId)
-           >>> Set.fromFoldable
-           >>> A.fromFoldable
-           -- Retrieve the groups for each existing window, and if they don't exist, create a group
-           >>> map \winId -> retrieveGroups winId >>= 
-             case _ of 
-                  [] -> updateGroupsMapping winId (createGroup (GroupId 0) "main") 
-                      *> retrieveGroups winId >>= \groups' -> pure $ Tuple winId groups'
-                  groups' -> pure $ Tuple winId groups'
-
-        -- | For each tab, set a default tab if it doesn't exist
-        setTabsGroups :: M.Map WindowId (Array GroupData) -> Array Tab ->  Aff Unit
-        setTabsGroups winToGroups tabs = 
-          let 
-              defaultGroupIdPerWin = winToGroups # map (A.head >>> maybe (GroupId 0) (unwrap >>> _.groupId))
-              defaultGroup winId = fromMaybe (GroupId 0) $ M.lookup winId defaultGroupIdPerWin
-          in
-              tabs # traverse_ \(Tab t) -> (getTabValue t.id "groupId" :: Aff (Maybe GroupId)) >>= 
-                case _ of 
-                     Nothing -> setTabValue t.id "groupId" $ defaultGroup t.windowId
-                     _ -> pure unit
-
 initializeBackground :: Ref.Ref GS.GlobalState -> Effect Unit
 initializeBackground ref = do
   (mkListenerOne $ onConnect ref) >>= Runtime.onConnectAddListener
@@ -116,7 +86,37 @@ onTabCreated :: StateRef -> Tab -> Effect Unit
 onTabCreated stateRef tab = do
   log $ "bg: created tab " <> (BT.showTabId tab) 
   state <- Ref.modify (GS.createTab tab) stateRef
-  GS.sendToTabPort tab state $ BgTabCreated tab
+
+  let Tab(t) = tab
+
+  -- Attempt to detect session restore.
+  -- If the tab we're opening already has a `groupId` value, it is either a
+  -- restored tab from the current session, or a restored tab from a full
+  -- session restore. If we found groups associated with the tab's window, we
+  -- ask the sidebar to initiliaze them.
+  -- 
+  -- This solution ignores one use case (for which it will probably be buggy):
+  -- opening a session on top of an already existing session. If the user
+  -- starts creating groups, opening tab, and then restore a session, then it
+  -- will probably break.
+
+  -- An other issue with this solution is that the action is triggered in a
+  -- fiber, delaying its action, and in particular allowing the tab creation
+  -- event to be sent later than e.g. the tab activation event to the sidebar.
+  -- A possible fix could be send the TabCreated event just as before, and then
+  -- launch a fiber to ask the sidebar to switch the tab's group (and
+  -- initialize the groups) in case it's needed.
+  launchAff_ $
+     (getTabValue t.id "groupId" :: Aff (Maybe GroupId)) >>= 
+       case _ of
+            Nothing -> liftEffect $ GS.sendToTabPort tab state $ BgTabCreated tab Nothing
+            Just gid -> do 
+               retrieveGroups t.windowId >>= 
+                 case _ of 
+                      [] -> pure unit
+                      groups -> liftEffect $ GS.sendToTabPort tab state $ BgInitializeGroups groups
+               liftEffect $ GS.sendToTabPort tab state $ BgTabCreated tab (Just gid)
+               
 
 onTabUpdated :: StateRef -> TabId -> OnUpdated.ChangeInfo -> Tab -> Effect Unit
 onTabUpdated stateRef tid cinfo tab = do
@@ -158,6 +158,7 @@ onTabAttached stateRef tid info = do
 
 onConnect :: StateRef -> Runtime.Port -> Effect Unit
 onConnect stateRef port = do
+  log "[bg] connection received"
   -- Create a temporary listener ref that will only be held until the sidebar has sent its current window
   listenerRef <- Ref.new Nothing
   initialListener <-
@@ -172,7 +173,7 @@ onConnect stateRef port = do
 
   windowListener :: (WindowId -> Effect Unit) -> SidebarEvent -> Effect Unit
   windowListener callback msg = case msg of
-    SbHasWindowId winId -> log ("bg: created winId " <> show winId) *> callback winId
+    SbHasWindowId winId -> log ("[bg] created winId " <> show winId) *> callback winId
     _ -> pure unit
 
 -- | Initialize the data and the listeners of a new window, and send the current window state.
@@ -201,22 +202,39 @@ onNewWindowId port stateRef listenerRef winId = do
           <#> (flip M.lookup w.tabs)
           # A.catMaybes
 
-        tabsWithGid = 
-          tabs <#> \tab@(Tab t)->
-            getTabValue t.id "groupId" <#> \gid -> TabWithGroup tab gid
-
     in
       launchAff_ do
-         tabsWithGroup <- sequence tabsWithGid
-         groups <- retrieveGroups winId
+         groups <- initialWindowGroups
+         tabsWithGroup <- initialTabsGroups tabs groups
          liftEffect $ Runtime.postMessageJson port $ BgInitialTabList groups tabsWithGroup
     
-
   --  Add the new onMessage listener
   sidebarListener <- Runtime.onMessageJsonAddListener port $ manageSidebar stateRef winId port
   onDisconnectListener <- mkListenerUnit $ onDisconnect stateRef winId sidebarListener
   Runtime.portOnDisconnect port onDisconnectListener
 
+  where
+        -- | Set a default group if none exist.
+        initialWindowGroups :: Aff (Array GroupData)
+        initialWindowGroups = 
+           retrieveGroups winId >>= 
+             case _ of 
+                  [] -> updateGroupsMapping winId (createGroup (GroupId 0) "main") 
+                      *> retrieveGroups winId >>= \groups' -> pure groups'
+                  groups' -> pure groups'
+
+        -- | For each tab, set a default tab if it doesn't exist
+        initialTabsGroups :: Array Tab -> Array GroupData -> Aff (Array TabWithGroup)
+        initialTabsGroups tabs groups = 
+          let 
+              defaultGroup = groups # (A.head >>> maybe (GroupId 0) (unwrap >>> _.groupId))
+          in
+              tabs # traverse \tab@(Tab t) -> (getTabValue t.id "groupId" :: Aff (Maybe GroupId)) >>= 
+                case _ of 
+                     Nothing -> setTabValue t.id "groupId" defaultGroup *> pure (TabWithGroup tab defaultGroup)
+                     Just gid -> pure $ TabWithGroup tab gid
+
+
 
 manageSidebar :: StateRef -> WindowId -> Runtime.Port -> SidebarEvent -> Effect Unit
 manageSidebar ref winId port = case _ of
@@ -242,7 +260,9 @@ manageSidebar ref winId port = case _ of
          tabIdsToHide = A.fromFoldable $ Set.difference allTabIds (Set.fromFoldable tabIds)
 
      BT.browserHideTabs tabIdsToHide
+     unsafeLog tabIdsToHide
      BT.browserShowTabs tabIds
+     unsafeLog tabIds
 
   SbDeletedGroup gid tabIds -> launchAff_ do
      BT.browserRemove tabIds

src/Browser/Runtime.js

@@ -2,7 +2,7 @@
 
 
 exports.connect = function () {
-    return browser.runtime.connect({name: name});
+    return browser.runtime.connect();
 }
 
 exports.postMessage = function (port) {

src/Model/BackgroundEvent.purs

@@ -13,7 +13,8 @@ import PureTabs.Model.TabWithGroup (TabWithGroup)
 
 data BackgroundEvent
   = BgInitialTabList (Array GroupData) (Array TabWithGroup)
-  | BgTabCreated Tab
+  | BgInitializeGroups (Array GroupData)
+  | BgTabCreated Tab (Maybe GroupId)
   | BgTabDeleted TabId
   | BgTabUpdated TabId ChangeInfo Tab
   | BgTabMoved TabId Int Int

src/Model/TabWithGroup.purs

@@ -3,14 +3,13 @@ module PureTabs.Model.TabWithGroup where
 import Browser.Tabs (Tab)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
-import Data.Maybe (Maybe)
 import Data.Show (class Show)
 import PureTabs.Model.Group (GroupId)
 import Foreign.Class (class Decode, class Encode)
 import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
 
 data TabWithGroup
-  = TabWithGroup Tab (Maybe GroupId)
+  = TabWithGroup Tab GroupId
 
 derive instance genTabWithGroup :: Generic TabWithGroup _
 

src/Sidebar/Components/Bar.purs

@@ -8,12 +8,13 @@ import Data.Array as A
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NonEmptyArray
 import Data.Eq ((/=))
+import Data.Foldable (for_)
 import Data.Function (($))
 import Data.Map as M
 import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', maybe)
 import Data.MediaType.Common (textPlain)
 import Data.Number (fromString)
-import Data.Set (Set, member, toUnfoldable) as S
+import Data.Set (Set, toUnfoldable) as S
 import Data.Set.NonEmpty (cons, max) as NES
 import Data.Symbol (SProxy(..))
 import Data.Traversable (sequence, traverse)
@@ -21,7 +22,7 @@ import Data.Tuple (Tuple(..))
 import Data.Tuple as T
 import Data.Unit (Unit, unit)
 import Effect.Aff.Class (class MonadAff)
-import Effect.Class (class MonadEffect)
+import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Console (log)
 import Halogen as H
 import Halogen.HTML as HH
@@ -70,6 +71,8 @@ data Action
 data Query a
   = TabsQuery (Tabs.Query a)
   | InitialTabsWithGroup (Array GroupData) (Array TabWithGroup) a
+  | InitializeGroups (Array GroupData) a
+  | TabCreated Tab (Maybe GroupId) a
   | GroupDeleted GroupId (Maybe TabId) a
 
 initialGroup :: M.Map GroupId Group
@@ -278,6 +281,20 @@ handleQuery :: forall a m. MonadEffect m => Query a -> H.HalogenM State Action S
 handleQuery = case _ of 
    TabsQuery q -> handleTabsQuery q
 
+   InitializeGroups groups a -> do
+      let newGroups = M.fromFoldable $ 
+            A.mapWithIndex (\idx (GroupData g) -> Tuple g.groupId { name: g.name, pos: idx}) groups
+
+      -- TODO: re-assign existing tabs to the new groups.
+      H.modify_ \s ->
+        if newGroups == s.groups then
+          s
+        else
+          s { groups = newGroups }
+
+      pure (Just a)
+
+
    InitialTabsWithGroup groups tabs a -> do
        -- Assign the tabs to their group and save the tabs positions
        s <- H.modify \s ->
@@ -293,9 +310,7 @@ handleQuery = case _ of
 
              existingGroups = M.keys newGroups
 
-             tabIdGroup = tabs <#> 
-                \(TabWithGroup (Tab t) gid) -> 
-                    Tuple t.id $ maybe s.currentGroup (\gid' -> if S.member gid' existingGroups then gid' else s.currentGroup) gid
+             tabIdGroup = tabs <#> \(TabWithGroup (Tab t) gid) -> Tuple t.id gid
           in
              s { groups = newGroups, tabsToGroup = M.fromFoldable tabIdGroup, groupTabsPositions = tabIdGroup }
 
@@ -328,41 +343,55 @@ handleQuery = case _ of
               in 
                   void $ tellChild gid $ Tabs.InitialTabList $ A.fromFoldable $ T.fst <$> groupedTabs
 
-   GroupDeleted gid currentTid a -> do 
-      H.modify_ \s -> 
-        let 
-            currentGroup = fromMaybe s.currentGroup $ currentTid >>= (flip M.lookup s.tabsToGroup)
-         in
-            s { groups = M.delete gid s.groups, currentGroup = currentGroup }
-      pure $ Just a
-
-
-handleTabsQuery :: forall act a m. Tabs.Query a -> H.HalogenM State act Slots SidebarEvent m (Maybe a)
-handleTabsQuery = case _ of
-
-    Tabs.InitialTabList tabs a -> pure $ Just a
-
-    Tabs.TabCreated (Tab tab) a -> do 
+   TabCreated (Tab tab) groupId a -> do 
+       liftEffect $ log $ "[sb] created tab " <> (show tab.id)
        s <- H.get
 
-       let newGroupTabsPositions = 
+       let tabGroupId = fromMaybe s.currentGroup groupId
+
+           newGroupTabsPositions = 
              fromMaybe s.groupTabsPositions 
-             $ A.insertAt tab.index (Tuple tab.id s.currentGroup) s.groupTabsPositions
+             $ A.insertAt tab.index (Tuple tab.id tabGroupId) s.groupTabsPositions
 
-           inGroupPosition = getPositionTabInGroup tab.index s.currentGroup newGroupTabsPositions 
+           inGroupPosition = getPositionTabInGroup tab.index tabGroupId newGroupTabsPositions 
 
            newTab = Tab $ tab { index = inGroupPosition }
 
        newS <- H.modify \state -> 
          state 
-         { tabsToGroup = M.insert tab.id s.currentGroup s.tabsToGroup 
+         { tabsToGroup = M.insert tab.id tabGroupId s.tabsToGroup 
          , groupTabsPositions = newGroupTabsPositions
          }
 
-       void $ tellChild newS.currentGroup $ Tabs.TabCreated newTab
-       H.raise $ SbChangeTabGroup tab.id (Just newS.currentGroup)
+       void $ tellChild tabGroupId $ Tabs.TabCreated newTab
+       H.raise $ SbChangeTabGroup tab.id (Just tabGroupId)
+
+       -- XXX: Temporary fix because Background.onTabCreated launches an async
+       -- computation to create a tab instead of doing it synchronously, which
+       -- makes the tab activation trigger *before* the tab creation.
+       if tab.active then 
+         void $ handleTabsQuery $ Tabs.TabActivated Nothing tab.id Nothing 
+       else 
+         pure unit
        pure (Just a)
 
+   GroupDeleted gid currentTid a -> do 
+      H.modify_ \s -> 
+        let 
+            currentGroup = fromMaybe s.currentGroup $ currentTid >>= (flip M.lookup s.tabsToGroup)
+         in
+            s { groups = M.delete gid s.groups, currentGroup = currentGroup }
+      pure $ Just a
+
+
+handleTabsQuery :: forall act a m. MonadEffect m => Tabs.Query a -> H.HalogenM State act Slots SidebarEvent m (Maybe a)
+handleTabsQuery = case _ of
+
+    Tabs.InitialTabList tabs a -> pure $ Just a
+
+    -- TODO: log an error, this shouldn't happen
+    Tabs.TabCreated tab a -> pure $ Just a
+
     Tabs.TabDeleted tid reply -> do 
        doOnTabGroup tid \gid -> do 
          H.modify_ (\s -> s 
@@ -378,12 +407,14 @@ handleTabsQuery = case _ of
        pure (Just (reply Nothing))
 
     Tabs.TabActivated prevTid' tid a -> do 
-       case prevTid' of
-            mPrevTid @ (Just prevTid) -> doOnTabGroup prevTid \gid -> 
-                void $ tellChild gid $ Tabs.TabActivated mPrevTid tid
-            Nothing -> pure unit
+       liftEffect $ log $ "[sb] activated tab " <> (show tid) <> " from " <> (show prevTid')
+       for_ prevTid' \prevTid ->
+         doOnTabGroup prevTid \gid -> 
+           void $ tellChild gid $ Tabs.TabActivated prevTid' tid
+
        doOnTabGroup tid \gid -> do 
          { tabsToGroup } <- H.modify (_ { currentGroup = gid})
+         liftEffect $ log $ "[sb] group of " <> (show tid) <> " is " <> (show gid)
          H.raise $ SbSelectedGroup $ getTabIdsOfGroup gid tabsToGroup
          void $ tellChild gid $ Tabs.TabActivated prevTid' tid
        pure (Just a)

src/Sidebar/Sidebar.purs

@@ -90,8 +90,12 @@ onBackgroundMsgConsumer query =
           void $ query $ H.tell $ \q -> Bar.InitialTabsWithGroup groups tabs q 
           pure Nothing
 
-        BgTabCreated tab -> do
-          void $ query $ H.tell $ \q -> Bar.TabsQuery (Tabs.TabCreated tab q)
+        BgInitializeGroups groups -> do
+          void $ query $ H.tell $ \q -> Bar.InitializeGroups groups q 
+          pure Nothing
+
+        BgTabCreated tab groupId -> do
+          void $ query $ H.tell $ \q -> Bar.TabCreated tab groupId q
           pure Nothing
 
         BgTabDeleted tabId -> do