feat: save and restore groups, w/ their tabs

src/Background.purs

@@ -15,8 +15,8 @@ import Browser.Windows (Window)
 import Browser.Windows.OnCreated as WinOnCreated
 import Browser.Windows.OnRemoved as WinOnRemoved
 import Control.Alt ((<#>))
-import Control.Alternative (pure, (*>))
-import Control.Bind ((=<<), (>>=))
+import Control.Alternative ((*>))
+import Control.Bind (map, (<*), (=<<), (>>=))
 import Control.Category ((>>>))
 import Data.Array as A
 import Data.CommutativeRing ((+))
@@ -25,7 +25,7 @@ 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(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
 import Data.Set as Set
@@ -33,14 +33,17 @@ import Data.Show (show)
 import Data.Traversable (sequence)
 import Data.Unit (unit)
 import Effect (Effect)
-import Effect.Aff (launchAff_)
+import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
+import Effect.Class.Console (error)
 import Effect.Console (log)
 import Effect.Ref as Ref
-import Prelude (Unit, bind, ($), discard, (<<<), (<$>))
+import Prelude (Unit, bind, discard, pure, ($), (<$>), (<<<), (==), (/=))
 import PureTabs.Browser.Sessions (getTabValue, removeTabValue, setTabValue)
-import PureTabs.Model.Events (BackgroundEvent(..), SidebarEvent(..), TabWithGroup(..))
+import PureTabs.Browser.Storage (storageLocalGet, storageLocalSet)
+import PureTabs.Model.Events (BackgroundEvent(..), GroupMapping(..), SidebarEvent(..), TabWithGroup(..), groupMapping)
 import PureTabs.Model.GlobalState as GS
+import PureTabs.Model.Group (GroupId(..))
 
 type Ports
   = Ref.Ref (List Runtime.Port)
@@ -53,6 +56,10 @@ main = do
   log "starting background"
   launchAff_ do
      allTabs <- BT.browserQuery {}
+     groups <- retrieveGroups
+     case groups of
+          [] -> updateGroupsMapping $ createGroup (GroupId 0) "main"
+          _ -> pure unit
      liftEffect $ initializeBackground =<< (Ref.new $ GS.initialTabsToGlobalState allTabs)
 
 initializeBackground :: Ref.Ref GS.GlobalState -> Effect Unit
@@ -174,7 +181,8 @@ onNewWindowId port stateRef listenerRef winId = do
     in
       launchAff_ do
          tabsWithGroup <- sequence tabsWithGid
-         liftEffect $ Runtime.postMessageJson port $ BgInitialTabList tabsWithGroup
+         groups <- retrieveGroups
+         liftEffect $ Runtime.postMessageJson port $ BgInitialTabList groups tabsWithGroup
     
 
   --  Add the new onMessage listener
@@ -182,6 +190,42 @@ onNewWindowId port stateRef listenerRef winId = do
   onDisconnectListener <- mkListenerUnit $ onDisconnect stateRef winId sidebarListener
   Runtime.portOnDisconnect port onDisconnectListener
 
+
+retrieveGroups :: Aff (Array GroupMapping)
+retrieveGroups = do 
+  (groups :: (Maybe (Array GroupMapping))) <- storageLocalGet "groups"
+  case groups of
+       Just groups' -> pure groups'
+       Nothing -> pure [] <* error "couldn't get key `groups` from local storage"
+
+type GroupsUpdate = Array GroupMapping -> Array GroupMapping
+
+updateGroupsMapping :: GroupsUpdate -> Aff Unit
+updateGroupsMapping updateGroups = do
+  groups <- retrieveGroups
+  let updatedGroups = updateGroups groups
+  storageLocalSet "groups" $ updatedGroups
+
+
+createGroup :: GroupId -> String -> GroupsUpdate
+createGroup gid name = ((flip A.snoc) $ groupMapping gid name) <<< A.filter (unwrap >>> _.groupId >>> (/=) gid)
+
+renameGroup :: GroupId -> String -> GroupsUpdate
+renameGroup gid newName = 
+  map $ case _ of 
+             GroupMapping { groupId: gid' } | gid == gid' -> groupMapping gid newName
+             other -> other
+
+moveGroup :: GroupId -> Int -> GroupsUpdate
+moveGroup gid to arr =
+  fromMaybe arr $ do
+    from <- A.findIndex (unwrap >>> _.groupId >>> (==) gid) arr
+    group <- arr A.!! from
+    A.deleteAt from arr >>= A.insertAt to group
+
+deleteGroup :: GroupId -> GroupsUpdate
+deleteGroup gid = A.filter (unwrap >>> _.groupId >>> (/=) gid)
+
 manageSidebar :: StateRef -> WindowId -> Runtime.Port -> SidebarEvent -> Effect Unit
 manageSidebar ref winId port = case _ of
 
@@ -213,10 +257,15 @@ manageSidebar ref winId port = case _ of
      activeTab <- BT.browserQuery { windowId: unwrap winId, active: true }
      let activeTabId = activeTab # A.head >>> (<$>) (unwrap >>> _.id)
      liftEffect $ Runtime.postMessageJson port $ BgGroupDeleted gid activeTabId
+     updateGroupsMapping $ deleteGroup gid
 
   SbChangeTabGroup tid Nothing -> launchAff_ $ removeTabValue tid "groupId"
   SbChangeTabGroup tid (Just gid) -> launchAff_ $ setTabValue tid "groupId" gid
 
+  SbCreatedGroup gid name -> launchAff_ $ updateGroupsMapping $ createGroup gid name
+  SbRenamedGroup gid name -> launchAff_ $ updateGroupsMapping $ renameGroup gid name
+  SbMovedGroup gid pos -> launchAff_ $ updateGroupsMapping $ moveGroup gid pos
+
   SbDetacheTab -> pure unit
   SbHasWindowId winId' -> pure unit
 

src/Browser/Storage.js

@@ -0,0 +1,15 @@
+"use strict";
+
+exports["storageLocalGetImpl"] = function(key, Just, Nothing) {
+  return browser.storage.local.get(key).then(obj => {
+    if (obj === undefined || obj[key] === undefined) {
+      return Nothing;
+    } else {
+      return Just(obj[key]);
+    }
+  });
+}
+
+exports["storageLocalSetImpl"] = function(key, value) {
+  return browser.storage.local.set({[key]: value});
+}

src/Browser/Storage.purs

@@ -0,0 +1,20 @@
+module PureTabs.Browser.Storage (storageLocalGet, storageLocalSet) where
+
+import Prelude
+
+import Control.Promise (Promise, toAffE)
+import Data.Maybe (Maybe(..))
+import Effect.Aff (Aff)
+import Effect.Uncurried (EffectFn2, EffectFn3, runEffectFn2, runEffectFn3)
+
+foreign import storageLocalGetImpl
+  :: forall r. EffectFn3 String (r -> Maybe r) (Maybe r) (Promise r)
+
+storageLocalGet :: forall r. String -> Aff (Maybe r)
+storageLocalGet keys = toAffE $ runEffectFn3 storageLocalGetImpl keys Just Nothing
+
+foreign import storageLocalSetImpl
+  :: forall r. EffectFn2 String r (Promise Unit)
+
+storageLocalSet :: forall r. String -> r -> Aff Unit
+storageLocalSet key value = toAffE $ runEffectFn2 storageLocalSetImpl key value

src/Model/Events.purs

@@ -2,12 +2,15 @@ module PureTabs.Model.Events (
   BackgroundEvent(..)
   , SidebarEvent(..)
   , TabWithGroup(..)
+  , GroupMapping(..)
+  , groupMapping
   ) where
 
 import Browser.Tabs (Tab, TabId, WindowId)
 import Browser.Tabs.OnUpdated (ChangeInfo)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
+import Data.Newtype (class Newtype)
 import Data.Maybe (Maybe)
 import Data.Show (class Show)
 import PureTabs.Model.Group (GroupId)
@@ -29,8 +32,30 @@ instance encodeTabWithGroup :: Encode TabWithGroup where
 instance decodeTabWithGroup :: Decode TabWithGroup where
   decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
+
+newtype GroupMapping
+  = GroupMapping { groupId :: GroupId
+                 , name :: String
+                 }
+
+groupMapping :: GroupId -> String -> GroupMapping
+groupMapping gid name = GroupMapping { groupId: gid, name: name }
+
+derive instance genGroupMapping :: Generic GroupMapping _
+derive instance newtypeGroupMapping :: Newtype GroupMapping _
+
+instance showGroupMapping :: Show GroupMapping where 
+  show = genericShow
+
+instance encodeGroupMapping :: Encode GroupMapping where
+  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
+
+instance decodeGroupMapping :: Decode GroupMapping where
+  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
+
+
 data BackgroundEvent
-  = BgInitialTabList (Array TabWithGroup)
+  = BgInitialTabList (Array GroupMapping) (Array TabWithGroup)
   | BgTabCreated Tab
   | BgTabDeleted TabId
   | BgTabUpdated TabId ChangeInfo Tab
@@ -55,6 +80,9 @@ data SidebarEvent
   | SbSelectedGroup (Array TabId)
   | SbDeletedGroup GroupId (Array TabId)
   | SbChangeTabGroup TabId (Maybe GroupId)
+  | SbCreatedGroup GroupId String
+  | SbRenamedGroup GroupId String
+  | SbMovedGroup GroupId Int
 
 derive instance genSidebarEvent :: Generic SidebarEvent _
 

src/Sidebar/Components/Bar.purs

@@ -1,7 +1,6 @@
 module PureTabs.Sidebar.Bar where
 
 import Browser.Tabs (Tab(..), TabId)
-import Control.Alternative (pure)
 import Control.Bind (bind, discard, map, void, (<#>), (>>=))
 import Data.Array ((:))
 import Data.Array as A
@@ -10,10 +9,10 @@ import Data.Array.NonEmpty as NonEmptyArray
 import Data.Eq ((/=))
 import Data.Function (($))
 import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isNothing, maybe)
+import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', maybe)
 import Data.MediaType.Common (textPlain)
 import Data.Number (fromString)
-import Data.Set (toUnfoldable, Set, fromFoldable, difference) as S
+import Data.Set (Set, member, toUnfoldable) as S
 import Data.Set.NonEmpty (cons, max) as NES
 import Data.Symbol (SProxy(..))
 import Data.Traversable (sequence, traverse)
@@ -27,8 +26,8 @@ import Halogen as H
 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(..), TabWithGroup(..))
+import Prelude (flip, pure, show, (#), (&&), (+), (-), (<$>), (<<<), (<>), (==), (>), (>>>))
+import PureTabs.Model.Events (GroupMapping(..), SidebarEvent(..), TabWithGroup(..))
 import PureTabs.Model.Group (GroupId(..))
 import PureTabs.Sidebar.Component.GroupName as GroupName
 import PureTabs.Sidebar.Component.TopMenu as TopMenu
@@ -39,6 +38,8 @@ import Web.HTML.Event.DataTransfer as DT
 import Web.HTML.Event.DragEvent as DE
 
 
+-- TODO: correctly use `pos` when adding or deleting a group (i.e. making sure
+-- the pos are contiguous from 0 to #groups - 1)
 type Group
   = { name :: String
     , pos :: Int
@@ -65,20 +66,19 @@ data Action
 
 data Query a
   = TabsQuery (Tabs.Query a)
-  | InitialTabsWithGroup (Array TabWithGroup) a
+  | InitialTabsWithGroup (Array GroupMapping) (Array TabWithGroup) a
   | GroupDeleted GroupId (Maybe TabId) a
 
+initialGroup :: M.Map GroupId Group
+initialGroup = M.fromFoldable [ Tuple (GroupId 0) { name: "main", pos: 0 } ]
+
 initialState :: forall i. i -> State
 initialState _ =
-  let
-    firstGroupId = GroupId 0
-  in
-    { 
-      groups: M.fromFoldable [ Tuple firstGroupId { name: "main", pos: 0 } ]
-      , tabsToGroup: M.empty
-      , groupTabsPositions : []
-      , currentGroup: firstGroupId 
-      , draggedCurrentGroup: Nothing
+  { groups: initialGroup
+    , tabsToGroup: M.empty
+    , groupTabsPositions : []
+    , currentGroup: GroupId 0
+    , draggedCurrentGroup: Nothing
     }
 
 type Slots
@@ -120,6 +120,7 @@ component =
                TopMenu.ChangedDeletion value -> UserChangedDeletion value
         )
 
+        -- TODO: order groups by `pos`
         barListGroup = HH.div [ HP.id_ "bar-list" ] [HH.ul [ HP.id_ "bar-list-group"] $ 
           (M.toUnfoldable state.groups) <#> \(Tuple gid g) -> renderGroup gid (gid == currentGroupShown) g
         ]
@@ -154,11 +155,15 @@ handleAction =
        UserSelectedGroup gid -> do
           H.modify_ _ { currentGroup = gid }
 
-       UserRenameGroup gid newName -> 
+       UserRenameGroup gid newName -> do
           H.modify_ \s -> s { groups = M.update (\g -> Just $ g { name = newName }) gid s.groups }
+          H.raise $ SbRenamedGroup gid newName
 
        UserCreatedGroup -> do
-         H.modify_ $ createGroup Nothing
+          s <- H.get
+          let Tuple gid newGroup = createGroup Nothing s
+          H.modify_ $ insertGroup gid newGroup
+          H.raise $ SbCreatedGroup gid newGroup.name
 
        UserChangedDeletion value -> void $ H.queryAll _groupName $ H.tell $ GroupName.DeletionEnabled value
 
@@ -270,35 +275,43 @@ handleQuery :: forall a m. MonadEffect m => Query a -> H.HalogenM State Action S
 handleQuery = case _ of 
    TabsQuery q -> handleTabsQuery q
 
-   InitialTabsWithGroup tabs a -> do
+   InitialTabsWithGroup groups 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
+             newGroups = 
+               case groups of
+                    [] -> initialGroup
+                    newGroups' -> 
+                      M.fromFoldable $ 
+                        A.mapWithIndex 
+                        (\idx (GroupMapping g) -> Tuple g.groupId { name: g.name, pos: idx})
+                        newGroups'
+
+             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
           in
-             s { tabsToGroup = M.fromFoldable tabIdGroup, groupTabsPositions = tabIdGroup }
+             s { groups = newGroups, tabsToGroup = M.fromFoldable tabIdGroup, groupTabsPositions = tabIdGroup }
+
+       -- Update the browser state to re-assign correctly all the tabs
 
-       -- 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)
+           (groupsTupled :: Array (Tuple TabId GroupId)) = M.toUnfoldableUnordered s.tabsToGroup
+           setGroups = groupsTupled <#>
+              (\(Tuple tid gid) -> H.raise $ SbChangeTabGroup tid (Just gid)) 
        void $ sequence setGroups
 
-       -- Initialize each child Tabs component with its tabs
+       -- 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
+            tabsGroups = tabs <#> \(TabWithGroup tab@(Tab t) _) -> Tuple tab $ fromMaybe s.currentGroup (M.lookup t.id s.tabsToGroup)
+            groupedTabs = A.groupBy (\(Tuple _ gid1) (Tuple _ gid2) -> gid1 == gid2) tabsGroups
        void $ traverse initializeGroup groupedTabs
 
        -- Activate the right tab and its group
-       let activatedTab = defaultTabs # A.head <<< A.filter (\(Tuple (Tab t) _) -> t.active)
+       let activatedTab = tabsGroups # 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
@@ -457,10 +470,13 @@ findNextGroupId values =
   let GroupId(maxValue) = NES.max (NES.cons (GroupId 0) values)
    in GroupId(maxValue + 1)
 
-createGroup :: (Maybe GroupId) -> State -> State
+createGroup :: (Maybe GroupId) -> State -> Tuple GroupId Group
 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 }
+    Tuple gid { name: "new group", pos: M.size s.groups }
+
+insertGroup :: GroupId -> Group -> State -> State
+insertGroup gid group s = s { groups = M.insert gid group s.groups }
 

src/Sidebar/Sidebar.purs

@@ -49,8 +49,8 @@ onBackgroundMsgConsumer query =
   CR.consumer
     $ case _ of
 
-        BgInitialTabList tabs -> do
-          void $ query $ H.tell $ \q -> Bar.InitialTabsWithGroup tabs q 
+        BgInitialTabList groups tabs -> do
+          void $ query $ H.tell $ \q -> Bar.InitialTabsWithGroup groups tabs q 
           pure Nothing
 
         BgTabCreated tab -> do