feat: highlight current tab

extension/sidebar.css

@@ -14,13 +14,22 @@ html, body {
   border: solid #cfcfcf 1px;
   margin-bottom: 1px;
   padding-left: 2px;
+  padding-bottom: 2px;
   width: 100%;
 }
 
+.tab.active {
+  background-color: #d4f2fc;
+}
+
 .tab:hover {
   background-color: #cccccc;
 }
 
+.tab.active:hover {
+  background-color: #b2dceb;
+}
+
 .tab-title {
   display: inline-block;
   align-self: center;

src/Background.purs

@@ -1,18 +1,23 @@
 module PureTabs.Background where
 
 import Browser.Runtime as Runtime
-import Browser.Tabs (Tab, TabId, WindowId, query, removeOne)
+import Browser.Tabs (Tab, TabId, WindowId, query, removeOne, activateTab)
+import Browser.Tabs.OnActivated as TabsOnActivated
 import Browser.Tabs.OnCreated as TabsOnCreated
 import Browser.Tabs.OnRemoved as TabsOnRemoved
 import Browser.Tabs.OnUpdated (ChangeInfo(..))
 import Browser.Tabs.OnUpdated as TabsOnUpdated
 import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
+import Control.Alt ((<$>))
 import Control.Alternative (pure, (*>))
+import Control.Bind ((>>=))
+import Control.Category (identity, (>>>))
 import Data.Array (fromFoldable)
 import Data.Foldable (for_)
 import Data.Function (flip)
 import Data.Lens (_Just, over, preview, set)
 import Data.Lens.At (at)
+import Data.Lens.Iso.Newtype (_Newtype)
 import Data.List (List, foldr, foldMap)
 import Data.Map (empty, lookup, values)
 import Data.Maybe (Maybe(..), maybe)
@@ -27,7 +32,7 @@ import Effect.Class (liftEffect)
 import Effect.Console (log)
 import Effect.Ref as Ref
 import Prelude (Unit, bind, ($), discard, (<<<))
-import PureTabs.Model (BackgroundEvent(..), GlobalState, SidebarEvent(..), _port, _portFromWindow, _tabFromTabIdAndWindow, _tabFromWindow, _windows, tabsToGlobalState)
+import PureTabs.Model (BackgroundEvent(..), GlobalState, SidebarEvent(..), _active, _port, _portFromWindow, _portFromWindowId, _tabFromTabIdAndWindow, _tabFromWindow, _windows, tabsToGlobalState)
 
 type Ports
   = Ref.Ref (List Runtime.Port)
@@ -48,13 +53,11 @@ main = do
 
 initializeBackground :: Ref.Ref GlobalState -> Effect Unit
 initializeBackground ref = do
-  _ <- TabsOnCreated.addListener $ onTabCreated ref
-  tabDeletedListener <- mkListenerTwo $ onTabDeleted ref
-  _ <- TabsOnRemoved.addListener tabDeletedListener
-  _ <- TabsOnUpdated.addListener $ onTabUpdated ref
-  onConnectedListener <- mkListenerOne $ onConnect ref
-  Runtime.onConnectAddListener onConnectedListener
-  pure unit
+  TabsOnCreated.addListener $ onTabCreated ref
+  (mkListenerTwo $ onTabDeleted ref) >>= TabsOnRemoved.addListener 
+  TabsOnActivated.addListener $ onTabActived ref
+  TabsOnUpdated.addListener $ onTabUpdated ref
+  (mkListenerOne $ onConnect ref) >>= Runtime.onConnectAddListener
 
 onTabCreated :: (Ref.Ref GlobalState) -> Tab -> Effect Unit
 onTabCreated stateRef tab' = do
@@ -75,6 +78,33 @@ onTabUpdated stateRef tid cinfo tab' = do
     Nothing -> pure unit
     Just port -> Runtime.postMessageJson port $ BgTabUpdated tid cinfo tab'
 
+onTabActived :: (Ref.Ref GlobalState) -> TabsOnActivated.ActiveInfo -> Effect Unit
+onTabActived stateRef (TabsOnActivated.ActiveInfo aInfo) = do
+  traceM aInfo
+  state <- Ref.modify (updateGlobalState aInfo.previousTabId aInfo.tabId) stateRef
+  case (preview (_portFromWindowId aInfo.windowId) state) of
+    Nothing -> pure unit
+    Just port -> Runtime.postMessageJson port $ BgTabActived aInfo.previousTabId aInfo.tabId
+  where
+  updateGlobalState :: (Maybe TabId) -> TabId -> GlobalState -> GlobalState
+  updateGlobalState prev new state =
+    let
+      -- TODO: we have the windowId, we can directly get the tab from that
+      -- without using _tabFromTabIdAndWindow that goes through all the windows.
+      prevTab = prev >>= _tabFromTabIdAndWindow state
+
+      prevTabF :: GlobalState -> GlobalState
+      prevTabF = maybe identity (\t -> set (_activeTab t) false) prevTab
+
+      newTab = _tabFromTabIdAndWindow state new
+
+      newTabF :: GlobalState -> GlobalState
+      newTabF = maybe identity (\t -> set (_activeTab t) true) newTab
+
+      _activeTab t = (_tabFromWindow t) <<< _Just <<< _Newtype <<< _active
+    in
+      (prevTabF >>> newTabF) state
+
 onTabDeleted :: (Ref.Ref GlobalState) -> TabId -> TabsOnRemoved.RemoveInfo -> Effect Unit
 onTabDeleted stateRef tabId info = do
   state <- Ref.read stateRef
@@ -144,6 +174,9 @@ initWindowState port ref winId =
 -- the data required
 manageSidebar :: (Ref.Ref GlobalState) -> Runtime.Port -> SidebarEvent -> Effect Unit
 manageSidebar stateRef port (SbTabDeleted tabId) = launchAff_ $ removeOne tabId
+
+manageSidebar stateRef port (SbTabActived tabId) = launchAff_ $ activateTab tabId
+
 manageSidebar stateRef port msg = pure unit
 
 onDisconnect :: forall a. (Ref.Ref GlobalState) -> WindowId -> Listener a -> Effect Unit

src/Browser/Tabs.js

@@ -10,3 +10,13 @@ exports["remove'"] = function (tabs) {
     return browser.tabs.remove(tabs);
   };
 };
