feat: improve storage (use setWindowValue) and initialization of groups

- When the background script start, make sure every window and every
  tab have at least a group assigned to it.
- Store the groups of a window using setWindowValue instead of local
  storage.

src/Background.purs

@@ -20,30 +20,30 @@ import Control.Bind (map, (=<<), (>>=))
 import Control.Category ((>>>))
 import Data.Array as A
 import Data.CommutativeRing ((+))
-import Data.Foldable (sequence_)
 import Data.Function (flip, (#))
 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, maybe)
 import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
 import Data.Set as Set
 import Data.Show (show)
-import Data.Traversable (sequence)
+import Data.Traversable (sequence, traverse_)
+import Data.Tuple (Tuple(..))
 import Data.Unit (unit)
 import Effect (Effect)
-import Effect.Aff (launchAff_)
+import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Console (log)
 import Effect.Ref as Ref
 import Prelude (Unit, bind, discard, pure, ($), (<$>), (<<<))
-import PureTabs.Browser.Sessions (getTabValue, getWindowValue, removeTabValue, setTabValue, setWindowValue)
+import PureTabs.Browser.Sessions (getTabValue, removeTabValue, setTabValue)
 import PureTabs.Model.BackgroundEvent (BackgroundEvent(..))
 import PureTabs.Model.GlobalState as GS
 import PureTabs.Model.Group (GroupId(..))
-import PureTabs.Model.GroupMapping (createGroup, deleteGroup, moveGroup, renameGroup, retrieveGroups, retrieveGroupsAt, updateGroupsMapping)
+import PureTabs.Model.GroupMapping (GroupData, createGroup, deleteGroup, moveGroup, renameGroup, retrieveGroups, updateGroupsMapping)
 import PureTabs.Model.SidebarEvent (SidebarEvent(..))
 import PureTabs.Model.TabWithGroup (TabWithGroup(..))
 
@@ -55,20 +55,40 @@ type StateRef = Ref.Ref GS.GlobalState
 
 main :: Effect Unit
 main = do
-  log "starting background"
+  log "[bg] starting"
   launchAff_ do
      allTabs <- BT.browserQuery {}
-     groups <- retrieveGroups
-     case groups of
-          [] -> sequence_ $ allTabs # 
-                  map (\(Tab t) -> t.windowId)
-                  >>> Set.fromFoldable
-                  >>> A.fromFoldable
-                  >>> map (\winId -> updateGroupsMapping $ createGroup winId (GroupId 0) "main")
-
-          _ -> pure unit
+     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
@@ -188,7 +208,7 @@ onNewWindowId port stateRef listenerRef winId = do
     in
       launchAff_ do
          tabsWithGroup <- sequence tabsWithGid
-         groups <- retrieveGroupsAt winId
+         groups <- retrieveGroups winId
          liftEffect $ Runtime.postMessageJson port $ BgInitialTabList groups tabsWithGroup
     
 
@@ -229,14 +249,14 @@ 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 winId gid
+     updateGroupsMapping winId $ deleteGroup gid
 
   SbChangeTabGroup tid Nothing -> launchAff_ $ removeTabValue tid "groupId"
   SbChangeTabGroup tid (Just gid) -> launchAff_ $ setTabValue tid "groupId" gid
 
-  SbCreatedGroup gid name -> launchAff_ $ updateGroupsMapping $ createGroup winId gid name
-  SbRenamedGroup gid name -> launchAff_ $ updateGroupsMapping $ renameGroup winId gid name
-  SbMovedGroup gid pos -> launchAff_ $ updateGroupsMapping $ moveGroup winId gid pos
+  SbCreatedGroup gid name -> launchAff_ $ updateGroupsMapping winId $ createGroup gid name
+  SbRenamedGroup gid name -> launchAff_ $ updateGroupsMapping winId $ renameGroup gid name
+  SbMovedGroup gid pos -> launchAff_ $ updateGroupsMapping winId $ moveGroup gid pos
 
   SbDetacheTab -> pure unit
   SbHasWindowId winId' -> pure unit

src/Browser/Sessions.js

@@ -15,3 +15,16 @@ exports["getTabValueImpl"] = function(Just, Nothing, tabId, key) {
       else return Just(val);
     });
 };
+
+
+exports["setWindowValueImpl"] = function(windowId, key, value) {
+  return browser.sessions.setWindowValue(windowId, key, value);
+};
+
+exports["removeWindowValueImpl"] = function(windowId, key) {
+  return browser.sessions.removeWindowValue(windowId, key);
+};
+
+exports["getWindowValueImpl"] = function(windowId, key) {
+  return browser.sessions.getWindowValue(windowId, key);
+};

src/Browser/Sessions.purs

@@ -2,15 +2,25 @@ module PureTabs.Browser.Sessions where
 
 import Prelude
 
-import Browser.Tabs (TabId(..))
+import Browser.Tabs (TabId(..), WindowId(..))
+import Control.Monad.Error.Class (throwError, try)
+import Control.Monad.Except (runExcept)
 import Control.Promise (Promise, toAffE)
