feat: support title update & loading state

spago.dhall

@@ -23,6 +23,7 @@ You can edit this file as you like.
   , "psci-support"
   , "refs"
   , "st"
+  , "undefined"
   , "unordered-collections"
   , "web-dom"
   , "web-html"

src/Background.purs

@@ -4,8 +4,9 @@ import Browser.Runtime as Runtime
 import Browser.Tabs (Tab, TabId, WindowId, query)
 import Browser.Tabs.OnCreated as TabsOnCreated
 import Browser.Tabs.OnRemoved as TabsOnRemoved
+import Browser.Tabs.OnUpdated as TabsOnUpdated
+import Browser.Tabs.OnUpdated (ChangeInfo(..))
 import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
-import Control.Alt (map)
 import Control.Alternative (pure, (*>))
 import Data.Array (fromFoldable)
 import Data.Foldable (for_)
@@ -50,12 +51,11 @@ initializeBackground ref = do
   _ <- TabsOnCreated.addListener $ onTabCreated ref
   tabDeletedListener <- mkListenerTwo $ onTabDeleted ref
   _ <- TabsOnRemoved.addListener tabDeletedListener
+  _ <- TabsOnUpdated.addListener $ onTabUpdated ref
   onConnectedListener <- mkListenerOne $ onConnect ref
   Runtime.onConnectAddListener onConnectedListener
   pure unit
 
 onTabCreated :: (Ref.Ref GlobalState) -> Tab -> Effect Unit
 onTabCreated stateRef tab' = do
   state <- Ref.modify (set (_tabFromWindow tab') (Just tab')) stateRef
@@ -68,6 +68,13 @@ onTabCreated stateRef tab' = do
   where
   tab = unwrap tab'
 
+onTabUpdated :: (Ref.Ref GlobalState) -> TabId -> ChangeInfo -> Tab -> Effect Unit
+onTabUpdated stateRef tid cinfo tab' = do
+  state <- Ref.modify (set (_tabFromWindow tab') (Just tab')) stateRef
+  case (preview (_portFromWindow tab') state) of
+    Nothing -> pure unit
+    Just port -> Runtime.postMessageJson port $ BgTabUpdated tid cinfo tab'
+
 onTabDeleted :: (Ref.Ref GlobalState) -> TabId -> TabsOnRemoved.RemoveInfo -> Effect Unit
 onTabDeleted stateRef tabId info = do
   state <- Ref.read stateRef

src/Browser/Tabs/OnCreated.purs

@@ -1,28 +1,17 @@
 module Browser.Tabs.OnCreated (addListener, removeListener) where
 
 import Browser.Tabs (Tab)
-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 Browser.Utils (Listener, UnregisteredListener, mkListenerOne, unwrapForeign)
+import Control.Bind ((>=>))
 import Effect (Effect)
-import Effect.Exception (throw)
-import Foreign (Foreign, renderForeignError)
-import Foreign.Generic (defaultOptions, genericDecode)
+import Foreign (Foreign)
 import Prelude (Unit, bind, ($))
 
 foreign import addListenerImpl :: (Listener Foreign) -> Effect Unit
 
 addListener :: (UnregisteredListener Tab) -> Effect Unit
 addListener listener = do
-  lst <- mkListenerOne foreignListener
+  lst <- mkListenerOne $ unwrapForeign >=> listener
   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

src/Browser/Tabs/OnMoved.js

@@ -0,0 +1,3 @@
+"use strict";
+
+

src/Browser/Tabs/OnMoved.purs

@@ -0,0 +1,19 @@
+module Browser.Tabs.OnMoved (addListener, removeListener) where
+
+import Browser.Tabs (TabId(..), WindowId)
+import Browser.Utils (Listener2, UnregisteredListener2)
+import Control.Alternative (pure)
+import Data.Unit (Unit, unit)
+import Effect (Effect)
+import Undefined (undefined)
+
+type MoveInfo = { windowId :: WindowId
+  , fromIndex :: Number
+  , toIndex :: Number
+} 
+
+addListener :: (UnregisteredListener2 TabId MoveInfo) -> Effect Unit
+addListener lst = undefined
+
+removeListener :: (Listener2 TabId MoveInfo) -> Effect Unit
+removeListener lst = undefined

src/Browser/Tabs/OnUpdated.js

@@ -0,0 +1,13 @@
+"use strict";
+
+exports["addListener'"] = function (listener) {
+  return function() {
+    return browser.tabs.onUpdated.addListener(listener, {});
+  };
+};
+
+exports["removeListener'"] = function (listener) {
+  return function() {
+    return browser.tabs.onUpdated.removeListener(listener);
+  };
+};

src/Browser/Tabs/OnUpdated.purs

@@ -0,0 +1,60 @@
+module Browser.Tabs.OnUpdated where
+
+import Browser.Tabs (Tab(..), TabId(..))
+import Browser.Utils (Listener3, UnregisteredListener3, mkListenerThree, unwrapForeign)
+import Control.Alternative (pure)
+import Control.Bind ((>>=))
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Maybe (Maybe)
+import Data.Newtype (class Newtype)
+import Data.Show (class Show)
+import Data.Tuple.Nested (Tuple3, tuple3, uncurry3)
+import Effect (Effect)
+import Foreign (Foreign)
+import Foreign.Class (class Decode, class Encode)
+import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
+import Prelude (Unit, bind, ($))
+
+newtype ChangeInfo
+  = ChangeInfo
+  { attention :: Maybe Boolean
+  , audible :: Maybe Boolean
+  , discarded :: Maybe Boolean
+  , favIconUrl :: Maybe String
+  , hidden :: Maybe Boolean
+  , isArticle :: Maybe Boolean
+  -- mutedInfo :: Maybe MutedInfo,
+  , pinned :: Maybe Boolean
+  , status :: Maybe String
+  , title :: Maybe String
+  , url :: Maybe String
+  }
+
+derive instance newtypeChangeInfo :: Newtype ChangeInfo _
+
+derive instance genChangeInfo :: Generic ChangeInfo _
+
+instance showChangeInfo :: Show ChangeInfo where
+  show = genericShow
+
+instance encodeChangeInfo :: Encode ChangeInfo where
+  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
+
+instance decodeChangeInfo :: Decode ChangeInfo where
+  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
+
+foreign import addListener' :: (Listener3 TabId Foreign Foreign) -> Effect Unit
+
+foreign import removeListener' :: (Listener3 TabId Foreign Foreign) -> Effect Unit
+
+addListener :: (UnregisteredListener3 TabId ChangeInfo Tab) -> Effect Unit
+addListener listener = do
+  lst' <- mkListenerThree \tid cinfo tab -> (lst tid cinfo tab) >>= uncurry3 listener
+  addListener' lst'
+
+lst :: TabId -> Foreign -> Foreign -> Effect (Tuple3 TabId ChangeInfo Tab)
+lst tid changeInfo tab = do
+  cinfo <- unwrapForeign changeInfo
+  t <- unwrapForeign tab
+  pure $ tuple3 tid cinfo t

src/Browser/Utils.js

@@ -24,3 +24,11 @@ exports.mkListenerTwo = function (fn) {
     }
   }
 };
