feat: initial version of saving/restoring tabs in their previous group

src/Background.purs

@@ -1,7 +1,7 @@
 module PureTabs.Background where
 
 import Browser.Runtime as Runtime
-import Browser.Tabs (Tab, TabId(..), WindowId(..))
+import Browser.Tabs (Tab(..), TabId, WindowId)
 import Browser.Tabs as BT
 import Browser.Tabs.OnActivated as OnActivated
 import Browser.Tabs.OnAttached as OnAttached
@@ -30,6 +30,7 @@ import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
 import Data.Set as Set
 import Data.Show (show)
+import Data.Traversable (sequence)
 import Data.Unit (unit)
 import Effect (Effect)
 import Effect.Aff (launchAff_)
@@ -37,7 +38,8 @@ import Effect.Class (liftEffect)
 import Effect.Console (log)
 import Effect.Ref as Ref
 import Prelude (Unit, bind, ($), discard, (<<<), (<$>))
-import PureTabs.Model.Events (BackgroundEvent(..), SidebarEvent(..))
+import PureTabs.Browser.Sessions (getTabValue, removeTabValue, setTabValue)
+import PureTabs.Model.Events (BackgroundEvent(..), SidebarEvent(..), TabWithGroup(..))
 import PureTabs.Model.GlobalState as GS
 
 type Ports
@@ -159,12 +161,20 @@ onNewWindowId port stateRef listenerRef winId = do
   -- Send initial tabs
   latestState <- Ref.read stateRef
   M.lookup winId latestState.windows # foldMap \w ->
-      Runtime.postMessageJson port
-      $ BgInitialTabList
-      $ A.fromFoldable
-      $ w.positions
-      <#> (flip M.lookup w.tabs)
-      # A.catMaybes
+    let 
+        tabs = A.fromFoldable
+          $ w.positions
+          <#> (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
+         liftEffect $ Runtime.postMessageJson port $ BgInitialTabList tabsWithGroup
     
 
   --  Add the new onMessage listener
@@ -204,6 +214,8 @@ manageSidebar ref winId port = case _ of
      let activeTabId = activeTab # A.head >>> (<$>) (unwrap >>> _.id)
      liftEffect $ Runtime.postMessageJson port $ BgGroupDeleted gid activeTabId
 
+  SbChangeTabGroup tid Nothing -> launchAff_ $ removeTabValue tid "groupId"
+  SbChangeTabGroup tid (Just gid) -> launchAff_ $ setTabValue tid "groupId" gid
 
   SbDetacheTab -> pure unit
   SbHasWindowId winId' -> pure unit

src/Browser/Sessions.js

@@ -0,0 +1,17 @@
+"use strict";
+
+
+exports["setTabValueImpl"] = function(tabId, key, value) {
+  return browser.sessions.setTabValue(tabId, key, value);
+};
+
+exports["removeTabValueImpl"] = function(tabId, key) {
+  return browser.sessions.removeTabValue(tabId, key);
+};
+
+exports["getTabValueImpl"] = function(Just, Nothing, tabId, key) {
+    return browser.sessions.getTabValue(tabId, key).then(val => {
+      if (val === undefined) return Nothing;
+      else return Just(val);
+    });
+};

src/Browser/Sessions.purs

@@ -0,0 +1,39 @@
+module PureTabs.Browser.Sessions where
+
+import Prelude
+
+import Browser.Tabs (TabId(..))
+import Control.Promise (Promise, toAffE)
+import Data.Maybe (Maybe(..))
+import Effect.Aff (Aff)
+import Effect.Uncurried (EffectFn2, EffectFn3, EffectFn4, runEffectFn2, runEffectFn3, runEffectFn4)
+
+foreign import setTabValueImpl 
+  :: forall r. EffectFn3 Number String r (Promise Unit)
+
+setTabValue 
+  :: forall r
+   . TabId
+  -> String
+  -> r
+  -> Aff Unit
+setTabValue (TabId tid) key value = toAffE $ runEffectFn3 setTabValueImpl tid key value
+
+foreign import removeTabValueImpl
+  :: EffectFn2 Number String (Promise Unit)
+
+removeTabValue
+  :: TabId
+  -> String
+  -> Aff Unit
+removeTabValue (TabId tid) key = toAffE $ runEffectFn2 removeTabValueImpl tid key
+
+foreign import getTabValueImpl
+  :: forall r. EffectFn4 (r -> Maybe r) (Maybe r) Number String (Promise (Maybe r))
+
+getTabValue
+  :: forall r
+   . TabId
+  -> String
+  -> Aff (Maybe r)
+getTabValue (TabId tid) key = toAffE $ runEffectFn4 getTabValueImpl Just Nothing tid key

