Procházet zdrojové kódy

feat: save groups per window instead of globally

Jocelyn Boullier před 4 roky
rodič
revize
c089bcc8b0

+ 22 - 50
src/Background.purs

@@ -16,16 +16,17 @@ 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 (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(..), fromMaybe)
+import Data.Maybe (Maybe(..))
 import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
 import Data.Set as Set
@@ -33,17 +34,18 @@ import Data.Show (show)
 import Data.Traversable (sequence)
 import Data.Unit (unit)
 import Effect (Effect)
-import Effect.Aff (Aff, launchAff_)
+import Effect.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, 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.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
   = Ref.Ref (List Runtime.Port)
@@ -55,11 +57,16 @@ main :: Effect Unit
 main = do
   log "starting background"
   launchAff_ do
+     allTabs <- BT.browserQuery {}
      groups <- retrieveGroups
      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
-     allTabs <- BT.browserQuery {}
      liftEffect $ initializeBackground =<< (Ref.new $ GS.initialTabsToGlobalState allTabs)
 
 initializeBackground :: Ref.Ref GS.GlobalState -> Effect Unit
@@ -181,7 +188,7 @@ onNewWindowId port stateRef listenerRef winId = do
     in
       launchAff_ do
          tabsWithGroup <- sequence tabsWithGid
-         groups <- retrieveGroups
+         groups <- retrieveGroupsAt winId
          liftEffect $ Runtime.postMessageJson port $ BgInitialTabList groups tabsWithGroup
     
 
@@ -191,41 +198,6 @@ onNewWindowId port stateRef listenerRef winId = do
   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
 
@@ -257,14 +229,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 gid
+     updateGroupsMapping $ deleteGroup winId 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
+  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
   SbHasWindowId winId' -> pure unit

+ 2 - 6
src/Browser/Storage.js

@@ -1,12 +1,8 @@
 "use strict";
 
-exports["storageLocalGetImpl"] = function(key, Just, Nothing) {
+exports["storageLocalGetImpl"] = function(key) {
   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 Browser.Utils (unsafeLog)
+import Control.Monad.Error.Class (try)
+import Control.Monad.Except (runExcept)
 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
   :: forall r. EffectFn2 String r (Promise Unit)

+ 1 - 1
src/Browser/Tabs.purs

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

+ 22 - 3
src/Browser/Utils.purs

@@ -12,20 +12,26 @@ module Browser.Utils
   , unwrapForeign
   , unsafeLog
   , unsafeLog'
+  , eqBy
+  , sortByKeyIndex
   ) where
 
 import Control.Alt (map)
 import Control.Alternative (pure)
 import Control.Monad.Except (runExcept)
-import Data.Array (intercalate)
+import Data.Array as A
 import Data.Either (Either(..))
+import Data.Eq (class Eq, (==))
+import Data.Foldable (fold)
 import Data.Function (($))
 import Data.Generic.Rep (class Generic)
+import Data.Ord (class Ord)
+import Data.Tuple as T
 import Effect (Effect)
 import Effect.Exception (throw)
 import Foreign (Foreign, renderForeignError)
 import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
-import Prelude (Unit)
+import Prelude (Unit, comparing, (>>>))
 
 type UnregisteredListener a
   = (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 d = case runExcept
     $ 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
 
 foreign import unsafeLog' :: forall a. a
 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.Exception.Unsafe (unsafeThrow)
 import Prelude ((#))
-import PureTabs.Model.Events (BackgroundEvent)
+import PureTabs.Model.BackgroundEvent (BackgroundEvent)
 
 type GlobalState
   = { 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
 
 import Browser.Tabs (Tab(..), TabId)
-import Browser.Utils (unsafeLog)
+import Browser.Utils (eqBy, sortByKeyIndex)
 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 (class Eq, (/=))
-import Data.Foldable (fold, foldr)
+import Data.Eq ((/=))
 import Data.Function (($))
 import Data.Map as M
 import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', maybe)
 import Data.MediaType.Common (textPlain)
-import Data.Monoid (class Monoid, mempty)
 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.NonEmpty (cons, max) as NES
 import Data.Symbol (SProxy(..))
@@ -26,15 +21,17 @@ 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, liftEffect)
+import Effect.Class (class MonadEffect)
 import Effect.Console (log)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Prelude (flip, pure, show, (#), (&&), (+), (-), (<$>), (<<<), (<>), (==), (>), (>>>))
-import PureTabs.Model.Events (GroupMapping(..), SidebarEvent(..), TabWithGroup(..))
 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.TopMenu as TopMenu
 import PureTabs.Sidebar.Tabs (Output(..))
@@ -72,7 +69,7 @@ data Action
 
 data Query a
   = TabsQuery (Tabs.Query a)
-  | InitialTabsWithGroup (Array GroupMapping) (Array TabWithGroup) a
+  | InitialTabsWithGroup (Array GroupData) (Array TabWithGroup) a
   | GroupDeleted GroupId (Maybe TabId) a
 
 initialGroup :: M.Map GroupId Group
@@ -291,7 +288,7 @@ handleQuery = case _ of
                     newGroups' -> 
                       M.fromFoldable $ 
                         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'
 
              existingGroups = M.keys newGroups
@@ -485,16 +482,3 @@ createGroup mGid s =
 insertGroup :: GroupId -> Group -> State -> State
 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 Prelude (negate, sub)
 import PureTabs.Browser.Dom.Element (scrollIntoView)
-import PureTabs.Model.Events (SidebarEvent(..))
+import PureTabs.Model.SidebarEvent (SidebarEvent(..))
 import Sidebar.Utils (moveElem)
 import Web.Event.Event (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.VDom.Driver (runUI)
 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.Tabs as Tabs
 import Web.DOM.ParentNode (QuerySelector(..))