refactor: clean up Background.purs, split Model.purs file

Now broken: attaching/detaching a tab from a window.

src/Background.purs

@@ -1,7 +1,8 @@
 module PureTabs.Background where
 
 import Browser.Runtime as Runtime
-import Browser.Tabs (Tab(..), TabId, WindowId, query, removeOne, activateTab, moveTab, createTab)
+import Browser.Tabs (Tab, TabId, WindowId)
+import Browser.Tabs as BT
 import Browser.Tabs.OnActivated as OnActivated
 import Browser.Tabs.OnAttached as OnAttached
 import Browser.Tabs.OnCreated as OnCreated
@@ -13,20 +14,18 @@ import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
 import Browser.Windows (Window)
 import Browser.Windows.OnCreated as WinOnCreated
 import Browser.Windows.OnRemoved as WinOnRemoved
-import Control.Alt (map, (<#>), (<|>))
+import Control.Alt ((<#>))
 import Control.Alternative (pure, (*>))
 import Control.Bind ((=<<), (>>=))
-import Control.Category (identity, (>>>))
+import Control.Category ((>>>))
 import Data.Array as A
 import Data.CommutativeRing ((+))
-import Data.Eq ((/=), (==))
-import Data.Function (const, flip, (#))
-import Data.Lens (_Just, over, preview, set, view)
+import Data.Function (flip, (#))
+import Data.Lens (_Just, set, view)
 import Data.Lens.At (at)
-import Data.Lens.Iso.Newtype (_Newtype)
 import Data.List (List, foldMap)
 import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe, maybe, maybe')
+import Data.Maybe (Maybe(..), maybe)
 import Data.Monoid ((<>))
 import Data.Show (show)
 import Data.Unit (unit)
@@ -34,34 +33,17 @@ import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Console (log)
-import Effect.Exception (throw)
-import Effect.Exception.Unsafe (unsafeThrow)
 import Effect.Ref as Ref
 import Prelude (Unit, bind, ($), discard, (<<<))
-import PureTabs.Model
-  ( BackgroundEvent(..)
-  , ExtWindow
-  , GlobalState
-  , SidebarEvent(..)
-  , _active
-  , _index
-  , _port
-  , _portFromWindow
-  , _portFromWindowId
-  , _positions
-  , _tabFromTabIdAndWindow
-  , _tabFromWindow
-  , _tabs
-  , _windowIdToWindow
-  , _windows
-  , _windowIdToTabIdToTab
-  , emptyWindow
-  , initialTabListToGlobalState
-  )
+import PureTabs.Model.Events (BackgroundEvent(..), SidebarEvent(..))
+import PureTabs.Model.GlobalState as GS 
 
 type Ports
   = Ref.Ref (List Runtime.Port)
 
+type StateRef = Ref.Ref GS.GlobalState
+
+
 main :: Effect Unit
 main = do
   log "starting background"
@@ -69,10 +51,10 @@ main = do
   where
   runMain :: Aff Unit
   runMain = do
-    allTabs <- query
-    liftEffect $ initializeBackground =<< (Ref.new $ initialTabListToGlobalState allTabs)
+    allTabs <- BT.browserQuery
+    liftEffect $ initializeBackground =<< (Ref.new $ GS.initialTabListToGlobalState allTabs)
 
-initializeBackground :: Ref.Ref GlobalState -> Effect Unit
+initializeBackground :: Ref.Ref GS.GlobalState -> Effect Unit
 initializeBackground ref = do
   (mkListenerOne $ onWindowCreated ref) >>= WinOnCreated.addListener
   (mkListenerOne $ onWindowRemoved ref) >>= WinOnRemoved.addListener
@@ -85,177 +67,61 @@ initializeBackground ref = do
   (mkListenerTwo $ onTabMoved ref) >>= OnMoved.addListener
   (mkListenerOne $ onConnect ref) >>= Runtime.onConnectAddListener
 
-onWindowCreated :: (Ref.Ref GlobalState) -> Window -> Effect Unit
-onWindowCreated ref { id: winId } =
-  (log $ "bg: created window " <> (show winId))
-    *> (ref # Ref.modify_ (over (_windows <<< at winId) (_ <|> (Just emptyWindow))))
+onWindowCreated :: StateRef -> Window -> Effect Unit
+onWindowCreated ref { id: winId } = do
+  log $ "bg: created window " <> (show winId)
+  ref # Ref.modify_ (GS.addEmptyWindow winId)
 
-onWindowRemoved :: (Ref.Ref GlobalState) -> WindowId -> Effect Unit
-onWindowRemoved ref winId =
-  (log $ "bg: deleted window " <> (show winId))
-    *> (ref # Ref.modify_ \s -> s { windows = M.delete winId s.windows })
+onWindowRemoved :: StateRef -> WindowId -> Effect Unit
+onWindowRemoved ref winId = do
+  log $ "bg: deleted window " <> (show winId)
+  ref # Ref.modify_ (GS.deleteWindow winId)
 
-onTabCreated :: (Ref.Ref GlobalState) -> Tab -> Effect Unit
-onTabCreated stateRef (Tab tab) = do
-  log $ "bg: created tab " <> show tab.id
-  state <-
-    Ref.modify (insertTab (Tab tab)) stateRef
-  case (preview (_portFromWindow (Tab tab)) state) of
-    Nothing -> pure unit
-    Just port -> Runtime.postMessageJson port $ BgTabCreated (Tab tab)
-  where
-  -- | insert a tab, creating the window and updating the position
-  insertTab :: Tab -> GlobalState -> GlobalState
-  insertTab (Tab t) s =
-    let
-      windows = case M.lookup t.windowId s.windows of
-        Nothing -> M.insert t.windowId emptyWindow s.windows
-        Just _ -> s.windows
-    in
-      s { windows = M.update updateWindow t.windowId windows }
-    where
-    updateWindow :: ExtWindow -> Maybe ExtWindow
-    updateWindow win =
-      -- this will delete the window if there is an issue with the position..
-      -- not the best solution but we can't really recover from it anyway.
-      (A.insertAt t.index t.id win.positions)
-        <#> \newPos ->
-            win
-              { positions = newPos
-              , tabs = M.insert t.id (Tab t) win.tabs
-              }
+onTabCreated :: StateRef -> Tab -> Effect Unit
+onTabCreated stateRef tab = do
+  log $ "bg: created tab " <> (BT.showTabId tab) 
+  state <- Ref.modify (GS.createTab tab) stateRef
+  GS.sendToTabPort tab state $ BgTabCreated tab
 
-onTabUpdated :: (Ref.Ref GlobalState) -> TabId -> OnUpdated.ChangeInfo -> Tab -> Effect Unit
-onTabUpdated stateRef tid cinfo tab' = do
+onTabUpdated :: StateRef -> TabId -> OnUpdated.ChangeInfo -> Tab -> Effect Unit
+onTabUpdated stateRef tid cinfo tab = do
   log $ "bg: updated tab " <> show tid
-  state <- Ref.modify (updateTab tab') stateRef
-  case (preview (_portFromWindow tab') state) of
-    Nothing -> pure unit
-    Just port -> Runtime.postMessageJson port $ BgTabUpdated tid cinfo tab'
-  where
-  updateTab :: Tab -> GlobalState -> GlobalState
-  updateTab (Tab t) =
-    -- update by replacing the tab only if it already exists
-    (over (_tabFromWindow (Tab t)) (map $ const (Tab t)))
-      -- or update the currently detached tab
-      
-      >>> ( \s -> case s.detached of
-            Just (Tab t')
-              | t.id == t'.id -> s { detached = Just (Tab t') }
-            _ -> s
-        )
+  state <- Ref.modify (GS.updateTab tab) stateRef
+  GS.sendToTabPort tab state $ BgTabUpdated tid cinfo tab
 
-onTabMoved :: (Ref.Ref GlobalState) -> TabId -> OnMoved.MoveInfo -> Effect Unit
+onTabMoved :: StateRef -> TabId -> OnMoved.MoveInfo -> Effect Unit
 onTabMoved ref tid minfo = do
   log $ "bg: moved tab " <> show tid
-  s <- Ref.modify (updateState minfo) ref
-  case (preview (_portFromWindowId minfo.windowId) s) of
-    Nothing -> pure unit
-    Just port -> Runtime.postMessageJson port $ BgTabMoved tid minfo.fromIndex minfo.toIndex
-  where
-  updateState :: OnMoved.MoveInfo -> GlobalState -> GlobalState
-  updateState minfo' state =
-    let
-      newState = updatePositions minfo' state
-
-      newPositions :: Array TabId
-      newPositions = view ((_windowIdToWindow minfo'.windowId) <<< _positions) newState
-    in
-      over ((_windowIdToWindow minfo'.windowId) <<< _tabs) (updateTabsIndex newPositions) newState
-
-  updatePositions :: OnMoved.MoveInfo -> GlobalState -> GlobalState
-  updatePositions minfo' = over ((_windowIdToWindow minfo'.windowId) <<< _positions) $ unsafeUpdatePositions minfo'
-
-  -- | given a move info, update the positions tabs
-  unsafeUpdatePositions :: OnMoved.MoveInfo -> Array TabId -> Array TabId
-  unsafeUpdatePositions minfo' =
-    (moveElement minfo'.fromIndex minfo'.toIndex)
-      -- the indexes should exist, we need to revisit the code if it doesn't
-      
-      >>> (maybe' (\_ -> unsafeThrow "invalid indexes") identity)
-
-  moveElement :: forall a. Int -> Int -> Array a -> Maybe (Array a)
-  moveElement from to arr = do
-    tab <- arr A.!! from
-    A.deleteAt from arr >>= A.insertAt to tab
+  state <- Ref.modify (GS.moveTab minfo.fromIndex minfo.toIndex minfo.windowId) ref
+  GS.sendToWindowPort minfo.windowId state $ BgTabMoved tid minfo.fromIndex minfo.toIndex
 
-  -- | update the index of the tab given the positions
-  updateTabsIndex :: Array TabId -> M.Map TabId Tab -> M.Map TabId Tab
-  updateTabsIndex positions tabs =
-    let
-      modifyFuncs :: Array (M.Map TabId Tab -> M.Map TabId Tab)
-      modifyFuncs = A.mapWithIndex (\idx tid' -> set (at tid' <<< _Just <<< _Newtype <<< _index) idx) positions
-    in
-      A.foldl (#) tabs modifyFuncs
-
-onTabActived :: (Ref.Ref GlobalState) -> OnActivated.ActiveInfo -> Effect Unit
+onTabActived :: StateRef -> OnActivated.ActiveInfo -> Effect Unit
 onTabActived stateRef (OnActivated.ActiveInfo aInfo) = do
   log $ "bg: activated tab " <> show aInfo.tabId
-  state <- Ref.modify (updateGlobalState aInfo.previousTabId aInfo.tabId) stateRef
-  case (preview (_portFromWindowId aInfo.windowId) state) of
-    Nothing -> pure unit
-    Just port -> Runtime.postMessageJson port $ BgTabActivated 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
+  state <- Ref.modify (GS.activateTab aInfo.windowId aInfo.previousTabId aInfo.tabId) stateRef
+  GS.sendToWindowPort aInfo.windowId state $ BgTabActivated aInfo.previousTabId aInfo.tabId
 
-      _activeTab t = (_tabFromWindow t) <<< _Just <<< _Newtype <<< _active
-    in
-      (prevTabF >>> newTabF) state
+onTabDeleted :: StateRef -> TabId -> OnRemoved.RemoveInfo -> Effect Unit
+onTabDeleted stateRef tabId info = do 
+  log $ "bg: deleted tab " <> show tabId
+  state <- Ref.modify (GS.deleteTab info.windowId tabId) stateRef
+  GS.sendToWindowPort info.windowId state $ BgTabDeleted tabId
 
-stateDeleteTab :: WindowId -> TabId -> GlobalState -> GlobalState
-stateDeleteTab wid tid =
-  ( (set (_windowIdToTabIdToTab wid tid) Nothing)
-      >>> over (_windowIdToWindow wid <<< _positions) (A.filter ((/=) tid))
-  )
-
-deleteTab :: (Ref.Ref GlobalState) -> WindowId -> TabId -> Effect Unit
-deleteTab stateRef wid tid = do
-  log $ "bg: deleted tab " <> show tid
-  state <- Ref.modify (stateDeleteTab wid tid) stateRef
-  let
-    port = preview (_portFromWindowId wid) state
-  maybe (pure unit) (\p -> Runtime.postMessageJson p (BgTabDeleted tid)) port
-
-onTabDeleted :: (Ref.Ref GlobalState) -> TabId -> OnRemoved.RemoveInfo -> Effect Unit
-onTabDeleted stateRef tabId info = deleteTab stateRef info.windowId tabId
-
-onTabDetached :: (Ref.Ref GlobalState) -> TabId -> OnDetached.DetachInfo -> Effect Unit
+onTabDetached :: StateRef -> TabId -> OnDetached.DetachInfo -> Effect Unit
 onTabDetached stateRef tabId info = do
   log $ "bg: detached tab " <> show tabId
-  oldState <- Ref.read stateRef
-  case preview (_windowIdToTabIdToTab info.oldWindowId tabId) oldState of
-    Just (Just tab) -> do
-      deleteTab stateRef info.oldWindowId tabId
-      Ref.modify_ (_ { detached = Just tab }) stateRef
-    _ -> throw $ "tab " <> (show tabId) <> " not found, shouldn't happen"
+  state <- Ref.modify (GS.detachTab info.oldWindowId tabId) stateRef
+  GS.sendToWindowPort info.oldWindowId state $ BgTabDetached tabId
 
-onTabAttached :: (Ref.Ref GlobalState) -> TabId -> OnAttached.AttachInfo -> Effect Unit
+onTabAttached :: StateRef -> TabId -> OnAttached.AttachInfo -> Effect Unit
 onTabAttached stateRef tid info = do
   log $ "bg: attached tab " <> show tid
-  state <- Ref.read stateRef
-  case state.detached of
-    Just (Tab tab) ->
-      let
-        newTab = Tab (tab { windowId = info.newWindowId, index = info.newPosition })
-      in
-        onTabCreated stateRef newTab
-          *> Ref.modify_ (_ { detached = Nothing }) stateRef
-    _ -> throw $ "tab " <> (show tid) <> " doesn't exist in the state, this shouldn't happen"
+  state <- Ref.modify (GS.attachTab info.newWindowId tid info.newPosition) stateRef
+  case GS.tabFromWinIdAndTabId info.newWindowId tid state of
+     Just newTab -> GS.sendToWindowPort info.newWindowId state $ BgTabAttached newTab
+     Nothing -> pure unit
 
-onConnect :: (Ref.Ref GlobalState) -> Runtime.Port -> Effect Unit
+onConnect :: StateRef -> Runtime.Port -> Effect Unit
 onConnect stateRef port = do
   -- create a temporary listener ref that will only be held until the sidebar has sent its current window
   listenerRef <- Ref.new Nothing
@@ -276,12 +142,12 @@ onConnect stateRef port = do
 onNewWindowId ::
   forall a.
   Runtime.Port ->
-  (Ref.Ref GlobalState) ->
+  StateRef ->
   (Ref.Ref (Maybe (Listener a))) ->
   WindowId -> Effect Unit
 onNewWindowId port stateRef listenerRef winId = do
   -- initial state of the current window
-  initWindowState port stateRef winId
+  Ref.modify_ (GS.initializeWindowState winId port) stateRef
   -- remove the previous onMessage listener
   ogListener <- Ref.read listenerRef
   foldMap (\l -> Runtime.onMessageRemoveListener port l) ogListener
@@ -303,28 +169,21 @@ onNewWindowId port stateRef listenerRef winId = do
   onDisconnectListener <- mkListenerUnit $ onDisconnect stateRef winId sidebarListener
   Runtime.portOnDisconnect port onDisconnectListener
 
-initWindowState :: Runtime.Port -> (Ref.Ref GlobalState) -> WindowId -> Effect Unit
-initWindowState port ref winId =
-  (flip Ref.modify_) ref
-    $ over (_windows <<< (at winId))
-        (\win -> Just $ set _port (Just port) (fromMaybe emptyWindow win))
-
 -- TODO don't pass the full ref, but only a set of function to manipulate/access 
 -- the data required
-manageSidebar :: (Ref.Ref GlobalState) -> WindowId -> Runtime.Port -> SidebarEvent -> Effect Unit
+manageSidebar :: StateRef -> WindowId -> Runtime.Port -> SidebarEvent -> Effect Unit
 manageSidebar ref winId port = case _ of
-  SbDeleteTab tabId -> launchAff_ $ removeOne tabId
-  SbActivateTab tabId -> launchAff_ $ activateTab tabId
-  SbMoveTab tabId newIndex -> moveTab tabId { index: newIndex }
+  SbDeleteTab tabId -> launchAff_ $ BT.browserRemoveOne tabId
+  SbActivateTab tabId -> launchAff_ $ BT.browserActivateTab tabId
+  SbMoveTab tabId newIndex -> BT.browserMoveTab tabId { index: newIndex }
   SbCreateTab tid' -> case tid' of
-    Nothing -> createTab { windowId: winId }
+    Nothing -> BT.browserCreateTab { windowId: winId }
     Just tid ->
-      Ref.read ref <#> view (_positions >>> _windowIdToWindow winId)
+      Ref.read ref <#> view (GS._positions >>> GS._windowIdToWindow winId)
         >>= \positions -> case A.elemIndex tid positions of
-            Nothing -> createTab { windowId: winId }
-            Just idx -> createTab { windowId: winId, index: idx + 1 }
+            Nothing -> BT.browserCreateTab { windowId: winId }
+            Just idx -> BT.browserCreateTab { windowId: winId, index: idx + 1 }
   _ -> 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
+onDisconnect :: forall a. StateRef -> WindowId -> Listener a -> Effect Unit
+onDisconnect stateRef winId listener = Ref.modify_ (set (GS._windows <<< (at winId) <<< _Just <<< GS._port) Nothing) stateRef

src/Browser/Tabs.js

@@ -4,13 +4,13 @@ exports.queryImpl = function () {
   return browser.tabs.query({});
 };
 
-exports["remove'"] = function (tabs) {
+exports["browserRemove'"] = function (tabs) {
   return function () {
     return browser.tabs.remove(tabs);
   };
 };
 
-exports["update'"] = function () {
+exports["browserUpdate'"] = function () {
   return function (updateProperties) {
     return function (tabId) {
       return function () {
@@ -20,7 +20,7 @@ exports["update'"] = function () {
   };
 };
 
-exports["moveTab"] = function (tabIds) {
+exports["browserMoveTab"] = function (tabIds) {
   return function (moveProperties) {
     return function () {
       return browser.tabs.move(tabIds, moveProperties);
@@ -28,7 +28,7 @@ exports["moveTab"] = function (tabIds) {
   };
 };
 
-exports["createTab"] = function (union) {
+exports["browserCreateTab"] = function (union) {
   return function (createProperties) {
     return function () {
       return browser.tabs.create(createProperties);

src/Browser/Tabs.purs

@@ -1,4 +1,18 @@
-module Browser.Tabs (WindowId, TabId(..), Tab(..), MoveProperties, CreateProperties, query, remove, removeOne, update, activateTab, moveTab, createTab) where
+module Browser.Tabs (
+  WindowId
+  , TabId(..)
+  , Tab(..)
+  , MoveProperties
+  , CreateProperties
+  , browserQuery
+  , browserRemove
+  , browserRemoveOne
+  , browserUpdate
+  , browserActivateTab
+  , browserMoveTab
+  , browserCreateTab
+  , showTabId
+  ) where
 
 import Browser.Utils (unwrapForeign)
 import Control.Alt (map)
@@ -12,7 +26,7 @@ import Data.Maybe (Maybe)
 import Data.Newtype (class Newtype)
 import Data.Number.Format (toString)
 import Data.Ord (class Ord)
-import Data.Show (class Show)
+import Data.Show (class Show, show)
 import Data.Traversable (traverse)
 import Data.Unit (Unit)
 import Effect (Effect)
@@ -49,7 +63,7 @@ derive instance eqTabId :: Eq TabId
 
 derive instance ordTabId :: Ord TabId
 
-instance showTabId :: Show TabId where
+instance showTabIdInstance :: Show TabId where
   show (TabId wid) = toString wid
 
 derive instance genTabId :: Generic TabId _
@@ -97,6 +111,9 @@ derive instance genTab :: Generic Tab _
 instance showTab :: Show Tab where
   show = genericShow
 
+showTabId :: Tab -> String
+showTabId (Tab t) = show t.id
+
 instance encodeTab :: Encode Tab where
   encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
 
@@ -105,27 +122,27 @@ instance decodeTab :: Decode Tab where
 
 foreign import queryImpl :: Effect (Promise (Array Foreign))
 
-query :: Aff (List Tab)
-query = do
+browserQuery :: Aff (List Tab)
+browserQuery = do
   tabsArray <- toAffE queryImpl
   let
     tabsList = fromFoldable tabsArray
   parsed <- liftEffect $ traverse unwrapForeign tabsList
   pure parsed
 
-foreign import remove' :: (Array Number) -> Effect (Promise Unit)
+foreign import browserRemove' :: (Array Number) -> Effect (Promise Unit)
 
-remove :: (List TabId) -> Aff Unit
-remove tabs =
+browserRemove :: (List TabId) -> Aff Unit
+browserRemove tabs =
   let
     tabIdsArray = toUnfoldable $ map unwrap tabs
   in
-    toAffE $ remove' tabIdsArray
+    toAffE $ browserRemove' tabIdsArray
   where
   unwrap (TabId n) = n
 
-removeOne :: TabId -> Aff Unit
-removeOne tabId = remove (singleton tabId)
+browserRemoveOne :: TabId -> Aff Unit
+browserRemoveOne tabId = browserRemove (singleton tabId)
 
 type RowUpdateProperties
   = ( active :: Boolean
@@ -139,21 +156,21 @@ type RowUpdateProperties
     , url :: String
     )
 
-foreign import update' :: forall given trash. Union given trash RowUpdateProperties => { | given } -> TabId -> Effect (Promise Tab)
+foreign import browserUpdate' :: 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
+browserUpdate :: forall prop b. Union prop b RowUpdateProperties => { | prop } -> TabId -> Aff Tab
+browserUpdate props tabId = toAffE $ browserUpdate' props tabId
 
 
-activateTab :: TabId -> Aff Tab
-activateTab tabId = update { active: true } tabId
+browserActivateTab :: TabId -> Aff Tab
+browserActivateTab tabId = browserUpdate { active: true } tabId
 
 type MoveProperties = {
   -- windowId :: Maybe WindowId
   index :: Int
 }
 
-foreign import moveTab :: TabId -> MoveProperties -> Effect Unit
+foreign import browserMoveTab :: TabId -> MoveProperties -> Effect Unit
 
 
 type CreateProperties = (
@@ -169,4 +186,4 @@ type CreateProperties = (
   windowId :: WindowId
 )
 
-foreign import createTab :: forall props trash. Union props trash CreateProperties => { | props } -> Effect Unit
+foreign import browserCreateTab :: forall props trash. Union props trash CreateProperties => { | props } -> Effect Unit

src/Model.purs

@@ -1,209 +0,0 @@
-module PureTabs.Model
-  ( ExtWindow
-  , GlobalState
-  , Group
-  , GroupId
-  , _active
-  , _id
-  , _index
-  , _port
-  , _portFromWindow
-  , _portFromWindowId
-  , _positions
-  , _tabFromTabIdAndWindow
-  , _tabFromWindow
-  , _tabId
-  , _tabs
-  , _tabWindowId
-  , _windowIdToWindow
-  , _windowIdToTabIdToTab
-  , _windows
-  , emptyWindow
-  , initialGlobalState
-  , initialTabListToGlobalState
-  , BackgroundEvent(..)
-  , SidebarEvent(..)
-  ) where
-
-import Browser.Runtime (Port)
-import Browser.Tabs (Tab(..), TabId, WindowId)
-import Browser.Tabs.OnUpdated (ChangeInfo)
-import Control.Bind (join)
-import Control.Category ((<<<))
-import Control.Plus (empty) as A
-import Data.Array (sortBy, singleton, fromFoldable) as A
-import Data.Eq ((==))
-import Data.Function (on, ($))
-import Data.Functor (map, (<#>), (<$>))
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
-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, groupBy, head) as L
-import Data.List.NonEmpty (NonEmptyList, head) as NEL
-import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe)
-import Data.Ord (compare)
-import Data.Show (class Show)
-import Data.Symbol (SProxy(..))
-import Data.Tuple (Tuple(..))
-
-type GlobalState
-  = { windows :: M.Map WindowId ExtWindow
-    , detached :: Maybe Tab
-    }
-
-initialGlobalState :: GlobalState
-initialGlobalState =
-  { windows: M.empty
-  , detached: Nothing
-  }
-
-newtype GroupId
-  = GroupId Int
-
-type Group
-  = { id :: GroupId, name :: String }
-
-newGroup :: Int -> (Maybe String) -> Group
-newGroup gid name = { id: GroupId gid, name: fromMaybe "Unnamed" name }
-
-type ExtWindow
-  = { positions :: Array TabId
-    , tabs :: M.Map TabId Tab
-    , port :: Maybe Port
-    , groups :: Array Group
-    , tabToGroup :: M.Map TabId GroupId
-    , currentGroup :: GroupId
-    }
-
-emptyWindow :: ExtWindow
-emptyWindow =
-  { positions: A.empty
-  , tabs: M.empty
-  , port: Nothing
-  , groups: A.singleton (newGroup 1 Nothing)
-  , tabToGroup: M.empty
-  , currentGroup: GroupId 1
-  }
-
-_tabs :: forall a r. Lens' { tabs :: a | r } a
-_tabs = prop (SProxy :: _ "tabs")
-
-_port :: forall a r. Lens' { port :: a | r } a
-_port = prop (SProxy :: _ "port")
-
-_windows :: forall a r. Lens' { windows :: a | r } a
-_windows = prop (SProxy :: _ "windows")
-
-_title :: forall a r. Lens' { title :: a | r } a
-_title = prop (SProxy :: _ "title")
-
-_index :: forall a r. Lens' { index :: a | r } a
-_index = prop (SProxy :: _ "index")
-
-_tabTitle :: Lens' Tab String
-_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
-
-_windowId :: forall a r. Lens' { windowId :: a | r } a
-_windowId = prop (SProxy :: _ "windowId")
-
-_positions :: forall a r. Lens' { positions :: a | r } a
-_positions = prop (SProxy :: _ "positions")
-
-_tabWindowId :: Lens' Tab WindowId
-_tabWindowId = _Newtype <<< _windowId
-
-_portFromWindow :: Tab -> Traversal' GlobalState Port
-_portFromWindow (Tab tab) = _portFromWindowId tab.windowId
-
-_portFromWindowId :: WindowId -> Traversal' GlobalState Port
-_portFromWindowId wid = _windowIdToWindow wid <<< _port <<< _Just
-
-_windowIdToWindow :: WindowId -> Traversal' GlobalState ExtWindow
-_windowIdToWindow wid = _windows <<< (at wid) <<< _Just
-
-_tabFromWindow :: Tab -> Traversal' GlobalState (Maybe Tab)
-_tabFromWindow (Tab tab) = _windowIdToWindow tab.windowId <<< _tabs <<< (at tab.id)
-
-_windowIdToTabIdToTab :: WindowId -> TabId -> Traversal' GlobalState (Maybe Tab)
-_windowIdToTabIdToTab wid tid = _windowIdToWindow wid <<< _tabs <<< (at tid)
-
-_tabFromTabIdAndWindow :: GlobalState -> TabId -> Maybe Tab
-_tabFromTabIdAndWindow s tabId =
-  let
-    allWindows = M.values s.windows
-
-    allTabs = map (view _tabs) allWindows
-
-    matchingTabId = map (M.lookup tabId) allTabs
-  in
-    join $ L.head matchingTabId
-
-initialTabListToGlobalState :: L.List Tab -> GlobalState
-initialTabListToGlobalState tabs = { windows: windows, detached: Nothing }
-  where
-  groupedTabs = L.groupBy (\(Tab t1) (Tab t2) -> t1.windowId == t2.windowId) tabs
-
-  tabsToWindow :: NEL.NonEmptyList Tab -> Tuple WindowId ExtWindow
-  tabsToWindow tabs' =
-    let
-      windowId = (\(Tab t) -> t.windowId) $ NEL.head tabs'
-
-      window =
-        { tabs: M.fromFoldable $ tabs' <#> \(Tab t) -> Tuple t.id (Tab t)
-        , port: Nothing
-        , positions: (\(Tab t) -> t.id) <$> A.sortBy (compare `on` \(Tab t) -> t.index) (A.fromFoldable tabs')
-        , groups: A.singleton (newGroup 1 Nothing)
-        , tabToGroup: M.fromFoldable $ tabs' <#> \(Tab t) -> Tuple t.id (GroupId 1)
-        , currentGroup: GroupId 1
-        }
-    in
-      Tuple windowId window
-
-  windows = M.fromFoldable $ (tabsToWindow <$> groupedTabs)
-
-data BackgroundEvent
-  = BgInitialTabList (Array Tab)
-  | BgTabCreated Tab
-  | BgTabDeleted TabId
-  | BgTabUpdated TabId ChangeInfo Tab
-  | BgTabMoved TabId Int Int
-  | BgTabActivated (Maybe TabId) TabId
-  | BgTabAttached Tab
-  | BgTabDetached TabId
-  | BgTabHighlighted
-  | BgTabReplaced
-  | BgTabZoomChanged
-
-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
-  | SbCreatedGroup
-  | SbDeleteGroup
-  | SbRenameGroup
-  | SbHasWindowId WindowId
-
-derive instance genSidebarEvent :: Generic SidebarEvent _
-
-instance showSidebarEvent :: Show SidebarEvent where
-  show = genericShow

src/Model/Events.purs

@@ -0,0 +1,46 @@
+module PureTabs.Model.Events (
+  BackgroundEvent(..)
+  , SidebarEvent(..)
+  ) 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.Maybe (Maybe)
+import Data.Show (class Show)
+
+
+data BackgroundEvent
+  = BgInitialTabList (Array Tab)
+  | BgTabCreated Tab
+  | BgTabDeleted TabId
+  | BgTabUpdated TabId ChangeInfo Tab
+  | BgTabMoved TabId Int Int
+  | BgTabActivated (Maybe TabId) TabId
+  | BgTabAttached Tab
+  | BgTabDetached TabId
+  | BgTabHighlighted
+  | BgTabReplaced
+  | BgTabZoomChanged
+
+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
+  | SbCreatedGroup
+  | SbDeleteGroup
+  | SbRenameGroup
+  | SbHasWindowId WindowId
+
+derive instance genSidebarEvent :: Generic SidebarEvent _
+
+instance showSidebarEvent :: Show SidebarEvent where
+  show = genericShow

src/Model/GlobalState.purs

@@ -0,0 +1,340 @@
+module PureTabs.Model.GlobalState (
+ ExtWindow
+  , GlobalState
+  , Group
+  , GroupId
+  , _active
+  , _id
+  , _index
+  , _port
+  , _portFromWindow
+  , _portFromWindowId
+  , _positions
+  , _tabFromTabIdAndWindow
+  , _tabFromWindow
+  , _tabId
+  , _tabs
+  , _tabWindowId
+  , _windowIdToWindow
+  , _windowIdToTabIdToTab
+  , _windows
+  , emptyWindow
+  , initialGlobalState
+  , initialTabListToGlobalState
+  , addEmptyWindow
+  , deleteWindow
+  , createTab
+  , updateTab
+  , activateTab
+  , moveTab
+  , deleteTab
+  , detachTab
+  , attachTab
+  , sendToTabPort
+  , sendToWindowPort
+  , tabFromWinIdAndTabId 
+  , initializeWindowState
+  ) where
+
+import Browser.Runtime (Port, postMessageJson)
+import Browser.Tabs (Tab(..), TabId, WindowId, showTabId)
+import Control.Alt ((<|>))
+import Control.Bind (join, bind, (>>=))
+import Control.Category (identity, (<<<), (>>>))
+import Control.Plus (empty) as A
+import Data.Array (sortBy, singleton, fromFoldable, insertAt, deleteAt, mapWithIndex, foldl, filter, (!!)) as A
+import Data.Eq ((==), (/=))
+import Data.Function (const, on, ($))
+import Data.Functor (map, (<#>), (<$>))
+import Data.Lens (Lens', Traversal', _Just, over, preview, set, view)
+import Data.Lens.At (at)
+import Data.Lens.Iso.Newtype (_Newtype)
+import Data.Lens.Record (prop)
+import Data.List (List, groupBy, head) as L
+import Data.List.NonEmpty (NonEmptyList, head) as NEL
+import Data.Map as M
+import Data.Maybe (Maybe(..), fromMaybe, maybe, maybe')
+import Data.Monoid ((<>))
+import Data.Ord (compare)
+import Data.Show (show)
+import Data.Symbol (SProxy(..))
+import Data.Tuple (Tuple(..))
+import Data.Unit (Unit)
+import Effect (Effect)
+import Effect.Console (error)
+import Effect.Exception.Unsafe (unsafeThrow)
+import Prelude ((#))
+import PureTabs.Model.Events (BackgroundEvent)
+
+type GlobalState
+  = { windows :: M.Map WindowId ExtWindow
+    , detached :: Maybe Tab
+    }
+
+initialGlobalState :: GlobalState
+initialGlobalState =
+  { windows: M.empty
+  , detached: Nothing
+  }
+
+newtype GroupId
+  = GroupId Int
+
+type Group
+  = { id :: GroupId, name :: String }
+
+newGroup :: Int -> (Maybe String) -> Group
+newGroup gid name = { id: GroupId gid, name: fromMaybe "Unnamed" name }
+
+type ExtWindow
+  = { positions :: Array TabId
+    , tabs :: M.Map TabId Tab
+    , port :: Maybe Port
+    , groups :: Array Group
+    , tabToGroup :: M.Map TabId GroupId
+    , currentGroup :: GroupId
+    }
+
+emptyWindow :: ExtWindow
+emptyWindow =
+  { positions: A.empty
+  , tabs: M.empty
+  , port: Nothing
+  , groups: A.singleton (newGroup 1 Nothing)
+  , tabToGroup: M.empty
+  , currentGroup: GroupId 1
+  }
+
+_tabs :: forall a r. Lens' { tabs :: a | r } a
+_tabs = prop (SProxy :: _ "tabs")
+
+_port :: forall a r. Lens' { port :: a | r } a
+_port = prop (SProxy :: _ "port")
+
+_windows :: forall a r. Lens' { windows :: a | r } a
+_windows = prop (SProxy :: _ "windows")
+
+_title :: forall a r. Lens' { title :: a | r } a
+_title = prop (SProxy :: _ "title")
+
+_index :: forall a r. Lens' { index :: a | r } a
+_index = prop (SProxy :: _ "index")
+
+_tabTitle :: Lens' Tab String
+_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
+
+_windowId :: forall a r. Lens' { windowId :: a | r } a
+_windowId = prop (SProxy :: _ "windowId")
+
+_positions :: forall a r. Lens' { positions :: a | r } a
+_positions = prop (SProxy :: _ "positions")
+
+_tabWindowId :: Lens' Tab WindowId
+_tabWindowId = _Newtype <<< _windowId
+
+_portFromWindow :: Tab -> Traversal' GlobalState Port
+_portFromWindow (Tab tab) = _portFromWindowId tab.windowId
+
+_portFromWindowId :: WindowId -> Traversal' GlobalState Port
+_portFromWindowId wid = _windowIdToWindow wid <<< _port <<< _Just
+
+_windowIdToWindow :: WindowId -> Traversal' GlobalState ExtWindow
+_windowIdToWindow wid = _windows <<< (at wid) <<< _Just
+
+_tabFromWindow :: Tab -> Traversal' GlobalState (Maybe Tab)
+_tabFromWindow (Tab tab) = _windowIdToWindow tab.windowId <<< _tabs <<< (at tab.id)
+
+_windowIdToTabIdToTab :: WindowId -> TabId -> Traversal' GlobalState (Maybe Tab)
+_windowIdToTabIdToTab wid tid = _windowIdToWindow wid <<< _tabs <<< (at tid)
+
+tabFromWinIdAndTabId :: WindowId -> TabId -> GlobalState -> Maybe Tab
+tabFromWinIdAndTabId winId tabId = join <<< preview (_windowIdToTabIdToTab winId tabId)
+
+_tabFromTabIdAndWindow :: GlobalState -> TabId -> Maybe Tab
+_tabFromTabIdAndWindow s tabId =
+  let
+    allWindows = M.values s.windows
+
+    allTabs = map (view _tabs) allWindows
+
+    matchingTabId = map (M.lookup tabId) allTabs
+  in
+    join $ L.head matchingTabId
+
+
+sendToTabPort :: Tab -> GlobalState -> BackgroundEvent -> Effect Unit
+sendToTabPort tab state msg =
+  case (preview (_portFromWindow tab) state) of 
+       Just port -> postMessageJson port msg
+       Nothing -> error $ "bg: no port found for tab id " <> (showTabId tab)
+
+sendToWindowPort :: WindowId -> GlobalState -> BackgroundEvent -> Effect Unit
+sendToWindowPort wid state event =
+  case (preview (_portFromWindowId wid) state) of
+    Just port -> postMessageJson port event
+    Nothing -> error $ "bg: no port found for window id " <> (show wid)
+
+initialTabListToGlobalState :: L.List Tab -> GlobalState
+initialTabListToGlobalState tabs = { windows: windows, detached: Nothing }
+  where
+  groupedTabs = L.groupBy (\(Tab t1) (Tab t2) -> t1.windowId == t2.windowId) tabs
+
+  tabsToWindow :: NEL.NonEmptyList Tab -> Tuple WindowId ExtWindow
+  tabsToWindow tabs' =
+    let
+      windowId = (\(Tab t) -> t.windowId) $ NEL.head tabs'
+
+      window =
+        { tabs: M.fromFoldable $ tabs' <#> \(Tab t) -> Tuple t.id (Tab t)
+        , port: Nothing
+        , positions: (\(Tab t) -> t.id) <$> A.sortBy (compare `on` \(Tab t) -> t.index) (A.fromFoldable tabs')
+        , groups: A.singleton (newGroup 1 Nothing)
+        , tabToGroup: M.fromFoldable $ tabs' <#> \(Tab t) -> Tuple t.id (GroupId 1)
+        , currentGroup: GroupId 0
+        }
+    in
+      Tuple windowId window
+
+  windows = M.fromFoldable $ (tabsToWindow <$> groupedTabs)
+
+
+addEmptyWindow :: WindowId -> GlobalState -> GlobalState
+addEmptyWindow winId = (over (_windows <<< at winId)) (_ <|> (Just emptyWindow))
+
+deleteWindow :: WindowId -> GlobalState -> GlobalState
+deleteWindow winId state = state { windows = M.delete winId state.windows }
+
+
+createTab :: Tab -> GlobalState -> GlobalState
+createTab (Tab t) s = s { windows = M.update updateWindow t.windowId windows }
+
+  where
+
+  windows = case M.lookup t.windowId s.windows of
+                 Nothing -> M.insert t.windowId emptyWindow s.windows
+                 Just _ -> s.windows
+
+  updateWindow :: ExtWindow -> Maybe ExtWindow
+  updateWindow win =
+    -- this will delete the window if there is an issue with the position..
+    -- not the best solution but we can't really recover from it anyway.
+    (A.insertAt t.index t.id win.positions)
+      <#> \newPos ->
+        win
+        { positions = newPos
+        , tabs = M.insert t.id (Tab t) win.tabs
+        }
+
+
+updateTab :: Tab -> GlobalState -> GlobalState
+updateTab tab = 
+  -- update by replacing the tab only if it already exists
+  (over (_tabFromWindow tab) (map $ const tab))
+  -- or update the currently detached tab
+    >>> ( \s -> case s.detached of
+          Just (Tab tab')
+            | (view _tabId tab) == tab'.id -> s { detached = Just (Tab tab') }
+          _ -> s
+      )
+
+
+moveTab :: Int -> Int -> WindowId -> GlobalState -> GlobalState
+moveTab fromIndex toIndex windowId state = 
+  let 
+      -- Update the state by moving the tab at `fromIndex` to `toIndex`.
+      newState = state # over ((_windowIdToWindow windowId) <<< _positions) unsafeUpdatePositions
+
+      -- Get the new positions for each tab based on the move just done.
+      newPositions = newState # view ((_windowIdToWindow windowId) <<< _positions)
+   in
+     -- Update the new positions for each tab
+     newState # over ((_windowIdToWindow windowId) <<< _tabs) (updateTabsIndex newPositions) 
+
+  where
+    -- | Move an element from `from` to `to` in array `arr`.
+    moveElement :: forall a. Int -> Int -> Array a -> Maybe (Array a)
+    moveElement from to arr = do
+      tab <- arr A.!! from
+      A.deleteAt from arr >>= A.insertAt to tab
+
+    -- | Update the positions tabs
+    unsafeUpdatePositions :: Array TabId -> Array TabId
+    unsafeUpdatePositions =
+      (moveElement fromIndex toIndex)
+      -- The indexes should exist, we need to revisit the code if it doesn't
+      >>> (maybe' (\_ -> unsafeThrow "bg: invalid indexes during moveTab") identity)
+
+    -- | Update the index of the tab given the positions.
+    -- | This is done by folding over a map of index update function applied to all tabs.
+    updateTabsIndex :: Array TabId -> M.Map TabId Tab -> M.Map TabId Tab
+    updateTabsIndex positions tabs =
+      let
+        modifyFuncs :: Array (M.Map TabId Tab -> M.Map TabId Tab)
+        modifyFuncs = A.mapWithIndex (\idx tid' -> set (at tid' <<< _Just <<< _Newtype <<< _index) idx) positions
+      in
+        A.foldl (#) tabs modifyFuncs
+
+activateTab :: WindowId -> (Maybe TabId) -> TabId -> GlobalState -> GlobalState
+activateTab winId previousTabId newTabId state =
+    let
+      prevTab :: Maybe Tab
+      prevTab = previousTabId >>= \ptid -> join $ preview (_windowIdToTabIdToTab winId ptid) state
+
+      prevTabF :: GlobalState -> GlobalState
+      prevTabF = maybe identity (\t -> set (_activeTab t) false) prevTab
+
+      newTab = join $ preview (_windowIdToTabIdToTab winId newTabId) state
+
+      newTabF :: GlobalState -> GlobalState
+      newTabF = maybe identity (\t -> set (_activeTab t) true) newTab
+
+      _activeTab t = (_tabFromWindow t) <<< _Just <<< _Newtype <<< _active
+    in
+      (prevTabF >>> newTabF) state
+
+
+deleteTab :: WindowId -> TabId -> GlobalState -> GlobalState
+deleteTab winId tabId = 
+  (set (_windowIdToTabIdToTab winId tabId) Nothing)
+    >>> over (_windowIdToWindow winId <<< _positions) (A.filter ((/=) tabId))
+
+
+detachTab :: WindowId -> TabId -> GlobalState -> GlobalState
+detachTab winId tabId state =
+  case preview (_windowIdToTabIdToTab winId tabId) state of
+    Just (Just tab) -> do
+      state # (deleteTab winId tabId) >>> \s -> s { detached = Just tab } 
+    -- XXX: We're losing the information that we couldn't fetch the tab.
+    -- This shouldn't happen, but I don't see how to go around it. We don't
+    -- have a (typed) proof that a given tab exists for a window id and a tab
+    -- id, so let's just assume everything is well behaved.
+    -- The other solution is to first do a read, then a write, and return an
+    -- effect where we can throw.
+    _ -> state
+
+
+attachTab :: WindowId -> TabId -> Int -> GlobalState -> GlobalState
+attachTab winId tabId newPosition state =
+  case state.detached of 
+       Just (Tab tab) -> 
+         let 
+             newTab = Tab (tab { windowId = winId, index = newPosition })
+         in 
+         state # (createTab newTab) >>> (_ { detached = Nothing})
+       _ -> state
+
+
+-- | Set the port of a new window connecting. If the window doesn't exist,
+-- | initialize it with new data.
+initializeWindowState :: WindowId -> Port -> GlobalState -> GlobalState
+initializeWindowState winId port = 
+  over (_windows <<< (at winId)) (\win -> Just $ set _port (Just port) (fromMaybe emptyWindow win))

src/Sidebar/Components/Bar.purs

@@ -19,7 +19,7 @@ import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Prelude (class Eq, class Ord, class Show, show, (+), (<<<), (<>), (==))
-import PureTabs.Model (SidebarEvent)
+import PureTabs.Model.Events (SidebarEvent)
 import PureTabs.Sidebar.Tabs (Output(..))
 import PureTabs.Sidebar.Tabs as Tabs
 import Sidebar.Component.GroupName as GroupName
@@ -134,13 +134,13 @@ component =
             let GroupId(maxValue) = NES.max (NES.cons (GroupId 0) values)
              in GroupId(maxValue + 1)
 
+  -- TODO: don't use the current group, but use the group associated with the TabId
   handleQuery :: forall act o a. Tabs.Query a -> H.HalogenM State act Slots o m (Maybe a)
   handleQuery = case _ of
-    -- select the current group
-    -- associate all the tab id to the current group
-    -- send an action to the corresponding slot
     Tabs.InitialTabList tabs a -> do
-       s <- H.modify (\s -> s { tabsToGroup = M.fromFoldable $ tabs <#> \(Tab t) -> Tuple t.id s.currentGroup })
+       s <- H.modify (\s -> 
+         s { tabsToGroup = M.fromFoldable $ tabs <#> \(Tab t) -> Tuple t.id s.currentGroup }
+       )
        void $ tellChild s.currentGroup $ Tabs.InitialTabList tabs
        pure (Just a)
     Tabs.TabCreated (Tab t) a -> do 
@@ -163,6 +163,10 @@ component =
        s <- H.get
        void $ tellChild s.currentGroup $ Tabs.TabInfoChanged tid cinfo
        pure (Just a)
+    Tabs.TabDetached tid a -> do 
+       s <- H.get
+       void $ tellChild s.currentGroup $ Tabs.TabDetached tid
+       pure (Just a)
 
     where
         tellChild :: GroupId -> (H.Tell Tabs.Query) -> H.HalogenM State act Slots o m (Maybe Unit)

src/Sidebar/Components/Tabs.purs

@@ -32,7 +32,8 @@ import Halogen.HTML.CSS as CSS
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Prelude (negate, sub)
-import PureTabs.Model (SidebarEvent(..), _tabs)
+import PureTabs.Model.Events (SidebarEvent(..))
+import PureTabs.Model.GlobalState (_tabs)
 import Web.Event.Event (Event)
 import Web.Event.Event as Event
 import Web.HTML.Event.DataTransfer as DT
@@ -46,6 +47,8 @@ data Query a
   | TabActivated (Maybe TabId) TabId a
   | TabMoved TabId Int Int a
   | TabInfoChanged TabId ChangeInfo a
+  | TabDetached TabId a
+  -- | TabAttached Tab a
 
 data Output 
   = TabsSidebarAction SidebarEvent
@@ -391,6 +394,9 @@ handleQuery = case _ of
       )
       *> pure (Just a)
 
+  TabDetached tid a -> 
+    handleQuery $ TabDeleted tid a
+
 setTabActive :: Boolean -> Tab -> Tab
 setTabActive act (Tab t) = Tab (t { active = act })
 

src/Sidebar/Sidebar.purs

@@ -18,7 +18,7 @@ import Halogen as H
 import Halogen.Aff as HA
 import Halogen.VDom.Driver (runUI)
 import Prelude (bind, discard)
-import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
+import PureTabs.Model.Events (BackgroundEvent(..), SidebarEvent(..))
 import PureTabs.Sidebar.Bar as Bar
 import PureTabs.Sidebar.Tabs as Tabs
 import Web.DOM.ParentNode (QuerySelector(..))
@@ -63,6 +63,9 @@ onBackgroundMsgConsumer query =
         BgTabUpdated tabId cinfo tab -> do
           void $ query $ H.tell $ Tabs.TabInfoChanged tabId cinfo
           pure Nothing
+        BgTabDetached tabId -> do 
+          void $ query $ H.tell $ Tabs.TabDetached tabId
+          pure Nothing
         _ -> pure Nothing
 
 onSidebarMsg :: Runtime.Port -> CR.Consumer SidebarEvent Aff Unit