Bladeren bron

feat: save groups per window instead of globally

Jocelyn Boullier 4 jaren geleden
bovenliggende
commit
c089bcc8b0

+ 22 - 50
src/Background.purs

@@ -16,16 +16,17 @@ import Browser.Windows.OnCreated as WinOnCreated
 import Browser.Windows.OnRemoved as WinOnRemoved
 import Browser.Windows.OnRemoved as WinOnRemoved
 import Control.Alt ((<#>))
 import Control.Alt ((<#>))
 import Control.Alternative ((*>))
 import Control.Alternative ((*>))
-import Control.Bind (map, (<*), (=<<), (>>=))
+import Control.Bind (map, (=<<), (>>=))
 import Control.Category ((>>>))
 import Control.Category ((>>>))
 import Data.Array as A
 import Data.Array as A
 import Data.CommutativeRing ((+))
 import Data.CommutativeRing ((+))
+import Data.Foldable (sequence_)
 import Data.Function (flip, (#))
 import Data.Function (flip, (#))
 import Data.Lens (_Just, set, view)
 import Data.Lens (_Just, set, view)
 import Data.Lens.At (at)
 import Data.Lens.At (at)
 import Data.List (List, foldMap)
 import Data.List (List, foldMap)
 import Data.Map as M
 import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Maybe (Maybe(..))
 import Data.Monoid ((<>))
 import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
 import Data.Newtype (unwrap)
 import Data.Set as Set
 import Data.Set as Set
@@ -33,17 +34,18 @@ import Data.Show (show)
 import Data.Traversable (sequence)
 import Data.Traversable (sequence)
 import Data.Unit (unit)
 import Data.Unit (unit)
 import Effect (Effect)
 import Effect (Effect)
-import Effect.Aff (Aff, launchAff_)
+import Effect.Aff (launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Class (liftEffect)
-import Effect.Class.Console (error)
 import Effect.Console (log)
 import Effect.Console (log)
 import Effect.Ref as Ref
 import Effect.Ref as Ref
-import Prelude (Unit, bind, discard, pure, ($), (<$>), (<<<), (==), (/=))
-import PureTabs.Browser.Sessions (getTabValue, removeTabValue, setTabValue)
-import PureTabs.Browser.Storage (storageLocalGet, storageLocalSet)
-import PureTabs.Model.Events (BackgroundEvent(..), GroupMapping(..), SidebarEvent(..), TabWithGroup(..), groupMapping)
+import Prelude (Unit, bind, discard, pure, ($), (<$>), (<<<))
+import PureTabs.Browser.Sessions (getTabValue, getWindowValue, removeTabValue, setTabValue, setWindowValue)
+import PureTabs.Model.BackgroundEvent (BackgroundEvent(..))
 import PureTabs.Model.GlobalState as GS
 import PureTabs.Model.GlobalState as GS
 import PureTabs.Model.Group (GroupId(..))
 import PureTabs.Model.Group (GroupId(..))
+import PureTabs.Model.GroupMapping (createGroup, deleteGroup, moveGroup, renameGroup, retrieveGroups, retrieveGroupsAt, updateGroupsMapping)
+import PureTabs.Model.SidebarEvent (SidebarEvent(..))
+import PureTabs.Model.TabWithGroup (TabWithGroup(..))
 
 
 type Ports
 type Ports
   = Ref.Ref (List Runtime.Port)
   = Ref.Ref (List Runtime.Port)
@@ -55,11 +57,16 @@ main :: Effect Unit
 main = do
 main = do
   log "starting background"
   log "starting background"
   launchAff_ do
   launchAff_ do
+     allTabs <- BT.browserQuery {}
      groups <- retrieveGroups
      groups <- retrieveGroups
      case groups of
      case groups of
-          [] -> updateGroupsMapping $ createGroup (GroupId 0) "main"
+          [] -> sequence_ $ allTabs # 
+                  map (\(Tab t) -> t.windowId)
+                  >>> Set.fromFoldable
+                  >>> A.fromFoldable
+                  >>> map (\winId -> updateGroupsMapping $ createGroup winId (GroupId 0) "main")
+
           _ -> pure unit
           _ -> pure unit
-     allTabs <- BT.browserQuery {}
      liftEffect $ initializeBackground =<< (Ref.new $ GS.initialTabsToGlobalState allTabs)
      liftEffect $ initializeBackground =<< (Ref.new $ GS.initialTabsToGlobalState allTabs)
 
 
 initializeBackground :: Ref.Ref GS.GlobalState -> Effect Unit
 initializeBackground :: Ref.Ref GS.GlobalState -> Effect Unit
@@ -181,7 +188,7 @@ onNewWindowId port stateRef listenerRef winId = do
     in
     in
       launchAff_ do
       launchAff_ do
          tabsWithGroup <- sequence tabsWithGid
          tabsWithGroup <- sequence tabsWithGid
-         groups <- retrieveGroups
+         groups <- retrieveGroupsAt winId
          liftEffect $ Runtime.postMessageJson port $ BgInitialTabList groups tabsWithGroup
          liftEffect $ Runtime.postMessageJson port $ BgInitialTabList groups tabsWithGroup
     
     
 
 
@@ -191,41 +198,6 @@ onNewWindowId port stateRef listenerRef winId = do
   Runtime.portOnDisconnect port onDisconnectListener
   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 :: StateRef -> WindowId -> Runtime.Port -> SidebarEvent -> Effect Unit
 manageSidebar ref winId port = case _ of
 manageSidebar ref winId port = case _ of
 
 
@@ -257,14 +229,14 @@ manageSidebar ref winId port = case _ of
      activeTab <- BT.browserQuery { windowId: unwrap winId, active: true }
      activeTab <- BT.browserQuery { windowId: unwrap winId, active: true }
      let activeTabId = activeTab # A.head >>> (<$>) (unwrap >>> _.id)
      let activeTabId = activeTab # A.head >>> (<$>) (unwrap >>> _.id)
      liftEffect $ Runtime.postMessageJson port $ BgGroupDeleted gid activeTabId
      liftEffect $ Runtime.postMessageJson port $ BgGroupDeleted gid activeTabId
-     updateGroupsMapping $ deleteGroup gid
+     updateGroupsMapping $ deleteGroup winId gid
 
 
   SbChangeTabGroup tid Nothing -> launchAff_ $ removeTabValue tid "groupId"
   SbChangeTabGroup tid Nothing -> launchAff_ $ removeTabValue tid "groupId"
   SbChangeTabGroup tid (Just gid) -> launchAff_ $ setTabValue tid "groupId" gid
   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
+  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
 
 
   SbDetacheTab -> pure unit
   SbDetacheTab -> pure unit
   SbHasWindowId winId' -> pure unit
   SbHasWindowId winId' -> pure unit

+ 2 - 6
src/Browser/Storage.js

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

+ 29 - 7
src/Browser/Storage.purs

@@ -2,16 +2,38 @@ module PureTabs.Browser.Storage (storageLocalGet, storageLocalSet) where
 
 
 import Prelude
 import Prelude
 
 
+import Browser.Utils (unsafeLog)
+import Control.Monad.Error.Class (try)
+import Control.Monad.Except (runExcept)
 import Control.Promise (Promise, toAffE)
 import Control.Promise (Promise, toAffE)
-import Data.Maybe (Maybe(..))
-import Effect.Aff (Aff)
-import Effect.Uncurried (EffectFn2, EffectFn3, runEffectFn2, runEffectFn3)
+import Data.Either (Either(..), hush)
+import Data.Foldable (intercalate)
+import Data.Generic.Rep (class Generic)
+import Data.Maybe (Maybe)
+import Effect.Aff (Aff, throwError)
+import Effect.Aff.Compat (EffectFn1, runEffectFn1)
+import Effect.Class (liftEffect)
+import Effect.Class.Console (error) as Log
+import Effect.Class.Console (log)
+import Effect.Exception (error)
+import Effect.Uncurried (EffectFn2, runEffectFn2)
+import Foreign (Foreign, renderForeignError)
+import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
 
 
-foreign import storageLocalGetImpl
-  :: forall r. EffectFn3 String (r -> Maybe r) (Maybe r) (Promise r)
+foreign import storageLocalGetImpl :: EffectFn1 String  (Promise Foreign)
 
 
-storageLocalGet :: forall r. String -> Aff (Maybe r)
-storageLocalGet keys = toAffE $ runEffectFn3 storageLocalGetImpl keys Just Nothing
+storageLocalGet' :: forall r rep. Generic r rep => GenericDecode rep => String -> Aff r
+storageLocalGet' keys = do 
+  msg <- toAffE $ runEffectFn1 storageLocalGetImpl keys
+  case runExcept (genericDecode (defaultOptions { unwrapSingleConstructors = true}) msg :: _ r) of
+       Left err -> do 
+          Log.error $ "error while trying to parse message: " <> intercalate ", " (map renderForeignError err)
+          throwError $ error "couldn't decode msg"
+       Right resp -> pure resp
+
+-- TODO: differentiate between missing key and decoding error
+storageLocalGet :: forall r rep. Generic r rep => GenericDecode rep => String -> Aff (Maybe r)
+storageLocalGet key = hush <$> (try $ storageLocalGet' key)
 
 
 foreign import storageLocalSetImpl
 foreign import storageLocalSetImpl
   :: forall r. EffectFn2 String r (Promise Unit)
   :: forall r. EffectFn2 String r (Promise Unit)

+ 1 - 1
src/Browser/Tabs.purs

@@ -1,5 +1,5 @@
 module Browser.Tabs (
 module Browser.Tabs (
-  WindowId
+  WindowId(..)
   , TabId(..)
   , TabId(..)
   , Tab(..)
   , Tab(..)
   , MoveProperties
   , MoveProperties

+ 22 - 3
src/Browser/Utils.purs

@@ -12,20 +12,26 @@ module Browser.Utils
   , unwrapForeign
   , unwrapForeign
   , unsafeLog
   , unsafeLog
   , unsafeLog'
   , unsafeLog'
+  , eqBy
+  , sortByKeyIndex
   ) where
   ) where
 
 
 import Control.Alt (map)
 import Control.Alt (map)
 import Control.Alternative (pure)
 import Control.Alternative (pure)
 import Control.Monad.Except (runExcept)
 import Control.Monad.Except (runExcept)
-import Data.Array (intercalate)
+import Data.Array as A
 import Data.Either (Either(..))
 import Data.Either (Either(..))
+import Data.Eq (class Eq, (==))
+import Data.Foldable (fold)
 import Data.Function (($))
 import Data.Function (($))
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep (class Generic)
+import Data.Ord (class Ord)
+import Data.Tuple as T
 import Effect (Effect)
 import Effect (Effect)
 import Effect.Exception (throw)
 import Effect.Exception (throw)
 import Foreign (Foreign, renderForeignError)
 import Foreign (Foreign, renderForeignError)
 import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
 import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
-import Prelude (Unit)
+import Prelude (Unit, comparing, (>>>))
 
 
 type UnregisteredListener a
 type UnregisteredListener a
   = (a -> Effect Unit)
   = (a -> Effect Unit)
@@ -56,8 +62,21 @@ foreign import mkListenerThree :: forall a b c. (UnregisteredListener3 a b c) ->
 unwrapForeign :: forall a rep. Generic a rep => GenericDecode rep => Foreign -> Effect a
 unwrapForeign :: forall a rep. Generic a rep => GenericDecode rep => Foreign -> Effect a
 unwrapForeign d = case runExcept
 unwrapForeign d = case runExcept
     $ genericDecode (defaultOptions { unwrapSingleConstructors = true }) d of
     $ genericDecode (defaultOptions { unwrapSingleConstructors = true }) d of
-  Left err -> throw $ intercalate ", " (map renderForeignError err)
+  Left err -> throw $ A.intercalate ", " (map renderForeignError err)
   Right val -> pure val
   Right val -> pure val
 
 
 foreign import unsafeLog' :: forall a. a
 foreign import unsafeLog' :: forall a. a
 foreign import unsafeLog :: forall a. a -> Effect Unit
 foreign import unsafeLog :: forall a. a -> Effect Unit
+
+-- | Given a mapping function from a to b, where Eq is defined for b, return a
+-- | comparison function.
+eqBy :: forall a b. Eq b => (a -> b) -> (a -> a -> Boolean)
+eqBy f = \a b -> f a == f b
+
+-- | Given a mapping function from a to b where Ord is defined for b, sort the
+-- | array by the mapping function, tie-breaking using the index.
+sortByKeyIndex :: forall a b. Ord b => (a -> b) -> Array a -> Array a
+sortByKeyIndex cmp = A.mapWithIndex T.Tuple >>> A.sortBy compareKey >>> map T.snd
+  where compareGiven = comparing (T.snd >>> cmp)
+        compareIdx = comparing T.fst
+        compareKey = fold [compareGiven, compareIdx]

+ 29 - 0
src/Model/BackgroundEvent.purs

@@ -0,0 +1,29 @@
+module PureTabs.Model.BackgroundEvent where 
+
+import Browser.Tabs (Tab, TabId)
+import Browser.Tabs.OnUpdated (ChangeInfo)
+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 PureTabs.Model.GroupMapping (GroupData)
+import PureTabs.Model.TabWithGroup (TabWithGroup)
+
+
+data BackgroundEvent
+  = BgInitialTabList (Array GroupData) (Array TabWithGroup)
+  | BgTabCreated Tab
+  | BgTabDeleted TabId
+  | BgTabUpdated TabId ChangeInfo Tab
+  | BgTabMoved TabId Int Int
+  | BgTabActivated (Maybe TabId) TabId
+  | BgTabAttached Tab
+  | BgTabDetached TabId
+  | BgGroupDeleted GroupId (Maybe TabId)
+
+derive instance genBackgroundEvent :: Generic BackgroundEvent _
+
+instance showBackgroundEvent :: Show BackgroundEvent where
+  show = genericShow
+

+ 0 - 90
src/Model/Events.purs

@@ -1,90 +0,0 @@
-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)
-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
-
-
-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 GroupMapping) (Array TabWithGroup)
-  | BgTabCreated Tab
-  | BgTabDeleted TabId
-  | BgTabUpdated TabId ChangeInfo Tab
-  | BgTabMoved TabId Int Int
-  | BgTabActivated (Maybe TabId) TabId
-  | BgTabAttached Tab
-  | BgTabDetached TabId
-  | BgGroupDeleted GroupId (Maybe TabId)
-
-derive instance genBackgroundEvent :: Generic BackgroundEvent _
-
-instance showBackgroundEvent :: Show BackgroundEvent where
-  show = genericShow
-
-data SidebarEvent
-  = SbDeleteTab TabId
-  | SbActivateTab TabId
-  | SbCreateTab (Maybe TabId)
-  | SbMoveTab TabId Int
-  | SbDetacheTab
-  | SbHasWindowId WindowId
-  | 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 _
-
-instance showSidebarEvent :: Show SidebarEvent where
-  show = genericShow

+ 1 - 1
src/Model/GlobalState.purs

@@ -63,7 +63,7 @@ import Effect (Effect)
 import Effect.Console (error)
 import Effect.Console (error)
 import Effect.Exception.Unsafe (unsafeThrow)
 import Effect.Exception.Unsafe (unsafeThrow)
 import Prelude ((#))
 import Prelude ((#))
-import PureTabs.Model.Events (BackgroundEvent)
+import PureTabs.Model.BackgroundEvent (BackgroundEvent)
 
 
 type GlobalState
 type GlobalState
   = { windows :: M.Map WindowId ExtWindow
   = { windows :: M.Map WindowId ExtWindow

+ 136 - 0
src/Model/GroupMapping.purs

@@ -0,0 +1,136 @@
+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 Effect.Aff (Aff)
+import Effect.Class (liftEffect)
+import Effect.Class.Console (error, log)
+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 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
+              }
+
+derive instance genGroupData :: Generic GroupData _
+derive instance newtypeGroupData :: Newtype GroupData _
+
+instance showGroupData :: Show GroupData where 
+  show = genericShow
+
+instance encodeGroupData :: Encode GroupData where
+  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
+
+instance decodeGroupData :: Decode GroupData where
+  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
+
+groupData :: GroupId -> String -> GroupData
+groupData gid name = GroupData { groupId: gid, name: name }
+
+type GroupMapping = M.Map WindowId (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
+
+retrieveGroups :: Aff (Array SavedGroupMapping)
+retrieveGroups = do 
+  (groups :: (Maybe SavedGroups)) <- storageLocalGet "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
+
+retrieveGroupsAt :: WindowId -> Aff (Array GroupData)
+retrieveGroupsAt winId = retrieveGroups' <#> (fromMaybe [] <<< M.lookup winId)
+
+type GroupsUpdate = GroupMapping -> GroupMapping
+
+updateGroupsMapping :: GroupsUpdate -> Aff Unit
+updateGroupsMapping updateGroups = do
+  groups <- retrieveGroups'
+  _ <- liftEffect $ (log "[bg] old groups:") *> (unsafeLog $ saveMap groups)
+  let updatedGroups = updateGroups groups
+  _ <- liftEffect $ (log "[bg] new groups:") *> (unsafeLog $ saveMap updatedGroups)
+  storageLocalSet "groups" $ saveMap 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) 
+
+renameGroup :: WindowId -> GroupId -> String -> GroupsUpdate
+renameGroup winId gid newName = 
+  updateMappingAt winId $ 
+    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 ->
+    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)

+ 29 - 0
src/Model/SidebarEvent.purs

@@ -0,0 +1,29 @@
+module PureTabs.Model.SidebarEvent where 
+
+import Browser.Tabs (TabId, WindowId)
+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)
+
+
+
+data SidebarEvent
+  = SbDeleteTab TabId
+  | SbActivateTab TabId
+  | SbCreateTab (Maybe TabId)
+  | SbMoveTab TabId Int
+  | SbDetacheTab
+  | SbHasWindowId WindowId
+  | 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 _
+
+instance showSidebarEvent :: Show SidebarEvent where
+  show = genericShow

+ 24 - 0
src/Model/TabWithGroup.purs

@@ -0,0 +1,24 @@
+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)
+
+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

+ 8 - 20
src/Sidebar/Components/Bar.purs

@@ -1,23 +1,18 @@
 module PureTabs.Sidebar.Bar where
 module PureTabs.Sidebar.Bar where
 
 
 import Browser.Tabs (Tab(..), TabId)
 import Browser.Tabs (Tab(..), TabId)
-import Browser.Utils (unsafeLog)
+import Browser.Utils (eqBy, sortByKeyIndex)
 import Control.Bind (bind, discard, map, void, (<#>), (>>=))
 import Control.Bind (bind, discard, map, void, (<#>), (>>=))
 import Data.Array ((:))
 import Data.Array ((:))
 import Data.Array as A
 import Data.Array as A
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NonEmptyArray
 import Data.Array.NonEmpty as NonEmptyArray
-import Data.Eq (class Eq, (/=))
-import Data.Foldable (fold, foldr)
+import Data.Eq ((/=))
 import Data.Function (($))
 import Data.Function (($))
 import Data.Map as M
 import Data.Map as M
 import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', maybe)
 import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', maybe)
 import Data.MediaType.Common (textPlain)
 import Data.MediaType.Common (textPlain)
-import Data.Monoid (class Monoid, mempty)
 import Data.Number (fromString)
 import Data.Number (fromString)
-import Data.Ord (class Ord, compare, comparing)
-import Data.Ordering (Ordering)
-import Data.Ordering as Ordering
 import Data.Set (Set, member, toUnfoldable) as S
 import Data.Set (Set, member, toUnfoldable) as S
 import Data.Set.NonEmpty (cons, max) as NES
 import Data.Set.NonEmpty (cons, max) as NES
 import Data.Symbol (SProxy(..))
 import Data.Symbol (SProxy(..))
@@ -26,15 +21,17 @@ import Data.Tuple (Tuple(..))
 import Data.Tuple as T
 import Data.Tuple as T
 import Data.Unit (Unit, unit)
 import Data.Unit (Unit, unit)
 import Effect.Aff.Class (class MonadAff)
 import Effect.Aff.Class (class MonadAff)
-import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Class (class MonadEffect)
 import Effect.Console (log)
 import Effect.Console (log)
 import Halogen as H
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Halogen.HTML.Properties as HP
 import Prelude (flip, pure, show, (#), (&&), (+), (-), (<$>), (<<<), (<>), (==), (>), (>>>))
 import Prelude (flip, pure, show, (#), (&&), (+), (-), (<$>), (<<<), (<>), (==), (>), (>>>))
-import PureTabs.Model.Events (GroupMapping(..), SidebarEvent(..), TabWithGroup(..))
 import PureTabs.Model.Group (GroupId(..))
 import PureTabs.Model.Group (GroupId(..))
+import PureTabs.Model.GroupMapping (GroupData(..))
+import PureTabs.Model.SidebarEvent (SidebarEvent(..))
+import PureTabs.Model.TabWithGroup (TabWithGroup(..))
 import PureTabs.Sidebar.Component.GroupName as GroupName
 import PureTabs.Sidebar.Component.GroupName as GroupName
 import PureTabs.Sidebar.Component.TopMenu as TopMenu
 import PureTabs.Sidebar.Component.TopMenu as TopMenu
 import PureTabs.Sidebar.Tabs (Output(..))
 import PureTabs.Sidebar.Tabs (Output(..))
@@ -72,7 +69,7 @@ data Action
 
 
 data Query a
 data Query a
   = TabsQuery (Tabs.Query a)
   = TabsQuery (Tabs.Query a)
-  | InitialTabsWithGroup (Array GroupMapping) (Array TabWithGroup) a
+  | InitialTabsWithGroup (Array GroupData) (Array TabWithGroup) a
   | GroupDeleted GroupId (Maybe TabId) a
   | GroupDeleted GroupId (Maybe TabId) a
 
 
 initialGroup :: M.Map GroupId Group
 initialGroup :: M.Map GroupId Group
@@ -291,7 +288,7 @@ handleQuery = case _ of
                     newGroups' -> 
                     newGroups' -> 
                       M.fromFoldable $ 
                       M.fromFoldable $ 
                         A.mapWithIndex 
                         A.mapWithIndex 
-                        (\idx (GroupMapping g) -> Tuple g.groupId { name: g.name, pos: idx})
+                        (\idx (GroupData g) -> Tuple g.groupId { name: g.name, pos: idx})
                         newGroups'
                         newGroups'
 
 
              existingGroups = M.keys newGroups
              existingGroups = M.keys newGroups
@@ -485,16 +482,3 @@ createGroup mGid s =
 insertGroup :: GroupId -> Group -> State -> State
 insertGroup :: GroupId -> Group -> State -> State
 insertGroup gid group s = s { groups = M.insert gid group s.groups }
 insertGroup gid group s = s { groups = M.insert gid group s.groups }
 
 
-
-eqBy :: forall a b. Eq b => (a -> b) -> (a -> a -> Boolean)
-eqBy f = \a b -> f a == f b
-
-sortByKeyIndex :: forall a b. Ord b => (a -> b) -> Array a -> Array a
-sortByKeyIndex cmp = A.mapWithIndex Tuple >>> A.sortBy compareKey >>> map T.snd
-  where compareGiven = comparing (T.snd >>> cmp)
-        compareIdx = comparing T.fst
-        compareKey = fold [compareGiven, compareIdx]

+ 1 - 1
src/Sidebar/Components/Tabs.purs

@@ -33,7 +33,7 @@ import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Halogen.HTML.Properties as HP
 import Prelude (negate, sub)
 import Prelude (negate, sub)
 import PureTabs.Browser.Dom.Element (scrollIntoView)
 import PureTabs.Browser.Dom.Element (scrollIntoView)
-import PureTabs.Model.Events (SidebarEvent(..))
+import PureTabs.Model.SidebarEvent (SidebarEvent(..))
 import Sidebar.Utils (moveElem)
 import Sidebar.Utils (moveElem)
 import Web.Event.Event (Event)
 import Web.Event.Event (Event)
 import Web.Event.Event as Event
 import Web.Event.Event as Event

+ 2 - 1
src/Sidebar/Sidebar.purs

@@ -24,7 +24,8 @@ import Halogen as H
 import Halogen.Aff as HA
 import Halogen.Aff as HA
 import Halogen.VDom.Driver (runUI)
 import Halogen.VDom.Driver (runUI)
 import Prelude (bind, discard, (*), (-), (<>))
 import Prelude (bind, discard, (*), (-), (<>))
-import PureTabs.Model.Events (BackgroundEvent(..), SidebarEvent(..))
+import PureTabs.Model.BackgroundEvent (BackgroundEvent(..))
+import PureTabs.Model.SidebarEvent (SidebarEvent(..))
 import PureTabs.Sidebar.Bar as Bar
 import PureTabs.Sidebar.Bar as Bar
 import PureTabs.Sidebar.Tabs as Tabs
 import PureTabs.Sidebar.Tabs as Tabs
 import Web.DOM.ParentNode (QuerySelector(..))
 import Web.DOM.ParentNode (QuerySelector(..))