ソースを参照

fix: correctly handle attach/detach event following refactor

Jocelyn Boullier 4 年 前
コミット
fdcfa8ba26
3 ファイル変更54 行追加18 行削除
  1. 40 14
      src/Sidebar/Components/Bar.purs
  2. 7 3
      src/Sidebar/Components/Tabs.purs
  3. 7 1
      src/Sidebar/Sidebar.purs

+ 40 - 14
src/Sidebar/Components/Bar.purs

@@ -5,6 +5,7 @@ import Control.Alternative (pure)
 import Control.Bind (bind, discard, void, (<#>))
 import Data.Array ((:))
 import Data.Function (($))
+import Data.Lens (view)
 import Data.Map as M
 import Data.Maybe (Maybe(..))
 import Data.Set (toUnfoldable, Set) as S
@@ -20,6 +21,7 @@ import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Prelude (class Eq, class Ord, class Show, show, (+), (<<<), (<>), (==))
 import PureTabs.Model.Events (SidebarEvent)
+import PureTabs.Model.GlobalState (_tabId)
 import PureTabs.Sidebar.Tabs (Output(..))
 import PureTabs.Sidebar.Tabs as Tabs
 import Sidebar.Component.GroupName as GroupName
@@ -137,37 +139,61 @@ component =
   -- 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
+
     Tabs.InitialTabList tabs a -> do
        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 
-       s <- H.modify (\s -> s { tabsToGroup = M.insert t.id s.currentGroup  s.tabsToGroup })
-       void $ tellChild s.currentGroup $ Tabs.TabCreated (Tab t)
+
+    Tabs.TabCreated tab a -> do 
+       let tabId = view _tabId tab
+       s <- H.modify (\s -> s { tabsToGroup = M.insert tabId s.currentGroup  s.tabsToGroup })
+       doOnTabGroup tabId \_ -> do
+         void $ tellChild s.currentGroup $ Tabs.TabAttached tab
        pure (Just a)
+
     Tabs.TabDeleted tid a -> do 
-       s <- H.modify (\s -> s { tabsToGroup = M.delete tid s.tabsToGroup })
-       void $ tellChild s.currentGroup $ Tabs.TabDeleted tid
+       doOnTabGroup tid \_ -> do 
+         s <- H.modify (\s -> s { tabsToGroup = M.delete tid s.tabsToGroup })
+         void $ tellChild s.currentGroup $ Tabs.TabDeleted tid
        pure (Just a)
+
     Tabs.TabActivated oldTid tid a -> do 
-       s <- H.get
-       void $ tellChild s.currentGroup $ Tabs.TabActivated oldTid tid
+       doOnTabGroup tid \gid -> do 
+         s <- H.modify (_ { currentGroup = gid})
+         void $ tellChild s.currentGroup $ Tabs.TabActivated oldTid tid
        pure (Just a)
+
     Tabs.TabMoved tid prev next a -> do 
-       s <- H.get
-       void $ tellChild s.currentGroup $ Tabs.TabMoved tid prev next
+       doOnTabGroup tid \_ -> do 
+         s <- H.get
+         void $ tellChild s.currentGroup $ Tabs.TabMoved tid prev next
        pure (Just a)
+
     Tabs.TabInfoChanged tid cinfo a -> do 
-       s <- H.get
-       void $ tellChild s.currentGroup $ Tabs.TabInfoChanged tid cinfo
+       doOnTabGroup tid \_ -> do
+         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)
+       handleQuery $ Tabs.TabDeleted tid a
+
+    Tabs.TabAttached tab a -> do 
+       handleQuery $ Tabs.TabCreated tab a
 
     where
         tellChild :: GroupId -> (H.Tell Tabs.Query) -> H.HalogenM State act Slots o m (Maybe Unit)
         tellChild gid q = H.query _tab gid $ H.tell q
+
+        doOnTabGroup 
+          :: TabId 
+          -> (GroupId -> H.HalogenM State act Slots o m Unit) 
+          -> H.HalogenM State act Slots o m Unit
+        doOnTabGroup tabId f = do
+          { tabsToGroup } <- H.get
+          case M.lookup tabId tabsToGroup of 
+               Just groupId -> f groupId
+               Nothing -> pure unit

+ 7 - 3
src/Sidebar/Components/Tabs.purs

@@ -1,6 +1,6 @@
 module PureTabs.Sidebar.Tabs (component, Query(..), Output(..)) where
 
-import Browser.Tabs (Tab(..), TabId)
+import Browser.Tabs (Tab(..), TabId, showTabId)
 import Browser.Tabs.OnUpdated (ChangeInfo(..), ChangeInfoRec)
 import CSS.Background as CssBackground
 import Control.Alt ((<$>))
@@ -48,7 +48,7 @@ data Query a
   | TabMoved TabId Int Int a
   | TabInfoChanged TabId ChangeInfo a
   | TabDetached TabId a
-  -- | TabAttached Tab a
+  | TabAttached Tab a
 
 data Output 
   = TabsSidebarAction SidebarEvent
@@ -344,7 +344,7 @@ handleAction = case _ of
       Nothing -> pure unit
       Just prevIdx -> H.modify_ _ { tabHovered = Nothing }
 
-handleQuery :: forall act o m a. Query a -> H.HalogenM State act () o m (Maybe a)
+handleQuery :: forall act o m a. MonadEffect m => Query a -> H.HalogenM State act () o m (Maybe a)
 handleQuery = case _ of
 
   InitialTabList tabs a -> H.modify_ (\s -> s { tabs = tabs }) *> pure (Just a)
@@ -397,6 +397,10 @@ handleQuery = case _ of
   TabDetached tid a -> 
     handleQuery $ TabDeleted tid a
 
+  TabAttached tab a -> do
+    H.liftEffect (log $ "sb: tab attached " <> (showTabId tab))
+    handleQuery $ TabCreated tab a
+
 setTabActive :: Boolean -> Tab -> Tab
 setTabActive act (Tab t) = Tab (t { active = act })
 

+ 7 - 1
src/Sidebar/Sidebar.purs

@@ -14,6 +14,7 @@ import Data.Unit (Unit, unit)
 import Effect (Effect)
 import Effect.Aff (Aff, error)
 import Effect.Class (liftEffect)
+import Effect.Class.Console (error) as Console
 import Halogen as H
 import Halogen.Aff as HA
 import Halogen.VDom.Driver (runUI)
@@ -66,7 +67,12 @@ onBackgroundMsgConsumer query =
         BgTabDetached tabId -> do 
           void $ query $ H.tell $ Tabs.TabDetached tabId
           pure Nothing
-        _ -> pure Nothing
+        BgTabAttached tab -> do 
+          void $ query $ H.tell $ Tabs.TabAttached tab
+          pure Nothing
+        _ -> do 
+           H.liftEffect $ Console.error "sb(main): un-handled message"
+           pure Nothing
 
 onSidebarMsg :: Runtime.Port -> CR.Consumer SidebarEvent Aff Unit
 onSidebarMsg port =