Главная Обзор Помощь
Регистрация Вход
theenglishway
/
purescript_linked_in
Следить 1
В избранное 0
Ответвить 0
Файлы Обсуждения 0 Запросы на слияние 0 Вики
Просмотр исходного кода

feat: initial sidebar load now contain existing tabs

Jocelyn Boullier 5 лет назад
Родитель
a72e1e8795
Сommit
1229c268de
13 измененных файлов с 7162 добавлено и 1724 удалено
Единый вид Показать статистику Diff
  1. 5209 533
      extension/background.js
  2. 1 1
      extension/background.js.map
  3. 2 0
      extension/jquery-3.4.1.slim.min.js
  4. 12 0
      extension/panel.css
  5. 3 0
      extension/sidebar.html
  6. 1762 1131
      extension/sidebar.js
  7. 1 1
      extension/sidebar.js.map
  8. 62 38
      src/Background.purs
  9. 5 0
      src/Browser/Tabs.js
  10. 26 4
      src/Browser/Tabs.purs
  11. 17 0
      src/Browser/Utils.purs
  12. 44 7
      src/Model.purs
  13. 18 9
      src/Sidebar.purs

Разница между файлами не показана из-за своего большого размера
+ 5209 - 533
extension/background.js


Разница между файлами не показана из-за своего большого размера
+ 1 - 1
extension/background.js.map


Разница между файлами не показана из-за своего большого размера
+ 2 - 0
extension/jquery-3.4.1.slim.min.js


+ 12 - 0
extension/panel.css
Просмотреть файл 

@@ -0,0 +1,12 @@
 
+#tabs {
 
+  margin-top: 1px;
 
+}
 
+
 
+.tab {
 
+  border: solid grey 1px;
 
+  margin-bottom: 1px;
 
+}
 
+
 
+.tab {
 
+  padding-left: 2px;
 
+}

+ 3 - 0
extension/sidebar.html
Просмотреть файл 

@@ -9,6 +9,9 @@
 
 
 
   <body>
 
   <body>
 
     <div id="content">
 
     <div id="content">
 
+      <div id="menu">
 
+      </div>
 
+      <div id="tabs"></div>
 
     </div>
 
     </div>
 
     <script src="sidebar.js"></script>
 
     <script src="sidebar.js"></script>
 
   </body>
 
   </body>

Разница между файлами не показана из-за своего большого размера
+ 1762 - 1131
extension/sidebar.js


Разница между файлами не показана из-за своего большого размера
+ 1 - 1
extension/sidebar.js.map


+ 62 - 38
src/Background.purs
Просмотреть файл 

@@ -1,18 +1,19 @@
 
 module PureTabs.Background where
 
 module PureTabs.Background where
 
 
 
-import Data.List
 
 import Browser.Runtime as Runtime
 
 import Browser.Runtime as Runtime
 
-import Browser.Tabs (Tab, TabId(..), WindowId)
 
+import Browser.Tabs (Tab, TabId, WindowId, query)
 
 import Browser.Tabs.OnCreated as TabsOnCreated
 
 import Browser.Tabs.OnCreated as TabsOnCreated
 
 import Browser.Tabs.OnRemoved as TabsOnRemoved
 
 import Browser.Tabs.OnRemoved as TabsOnRemoved
 
 import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
 
 import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
 
 import Control.Alt (map)
 
 import Control.Alt (map)
 
 import Control.Alternative (pure, (*>))
 
 import Control.Alternative (pure, (*>))
 
+import Data.Array (fromFoldable)
 
 import Data.Foldable (for_)
 
 import Data.Foldable (for_)
 
 import Data.Function (flip)
 
 import Data.Function (flip)
 
-import Data.Lens (_Just, over, preview, set, view)
 
+import Data.Lens (_Just, over, preview, set)
 
 import Data.Lens.At (at)
 
 import Data.Lens.At (at)
 
-import Data.Map (empty)
 
+import Data.List (List, foldr, foldMap)
 
+import Data.Map (empty, lookup, values)
 
 import Data.Maybe (Maybe(..), maybe)
 
 import Data.Maybe (Maybe(..), maybe)
 
 import Data.Monoid ((<>))
 
 import Data.Monoid ((<>))
 
 import Data.Newtype (unwrap)
 
 import Data.Newtype (unwrap)
 
