Ana Sayfa Keşfet Yardım
Üye Ol Giriş Yap
theenglishway
/
purescript_linked_in
İzle 1
Yıldızla 0
Çatalla 0
Dosyalar Sorunlar 0 Değişiklik İstekleri 0 Wiki
Kaynağa Gözat

feat: working sidebar with support for creation and deletion of tabs

Jocelyn Boullier 5 yıl önce
ebeveyn
b33f5d48e0
işleme
a72e1e8795
20 değiştirilmiş dosya ile 62750 ekleme ve 5372 silme
Görünümü Böl Farklılık Durumunu Göster
  1. 26313 5192
      extension/background.js
  2. 1 1
      extension/background.js.map
  3. 8 8
      extension/sidebar.html
  4. 35834 78
      extension/sidebar.js
  5. 1 1
      extension/sidebar.js.map
  6. 24 2
      spago.dhall
  7. 102 28
      src/Background.purs
  8. 25 4
      src/Browser/Runtime.js
  9. 43 5
      src/Browser/Runtime.purs
  10. 90 22
      src/Browser/Tabs.purs
  11. 1 9
      src/Browser/Tabs/OnCreated.js
  12. 26 18
      src/Browser/Tabs/OnCreated.purs
  13. 13 0
      src/Browser/Tabs/OnRemoved.js
  14. 15 0
      src/Browser/Tabs/OnRemoved.purs
  15. 26 0
      src/Browser/Utils.js
  16. 30 0
      src/Browser/Utils.purs
  17. 5 0
      src/Browser/Windows.js
  18. 38 0
      src/Browser/Windows.purs
  19. 107 0
      src/Model.purs
  20. 48 4
      src/Sidebar.purs

Dosya farkı çok büyük olduğundan ihmal edildi
+ 26313 - 5192
extension/background.js


Dosya farkı çok büyük olduğundan ihmal edildi
+ 1 - 1
extension/background.js.map


+ 8 - 8
extension/sidebar.html
Dosyayı Görüntüle 

@@ -2,14 +2,14 @@
 
 
 <html>
 
   <head>
 
-    <meta charset="utf-8">
 
-    <link rel="stylesheet" href="panel.css"/>
 
+    <meta charset="utf-8" />
 
+    <link rel="stylesheet" href="panel.css" />
 
+    <script src="jquery-3.4.1.slim.min.js"></script>
 
   </head>
 
 
-<body>
 
-  <div id = "content"></div>
 
-  <p>This is the Sidebar</p>
 
-  <script src="sidebar.js"></script>
 
-</body>
 
-
 
+  <body>
 
+    <div id="content">
 
+    </div>
 
+    <script src="sidebar.js"></script>
 
+  </body>
 
 </html>

Dosya farkı çok büyük olduğundan ihmal edildi
+ 35834 - 78
extension/sidebar.js


Dosya farkı çok büyük olduğundan ihmal edildi
+ 1 - 1
extension/sidebar.js.map


+ 24 - 2
spago.dhall
Dosyayı Görüntüle 

@@ -2,9 +2,31 @@
 
 Welcome to a Spago project!
 
 You can edit this file as you like.
 
 -}
 
