fix: sidebar: wait for successful connect to background before starting

On restore the background process can take some time to get the
initial state and to start listening to `runtime.connect()` event. On
the sidebar we're now retrying several times with some delay to obtain a
port.

src/Background.purs

@@ -55,15 +55,16 @@ main :: Effect Unit
 main = do
   log "starting background"
   launchAff_ do
-     allTabs <- BT.browserQuery {}
      groups <- retrieveGroups
      case groups of
           [] -> updateGroupsMapping $ createGroup (GroupId 0) "main"
           _ -> pure unit
+     allTabs <- BT.browserQuery {}
      liftEffect $ initializeBackground =<< (Ref.new $ GS.initialTabsToGlobalState allTabs)
 
 initializeBackground :: Ref.Ref GS.GlobalState -> Effect Unit
 initializeBackground ref = do
+  (mkListenerOne $ onConnect ref) >>= Runtime.onConnectAddListener
   (mkListenerOne $ onWindowCreated ref) >>= WinOnCreated.addListener
   (mkListenerOne $ onWindowRemoved ref) >>= WinOnRemoved.addListener
   onTabCreated ref # OnCreated.addListener
@@ -73,7 +74,6 @@ initializeBackground ref = do
   (mkListenerTwo $ onTabDetached ref) >>= OnDetached.addListener
   (mkListenerTwo $ onTabAttached ref) >>= OnAttached.addListener
   (mkListenerTwo $ onTabMoved ref) >>= OnMoved.addListener
-  (mkListenerOne $ onConnect ref) >>= Runtime.onConnectAddListener
 
 onWindowCreated :: StateRef -> Window -> Effect Unit
 onWindowCreated ref { id: winId } = do

src/Browser/Runtime.js

@@ -48,3 +48,10 @@ exports.portEquality = function (p1) {
     return p1 === p2
   }
 }
+
+
+exports.portHasError = function(port) {
+  return function () {
+    return port.error != null;
+  };
+};

src/Browser/Runtime.purs

@@ -1,4 +1,15 @@
-module Browser.Runtime (Port, connect, onConnectAddListener, portOnDisconnect, postMessage, postMessageJson, onMessageAddListener, onMessageJsonAddListener, onMessageRemoveListener) where
+module Browser.Runtime (
+  Port,
+  connect,
+  onConnectAddListener,
+  portOnDisconnect,
+  postMessage,
+  postMessageJson,
+  onMessageAddListener,
+  onMessageJsonAddListener,
+  onMessageRemoveListener,
+  portHasError
+) where
 
 import Browser.Utils (mkListenerOne, Listener, UnregisteredListener)
 import Control.Alt (map)
@@ -34,6 +45,8 @@ foreign import portOnDisconnect :: Port -> Listener Unit -> Effect Unit
 
 foreign import onMessageAddListener :: forall a. Port -> Listener a -> Effect Unit
 
+foreign import portHasError :: Port -> Effect Boolean
+
 onMessageJsonAddListener :: forall a rep. Generic a rep => GenericDecode rep => Port -> UnregisteredListener a -> Effect (Listener String)
 onMessageJsonAddListener port f = do 
   jsonLst <- mkListenerOne listener

src/Sidebar/Sidebar.purs

@@ -6,31 +6,59 @@ import Browser.Tabs.OnUpdated (ChangeInfo(..))
 import Browser.Windows (getCurrent)
 import Control.Alt (void)
 import Control.Alternative (pure)
+import Control.Bind ((<*), (*>))
 import Control.Coroutine as CR
 import Control.Coroutine.Aff (emit)
 import Control.Coroutine.Aff as CRA
 import Control.Monad.Error.Class (throwError)
 import Data.Function (($))
 import Data.Maybe (Maybe(..))
+import Data.Show (show)
+import Data.Time.Duration (Milliseconds(..))
 import Data.Unit (Unit, unit)
 import Effect (Effect)
-import Effect.Aff (Aff, error)
+import Effect.Aff (Aff, delay, error)
 import Effect.Class (liftEffect)
+import Effect.Console (log)
 import Halogen as H
 import Halogen.Aff as HA
 import Halogen.VDom.Driver (runUI)
-import Prelude (bind, discard)
+import Prelude (bind, discard, (*), (-), (<>))
 import PureTabs.Model.Events (BackgroundEvent(..), SidebarEvent(..))
 import PureTabs.Sidebar.Bar as Bar
 import PureTabs.Sidebar.Tabs as Tabs
 import Web.DOM.ParentNode (QuerySelector(..))
 
+
+-- | Try to connect the port and wait for the connection to succeed.
+tryConnectPort :: Aff Runtime.Port
+tryConnectPort = loopConnect 5 (Milliseconds 50.0)
+  where 
+        loopConnect :: Int -> Milliseconds -> Aff Runtime.Port
+        loopConnect 0 _ = 
+          throwError $ error "[sb] couldn't connect to the background extesion :("
+        loopConnect attemptLeft timeout = do
+          liftEffect $ 
+            log $ "[sb] attempt to connect to background extension (left: " <> (show attemptLeft) <> ")"
+          port <- liftEffect $ Runtime.connect
+          portHasError <- liftEffect $ Runtime.portHasError port
+          if portHasError then
+            (delay timeout) *> loopConnect (attemptLeft - 1) (multiplyMs 2.0 timeout)
+          else
+            pure port
+
+        multiplyMs by (Milliseconds t) = Milliseconds (t * by)
+
+
+
 main :: Effect Unit
 main = do
-  port <- Runtime.connect
+  log "[sb] starting"
   HA.runHalogenAff do
+    port <- tryConnectPort
     currentWindow <- getCurrent
-    liftEffect $ Runtime.postMessageJson port $ SbHasWindowId currentWindow.id
+    liftEffect $ Runtime.postMessageJson port (SbHasWindowId currentWindow.id)
+        <* log "[sb] windowId sent"
     content' <- HA.selectElement (QuerySelector "#content")
     io <- case content' of
       Nothing -> throwError (error "Could not find #content")