@@ -20,10 +21,12 @@ import Data.Show (show)
 
 import Data.Unit (unit)
 
 import Data.Unit (unit)
 
 import Debug.Trace (traceM)
 
 import Debug.Trace (traceM)
 
 import Effect (Effect)
 
 import Effect (Effect)
 
+import Effect.Aff (Aff, launchAff_)
 
+import Effect.Class (liftEffect)
 
 import Effect.Console (log)
 
 import Effect.Console (log)
 
 import Effect.Ref as Ref
 
 import Effect.Ref as Ref
 
 import Prelude (Unit, bind, ($), discard, (<<<))
 
 import Prelude (Unit, bind, ($), discard, (<<<))
 
-import PureTabs.Model (_windows, _portFromWindow, _tabFromWindow, _port, _tabFromTabIdAndWindow, initialGlobalState, GlobalState, BackgroundEvent(..), SidebarEvent(..))
 
+import PureTabs.Model (_windows, _portFromWindow, _tabFromWindow, _port, _tabFromTabIdAndWindow, tabsToGlobalState, GlobalState, BackgroundEvent(..), SidebarEvent(..))
 
 
 
 type Ports
 
 type Ports
 
   = Ref.Ref (List Runtime.Port)
 
   = Ref.Ref (List Runtime.Port)
 
@@ -31,17 +34,22 @@ type Ports
 
 main :: Effect Unit
 
 main :: Effect Unit
 
 main = do
 
 main = do
 
   log "starting background"
 
   log "starting background"
 
-  state <- Ref.new initialGlobalState
 
-  initializeBackground state
 
-  log "all listener initialized"
 
+  launchAff_ runMain
 
+  where
 
+  runMain :: Aff Unit
 
+  runMain = do
 
+    allTabs <- query
 
+    liftEffect
 
+      $ do
 
+          state <- Ref.new $ tabsToGlobalState allTabs
 
+          initializeBackground state
 
+          log "all listener initialized"
 
 
 
 initializeBackground :: Ref.Ref GlobalState -> Effect Unit
 
 initializeBackground :: Ref.Ref GlobalState -> Effect Unit
 
 initializeBackground ref = do
 
 initializeBackground ref = do
 
   _ <- TabsOnCreated.addListener $ onTabCreated ref
 
   _ <- TabsOnCreated.addListener $ onTabCreated ref
 
-
 
   tabDeletedListener <- mkListenerTwo $ onTabDeleted ref
 
   tabDeletedListener <- mkListenerTwo $ onTabDeleted ref
 
   _ <- TabsOnRemoved.addListener tabDeletedListener
 
   _ <- TabsOnRemoved.addListener tabDeletedListener
 
-
 
   onConnectedListener <- mkListenerOne $ onConnect ref
 
   onConnectedListener <- mkListenerOne $ onConnect ref
 
   Runtime.onConnectAddListener onConnectedListener
 
   Runtime.onConnectAddListener onConnectedListener
 
   pure unit
 
   pure unit
 
@@ -51,37 +59,38 @@ initializeBackground ref = do
 
 onTabCreated :: (Ref.Ref GlobalState) -> Tab -> Effect Unit
 
 onTabCreated :: (Ref.Ref GlobalState) -> Tab -> Effect Unit
 
 onTabCreated stateRef tab' = do
 
 onTabCreated stateRef tab' = do
 
   state <- Ref.modify (set (_tabFromWindow tab') (Just tab')) stateRef
 
   state <- Ref.modify (set (_tabFromWindow tab') (Just tab')) stateRef
 
-
 
   log $ "tabId: " <> (show tab.id) <> " windowId " <> show tab.windowId
 
   log $ "tabId: " <> (show tab.id) <> " windowId " <> show tab.windowId
 
