feat: support tab deletion from the sidebar

extension/panel.css

@@ -10,6 +10,7 @@ html, body {
 .tab {
   display: flex;
   align-items: center;
+  justify-content: flex-start;
   border: solid #cfcfcf 1px;
   margin-bottom: 1px;
   padding-left: 2px;
@@ -18,13 +19,16 @@ html, body {
 
 .tab-title {
   display: inline-block;
+  align-self: center;
   overflow: hidden;
   text-overflow: ellipsis;
   white-space: nowrap;
-  width: 90%;
+  width: 100%;
 }
 
 .tab-favicon {
+  /* necessary to avoid flicker when hovering the close button */
+  flex-shrink: 0;
   display: inline-block;
   background-size: cover;
   background-position: center;
@@ -34,3 +38,12 @@ html, body {
   margin-right: 5px;
   vertical-align: middle;
 }
+
+.close-button {
+  padding: 0 2px;
+  display: none;
+}
+
+.tab:hover > .close-button {
+  display: inline-block;
+}

src/Background.purs

@@ -1,11 +1,11 @@
 module PureTabs.Background where
 
 import Browser.Runtime as Runtime
-import Browser.Tabs (Tab, TabId, WindowId, query)
+import Browser.Tabs (Tab, TabId, WindowId, query, removeOne)
 import Browser.Tabs.OnCreated as TabsOnCreated
 import Browser.Tabs.OnRemoved as TabsOnRemoved
-import Browser.Tabs.OnUpdated as TabsOnUpdated
 import Browser.Tabs.OnUpdated (ChangeInfo(..))
+import Browser.Tabs.OnUpdated as TabsOnUpdated
 import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
 import Control.Alternative (pure, (*>))
 import Data.Array (fromFoldable)
@@ -27,7 +27,7 @@ import Effect.Class (liftEffect)
 import Effect.Console (log)
 import Effect.Ref as Ref
 import Prelude (Unit, bind, ($), discard, (<<<))
-import PureTabs.Model (_windows, _portFromWindow, _tabFromWindow, _port, _tabFromTabIdAndWindow, tabsToGlobalState, GlobalState, BackgroundEvent(..), SidebarEvent(..))
+import PureTabs.Model (BackgroundEvent(..), GlobalState, SidebarEvent(..), _port, _portFromWindow, _tabFromTabIdAndWindow, _tabFromWindow, _windows, tabsToGlobalState)
 
 type Ports
   = Ref.Ref (List Runtime.Port)
@@ -143,8 +143,8 @@ initWindowState port ref winId =
 -- TODO don't pass the full ref, but only a set of function to manipulate/access 
 -- the data required
 manageSidebar :: (Ref.Ref GlobalState) -> Runtime.Port -> SidebarEvent -> Effect Unit
-manageSidebar stateRef port msg = do
-  pure unit
+manageSidebar stateRef port (SbTabDeleted tabId) = launchAff_ $ removeOne tabId
+manageSidebar stateRef port msg = pure unit
 
 onDisconnect :: forall a. (Ref.Ref GlobalState) -> WindowId -> Listener a -> Effect Unit
 onDisconnect stateRef winId listener = Ref.modify_ (set (_windows <<< (at winId) <<< _Just <<< _port) Nothing) stateRef

src/Browser/Tabs.js

@@ -2,4 +2,11 @@
 
 exports.queryImpl = function () {
   return browser.tabs.query({});
-}
+};
+
+
+exports["remove'"] = function (tabs) {
+  return function () {
+    return browser.tabs.remove(tabs);
+  };
+};

src/Browser/Tabs.purs

@@ -1,4 +1,4 @@
-module Browser.Tabs (WindowId, TabId(..), Tab(..), query) where
+module Browser.Tabs (WindowId, TabId(..), Tab(..), query, remove, removeOne) where
 
 import Browser.Utils (unwrapForeign)
 import Control.Alt (map)
@@ -9,14 +9,14 @@ import Data.Eq (class Eq)
 import Data.Function (($))
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
-import Data.List (List, fromFoldable)
+import Data.List (List, fromFoldable, toUnfoldable, (!!), singleton)
 import Data.Maybe (Maybe)
-import Data.Newtype (class Newtype)
+import Data.Newtype (class Newtype, unwrap)
 import Data.Number.Format (toString)
 import Data.Ord (class Ord)
 import Data.Show (class Show)
 import Data.Traversable (traverse)
-import Data.Unit (unit)
+import Data.Unit (Unit, unit)
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
@@ -111,3 +111,19 @@ query = do
   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
+
+  where
+        unwrap (TabId n) = n
+
+removeOne :: TabId -> Aff Unit
+removeOne tabId = remove (singleton tabId)
+

src/Sidebar.purs

@@ -8,6 +8,7 @@ import Control.Alternative (pure, (*>))
 import Control.Bind ((>=>))
 import Data.Foldable (traverse_)
 import Data.Function (flip)
+import Data.Lens (view)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
@@ -18,9 +19,9 @@ import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Console (log)
-import JQuery (JQuery, append, create, css, remove, select, setAttr, setText)
+import JQuery as J
 import Prelude (Unit, bind, ($), discard)
-import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
+import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..), _tabId)
 
 main :: Effect Unit
 main = do
@@ -37,47 +38,60 @@ initSidebar :: Runtime.Port -> WindowId -> Effect Unit
 initSidebar port winId = do
   log $ "windowId " <> (show winId)
   Runtime.postMessageJson port $ SbHasWindowId winId
-  tabsDiv <- select "#tabs"
+  tabsDiv <- J.select "#tabs"
   _ <- Runtime.onMessageJsonAddListener port $ onMsg tabsDiv
   pure unit
   where
-  onMsg :: JQuery -> BackgroundEvent -> Effect Unit
+  onMsg :: J.JQuery -> BackgroundEvent -> Effect Unit
   onMsg contentDiv event = case event of
     BgTabCreated tab -> do
-      tabElem <- createTabElement tab
-      append tabElem contentDiv
+      tabElem <- createTabElement port tab
+      J.append tabElem contentDiv
       pure unit
     BgTabDeleted tabId -> deleteTabElement tabId
-    BgInitialTabList tabs -> traverse_ (createTabElement >=> (flip append) contentDiv) tabs
+    BgInitialTabList tabs -> traverse_ (createTabElement port >=> (flip J.append) contentDiv) tabs
     BgTabUpdated tid cinfo tab -> updateTabInfo tid cinfo tab
     _ -> log "received unsupported message type"
 
-createTabElement :: Tab -> Effect JQuery
-createTabElement tab' = do
+createTabElement :: Runtime.Port -> Tab -> Effect J.JQuery
+createTabElement port tab' = do
   let
     tab = unwrap tab'
-  tabDiv <- create "<div>"
-  setAttr "class" "tab" tabDiv
-  setAttr "id" tab.id tabDiv
+  tabDiv <- J.create "<div>"
+  J.setAttr "class" "tab" tabDiv
+  J.setAttr "id" tab.id tabDiv
   -- favicon
-  faviconDiv <- create "<div class=\"tab-favicon\">"
+  faviconDiv <- J.create "<div>"
+  J.addClass "tab-favicon" faviconDiv
   setFaviconUrl tab.favIconUrl faviconDiv
-  append faviconDiv tabDiv
+  J.append faviconDiv tabDiv
   -- title
-  tabTitle <- create "<div class=\"tab-title\">"
-  setText tab.title tabTitle
-  append tabTitle tabDiv
+  tabTitle <- J.create "<div>"
+  J.addClass "tab-title" tabTitle
+  J.setText tab.title tabTitle
+  J.append tabTitle tabDiv
+  -- close button
+  closeButton <- J.create "<div>"
+  J.addClass "close-button" closeButton
+  J.setText "×" closeButton
+  J.append closeButton tabDiv
+  J.on "click" onCloseClick closeButton
   pure tabDiv
+  where
+  onCloseClick :: J.JQueryEvent -> J.JQuery -> Effect Unit
+  onCloseClick event j = Runtime.postMessageJson port $ SbTabDeleted $ view _tabId tab'
 
-setFaviconUrl :: Maybe String -> JQuery -> Effect Unit
+setFaviconUrl :: Maybe String -> J.JQuery -> Effect Unit
 setFaviconUrl Nothing div = pure unit
-setFaviconUrl (Just favData) div = css {"background-image": favUrl} div
-  where favUrl = "url(" <> favData <> ")"
+
+setFaviconUrl (Just favData) div = J.css { "background-image": favUrl } div
+  where
+  favUrl = "url(" <> favData <> ")"
 
 deleteTabElement :: TabId -> Effect Unit
 deleteTabElement tabId = do
-  div <- select ("#" <> show tabId)
-  remove div
+  div <- J.select ("#" <> show tabId)
+  J.remove div
 
 updateTabInfo :: TabId -> ChangeInfo -> Tab -> Effect Unit
 updateTabInfo tid cinfo' tab' = do
@@ -85,12 +99,11 @@ updateTabInfo tid cinfo' tab' = do
     tab = unwrap tab'
 
     cinfo = unwrap cinfo'
-  tabTitleDiv <- select ("#" <> (show tid) <> " > .tab-title")
+  tabTitleDiv <- J.select ("#" <> (show tid) <> " > .tab-title")
   let
     newTitle = case cinfo.status of
       Just "loading" -> Just "Loading ..."
       _ -> Just tab.title
-  maybe (pure unit) (\t -> setText t tabTitleDiv) newTitle
-
-  tabFaviconDiv <- select ("#" <> (show tid) <> " > .tab-favicon")
+  maybe (pure unit) (\t -> J.setText t tabTitleDiv) newTitle
+  tabFaviconDiv <- J.select ("#" <> (show tid) <> " > .tab-favicon")
   setFaviconUrl cinfo.favIconUrl tabFaviconDiv