+
+exports.mkListenerThree = function (fn) {
+  return function () {
+    return function (one, two, three) {
+        return fn(one)(two)(three)();
+    }
+  }
+};

src/Browser/Utils.purs

@@ -1,11 +1,14 @@
 module Browser.Utils
   ( UnregisteredListener
   , UnregisteredListener2
+  , UnregisteredListener3
   , Listener
   , Listener2
+  , Listener3
   , mkListenerUnit
   , mkListenerOne
   , mkListenerTwo
+  , mkListenerThree
   , unwrapForeign
   ) where
 
@@ -28,20 +31,28 @@ type UnregisteredListener a
 type UnregisteredListener2 a b
   = (a -> b -> Effect Unit)
 
+type UnregisteredListener3 a b c
+  = (a -> b -> c -> Effect Unit)
+
 newtype Listener a
   = Listener (UnregisteredListener a)
 
 newtype Listener2 a b
   = Listener2 (UnregisteredListener2 a b)
 
+newtype Listener3 a b c
+  = Listener3 (UnregisteredListener3 a b c)
+
 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)
 
+foreign import mkListenerThree :: forall a b c. (UnregisteredListener3 a b c) -> Effect (Listener3 a b c)
 
 unwrapForeign :: forall a rep. Generic a rep => GenericDecode rep => Foreign -> Effect a
-unwrapForeign d = case runExcept $ genericDecode (defaultOptions { unwrapSingleConstructors = true }) d of
+unwrapForeign d = case runExcept
+    $ genericDecode (defaultOptions { unwrapSingleConstructors = true }) d of
   Left err -> throw $ intercalate ", " (map renderForeignError err)
   Right val -> pure val

src/Model.purs

@@ -17,6 +17,7 @@ module PureTabs.Model
 
 import Browser.Runtime (Port)
 import Browser.Tabs (TabId, WindowId, Tab)
+import Browser.Tabs.OnUpdated (ChangeInfo(..))
 import Control.Alt (map)
 import Data.Function (($))
 import Data.Generic.Rep (class Generic)
@@ -115,6 +116,7 @@ data BackgroundEvent
   = BgInitialTabList (Array Tab)
   | BgTabCreated Tab
   | BgTabDeleted TabId
+  | BgTabUpdated TabId ChangeInfo Tab
   | BgTabMoved
   | BgTabActived TabId
   | BgTabAttached Tab

src/Sidebar.purs

@@ -2,11 +2,13 @@ module PureTabs.Sidebar where
 
 import Browser.Runtime as Runtime
 import Browser.Tabs (Tab, TabId, WindowId)
+import Browser.Tabs.OnUpdated (ChangeInfo(..))
 import Browser.Windows (getCurrent)
 import Control.Alternative (pure)
 import Control.Bind ((>=>))
 import Data.Foldable (traverse_)
 import Data.Function (flip)
+import Data.Maybe (Maybe(..))
 import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
 import Data.Show (show)
@@ -46,8 +48,8 @@ initSidebar port winId = do
       append tabElem contentDiv
       pure unit
     BgTabDeleted tabId -> deleteTabElement tabId
-    BgInitialTabList tabs -> 
-      traverse_ (createTabElement >=> (flip append) contentDiv) tabs
+    BgInitialTabList tabs -> traverse_ (createTabElement >=> (flip append) contentDiv) tabs
+    BgTabUpdated tid cinfo tab -> updateTabInfo tid cinfo tab
     _ -> log "received unsupported message type"
 
 createTabElement :: Tab -> Effect JQuery
@@ -66,5 +68,18 @@ createTabElement tab' = do
 
 deleteTabElement :: TabId -> Effect Unit
 deleteTabElement tabId = do
-    div <- select ("#" <> show tabId)
-    remove div
+  div <- select ("#" <> show tabId)
+  remove div
+
+updateTabInfo :: TabId -> ChangeInfo -> Tab -> Effect Unit
+updateTabInfo tid cinfo' tab' = do
+  let
+    tab = unwrap tab'
+
+    cinfo = unwrap cinfo'
+  tabTitleDiv <- select ("#" <> (show tid) <> " > .tab-title")
+  let
+    newTitle = case cinfo.status of
+      Just "loading" -> "Loading ..."
+      _ -> tab.title
+  setText newTitle tabTitleDiv