-
 
   case (preview (_portFromWindow tab') state) of
 
   case (preview (_portFromWindow tab') state) of
 
     Nothing -> pure unit
 
     Nothing -> pure unit
 
     Just port -> do
 
     Just port -> do
 
       _ <- Runtime.postMessageJson port $ BgTabCreated tab'
 
       _ <- Runtime.postMessageJson port $ BgTabCreated tab'
 
       log $ "tab " <> (show tab.id) <> " created: " <> tab.title
 
       log $ "tab " <> (show tab.id) <> " created: " <> tab.title
 
-
 
   where
 
   where
 
-    tab = unwrap tab'
 
+  tab = unwrap tab'
 
 
 
 onTabDeleted :: (Ref.Ref GlobalState) -> TabId -> TabsOnRemoved.RemoveInfo -> Effect Unit
 
 onTabDeleted :: (Ref.Ref GlobalState) -> TabId -> TabsOnRemoved.RemoveInfo -> Effect Unit
 
 onTabDeleted stateRef tabId info = do
 
 onTabDeleted stateRef tabId info = do
 
   state <- Ref.read stateRef
 
   state <- Ref.read stateRef
 
-
 
   let
 
   let
 
     allTabs = _tabFromTabIdAndWindow state tabId
 
     allTabs = _tabFromTabIdAndWindow state tabId
 
-    newState = foldr (\t -> set (_tabFromWindow t) Nothing) state allTabs
 
 
 
+    newState = foldr (\t -> set (_tabFromWindow t) Nothing) state allTabs
 
   Ref.write newState stateRef
 
   Ref.write newState stateRef
 
-
 
   for_ allTabs \t -> do
 
   for_ allTabs \t -> do
 
     let
 
     let
 
       port = preview (_portFromWindow t) state
 
       port = preview (_portFromWindow t) state
 
     maybe (pure unit) ((flip Runtime.postMessageJson) (BgTabDeleted tabId)) port
 
     maybe (pure unit) ((flip Runtime.postMessageJson) (BgTabDeleted tabId)) port
 
 
 
 onConnect :: (Ref.Ref GlobalState) -> Runtime.Port -> Effect Unit
 
 onConnect :: (Ref.Ref GlobalState) -> Runtime.Port -> Effect Unit
 
-onConnect stateRef port = do
 
+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
 
   listenerRef <- Ref.new Nothing
 
-  initialListener <- Runtime.onMessageJsonAddListener port $ windowListener $ onNewWindowId listenerRef
 
+  initialListener <-
 
+    Runtime.onMessageJsonAddListener port $ windowListener
 
+      $ onNewWindowId port stateRef' listenerRef
 
+  -- XXX: is it possible a message arrive *before* this is executed ? 
+  -- theoretically yes, and this means this way of doing is unsafe, but it's
 
+  -- difficult for a handler to remove itself otherwise.
 
   Ref.write (Just initialListener) listenerRef
 
   Ref.write (Just initialListener) listenerRef
 
   where
 
   where
 
   windowListener :: (WindowId -> Effect Unit) -> SidebarEvent -> Effect Unit
 
   windowListener :: (WindowId -> Effect Unit) -> SidebarEvent -> Effect Unit
 
@@ -89,25 +98,40 @@ onConnect stateRef port = do
 
     SbHasWindowId winId -> log ("bg: created winId " <> show winId) *> callback winId
 
     SbHasWindowId winId -> log ("bg: created winId " <> show winId) *> callback winId
 
     _ -> pure unit
 
     _ -> pure unit
 
 
 
-  onNewWindowId :: forall a. (Ref.Ref (Maybe (Listener a))) -> WindowId -> Effect Unit
 
-  onNewWindowId listenerRef winId =
 
-    let
 
-      winLens = _windows <<< (at winId)
 
-    in
 
-      do
 
-        (flip Ref.modify_) stateRef
 
-          $ over winLens
 
-              ( case _ of
 
-                  Nothing -> Just $ { tabs: empty, port: Just port }
 
-                  Just win -> Just $ set _port (Just port) win
 
-              )
 
-        r <- Ref.read stateRef
 
-        ogListener <- Ref.read listenerRef
 
-        foldMap (\l -> Runtime.onMessageRemoveListener port l) ogListener
 
-        Ref.write Nothing listenerRef
 
-        sidebarListener <- Runtime.onMessageJsonAddListener port $ manageSidebar stateRef port
 
-        onDisconnectListener <- mkListenerUnit $ onDisconnect stateRef winId sidebarListener
 
-        Runtime.portOnDisconnect port onDisconnectListener
 
+onNewWindowId ::
 
+  forall a.
 
+  Runtime.Port ->
 
+  (Ref.Ref GlobalState) ->
 
+  ( Ref.Ref
 
+      ( Maybe
 
+          (Listener a)
 
+      )
 
+  ) ->
 
+  WindowId -> Effect Unit
 
+onNewWindowId port stateRef listenerRef winId = do
 
+  -- initial state of the current window
 
+  r <- initWindowState port stateRef winId
 
+  -- remove the previous onMessage listener
 
+  ogListener <- Ref.read listenerRef
 
+  foldMap (\l -> Runtime.onMessageRemoveListener port l) ogListener
 
+  Ref.write Nothing listenerRef
 
+  -- send initial tabs
 
+  maybe (pure unit)
 
+    (\w -> Runtime.postMessageJson port $ BgInitialTabList $ fromFoldable $ values w.tabs)
 
+    (lookup winId r.windows)
 
+  --  add the new onMessage listener
 
+  sidebarListener <- Runtime.onMessageJsonAddListener port $ manageSidebar stateRef port
 
+  onDisconnectListener <- mkListenerUnit $ onDisconnect stateRef winId sidebarListener
 
+  Runtime.portOnDisconnect port onDisconnectListener
 
+
 
+initWindowState :: Runtime.Port -> (Ref.Ref GlobalState) -> WindowId -> Effect GlobalState
 
+initWindowState port ref winId =
 
+  (flip Ref.modify) ref
 
+    $ over (_windows <<< (at winId))
 
+        ( case _ of
 
+            Nothing -> Just $ { tabs: empty, port: Just port }
 
+            Just win -> Just $ set _port (Just port) win
 
+        )
 
 
 
 -- TODO don't pass the full ref, but only a set of function to manipulate/access 
 -- TODO don't pass the full ref, but only a set of function to manipulate/access 
 -- the data required
 
 -- the data required

+ 5 - 0
src/Browser/Tabs.js
Просмотреть файл 

@@ -0,0 +1,5 @@
 
+"use strict";
 
+
 
+exports.queryImpl = function () {
 
+  return browser.tabs.query({});
 
+}

+ 26 - 4
src/Browser/Tabs.purs
Просмотреть файл 

@@ -1,16 +1,29 @@
 
-module Browser.Tabs (WindowId, TabId(..), Tab(..)) where
 
+module Browser.Tabs (WindowId, TabId(..), Tab(..), query) where
 
 
 
+import Browser.Utils (unwrapForeign)
 
+import Control.Alt (map)
 
+import Control.Bind ((>>=))
 
+import Control.Promise (Promise, toAffE)
 
 import Data.Argonaut (class DecodeJson, class EncodeJson)
 
 import Data.Argonaut (class DecodeJson, class EncodeJson)
 
 import Data.Eq (class Eq)
 
 import Data.Eq (class Eq)
 
+import Data.Function (($))
 
 import Data.Generic.Rep (class Generic)
 
 import Data.Generic.Rep (class Generic)
 
 import Data.Generic.Rep.Show (genericShow)
 
 import Data.Generic.Rep.Show (genericShow)
 
+import Data.List (List, fromFoldable)
 
 import Data.Maybe (Maybe)
 
 import Data.Maybe (Maybe)
 
 import Data.Newtype (class Newtype)
 
 import Data.Newtype (class Newtype)
 
 import Data.Number.Format (toString)
 
 import Data.Number.Format (toString)
 
 import Data.Ord (class Ord)
 
 import Data.Ord (class Ord)
 
 import Data.Show (class Show)
 
 import Data.Show (class Show)
 
+import Data.Traversable (traverse)
 
+import Data.Unit (unit)
 
+import Effect (Effect)
 
+import Effect.Aff (Aff)
 
+import Effect.Class (liftEffect)
 
+import Foreign (Foreign)
 
 import Foreign.Class (class Decode, class Encode)
 
 import Foreign.Class (class Decode, class Encode)
 
 import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
 
 import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
 
+import Prelude (bind, pure)
 
 
 
 newtype WindowId
 
 newtype WindowId
 
   = WindowId Number
 
   = WindowId Number
 
@@ -48,9 +61,7 @@ instance encodeTabId :: Encode TabId where
 
 instance decodeTabId :: Decode TabId where
 
 instance decodeTabId :: Decode TabId where
 
   decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
   decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
 
 
-newtype Tab
 
-  = Tab
 
-  { active :: Boolean
 
+newtype Tab = Tab { active :: Boolean
 
   , attention :: Maybe Boolean
 
   , attention :: Maybe Boolean
 
   , audible :: Maybe Boolean
 
   , audible :: Maybe Boolean
 
   , autoDiscardable :: Maybe Boolean
 
   , autoDiscardable :: Maybe Boolean
 
@@ -59,6 +70,7 @@ newtype Tab
 
   , favIconUrl :: Maybe String
 
   , favIconUrl :: Maybe String
 
   , height :: Maybe Number
 
   , height :: Maybe Number
 
   , hidden :: Boolean
 
   , hidden :: Boolean
 
+  , highlighted :: Boolean
 
   , -- should be optional
 
   , -- should be optional
 
     id :: TabId
 
     id :: TabId
 
   , incognito :: Boolean
 
   , incognito :: Boolean
 
@@ -89,3 +101,13 @@ instance encodeTab :: Encode Tab where
 
 
 
 instance decodeTab :: Decode Tab where
 
 instance decodeTab :: Decode Tab where
 
   decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
   decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
+
 
+
 
+foreign import queryImpl :: Effect (Promise (Array Foreign))
 
+
 
+query :: Aff (List Tab)
 
+query = do 
+  tabsArray <- toAffE queryImpl
 
+  let tabsList = fromFoldable tabsArray
 
+  parsed <- liftEffect $ traverse unwrapForeign tabsList
 
+  pure parsed

+ 17 - 0
src/Browser/Utils.purs
Просмотреть файл 

@@ -6,9 +6,20 @@ module Browser.Utils
 
   , mkListenerUnit
 
   , mkListenerUnit
 
   , mkListenerOne
 
   , mkListenerOne
 
   , mkListenerTwo
 
   , mkListenerTwo
 
+  , unwrapForeign
 
   ) where
 
   ) where
 
 
 
+import Control.Alt (map)
 
+import Control.Alternative (pure)
 
+import Control.Monad.Except (runExcept)
 
+import Data.Array (intercalate)
 
+import Data.Either (Either(..))
 
+import Data.Function (($))
 
+import Data.Generic.Rep (class Generic)
 
 import Effect (Effect)
 
 import Effect (Effect)
 
+import Effect.Exception (throw)
 
+import Foreign (Foreign, renderForeignError)
 
+import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
 
 import Prelude (Unit)
 
 import Prelude (Unit)
 
 
 
 type UnregisteredListener a
 
 type UnregisteredListener a
 
@@ -28,3 +39,9 @@ foreign import mkListenerUnit :: (Effect Unit) -> Effect (Listener Unit)
 
 foreign import mkListenerOne :: forall a. (UnregisteredListener a) -> Effect (Listener a)
 
 foreign import mkListenerOne :: forall a. (UnregisteredListener a) -> Effect (Listener a)
 
 
 
 foreign import mkListenerTwo :: forall a b. (UnregisteredListener2 a b) -> Effect (Listener2 a b)
 
 foreign import mkListenerTwo :: forall a b. (UnregisteredListener2 a b) -> Effect (Listener2 a b)
 
+
 
+
 
+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)
 
+  Right val -> pure val

+ 44 - 7
src/Model.purs
Просмотреть файл 

@@ -6,28 +6,32 @@ module PureTabs.Model
 
   , _windows
 
   , _windows
 
   , _portFromWindow
 
   , _portFromWindow
 
   , _tabFromWindow
 
   , _tabFromWindow
 
+  , _tabWindowId
 
+  , _tabId
 
   , _tabFromTabIdAndWindow
 
   , _tabFromTabIdAndWindow
 
   , initialGlobalState
 
   , initialGlobalState
 
+  , tabsToGlobalState
 
   , BackgroundEvent(..)
 
   , BackgroundEvent(..)
 
   , SidebarEvent(..)
 
   , SidebarEvent(..)
 
   ) where
 
   ) where
 
 
 
 import Browser.Runtime (Port)
 
 import Browser.Runtime (Port)
 
-import Browser.Tabs (TabId, WindowId, Tab(..))
 
+import Browser.Tabs (TabId, WindowId, Tab)
 
 import Control.Alt (map)
 
 import Control.Alt (map)
 
+import Data.Function (($))
 
 import Data.Generic.Rep (class Generic)
 
 import Data.Generic.Rep (class Generic)
 
 import Data.Generic.Rep.Show (genericShow)
 
 import Data.Generic.Rep.Show (genericShow)
 
-import Data.Lens (Lens', Traversal', _Just, filtered, itoListOf, toListOf, view)
 
+import Data.Lens (Lens', Traversal', _Just, view)
 
 import Data.Lens.At (at)
 
 import Data.Lens.At (at)
 
+import Data.Lens.Iso.Newtype (_Newtype)
 
 import Data.Lens.Record (prop)
 
 import Data.Lens.Record (prop)
 
 import Data.List (List, catMaybes)
 
 import Data.List (List, catMaybes)
 
-import Data.Map (Map, empty, lookup, member, values)
 
-import Data.Maybe (Maybe)
 
+import Data.Map (Map, empty, fromFoldableWith, lookup, singleton, union, values)
 
+import Data.Maybe (Maybe(..))
 
 import Data.Newtype (unwrap)
 
 import Data.Newtype (unwrap)
 
 import Data.Show (class Show)
 
 import Data.Show (class Show)
 
 import Data.Symbol (SProxy(..))
 
 import Data.Symbol (SProxy(..))
 
 import Data.Tuple (Tuple(..))
 
 import Data.Tuple (Tuple(..))
 
-import Data.Unit (Unit)
 
 import Prelude ((<<<))
 
 import Prelude ((<<<))
 
 
 
 type Window
 
 type Window
 
@@ -48,6 +52,24 @@ type GlobalState
 
 _windows :: forall a r. Lens' { windows :: a | r } a
 
 _windows :: forall a r. Lens' { windows :: a | r } a
 
 _windows = prop (SProxy :: SProxy "windows")
 
 _windows = prop (SProxy :: SProxy "windows")
 
 
 
+_title :: forall a r. Lens' { title :: a | r } a
 
+_title = prop (SProxy :: SProxy "title")
 
+
 
+_tabTitle :: Lens' Tab String
 
+_tabTitle = _Newtype <<< _title
 
+
 
+_id :: forall a r. Lens' { id :: a | r } a
 
+_id = prop (SProxy :: SProxy "id")
 
+
 
+_tabId :: Lens' Tab TabId
 
+_tabId = _Newtype <<< _id
 
+
 
+_windowId :: forall a r. Lens' { windowId :: a | r } a
 
+_windowId = prop (SProxy :: SProxy "windowId")
 
+
 
+_tabWindowId :: Lens' Tab WindowId
 
+_tabWindowId = _Newtype <<< _windowId
 
+
 
 _portFromWindow :: Tab -> Traversal' GlobalState Port
 
 _portFromWindow :: Tab -> Traversal' GlobalState Port
 
 _portFromWindow tab' = _windows <<< (at tab.windowId) <<< _Just <<< _port <<< _Just
 
 _portFromWindow tab' = _windows <<< (at tab.windowId) <<< _Just <<< _port <<< _Just
 
   where
 
   where
 
@@ -69,14 +91,29 @@ _tabFromTabIdAndWindow s tabId =
 
   in
 
   in
 
     catMaybes matchingTabId
 
     catMaybes matchingTabId
 
 
 
-{-- (values . map (view _tabs) . map (lookup tabId)) s.windows --}
 
 initialGlobalState :: GlobalState
 
 initialGlobalState :: GlobalState
 
 initialGlobalState =
 
 initialGlobalState =
 
   { windows: empty
 
   { windows: empty
 
   }
 
   }
 
 
 
+tabsToGlobalState :: List Tab -> GlobalState
 
+tabsToGlobalState tabs = { windows: tabsToWindows tabs }
 
+  where
 
+  tabsToWindows :: List Tab -> Map WindowId Window
 
+  tabsToWindows tabs' =
 
+    fromFoldableWith
 
+      (\v1 v2 -> { tabs: union v1.tabs v2.tabs, port: Nothing })
 
+      $ map
 
+          ( \t ->
 
+              Tuple
 
+                (view _tabWindowId t)
 
+                { tabs: singleton (view _tabId t) t, port: Nothing }
 
+          )
 
+          tabs'
 
+
 
 data BackgroundEvent
 
 data BackgroundEvent
 
-  = BgTabCreated Tab
 
+  = BgInitialTabList (Array Tab)
 
+  | BgTabCreated Tab
 
   | BgTabDeleted TabId
 
   | BgTabDeleted TabId
 
   | BgTabMoved
 
   | BgTabMoved
 
   | BgTabActived TabId
 
   | BgTabActived TabId

+ 18 - 9
src/Sidebar.purs
Просмотреть файл 

@@ -1,10 +1,12 @@
 
 module PureTabs.Sidebar where
 
 module PureTabs.Sidebar where
 
 
 
 import Browser.Runtime as Runtime
 
 import Browser.Runtime as Runtime
 
-import Browser.Tabs (Tab(..), TabId(..), WindowId)
 
-import Browser.Utils (mkListenerOne)
 
+import Browser.Tabs (Tab, TabId, WindowId)
 
 import Browser.Windows (getCurrent)
 
 import Browser.Windows (getCurrent)
 
 import Control.Alternative (pure)
 
 import Control.Alternative (pure)
 
+import Control.Bind ((>=>))
 
+import Data.Foldable (traverse_)
 
+import Data.Function (flip)
 
 import Data.Monoid ((<>))
 
 import Data.Monoid ((<>))
 
 import Data.Newtype (unwrap)
 
 import Data.Newtype (unwrap)
 
 import Data.Show (show)
 
 import Data.Show (show)
 
@@ -14,7 +16,7 @@ import Effect (Effect)
 
 import Effect.Aff (Aff, launchAff_)
 
 import Effect.Aff (Aff, launchAff_)
 
 import Effect.Class (liftEffect)
 
 import Effect.Class (liftEffect)
 
 import Effect.Console (log)
 
 import Effect.Console (log)
 
-import JQuery (JQuery, append, create, find, remove, select, setAttr, setText)
 
+import JQuery (JQuery, append, create, remove, select, setAttr, setText)
 
 import Prelude (Unit, bind, ($), discard)
 
 import Prelude (Unit, bind, ($), discard)
 
 import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
 
 import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
 
 
 
@@ -33,8 +35,8 @@ initSidebar :: Runtime.Port -> WindowId -> Effect Unit
 
 initSidebar port winId = do
 
 initSidebar port winId = do
 
   log $ "windowId " <> (show winId)
 
   log $ "windowId " <> (show winId)
 
   Runtime.postMessageJson port $ SbHasWindowId winId
 
   Runtime.postMessageJson port $ SbHasWindowId winId
 
-  content <- select "#content"
 
-  _ <- Runtime.onMessageJsonAddListener port $ onMsg content
 
+  tabsDiv <- select "#tabs"
 
+  _ <- Runtime.onMessageJsonAddListener port $ onMsg tabsDiv
 
   pure unit
 
   pure unit
 
   where
 
   where
 
   onMsg :: JQuery -> BackgroundEvent -> Effect Unit
 
   onMsg :: JQuery -> BackgroundEvent -> Effect Unit
 
@@ -44,16 +46,23 @@ initSidebar port winId = do
 
       append tabElem contentDiv
 
       append tabElem contentDiv
 
       pure unit
 
       pure unit
 
     BgTabDeleted tabId -> deleteTabElement tabId
 
     BgTabDeleted tabId -> deleteTabElement tabId
 
+    BgInitialTabList tabs -> 
+      traverse_ (createTabElement >=> (flip append) contentDiv) tabs
 
     _ -> log "received unsupported message type"
 
     _ -> log "received unsupported message type"
 
 
 
 createTabElement :: Tab -> Effect JQuery
 
 createTabElement :: Tab -> Effect JQuery
 
 createTabElement tab' = do
 
 createTabElement tab' = do
 
   let
 
   let
 
     tab = unwrap tab'
 
     tab = unwrap tab'
 
-  div <- create "<div>"
 
-  setText tab.title div
 
-  setAttr "id" tab.id div
 
-  pure div
 
+  tabDiv <- create "<div>"
 
+  setText tab.title tabDiv
 
+  setAttr "class" "tab" tabDiv
 
+  setAttr "id" tab.id tabDiv
 
+  favicon <- create "<span class=\"favicon\">"
 
+  tabTitle <- create "<span class=\"tab-title\">"
 
+  append favicon tabDiv
 
+  append tabTitle tabDiv
 
+  pure tabDiv
 
 
 
 deleteTabElement :: TabId -> Effect Unit
 
 deleteTabElement :: TabId -> Effect Unit
 
 deleteTabElement tabId = do
 
 deleteTabElement tabId = do