+import Data.Either (Either(..), hush)
+import Data.Foldable (intercalate)
+import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Effect.Aff (Aff)
+import Effect.Class.Console as Log
+import Effect.Exception (error)
 import Effect.Uncurried (EffectFn2, EffectFn3, EffectFn4, runEffectFn2, runEffectFn3, runEffectFn4)
+import Foreign (renderForeignError)
+import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
 
 foreign import setTabValueImpl 
   :: forall r. EffectFn3 Number String r (Promise Unit)
 
+-- | Set a value from a tab.
 setTabValue 
   :: forall r
    . TabId
@@ -31,9 +41,64 @@ removeTabValue (TabId tid) key = toAffE $ runEffectFn2 removeTabValueImpl tid ke
 foreign import getTabValueImpl
   :: forall r. EffectFn4 (r -> Maybe r) (Maybe r) Number String (Promise (Maybe r))
 
+-- | Get a value from a tab.
 getTabValue
   :: forall r
    . TabId
   -> String
   -> Aff (Maybe r)
 getTabValue (TabId tid) key = toAffE $ runEffectFn4 getTabValueImpl Just Nothing tid key
+
+
+foreign import setWindowValueImpl 
+  :: forall r. EffectFn3 Number String r (Promise Unit)
+
+-- | Set a value for a window. The type `r` should be represented the same way
+-- | in Purescript and in Javascript (so primitive types and newtypes of
+-- | primitive types only).
+--
+-- TODO: use GenericEncode to properly encode the data we're setting.
+setWindowValue 
+  :: forall r
+   . WindowId
+  -> String
+  -> r
+  -> Aff Unit
+setWindowValue (WindowId winId) key value = toAffE $ runEffectFn3 setWindowValueImpl winId key value
+
+foreign import removeWindowValueImpl
+  :: EffectFn2 Number String (Promise Unit)
+
+removeWindowValue
+  :: WindowId
+  -> String
+  -> Aff Unit
+removeWindowValue (WindowId winId) key = toAffE $ runEffectFn2 removeWindowValueImpl winId key
+
+foreign import getWindowValueImpl :: forall r. EffectFn2 Number String (Promise r)
+
+-- | Get the value from a window. Throw an error if we couldn't decode it or we couldn't decode it.
+getWindowValue'
+  :: forall r rep
+   . Generic r rep
+  => GenericDecode rep
+  => WindowId
+  -> String
+  -> Aff r
+getWindowValue' (WindowId winId) key = do 
+  content <- toAffE $ runEffectFn2 getWindowValueImpl winId key
+  case runExcept (genericDecode (defaultOptions { unwrapSingleConstructors = true}) content :: _ r) of
+       Left err -> do 
+          Log.error $ "error while trying to getWindowValue of " <> key <> ": " <> intercalate ", " (map renderForeignError err)
+          throwError $ error "couldn't decode msg"
+       Right resp -> pure resp
+
+-- | Get the value from a window, returning Nothing if it doesn't exist or we couldn't decode it.
+getWindowValue
+  :: forall r rep
+   . Generic r rep
+  => GenericDecode rep
+  => WindowId
+  -> String
+  -> Aff (Maybe r)
+getWindowValue winId key = hush <$> (try $ getWindowValue' winId key)

src/Model/GroupMapping.purs

@@ -2,53 +2,21 @@ module PureTabs.Model.GroupMapping where
 
 
 import Browser.Tabs (WindowId)
-import Browser.Utils (unsafeLog)
-import Control.Bind ((<#>))
 import Data.Array as A
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
-import Data.Map as M
 import Data.Maybe (fromMaybe, Maybe(..))
 import Data.Newtype (class Newtype, unwrap)
-import Data.Semigroup ((<>))
-import Data.Show (class Show)
-import Data.Tuple (Tuple(..))
+import Data.Show (class Show, show)
 import Effect.Aff (Aff)
-import Effect.Class (liftEffect)
-import Effect.Class.Console (error, log)
+import Effect.Class.Console (error)
 import Foreign.Class (class Decode, class Encode)
 import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
-import Prelude (Unit, bind, flip, join, map, pure, ($), (*>), (/=), (<*), (<<<), (==), (>>=), (>>>))
-import PureTabs.Browser.Storage (storageLocalGet, storageLocalSet)
+import Prelude (Unit, bind, flip, map, pure, ($), (/=), (<*), (<>), (==), (>>=), (>>>))
+import PureTabs.Browser.Sessions (getWindowValue, setWindowValue)
 import PureTabs.Model.Group (GroupId)
 
 
-newtype SavedGroupMapping
-  = SavedGroupMapping { windowId :: WindowId
-                      , groupId :: GroupId
-                      , name :: String
-                      }
-
-savedGroupMapping :: WindowId -> GroupId -> String -> SavedGroupMapping
-savedGroupMapping winId gid name = SavedGroupMapping { windowId: winId, groupId: gid, name: name }
-
-derive instance genGroupMapping :: Generic SavedGroupMapping _
-derive instance newtypeGroupMapping :: Newtype SavedGroupMapping _
-
-instance showGroupMapping :: Show SavedGroupMapping where 
-  show = genericShow
-
-instance encodeGroupMapping :: Encode SavedGroupMapping where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeGroupMapping :: Decode SavedGroupMapping where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
-
-newtype SavedGroups = SavedGroups (Array SavedGroupMapping)
-
-derive instance genSavedGroups :: Generic SavedGroups _
-derive instance newtypeSavedGroups :: Newtype SavedGroups _
-
 newtype GroupData 
   = GroupData { groupId :: GroupId
               , name :: String
@@ -69,68 +37,44 @@ instance decodeGroupData :: Decode GroupData where
 groupData :: GroupId -> String -> GroupData
 groupData gid name = GroupData { groupId: gid, name: name }
 
-type GroupMapping = M.Map WindowId (Array GroupData)
+newtype SavedGroups = SavedGroups (Array GroupData)
 
-loadMap :: Array (SavedGroupMapping) -> GroupMapping
-loadMap = M.fromFoldableWith ((<>)) 
-  <<< map (unwrap >>> \r -> Tuple r.windowId (A.singleton (groupData r.groupId r.name)))
-
-saveMap :: GroupMapping -> SavedGroups
-saveMap = 
-  M.toUnfoldable
-  >>> map (\(Tuple winId groups) -> groups <#> \(GroupData g) -> savedGroupMapping winId g.groupId g.name)
-  >>> join
-  >>> SavedGroups
+derive instance genSavedGroups :: Generic SavedGroups _
+derive instance newtypeSavedGroups :: Newtype SavedGroups _
 
-retrieveGroups :: Aff (Array SavedGroupMapping)
-retrieveGroups = do 
-  (groups :: (Maybe SavedGroups)) <- storageLocalGet "groups"
+retrieveGroups :: WindowId -> Aff (Array GroupData)
+retrieveGroups winId = do 
+  (groups :: (Maybe SavedGroups)) <- getWindowValue winId "groups"
   case groups of
        Just (SavedGroups groups') -> pure groups'
-       Nothing -> pure [] <* error "couldn't get key `groups` from local storage"
-
-retrieveGroups' :: Aff GroupMapping
-retrieveGroups' = retrieveGroups <#> loadMap
+       Nothing -> pure [] <* error ("couldn't get key `groups` for window " <> (show winId))
 
-retrieveGroupsAt :: WindowId -> Aff (Array GroupData)
-retrieveGroupsAt winId = retrieveGroups' <#> (fromMaybe [] <<< M.lookup winId)
+type GroupsUpdate = (Array GroupData) -> (Array GroupData)
 
-type GroupsUpdate = GroupMapping -> GroupMapping
-
-updateGroupsMapping :: GroupsUpdate -> Aff Unit
-updateGroupsMapping updateGroups = do
-  groups <- retrieveGroups'
-  _ <- liftEffect $ (log "[bg] old groups:") *> (unsafeLog $ saveMap groups)
+updateGroupsMapping :: WindowId -> GroupsUpdate -> Aff Unit
+updateGroupsMapping winId updateGroups = do
+  groups <- retrieveGroups winId
   let updatedGroups = updateGroups groups
-  _ <- liftEffect $ (log "[bg] new groups:") *> (unsafeLog $ saveMap updatedGroups)
-  storageLocalSet "groups" $ saveMap updatedGroups
-
+  setWindowValue winId "groups" updatedGroups
 
-updateMappingAt :: WindowId -> (Array GroupData -> Array GroupData) -> GroupsUpdate
-updateMappingAt winId update = M.update (update >>> Just) winId
 
-createGroup :: WindowId -> GroupId -> String -> GroupsUpdate
-createGroup winId gid name = insertIfNotExist >>> createGroup'
-  where
-        insertIfNotExist mapping = if M.member winId mapping then mapping else M.insert winId [] mapping
-        createGroup' = updateMappingAt winId $ 
-                         A.filter (unwrap >>> _.groupId >>> (/=) gid)
-                         >>> (flip A.snoc) (groupData gid name) 
+createGroup :: GroupId -> String -> GroupsUpdate
+createGroup gid name = 
+  A.filter (unwrap >>> _.groupId >>> (/=) gid)
+  >>> (flip A.snoc) (groupData gid name)
 
-renameGroup :: WindowId -> GroupId -> String -> GroupsUpdate
-renameGroup winId gid newName = 
-  updateMappingAt winId $ 
+renameGroup :: GroupId -> String -> GroupsUpdate
+renameGroup gid newName = 
     map $ case _ of 
                GroupData { groupId: gid' } | gid == gid' -> groupData gid newName
                other -> other
 
-moveGroup :: WindowId -> GroupId -> Int -> GroupsUpdate
-moveGroup winId gid to =
-  updateMappingAt winId $ \arr ->
+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 :: WindowId -> GroupId -> GroupsUpdate
-deleteGroup winId gid = updateMappingAt winId $ A.filter (unwrap >>>_.groupId >>> (/=) gid)
+deleteGroup :: GroupId -> GroupsUpdate
+deleteGroup gid = A.filter (unwrap >>>_.groupId >>> (/=) gid)