src/Model/Events.purs

@@ -1,6 +1,7 @@
 module PureTabs.Model.Events (
   BackgroundEvent(..)
   , SidebarEvent(..)
+  , TabWithGroup(..)
   ) where
 
 import Browser.Tabs (Tab, TabId, WindowId)
@@ -10,10 +11,26 @@ 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)
+
+derive instance genTabWithGroup :: Generic TabWithGroup _
+
+instance showTabWithGroup :: Show TabWithGroup where 
+  show = genericShow
+
+instance encodeTabWithGroup :: Encode TabWithGroup where
+  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
+
+instance decodeTabWithGroup :: Decode TabWithGroup where
+  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
+
 data BackgroundEvent
-  = BgInitialTabList (Array Tab)
+  = BgInitialTabList (Array TabWithGroup)
   | BgTabCreated Tab
   | BgTabDeleted TabId
   | BgTabUpdated TabId ChangeInfo Tab
@@ -37,6 +54,7 @@ data SidebarEvent
   | SbHasWindowId WindowId
   | SbSelectedGroup (Array TabId)
   | SbDeletedGroup GroupId (Array TabId)
+  | SbChangeTabGroup TabId (Maybe GroupId)
 
 derive instance genSidebarEvent :: Generic SidebarEvent _
 

src/Sidebar/Components/Bar.purs