-{ name = "my-project"
 
+{ name = "pure-tabs"
 
 , dependencies =
 
-  [ "console", "effect", "lists", "numbers", "psci-support", "refs", "st" ]
 
+  [ "aff"
 
+  , "aff-promise"
 
+  , "argonaut"
 
+  , "argonaut-codecs"
 
+  , "argonaut-generic"
 
+  , "console"
 
+  , "debug"
 
+  , "effect"
 
+  , "foreign"
 
+  , "foreign-generic"
 
+  , "generics-rep"
 
+  , "jquery"
 
+  , "lists"
 
+  , "numbers"
 
+  , "profunctor"
 
+  , "profunctor-lenses"
 
+  , "psci-support"
 
+  , "refs"
 
+  , "st"
 
+  , "unordered-collections"
 
+  , "web-dom"
 
+  , "web-html"
 
+  ]
 
 , packages = ./packages.dhall
 
 , sources = [ "src/**/*.purs", "test/**/*.purs" ]
 
 }

+ 102 - 28
src/Background.purs
Dosyayı Görüntüle 

@@ -1,45 +1,119 @@
 
 module PureTabs.Background where
 
 
 import Data.List
 
-
 
 import Browser.Runtime as Runtime
 
-import Browser.Tabs (Tab)
 
-import Browser.Tabs.OnCreated as OnCreated
 
+import Browser.Tabs (Tab, TabId(..), WindowId)
 
+import Browser.Tabs.OnCreated as TabsOnCreated
 
+import Browser.Tabs.OnRemoved as TabsOnRemoved
 
+import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
 
+import Control.Alt (map)
 
+import Control.Alternative (pure, (*>))
 
 import Data.Foldable (for_)
 
+import Data.Function (flip)
 
+import Data.Lens (_Just, over, preview, set, view)
 
+import Data.Lens.At (at)
 
+import Data.Map (empty)
 
+import Data.Maybe (Maybe(..), maybe)
 
 import Data.Monoid ((<>))
 
-import Data.Number.Format (toString)
 
+import Data.Newtype (unwrap)
 
+import Data.Show (show)
 
+import Data.Unit (unit)
 
+import Debug.Trace (traceM)
 
 import Effect (Effect)
 
 import Effect.Console (log)
 
 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(..))
 
 
-type Ports = Ref.Ref (List Runtime.Port)
 
+type Ports
 
+  = Ref.Ref (List Runtime.Port)
 
 
 main :: Effect Unit
 
 main = do
 
-  log "started background"
 
-  ports <- Ref.new Nil
 
+  log "starting background"
 
+  state <- Ref.new initialGlobalState
 
+  initializeBackground state
 
+  log "all listener initialized"
 
+
 
+initializeBackground :: Ref.Ref GlobalState -> Effect Unit
 
+initializeBackground ref = do
 
+  _ <- TabsOnCreated.addListener $ onTabCreated ref
 
+
 
+  tabDeletedListener <- mkListenerTwo $ onTabDeleted ref
 
+  _ <- TabsOnRemoved.addListener tabDeletedListener
 
+
 
+  onConnectedListener <- mkListenerOne $ onConnect ref
 
+  Runtime.onConnectAddListener onConnectedListener
 
+  pure unit
 
+
 
+-- port on connect
 
+-- created tab
 
+onTabCreated :: (Ref.Ref GlobalState) -> Tab -> Effect Unit
 
+onTabCreated stateRef tab' = do
 
+  state <- Ref.modify (set (_tabFromWindow tab') (Just tab')) stateRef
 
+
 
+  log $ "tabId: " <> (show tab.id) <> " windowId " <> show tab.windowId
 
+
 