+
+exports["update'"] = function () {
+  return function (updateProperties) {
+    return function (tabId) {
+      return function () {
+        return browser.tabs.update(tabId, updateProperties);
+      };
+    }
+  };
+};

src/Browser/Tabs.purs

@@ -1,4 +1,4 @@
-module Browser.Tabs (WindowId, TabId(..), Tab(..), query, remove, removeOne) where
+module Browser.Tabs (WindowId, TabId(..), Tab(..), query, remove, removeOne, update, activateTab) where
 
 import Browser.Utils (unwrapForeign)
 import Control.Alt (map)
@@ -16,7 +16,7 @@ import Data.Number.Format (toString)
 import Data.Ord (class Ord)
 import Data.Show (class Show)
 import Data.Traversable (traverse)
-import Data.Unit (Unit, unit)
+import Data.Unit (Unit)
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
@@ -24,6 +24,7 @@ import Foreign (Foreign)
 import Foreign.Class (class Decode, class Encode)
 import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
 import Prelude (bind, pure)
+import Prim.Row (class Union)
 
 newtype WindowId
   = WindowId Number
@@ -61,7 +62,9 @@ instance encodeTabId :: Encode TabId where
 instance decodeTabId :: Decode TabId where
   decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
-newtype Tab = Tab { active :: Boolean
+newtype Tab
+  = Tab
+  { active :: Boolean
   , attention :: Maybe Boolean
   , audible :: Maybe Boolean
   , autoDiscardable :: Maybe Boolean
@@ -71,8 +74,8 @@ newtype Tab = Tab { active :: Boolean
   , height :: Maybe Number
   , hidden :: Boolean
   , highlighted :: Boolean
-  , -- should be optional
-    id :: TabId
+  -- should be optional
+  , id :: TabId
   , incognito :: Boolean
   , index :: Number
   , isArticle :: Maybe Boolean
@@ -82,7 +85,7 @@ newtype Tab = Tab { active :: Boolean
   , pinned :: Boolean
   , sessionId :: Maybe String
   , status :: Maybe String
-   -- create an enum for that successorTabId :: Maybe Number
+  -- create an enum for that successorTabId :: Maybe Number
   , title :: String
   , url :: Maybe String
   , width :: Maybe Number
@@ -102,28 +105,47 @@ instance encodeTab :: Encode Tab where
 instance decodeTab :: Decode Tab where
   decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
-
 foreign import queryImpl :: Effect (Promise (Array Foreign))
 
 query :: Aff (List Tab)
-query = do 
+query = do
   tabsArray <- toAffE queryImpl
-  let tabsList = fromFoldable tabsArray
+  let
+    tabsList = fromFoldable tabsArray
   parsed <- liftEffect $ traverse unwrapForeign tabsList
   pure parsed
 
-
 foreign import remove' :: (Array Number) -> Effect (Promise Unit)
 
 remove :: (List TabId) -> Aff Unit
-remove tabs = 
-  let tabIdsArray = toUnfoldable $ map unwrap tabs
-   in
-  toAffE $ remove' tabIdsArray
-
+remove tabs =
+  let
+    tabIdsArray = toUnfoldable $ map unwrap tabs
+  in
+    toAffE $ remove' tabIdsArray
   where
-        unwrap (TabId n) = n
+  unwrap (TabId n) = n
 
 removeOne :: TabId -> Aff Unit
 removeOne tabId = remove (singleton tabId)
 
+type RowUpdateProperties
+  = ( active :: Boolean
+    , autoDiscardable :: Boolean
+    , highlighted :: Boolean
+    , loadReplace :: Boolean
+    , muted :: Boolean
+    , openerTabId :: TabId
+    , pinned :: Boolean
+    , successorTabId :: TabId
+    , url :: String
+    )
+
+foreign import update' :: forall given trash. Union given trash RowUpdateProperties => { | given } -> TabId -> Effect (Promise Tab)
+
+update :: forall prop b. Union prop b RowUpdateProperties => { | prop } -> TabId -> Aff Tab
+update props tabId = toAffE $ update' props tabId
+
+
+activateTab :: TabId -> Aff Tab
+activateTab tabId = update { active: true } tabId

src/Browser/Tabs/OnActivated.js

@@ -0,0 +1,13 @@
+"use strict";
+
+exports["addListener'"] = function (listener) {
+  return function() {
+    return browser.tabs.onActivated.addListener(listener);
+  };
+};
+
+exports["removeListener"] = function (listener) {
+  return function() {
+    return browser.tabs.onActivated.removeListener(listener);
+  };
+};

src/Browser/Tabs/OnActivated.purs

@@ -0,0 +1,46 @@
+module Browser.Tabs.OnActivated (addListener, removeListener, ActiveInfo(..)) where
+
+import Browser.Tabs (TabId, WindowId)
+import Browser.Utils (Listener, UnregisteredListener, unwrapForeign, mkListenerOne)
+import Control.Bind ((>=>))
+import Data.Function (($))
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Maybe (Maybe)
+import Data.Newtype (class Newtype)
+import Data.Show (class Show)
+import Data.Unit (Unit)
+import Effect (Effect)
+import Foreign (Foreign)
+import Foreign.Class (class Decode, class Encode)
+import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
+import Prelude (bind)
+
+newtype ActiveInfo
+  = ActiveInfo
+  { previousTabId :: Maybe TabId
+  , tabId :: TabId
+  , windowId :: WindowId
+  }
+
+derive instance newtypeActiveInfo :: Newtype ActiveInfo _
+
+derive instance genActiveInfo :: Generic ActiveInfo _
+
+instance showActiveInfo :: Show ActiveInfo where
+  show = genericShow
+
+instance encodeActiveInfo :: Encode ActiveInfo where
+  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
+
+instance decodeActiveInfo :: Decode ActiveInfo where
+  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
+
+foreign import addListener' :: (Listener Foreign) -> Effect Unit
+
+addListener :: (UnregisteredListener ActiveInfo) -> Effect Unit
+addListener listener = do
+  lst <- mkListenerOne $ unwrapForeign >=> listener
+  addListener' lst
+
+foreign import removeListener :: (Listener ActiveInfo) -> Effect Unit

src/Model.purs

@@ -1,10 +1,13 @@
 module PureTabs.Model
   ( Window
   , GlobalState
+  , _id
+  , _active
   , _tabs
   , _port
   , _windows
   , _portFromWindow
+  , _portFromWindowId
   , _tabFromWindow
   , _tabWindowId
   , _tabId
@@ -19,6 +22,7 @@ import Browser.Runtime (Port)
 import Browser.Tabs (TabId, WindowId, Tab)
 import Browser.Tabs.OnUpdated (ChangeInfo(..))
 import Control.Alt (map)
+import Control.Bind (join)
 import Data.Function (($))
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
@@ -26,7 +30,7 @@ import Data.Lens (Lens', Traversal', _Just, view)
 import Data.Lens.At (at)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
-import Data.List (List, catMaybes)
+import Data.List (List, catMaybes, head)
 import Data.Map (Map, empty, fromFoldableWith, lookup, singleton, union, values)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
@@ -62,6 +66,9 @@ _tabTitle = _Newtype <<< _title
 _id :: forall a r. Lens' { id :: a | r } a
 _id = prop (SProxy ::_ "id")
 
+_active :: forall a r. Lens' { active :: a | r } a
+_active = prop (SProxy ::_ "active")
+
 _tabId :: Lens' Tab TabId
 _tabId = _Newtype <<< _id
 
@@ -72,16 +79,19 @@ _tabWindowId :: Lens' Tab WindowId
 _tabWindowId = _Newtype <<< _windowId
 
 _portFromWindow :: Tab -> Traversal' GlobalState Port
-_portFromWindow tab' = _windows <<< (at tab.windowId) <<< _Just <<< _port <<< _Just
+_portFromWindow tab' = _portFromWindowId tab.windowId
   where
   tab = unwrap tab'
 
+_portFromWindowId :: WindowId -> Traversal' GlobalState Port
+_portFromWindowId wid = _windows <<< (at wid) <<< _Just <<< _port <<< _Just
+
 _tabFromWindow :: Tab -> Traversal' GlobalState (Maybe Tab)
 _tabFromWindow tab' = _windows <<< (at tab.windowId) <<< _Just <<< _tabs <<< (at tab.id)
   where
   tab = unwrap tab'
 
-_tabFromTabIdAndWindow :: GlobalState -> TabId -> List Tab
+_tabFromTabIdAndWindow :: GlobalState -> TabId -> Maybe Tab
 _tabFromTabIdAndWindow s tabId =
   let
     allWindows = values s.windows
@@ -90,7 +100,7 @@ _tabFromTabIdAndWindow s tabId =
 
     matchingTabId = map (lookup tabId) allTabs
   in
-    catMaybes matchingTabId
+    join $ head matchingTabId
 
 initialGlobalState :: GlobalState
 initialGlobalState =
@@ -118,7 +128,7 @@ data BackgroundEvent
   | BgTabDeleted TabId
   | BgTabUpdated TabId ChangeInfo Tab
   | BgTabMoved
-  | BgTabActived TabId
+  | BgTabActived (Maybe TabId) TabId
   | BgTabAttached Tab
   | BgTabDetached TabId
   | BgTabHighlighted
@@ -132,6 +142,7 @@ instance showBackgroundEvent :: Show BackgroundEvent where
 
 data SidebarEvent
   = SbTabDeleted TabId
+  | SbTabActived TabId
   | SbTabCreated
   | SbTabMoved
   | SbTabDetached

src/Sidebar.purs

@@ -1,11 +1,11 @@
 module PureTabs.Sidebar where
 
 import Browser.Runtime as Runtime
-import Browser.Tabs (Tab, TabId, WindowId)
+import Browser.Tabs (Tab(..), TabId, WindowId)
 import Browser.Tabs.OnUpdated (ChangeInfo(..))
 import Browser.Windows (getCurrent)
-import Control.Alternative (pure, (*>))
-import Control.Bind ((>=>))
+import Control.Alternative (pure)
+import Control.Bind ((>=>), (>>=))
 import Data.Foldable (traverse_)
 import Data.Function (flip)
 import Data.Lens (view)
@@ -51,6 +51,7 @@ initSidebar port winId = do
     BgTabDeleted tabId -> deleteTabElement tabId
     BgInitialTabList tabs -> traverse_ (createTabElement port >=> (flip J.append) contentDiv) tabs
     BgTabUpdated tid cinfo tab -> updateTabInfo tid cinfo tab
+    BgTabActived prev new -> activateTab prev new
     _ -> log "received unsupported message type"
 
 createTabElement :: Runtime.Port -> Tab -> Effect J.JQuery
@@ -60,6 +61,8 @@ createTabElement port tab' = do
   tabDiv <- J.create "<div>"
   J.setAttr "class" "tab" tabDiv
   J.setAttr "id" tab.id tabDiv
+  J.on "click" onTabClick tabDiv
+  if tab.active then (J.addClass "active" tabDiv) else (pure unit)
   -- favicon
   faviconDiv <- J.create "<div>"
   J.addClass "tab-favicon" faviconDiv
@@ -79,6 +82,9 @@ createTabElement port tab' = do
   onCloseClick :: J.JQueryEvent -> J.JQuery -> Effect Unit
   onCloseClick event j = Runtime.postMessageJson port $ SbTabDeleted $ view _tabId tab'
 
+  onTabClick :: J.JQueryEvent -> J.JQuery -> Effect Unit
+  onTabClick event j = Runtime.postMessageJson port $ SbTabActived $ view _tabId tab'
+
 createCloseButton :: Effect J.JQuery
 createCloseButton = do
   parent <- J.create "<div>"
@@ -104,11 +110,7 @@ deleteTabElement tabId = do
   J.remove div
 
 updateTabInfo :: TabId -> ChangeInfo -> Tab -> Effect Unit
-updateTabInfo tid cinfo' tab' = do
-  let
-    tab = unwrap tab'
-
-    cinfo = unwrap cinfo'
+updateTabInfo tid (ChangeInfo cinfo) (Tab tab) = do
   tabTitleDiv <- J.select ("#" <> (show tid) <> " > .tab-title")
   let
     newTitle = case cinfo.status of
@@ -117,3 +119,9 @@ updateTabInfo tid cinfo' tab' = do
   maybe (pure unit) (\t -> J.setText t tabTitleDiv) newTitle
   tabFaviconDiv <- J.select ("#" <> (show tid) <> " > .tab-favicon")
   setFaviconUrl cinfo.favIconUrl tabFaviconDiv
+
+activateTab :: (Maybe TabId) -> TabId -> Effect Unit
+activateTab prev new = do
+  maybe (pure unit) (\p -> (J.select ("#" <> (show p))) >>= J.setClass "active" false) prev
+  newTab <- J.select ("#" <> (show new))
+  J.setClass "active" true newTab