@@ -5,15 +5,18 @@ import Control.Alternative (pure)
 import Control.Bind (bind, discard, map, void, (<#>), (>>=))
 import Data.Array ((:))
 import Data.Array as A
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Array.NonEmpty as NonEmptyArray
 import Data.Eq ((/=))
 import Data.Function (($))
 import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isNothing, maybe)
 import Data.MediaType.Common (textPlain)
 import Data.Number (fromString)
-import Data.Set (toUnfoldable, Set) as S
+import Data.Set (toUnfoldable, Set, fromFoldable, difference) as S
 import Data.Set.NonEmpty (cons, max) as NES
 import Data.Symbol (SProxy(..))
+import Data.Traversable (sequence, traverse)
 import Data.Tuple (Tuple(..))
 import Data.Tuple as T
 import Data.Unit (Unit, unit)
@@ -25,7 +28,7 @@ import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Prelude (flip, show, (<$>), (#), (&&), (+), (-), (<<<), (<>), (==), (>), (>>>))
-import PureTabs.Model.Events (SidebarEvent(..))
+import PureTabs.Model.Events (SidebarEvent(..), TabWithGroup(..))
 import PureTabs.Model.Group (GroupId(..))
 import PureTabs.Sidebar.Component.GroupName as GroupName
 import PureTabs.Sidebar.Component.TopMenu as TopMenu
@@ -62,6 +65,7 @@ data Action
 
 data Query a
   = TabsQuery (Tabs.Query a)
+  | InitialTabsWithGroup (Array TabWithGroup) a
   | GroupDeleted GroupId (Maybe TabId) a
 
 initialState :: forall i. i -> State
@@ -143,139 +147,172 @@ component =
                GroupName.DeleteGroup -> Just (UserDeletedGroup groupId)
     ] 
 
-  handleAction :: MonadEffect m => Action -> H.HalogenM State Action Slots SidebarEvent m Unit
-  handleAction = 
-    case _ of
+handleAction :: forall m. MonadEffect m => Action -> H.HalogenM State Action Slots SidebarEvent m Unit
+handleAction = 
+  case _ of
 
-         UserSelectedGroup gid -> do
-            H.modify_ _ { currentGroup = gid }
+       UserSelectedGroup gid -> do
+          H.modify_ _ { currentGroup = gid }
 
-         UserRenameGroup gid newName -> 
-            H.modify_ \s -> s { groups = M.update (\g -> Just $ g { name = newName }) gid s.groups }
+       UserRenameGroup gid newName -> 
+          H.modify_ \s -> s { groups = M.update (\g -> Just $ g { name = newName }) gid s.groups }
 
-         UserCreatedGroup -> do
-           H.modify_ \s -> 
-             s { groups = 
-               M.insert 
-                 (findNextGroupId $ M.keys s.groups) 
-                 { name: "new group", pos: M.size s.groups } 
-                 s.groups 
-               }
+       UserCreatedGroup -> do
+         H.modify_ $ createGroup Nothing
 
-         UserChangedDeletion value -> void $ H.queryAll _groupName $ H.tell $ GroupName.DeletionEnabled value
+       UserChangedDeletion value -> void $ H.queryAll _groupName $ H.tell $ GroupName.DeletionEnabled value
 
-         UserDeletedGroup gid -> do 
-            s <- H.get
-            if M.size s.groups > 1 then
-              H.raise $ SbDeletedGroup gid $ getTabIdsOfGroup gid s.tabsToGroup
-            else 
-              void $ H.query _groupName gid $ H.tell $ GroupName.TriedToDeleteLastGroup
+       UserDeletedGroup gid -> do 
+          s <- H.get
+          if M.size s.groups > 1 then
+            H.raise $ SbDeletedGroup gid $ getTabIdsOfGroup gid s.tabsToGroup
+          else 
+            void $ H.query _groupName gid $ H.tell $ GroupName.TriedToDeleteLastGroup
 
-         GroupNameDragOver dragEvent gid -> do
+       GroupNameDragOver dragEvent gid -> do
+         let 
+             dataTransfer = DE.dataTransfer dragEvent
+         dragData <- H.liftEffect $ DT.getData textPlain dataTransfer
+         case fromString dragData of
+              Nothing -> H.liftEffect $ log $ "sb: group drag over, got something else than a number: " <> dragData
+              Just tid -> do 
+                 H.modify_ _ { draggedCurrentGroup = Just gid }
+                 H.liftEffect $ log $ "sb: dragging " <> (show tid) <> " over " <> (show gid)
+
+       DragEnd evt -> do 
+          H.modify_ _ { draggedCurrentGroup = Nothing }
+          H.liftEffect $ log $ "sb: drag end from bar component"
+
+       HandleTabsOutput gid output -> 
+         case output of 
+            OutputTabDragEnd tid' -> do 
+                 s <- H.get
+                 case Tuple tid' s.draggedCurrentGroup of 
+                      -- Only perform a move when we're dragging a tab onto a different group
+                      Tuple (Just tid) (Just draggedGroup) | s.currentGroup /= draggedGroup -> 
+                               moveTabToGroup tid gid draggedGroup s
+                      _ -> pure unit
+
+                 H.modify_ _ { draggedCurrentGroup = Nothing }
+
+
+            TabsSidebarAction (SbMoveTab tid groupIndex) -> sidebarMoveTab tid gid groupIndex
+            TabsSidebarAction sbEvent -> H.raise sbEvent
+
+  where
+        moveTabToGroup 
+          :: MonadEffect m => TabId 
+          -> GroupId 
+          -> GroupId 
+          -> State 
+          -> H.HalogenM State Action Slots SidebarEvent m Unit
+        moveTabToGroup tid fromGroup toGroup state = do
+          let 
+              -- XXX: The goal is to put it at the end, but if you:
+              --  - create a new group
+              --  - drag a tab from the first one to it
+              --  - drag it back to the first group
+              --  Then it will be at the beginning of the group, not the end.
+
+              -- Right now we only put it at the end of the list. 
+              -- We don't support dragging at a specific place.
+              newTabIndex = 
+                fromMaybe (A.length state.groupTabsPositions) 
+                $ lastWinTabIndexInGroup toGroup state.groupTabsPositions
+
+          s <- H.modify \s -> 
+            s { tabsToGroup = M.update (\_ -> Just toGroup) tid s.tabsToGroup
+            , groupTabsPositions = 
+              s.groupTabsPositions
+              <#> 
+              (\(Tuple tid' gid') -> if tid' == tid then Tuple tid' toGroup else Tuple tid' gid') 
+            -- Reassign the current group directly here to avoid flickering
+            , currentGroup = toGroup
+            }
+          let newIndexInGroup = getPositionTabInGroup newTabIndex toGroup s.groupTabsPositions
+
+          deletedTab' <- H.query _tabs fromGroup $ H.request $ Tabs.TabDeleted tid
+          case deletedTab' of 
+               Just (Just (Tab tab)) -> 
+                 void $ H.query _tabs toGroup $ H.tell 
+                  $ Tabs.TabCreated $ Tab (tab { index = newIndexInGroup })
+               _ -> pure unit
+
+          H.raise $ SbMoveTab tid newTabIndex
+          H.raise $ SbActivateTab tid
+          H.raise $ SbChangeTabGroup tid (Just toGroup)
+
+        sidebarMoveTab 
+          :: TabId 
+          -> GroupId 
+          -> Int 
+          -> H.HalogenM State Action Slots SidebarEvent m Unit
+        sidebarMoveTab tid gid groupIndex = do
+           s <- H.get
            let 
-               dataTransfer = DE.dataTransfer dragEvent
-           dragData <- H.liftEffect $ DT.getData textPlain dataTransfer
-           case fromString dragData of
-                Nothing -> H.liftEffect $ log $ "sb: group drag over, got something else than a number: " <> dragData
-                Just tid -> do 
-                   H.modify_ _ { draggedCurrentGroup = Just gid }
-                   H.liftEffect $ log $ "sb: dragging " <> (show tid) <> " over " <> (show gid)
-
-         DragEnd evt -> do 
-            H.modify_ _ { draggedCurrentGroup = Nothing }
-            H.liftEffect $ log $ "sb: drag end from bar component"
-
-         HandleTabsOutput gid output -> 
-           case output of 
-              OutputTabDragEnd tid' -> do 
-                   s <- H.get
-                   case Tuple tid' s.draggedCurrentGroup of 
-                        -- Only perform a move when we're dragging a tab onto a different group
-                        Tuple (Just tid) (Just draggedGroup) | s.currentGroup /= draggedGroup -> 
-                                 moveTabToGroup tid gid draggedGroup s
-                        _ -> pure unit
-
-                   H.modify_ _ { draggedCurrentGroup = Nothing }
-
-
-              TabsSidebarAction (SbMoveTab tid groupIndex) -> sidebarMoveTab tid gid groupIndex
-              TabsSidebarAction sbEvent -> H.raise sbEvent
-
-    where
-          findNextGroupId :: S.Set GroupId -> GroupId
-          findNextGroupId values = 
-            let GroupId(maxValue) = NES.max (NES.cons (GroupId 0) values)
-             in GroupId(maxValue + 1)
-
-          moveTabToGroup 
-            :: MonadEffect m => TabId 
-            -> GroupId 
-            -> GroupId 
-            -> State 
-            -> H.HalogenM State Action Slots SidebarEvent m Unit
-          moveTabToGroup tid fromGroup toGroup state = do
-            let 
-                -- XXX: The goal is to put it at the end, but if you:
-                --  - create a new group
-                --  - drag a tab from the first one to it
-                --  - drag it back to the first group
-                --  Then it will be at the beginning of the group, not the end.
-
-                -- Right now we only put it at the end of the list. 
-                -- We don't support dragging at a specific place.
-                newTabIndex = 
-                  fromMaybe (A.length state.groupTabsPositions) 
-                  $ lastWinTabIndexInGroup toGroup state.groupTabsPositions
-
-            s <- H.modify \s -> 
-              s { tabsToGroup = M.update (\_ -> Just toGroup) tid s.tabsToGroup
-              , groupTabsPositions = 
-                s.groupTabsPositions
-                <#> 
-                (\(Tuple tid' gid') -> if tid' == tid then Tuple tid' toGroup else Tuple tid' gid') 
-              -- Reassign the current group directly here to avoid flickering
-              , currentGroup = toGroup
-              }
-            let newIndexInGroup = getPositionTabInGroup newTabIndex toGroup s.groupTabsPositions
-
-            deletedTab' <- H.query _tabs fromGroup $ H.request $ Tabs.TabDeleted tid
-            case deletedTab' of 
-                 Just (Just (Tab tab)) -> 
-                   void $ H.query _tabs toGroup $ H.tell 
-                    $ Tabs.TabCreated $ Tab (tab { index = newIndexInGroup })
-                 _ -> pure unit
-
-            H.raise $ SbMoveTab tid newTabIndex
-            H.raise $ SbActivateTab tid
-
-          sidebarMoveTab 
-            :: TabId 
-            -> GroupId 
-            -> Int 
-            -> H.HalogenM State Action Slots SidebarEvent m Unit
-          sidebarMoveTab tid gid groupIndex = do
-             s <- H.get
-             let 
-                 oldPosition = getPositionTab tid gid s.groupTabsPositions
-                 newIndex = do 
-                    prevIdx <- oldPosition
-                    s.groupTabsPositions #
-                      A.mapWithIndex (Tuple) 
-                            >>> A.filter (\(Tuple _ (Tuple _ gid')) -> gid' == gid)
-                            >>> (flip A.index) groupIndex
-                            >>> map T.fst
-
-             -- Important: we ask Firefox to do the move, but we don't
-             -- perform it ourselves.  This means we don't update the state.
-             -- We will get back a TabMoved event that will then be
-             -- processed accordingly.
-             newIndex # maybe (pure unit) \idx -> H.raise $ SbMoveTab tid idx 
+               oldPosition = getPositionTab tid gid s.groupTabsPositions
+               newIndex = do 
+                  prevIdx <- oldPosition
+                  s.groupTabsPositions #
+                    A.mapWithIndex (Tuple) 
+                          >>> A.filter (\(Tuple _ (Tuple _ gid')) -> gid' == gid)
+                          >>> (flip A.index) groupIndex
+                          >>> map T.fst
+
+           -- Important: we ask Firefox to do the move, but we don't
+           -- perform it ourselves.  This means we don't update the state.
+           -- We will get back a TabMoved event that will then be
+           -- processed accordingly.
+           newIndex # maybe (pure unit) \idx -> H.raise $ SbMoveTab tid idx 
 
  
-handleQuery :: forall act a m. Query a -> H.HalogenM State act Slots SidebarEvent m (Maybe a)
+handleQuery :: forall a m. MonadEffect m => Query a -> H.HalogenM State Action Slots SidebarEvent m (Maybe a)
 handleQuery = case _ of 
    TabsQuery q -> handleTabsQuery q
 
+   InitialTabsWithGroup tabs a -> do
+       -- Assign the tabs to their group and save the tabs positions
+       s <- H.modify \s ->
+         let 
+             tabIdGroup = tabs <#> \(TabWithGroup (Tab t) gid) -> Tuple t.id $ fromMaybe s.currentGroup gid
+          in
+             s { tabsToGroup = M.fromFoldable tabIdGroup, groupTabsPositions = tabIdGroup }
+
+       -- Create the missing groups
+       let 
+           existingGroups = M.keys s.groups
+           addedGroups = S.fromFoldable $ A.catMaybes $ tabs <#> \(TabWithGroup _ gid) -> gid
+           missingGroups = S.difference addedGroups existingGroups
+       void $ traverse (\gid -> H.modify_ $ createGroup $ Just gid) $ A.fromFoldable missingGroups
+
+       -- Update the browser state to assign tabs with a saved group to the current group
+       let setGroups = tabs # 
+              map (\(TabWithGroup (Tab t) gid) -> H.raise $ SbChangeTabGroup t.id (Just s.currentGroup)) 
+              <<< A.filter (\(TabWithGroup _ maybeGid) -> isNothing maybeGid)
+       void $ sequence setGroups
+
+       -- Initialize each child Tabs component with its tabs
+       let 
+            defaultTabs = tabs <#> \(TabWithGroup tab maybeGid) -> Tuple tab $ fromMaybe s.currentGroup maybeGid
+            groupedTabs = A.groupBy (\(Tuple _ gid1) (Tuple _ gid2) -> gid1 == gid2) defaultTabs
+       void $ traverse initializeGroup groupedTabs
+
+       -- Activate the right tab and its group
+       let activatedTab = defaultTabs # A.head <<< A.filter (\(Tuple (Tab t) _) -> t.active)
+       activatedTab # maybe (pure unit) \(Tuple (Tab t) gid) -> do
+         void $ tellChild gid $ Tabs.TabActivated Nothing t.id
+         handleAction $ UserSelectedGroup gid
+
+       pure (Just a)
+
+      where 
+            initializeGroup :: forall act. NonEmptyArray (Tuple Tab GroupId) -> H.HalogenM State act Slots SidebarEvent m Unit
+            initializeGroup groupedTabs = 
+              let 
+                  gid = T.snd $ NonEmptyArray.head groupedTabs
+              in 
+                  void $ tellChild gid $ Tabs.InitialTabList $ A.fromFoldable $ T.fst <$> groupedTabs
+
    GroupDeleted gid currentTid a -> do 
       H.modify_ \s -> 
         let 
@@ -288,18 +325,7 @@ handleQuery = case _ of
 handleTabsQuery :: forall act a m. Tabs.Query a -> H.HalogenM State act Slots SidebarEvent m (Maybe a)
 handleTabsQuery = case _ of
 
-    Tabs.InitialTabList tabs a -> do
-       s <- H.modify (\s -> 
-         let 
-             tabIdGroup = tabs <#> \(Tab t) -> Tuple t.id s.currentGroup
-          in
-         s { tabsToGroup = M.fromFoldable tabIdGroup , groupTabsPositions = tabIdGroup }
-       )
-       let activatedTab = tabs # A.filter (\(Tab t) -> t.active) >>> A.head
-       void $ tellChild s.currentGroup $ Tabs.InitialTabList tabs
-       activatedTab # maybe (pure unit) \(Tab t) -> 
-         void $ tellChild s.currentGroup $ Tabs.TabActivated Nothing t.id
-       pure (Just a)
+    Tabs.InitialTabList tabs a -> pure $ Just a
 
     Tabs.TabCreated (Tab tab) a -> do 
        s <- H.get
@@ -319,6 +345,7 @@ handleTabsQuery = case _ of
          }
 
        void $ tellChild newS.currentGroup $ Tabs.TabCreated newTab
+       H.raise $ SbChangeTabGroup tab.id (Just newS.currentGroup)
        pure (Just a)
 
     Tabs.TabDeleted tid reply -> do 
@@ -371,24 +398,22 @@ handleTabsQuery = case _ of
     Tabs.TabAttached tab a -> do 
        handleTabsQuery $ Tabs.TabCreated tab a
 
-    where
-        tellChild :: GroupId -> (H.Tell Tabs.Query) -> H.HalogenM State act Slots SidebarEvent m (Maybe Unit)
-        tellChild gid q = H.query _tabs gid $ H.tell q
-        -- 
-        -- requestChild :: GroupId -> (H.Request Tabs.Query) -> H.HalogenM State act Slots SidebarEvent M (Maybe a)
-        -- requestChild gid q = H.request 
+  where 
+    doOnTabGroup 
+      :: TabId 
+      -> (GroupId -> H.HalogenM State act Slots SidebarEvent m Unit) 
+      -> H.HalogenM State act Slots SidebarEvent m Unit
+    doOnTabGroup tabId f = do
+      { tabsToGroup } <- H.get
+      case M.lookup tabId tabsToGroup of 
+           Just groupId -> f groupId
+           Nothing -> pure unit
 
-        doOnTabGroup 
-          :: TabId 
-          -> (GroupId -> H.HalogenM State act Slots SidebarEvent m Unit) 
-          -> H.HalogenM State act Slots SidebarEvent m Unit
-        doOnTabGroup tabId f = do
-          { tabsToGroup } <- H.get
-          case M.lookup tabId tabsToGroup of 
-               Just groupId -> f groupId
-               Nothing -> pure unit
 
 
+tellChild :: forall act m. GroupId -> (H.Tell Tabs.Query) -> H.HalogenM State act Slots SidebarEvent m (Maybe Unit)
+tellChild gid q = H.query _tabs gid $ H.tell q
+
 getPositionTabInGroup
   :: Int
   -> GroupId
@@ -427,3 +452,15 @@ lastWinTabIndexInGroup gid =
     >>> map T.fst
     >>> A.head
 
+findNextGroupId :: S.Set GroupId -> GroupId
+findNextGroupId values = 
+  let GroupId(maxValue) = NES.max (NES.cons (GroupId 0) values)
+   in GroupId(maxValue + 1)
+
+createGroup :: (Maybe GroupId) -> State -> State
+createGroup mGid s =
+  let 
+      gid = fromMaybe' (\_ -> findNextGroupId $ M.keys s.groups) mGid
+  in
+     s { groups = M.insert gid { name: "new group", pos: M.size s.groups } s.groups }
+

src/Sidebar/Sidebar.purs

@@ -50,7 +50,7 @@ onBackgroundMsgConsumer query =
     $ case _ of
 
         BgInitialTabList tabs -> do
-          void $ query $ H.tell $ \q -> Bar.TabsQuery (Tabs.InitialTabList tabs q) 
+          void $ query $ H.tell $ \q -> Bar.InitialTabsWithGroup tabs q 
           pure Nothing
 
         BgTabCreated tab -> do