+  case (preview (_portFromWindow tab') state) of
 
+    Nothing -> pure unit
 
+    Just port -> do
 
+      _ <- Runtime.postMessageJson port $ BgTabCreated tab'
 
+      log $ "tab " <> (show tab.id) <> " created: " <> tab.title
 
 
-  Runtime.onConnectAddListener $ onConnect ports
 
+  where
 
+    tab = unwrap tab'
 
+
 
+onTabDeleted :: (Ref.Ref GlobalState) -> TabId -> TabsOnRemoved.RemoveInfo -> Effect Unit
 
+onTabDeleted stateRef tabId info = do
 
+  state <- Ref.read stateRef
 
+
 
+  let
 
+    allTabs = _tabFromTabIdAndWindow state tabId
 
+    newState = foldr (\t -> set (_tabFromWindow t) Nothing) state allTabs
 
+
 
+  Ref.write newState stateRef
 
 
-  listener <- OnCreated.mkListener $ sendCreatedTab ports
 
-  OnCreated.addListener listener
 
+  for_ allTabs \t -> do
 
+    let
 
+      port = preview (_portFromWindow t) state
 
+    maybe (pure unit) ((flip Runtime.postMessageJson) (BgTabDeleted tabId)) port
 
 
+onConnect :: (Ref.Ref GlobalState) -> Runtime.Port -> Effect Unit
 
+onConnect stateRef port = do
 
+  listenerRef <- Ref.new Nothing
 
+  initialListener <- Runtime.onMessageJsonAddListener port $ windowListener $ onNewWindowId listenerRef
 
+  Ref.write (Just initialListener) listenerRef
 
   where
 
-        logTabId :: Tab -> Effect Unit
 
-        logTabId tab = do 
-           log $ toString tab.id
 
-
 
-        sendCreatedTab :: Ports -> Tab -> Effect Unit
 
-        sendCreatedTab portsRef tab = do
 
-           log $ "(bg) tab created" <> tabId
 
-           ports <- Ref.read portsRef
 
-           for_ ports (\p -> Runtime.postMessage p tabId)
 
-
 
-            where
 
-                  tabId = toString tab.id
 
-
 
-        onConnect :: Ports -> Runtime.Port -> Effect Unit
 
-        onConnect ref port = do 
-           log "new connect"
 
-           Ref.modify_ (\ports -> port : ports) ref
 
+  windowListener :: (WindowId -> Effect Unit) -> SidebarEvent -> Effect Unit
 
+  windowListener callback msg = case msg of
 
+    SbHasWindowId winId -> log ("bg: created winId " <> show winId) *> callback winId
 
+    _ -> 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
 
+
 
+-- 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
 
+
 
+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

+ 25 - 4
src/Browser/Runtime.js
Dosyayı Görüntüle 

@@ -1,5 +1,6 @@
 
 "use strict";
 
 
+
 
 exports.connect = function () {
 
     return browser.runtime.connect({name: name});
 
 }
 
@@ -14,16 +15,36 @@ exports.postMessage = function (port) {
 
 
 exports.onConnectAddListener = function (fn) {
 
   return function () {
 
-    return browser.runtime.onConnect.addListener(p => {
 
-      fn(p)();
 
-    })
 
+    return browser.runtime.onConnect.addListener(fn)
 
+  }
 
+}
 
+
 
+exports.portOnDisconnect = function(port) {
 
+  return function (fn) {
 
+    return function () {
 
+      return port.onDisconnect.addListener(fn)
 
+    }
 
   }
 
 }
 
 
 exports.onMessageAddListener = function (port) {
 
   return function (fn) {
 
     return function () {
 
-      return port.onMessage.addListener(m => fn(m)());
 
+      return port.onMessage.addListener(fn);
 
+    }
 
+  }
 
+}
 
+
 
+exports.onMessageRemoveListener = function (port) {
 
+  return function (fn) {
 
+    return function () {
 
+      return port.onMessage.removeListener(fn);
 
     }
 
   }
 
 }
 
+
 
+exports.portEquality = function (p1) {
 
+  return function (p2) {
 
+    return p1 === p2
 
+  }
 
+}

+ 43 - 5
src/Browser/Runtime.purs
Dosyayı Görüntüle 

@@ -1,14 +1,52 @@
 
-module Browser.Runtime (Port, connect, onConnectAddListener, postMessage, onMessageAddListener) where
 
+module Browser.Runtime (Port, connect, onConnectAddListener, portOnDisconnect, postMessage, postMessageJson, onMessageAddListener, onMessageJsonAddListener, onMessageRemoveListener) where
 
 
-import Prelude (Unit)
 
+import Browser.Utils (mkListenerOne, Listener, UnregisteredListener)
 
+import Control.Alt (map)
 
+import Control.Bind ((=<<))
 
+import Control.Monad.Except (runExcept)
 
+import Data.Array (intercalate)
 
+import Data.Bifunctor (lmap)
 
+import Data.Either (Either(..))
 
+import Data.Eq (class Eq)
 
+import Data.Generic.Rep (class Generic)
 
+import Data.Monoid ((<>))
 
 import Effect (Effect)
 
+import Effect.Console (error)
 
+import Foreign (renderForeignError)
 
+import Foreign.Generic (class GenericEncode, class GenericDecode, defaultOptions, genericEncodeJSON, genericDecodeJSON)
 
+import Prelude (Unit, ($), bind, discard, pure)
 
   
 foreign import data Port :: Type
 
 
+foreign import portEquality :: Port -> Port -> Boolean
 
+
 
+instance eqPort :: Eq Port where
 
+  eq = portEquality
 
+
 
 foreign import connect :: Effect Port
 
 
-foreign import onConnectAddListener :: (Port -> Effect Unit) -> Effect Unit
 
+foreign import onConnectAddListener :: Listener Port -> Effect Unit
 
+
 
+foreign import postMessage :: forall a. Port -> a -> Effect Unit
 
+
 
+postMessageJson :: forall a rep. Generic a rep => GenericEncode rep => Port -> a -> Effect Unit
 
+postMessageJson port d = postMessage port $ genericEncodeJSON (defaultOptions { unwrapSingleConstructors = true}) d
 
+
 
+foreign import portOnDisconnect :: Port -> Listener Unit -> Effect Unit
 
+
 
+foreign import onMessageAddListener :: forall a. Port -> Listener a -> Effect Unit
 
+
 
+onMessageJsonAddListener :: forall a rep. Generic a rep => GenericDecode rep => Port -> UnregisteredListener a -> Effect (Listener String)
 
+onMessageJsonAddListener port f = do 
+  jsonLst <- mkListenerOne listener
 
+  onMessageAddListener port jsonLst
 
+  pure jsonLst
 
 
-foreign import postMessage :: Port -> String -> Effect Unit
 
+  where
 
+        listener msg = case runExcept (genericDecodeJSON (defaultOptions { unwrapSingleConstructors = true}) msg :: _ a) of 
+                 Left err -> do 
+                    error $ "error while trying to parse message: " <> intercalate ", " (map renderForeignError err)
 
+                    error $ "message was " <> msg
 
+                 Right d -> f d
 
 
-foreign import onMessageAddListener :: Port -> (String -> Effect Unit) -> Effect Unit
 
+foreign import onMessageRemoveListener :: forall a. Port -> Listener a -> Effect Unit

+ 90 - 22
src/Browser/Tabs.purs
Dosyayı Görüntüle 

@@ -1,23 +1,91 @@
 
-module Browser.Tabs (Tab(..)) where
 
-
 
-type Tab = {
 
-  active :: Boolean,
 
-  attention :: Boolean,
 
-  audible :: Boolean,
 
-  discarded :: Boolean,
 
-  favIconUrl :: String,
 
-  height :: Number,
 
-  hidden :: Boolean,
 
-  id :: Number,
 
-  incognito :: Boolean,
 
-  index :: Number,
 
-  isArticle :: Boolean,
 
-  pinned :: Boolean,
 
-  status :: String, -- create an enum for that
 
-  successorTabId :: Number,
 
-  title :: String,
 
-  url :: String,
 
-  width :: Number,
 
-  windowId :: Number
 
-}
 
+module Browser.Tabs (WindowId, TabId(..), Tab(..)) where
 
 
+import Data.Argonaut (class DecodeJson, class EncodeJson)
 
+import Data.Eq (class Eq)
 
+import Data.Generic.Rep (class Generic)
 
+import Data.Generic.Rep.Show (genericShow)
 
+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 Foreign.Class (class Decode, class Encode)
 
+import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
 
+
 
+newtype WindowId
 
+  = WindowId Number
 
+
 
+derive instance eqWindowId :: Eq WindowId
 
+
 
+derive instance ordWindowId :: Ord WindowId
 
+
 
+instance showWindowId :: Show WindowId where
 
+  show (WindowId wid) = toString wid
 
+
 
+derive instance genWindowId :: Generic WindowId _
 
+
 
+instance encodeWindowId :: Encode WindowId where
 
+  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
 
+
 
+instance decodeWindowId :: Decode WindowId where
 
+  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
+
 
+newtype TabId
 
+  = TabId Number
 
+
 
+derive instance eqTabId :: Eq TabId
 
+
 
+derive instance ordTabId :: Ord TabId
 
+
 
+instance showTabId :: Show TabId where
 
+  show (TabId wid) = toString wid
 
+
 
+derive instance genTabId :: Generic TabId _
 
+
 
+instance encodeTabId :: Encode TabId where
 
+  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
 
+
 
+instance decodeTabId :: Decode TabId where
 
+  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
 
+
 
+newtype Tab
 
+  = Tab
 
+  { active :: Boolean
 
+  , attention :: Maybe Boolean
 
+  , audible :: Maybe Boolean
 
+  , autoDiscardable :: Maybe Boolean
 
+  , cookieStoreId :: Maybe String
 
+  , discarded :: Maybe Boolean
 
+  , favIconUrl :: Maybe String
 
+  , height :: Maybe Number
 
+  , hidden :: Boolean
 
+  , -- should be optional
 
+    id :: TabId
 
+  , incognito :: Boolean
 
+  , index :: Number
 
+  , isArticle :: Maybe Boolean
 
+  , isInReaderMode :: Boolean
 
+  , lastAccessed :: Number
 
+  , openerTabId :: Maybe TabId
 
+  , pinned :: Boolean
 
+  , sessionId :: Maybe String
 
+  , status :: Maybe String
 
+   -- create an enum for that successorTabId :: Maybe Number
 
+  , title :: String
 
+  , url :: Maybe String
 
+  , width :: Maybe Number
 
+  , windowId :: WindowId
 
+  }
 
+
 
+derive instance newtypeTab :: Newtype Tab _
 
+
 
+derive instance genTab :: Generic Tab _
 
+
 
+instance showTab :: Show Tab where
 
+  show = genericShow
 
+
 
+instance encodeTab :: Encode Tab where
 
+  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
 
+
 
+instance decodeTab :: Decode Tab where
 
+  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x

+ 1 - 9
src/Browser/Tabs/OnCreated.js
Dosyayı Görüntüle 

@@ -1,14 +1,6 @@
 
 "use stricts";
 
 
-exports.mkListener = function (fn) {
 
-  return function () {
 
-    return function (event) {
 
-      return fn(event)();
 
-    }
 
-  }
 
-};
 
-
 
-exports.addListener = function (listener) {
 
+exports.addListenerImpl = function (listener) {
 
   return function () {
 
     browser.tabs.onCreated.addListener(listener);
 
   }

+ 26 - 18
src/Browser/Tabs/OnCreated.purs
Dosyayı Görüntüle 

@@ -1,20 +1,28 @@
 
-module Browser.Tabs.OnCreated (Listener, ListenerRef, mkListener, addListener, removeListener) where
 
+module Browser.Tabs.OnCreated (addListener, removeListener) where
 
 
-import Prelude
 
-import Effect (Effect)
 
 import Browser.Tabs (Tab)
 
-
 
-
 
-foreign import data ListenerRef :: Type
 
-
 
-type Listener = (Tab -> Effect Unit)
 
-
 
-
 
-foreign import mkListener
 
-  :: Listener -> Effect ListenerRef
 
-
 
-foreign import addListener
 
-  :: ListenerRef -> Effect Unit
 
-
 
-foreign import removeListener
 
-  :: ListenerRef -> Effect Unit
 
+import Browser.Utils (Listener, UnregisteredListener, mkListenerOne)
 
+import Control.Alt (map)
 
+import Control.Monad.Error.Class (throwError)
 
+import Control.Monad.Except (runExcept)
 
+import Data.Array (intercalate)
 
+import Data.Either (Either(..))
 
+import Effect (Effect)
 
+import Effect.Exception (throw)
 
+import Foreign (Foreign, renderForeignError)
 
+import Foreign.Generic (defaultOptions, genericDecode)
 
+import Prelude (Unit, bind, ($))
 
+
 
+foreign import addListenerImpl :: (Listener Foreign) -> Effect Unit
 
+
 
+addListener :: (UnregisteredListener Tab) -> Effect Unit
 
+addListener listener = do
 
+  lst <- mkListenerOne foreignListener
 
+  addListenerImpl lst
 
+  where
 
+  foreignListener :: UnregisteredListener Foreign
 
+  foreignListener f = case runExcept $ genericDecode (defaultOptions { unwrapSingleConstructors = true }) f of
 
+    Left err -> throw $ intercalate ", " (map renderForeignError err)
 
+    Right val -> listener val
 
+
 
+foreign import removeListener :: (Listener Tab) -> Effect Unit

+ 13 - 0
src/Browser/Tabs/OnRemoved.js
Dosyayı Görüntüle 

@@ -0,0 +1,13 @@
 
+"use stricts";
 
+
 
+exports.addListener = function (listener) {
 
+  return function () {
 
+    browser.tabs.onRemoved.addListener(listener);
 
+  }
 
+}
 
+
 
+exports.removeListener = function (listener) {
 
+  return function () {
 
+    return browser.tabs.onRemoved.removeListener(listener);
 
+  }
 
+}

+ 15 - 0
src/Browser/Tabs/OnRemoved.purs
Dosyayı Görüntüle 

@@ -0,0 +1,15 @@
 
+module Browser.Tabs.OnRemoved (RemoveInfo, addListener, removeListener) where
 
+
 
+import Prelude (Unit)
 
+import Effect (Effect)
 
+import Browser.Tabs (WindowId, TabId)
 
+import Browser.Utils (Listener2)
 
+
 
+type RemoveInfo = {
 
+  windowId :: WindowId,
 
+  isWindowClosing :: Boolean
 
+}
 
+
 
+foreign import addListener :: (Listener2 TabId RemoveInfo) -> Effect Unit
 
+
 
+foreign import removeListener :: (Listener2 TabId RemoveInfo) -> Effect Unit

+ 26 - 0
src/Browser/Utils.js
Dosyayı Görüntüle 

@@ -0,0 +1,26 @@
 
+"use stricts";
 
+
 
+
 
+exports.mkListenerUnit = function (fn) {
 
+  return function () {
 
+    return function () {
 
+      return fn();
 
+    }
 
+  }
 
+};
 
+
 
+exports.mkListenerOne = function (fn) {
 
+  return function () {
 
+    return function (one) {
 
+      return fn(one)();
 
+    }
 
+  }
 
+};
 
+
 
+exports.mkListenerTwo = function (fn) {
 
+  return function () {
 
+    return function (one, two) {
 
+        return fn(one)(two)();
 
+    }
 
+  }
 
+};

+ 30 - 0
src/Browser/Utils.purs
Dosyayı Görüntüle 

@@ -0,0 +1,30 @@
 
+module Browser.Utils
 
+  ( UnregisteredListener
 
+  , UnregisteredListener2
 
+  , Listener
 
+  , Listener2
 
+  , mkListenerUnit
 
+  , mkListenerOne
 
+  , mkListenerTwo
 
+  ) where
 
+
 
+import Effect (Effect)
 
+import Prelude (Unit)
 
+
 
+type UnregisteredListener a
 
+  = (a -> Effect Unit)
 
+
 
+type UnregisteredListener2 a b
 
+  = (a -> b -> Effect Unit)
 
+
 
+newtype Listener a
 
+  = Listener (UnregisteredListener a)
 
+
 
+newtype Listener2 a b
 
+  = Listener2 (UnregisteredListener2 a b)
 
+
 
+foreign import mkListenerUnit :: (Effect Unit) -> Effect (Listener Unit)
 
+
 
+foreign import mkListenerOne :: forall a. (UnregisteredListener a) -> Effect (Listener a)
 
+
 
+foreign import mkListenerTwo :: forall a b. (UnregisteredListener2 a b) -> Effect (Listener2 a b)

+ 5 - 0
src/Browser/Windows.js
Dosyayı Görüntüle 

@@ -0,0 +1,5 @@
 
+"use strict";
 
+
 
+exports.getCurrentImpl = function () {
 
+  return browser.windows.getCurrent()
 
+};

+ 38 - 0
src/Browser/Windows.purs
Dosyayı Görüntüle 

@@ -0,0 +1,38 @@
 
+module Browser.Windows (Window, getCurrent) where 
+
 
+import Browser.Tabs (Tab, WindowId)
 
+import Control.Promise (toAffE, Promise)
 
+import Effect (Effect)
 
+import Effect.Aff (Aff)
 
+
 
+
 
+type Window = {
 
+  alwaysOnTop :: Boolean,
 
+  focused :: Boolean,
 
+  -- optional
 
+  height :: Number,
 
+  -- optional
 
+  id :: WindowId,
 
+  incognito :: Boolean,
 
+  -- optional
 
+  left :: Number,
 
+  -- optional
 
+  sessionId :: String,
 
+  -- optional
 
+  {-- state :: Null --}
 
+  -- optional
 
+  tabs :: Array Tab,
 
+  -- optional
 
+  title :: String,
 
+  -- optional
 
+  top :: Number,
 
+  -- optional
 
+  {-- type ::  --}
 
+  -- optional
 
+  width :: Number
 
+}
 
+
 
+foreign import getCurrentImpl :: Effect (Promise Window)
 
+
 
+getCurrent :: Aff Window
 
+getCurrent = toAffE getCurrentImpl

+ 107 - 0
src/Model.purs
Dosyayı Görüntüle 

@@ -0,0 +1,107 @@
 
+module PureTabs.Model
 
+  ( Window
 
+  , GlobalState
 
+  , _tabs
 
+  , _port
 
+  , _windows
 
+  , _portFromWindow
 
+  , _tabFromWindow
 
+  , _tabFromTabIdAndWindow
 
+  , initialGlobalState
 
+  , BackgroundEvent(..)
 
+  , SidebarEvent(..)
 
+  ) where
 
+
 
+import Browser.Runtime (Port)
 
+import Browser.Tabs (TabId, WindowId, Tab(..))
 
+import Control.Alt (map)
 
+import Data.Generic.Rep (class Generic)
 
+import Data.Generic.Rep.Show (genericShow)
 
+import Data.Lens (Lens', Traversal', _Just, filtered, itoListOf, toListOf, view)
 
+import Data.Lens.At (at)
 
+import Data.Lens.Record (prop)
 
+import Data.List (List, catMaybes)
 
+import Data.Map (Map, empty, lookup, member, values)
 
+import Data.Maybe (Maybe)
 
+import Data.Newtype (unwrap)
 
+import Data.Show (class Show)
 
+import Data.Symbol (SProxy(..))
 
+import Data.Tuple (Tuple(..))
 
+import Data.Unit (Unit)
 
+import Prelude ((<<<))
 
+
 
+type Window
 
+  = { tabs :: Map TabId Tab
 
+    , port :: Maybe Port
 
+    }
 
+
 
+_tabs :: forall a r. Lens' { tabs :: a | r } a
 
+_tabs = prop (SProxy :: SProxy "tabs")
 
+
 
+_port :: forall a r. Lens' { port :: a | r } a
 
+_port = prop (SProxy :: SProxy "port")
 
+
 
+type GlobalState
 
+  = { windows :: Map WindowId Window
 
+    }
 
+
 
+_windows :: forall a r. Lens' { windows :: a | r } a
 
+_windows = prop (SProxy :: SProxy "windows")
 
+
 
+_portFromWindow :: Tab -> Traversal' GlobalState Port
 
+_portFromWindow tab' = _windows <<< (at tab.windowId) <<< _Just <<< _port <<< _Just
 
+  where
 
+  tab = unwrap tab'
 
+
 
+_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 s tabId =
 
+  let
 
+    allWindows = values s.windows
 
+
 
+    allTabs = map (view _tabs) allWindows
 
+
 
+    matchingTabId = map (lookup tabId) allTabs
 
+  in
 
+    catMaybes matchingTabId
 
+
 
+{-- (values . map (view _tabs) . map (lookup tabId)) s.windows --}
 
+initialGlobalState :: GlobalState
 
+initialGlobalState =
 
+  { windows: empty
 
+  }
 
+
 
+data BackgroundEvent
 
+  = BgTabCreated Tab
 
+  | BgTabDeleted TabId
 
+  | BgTabMoved
 
+  | BgTabActived TabId
 
+  | BgTabAttached Tab
 
+  | BgTabDetached TabId
 
+  | BgTabHighlighted
 
+  | BgTabReplaced
 
+  | BgTabZoomChanged
 
+
 
+derive instance genBackgroundEvent :: Generic BackgroundEvent _
 
+
 
+instance showBackgroundEvent :: Show BackgroundEvent where
 
+  show = genericShow
 
+
 
+data SidebarEvent
 
+  = SbTabDeleted TabId
 
+  | SbTabCreated
 
+  | SbTabMoved
 
+  | SbTabDetached
 
+  | SbGroupCreated
 
+  | SbGroupDeleted
 
+  | SbGroupRenamed
 
+  | SbHasWindowId WindowId
 
+
 
+derive instance genSidebarEvent :: Generic SidebarEvent _
 
+
 
+instance showSidebarEvent :: Show SidebarEvent where
 
+  show = genericShow

+ 48 - 4
src/Sidebar.purs
Dosyayı Görüntüle 

@@ -1,17 +1,61 @@
 
 module PureTabs.Sidebar where
 
 
 import Browser.Runtime as Runtime
 
+import Browser.Tabs (Tab(..), TabId(..), WindowId)
 
+import Browser.Utils (mkListenerOne)
 
+import Browser.Windows (getCurrent)
 
+import Control.Alternative (pure)
 
 import Data.Monoid ((<>))
 
+import Data.Newtype (unwrap)
 
+import Data.Show (show)
 
+import Data.Unit (unit)
 
+import Debug.Trace (traceM)
 
 import Effect (Effect)
 
+import Effect.Aff (Aff, launchAff_)
 
+import Effect.Class (liftEffect)
 
 import Effect.Console (log)
 
+import JQuery (JQuery, append, create, find, remove, select, setAttr, setText)
 
 import Prelude (Unit, bind, ($), discard)
 
+import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
 
 
 main :: Effect Unit
 
-main = do 
+main = do
 
   log "started sidebar"
 
   port <- Runtime.connect
 
-  Runtime.onMessageAddListener port onMsg
 
+  launchAff_ $ runSidebar port
 
+  where
 
+  runSidebar :: Runtime.Port -> Aff Unit
 
+  runSidebar port = do
 
+    currentWindow <- getCurrent
 
+    liftEffect $ initSidebar port currentWindow.id
 
 
+initSidebar :: Runtime.Port -> WindowId -> Effect Unit
 
+initSidebar port winId = do
 
+  log $ "windowId " <> (show winId)
 
+  Runtime.postMessageJson port $ SbHasWindowId winId
 
+  content <- select "#content"
 
+  _ <- Runtime.onMessageJsonAddListener port $ onMsg content
 
+  pure unit
 
   where
 
-        onMsg m = do 
-           log $ "(sb) tab created: " <> m
 
+  onMsg :: JQuery -> BackgroundEvent -> Effect Unit
 
+  onMsg contentDiv event = case event of
 
+    BgTabCreated tab -> do
 
+      tabElem <- createTabElement tab
 
+      append tabElem contentDiv
 
+      pure unit
 
+    BgTabDeleted tabId -> deleteTabElement tabId
 
+    _ -> log "received unsupported message type"
 
+
 
+createTabElement :: Tab -> Effect JQuery
 
+createTabElement tab' = do
 
+  let
 
+    tab = unwrap tab'
 
+  div <- create "<div>"
 
+  setText tab.title div
 
+  setAttr "id" tab.id div
 
+  pure div
 
+
 
+deleteTabElement :: TabId -> Effect Unit
 
+deleteTabElement tabId = do
 
+    div <- select ("#" <> show tabId)
 
+    remove div