Add MessageSender parameter to listener of Runtime messages

src/Background.purs

@@ -5,6 +5,7 @@ import Prelude
 import Browser.WebExt.BrowserAction (onClickedAddListener)
 import Browser.WebExt.Listener (mkListener)
 import Browser.WebExt.Port (Port)
+import Browser.WebExt.Runtime (MessageSender)
 import Browser.WebExt.Tabs (Tab)
 import Data.Argonaut.Decode (printJsonDecodeError)
 import Data.Either (Either(..))
@@ -34,8 +35,10 @@ browserActionOnClickedHandler tab = do
   _ <- sendMessageToContent tab.id RuntimeMessageRequestPageContent
   pure unit
 
-contentScriptMessageHandler ∷ ∀ m. MonadEffect m => RuntimeMessage → m Unit
-contentScriptMessageHandler m = logShow m
+contentScriptMessageHandler ∷ ∀ m. MonadEffect m => RuntimeMessage -> MessageSender → m Unit
+contentScriptMessageHandler m sender = do
+  logShow m
+  logShow sender
 
 nativeMessageHandler ∷ ∀ m. MonadEffect m ⇒ NativeMessage → m Unit
 nativeMessageHandler m = logShow m

src/Browser/WebExt/Listener.purs

@@ -1,14 +1,20 @@
 module Browser.WebExt.Listener (
   Listener,
-  mkListener
+  Listener2,
+  mkListener,
+  mkListener2
 ) where
 
 import Prelude
 
 import Effect (Effect)
-import Effect.Uncurried (EffectFn1, mkEffectFn1)
+import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, mkEffectFn2)
 
 type Listener a = EffectFn1 a Unit
+type Listener2 a b = EffectFn2 a b Unit
 
 mkListener :: forall a. (a -> Effect Unit) -> Listener a
 mkListener = mkEffectFn1
+
+mkListener2 ∷ ∀ a b. (a → b → Effect Unit) → Listener2 a b
+mkListener2 = mkEffectFn2

src/Browser/WebExt/Runtime.purs

@@ -1,5 +1,7 @@
 module Browser.WebExt.Runtime (
   Application,
+  MessageSender(..),
+  MessageSenderObj,
   sendMessage,
   onMessageAddListener,
   connectNative
@@ -7,21 +9,44 @@ module Browser.WebExt.Runtime (
 
 import Prelude
 
-import Browser.WebExt.Listener (Listener)
+import Browser.WebExt.Listener (Listener2)
 import Browser.WebExt.Message (Message)
 import Browser.WebExt.Port (Port)
+import Browser.WebExt.Tabs (Tab)
+import Data.Argonaut.Core (Json)
+import Data.Argonaut.Decode (class DecodeJson, decodeJson, printJsonDecodeError)
+import Data.Argonaut.Decode.Generic (genericDecodeJson)
+import Data.Either (Either(..))
+import Data.Generic.Rep (class Generic)
+import Data.Maybe (Maybe)
+import Data.Show.Generic (genericShow)
 import Effect (Effect)
-import Effect.Uncurried (EffectFn1, runEffectFn1)
+import Effect.Class.Console (error)
+import Effect.Uncurried (EffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2)
 import Promise (Promise)
 
 type Application = String
+type MessageSenderJS = Json
+type MessageSenderObj = {
+  id :: String,
+  url :: Maybe String,
+  tab :: Maybe Tab
+}
+data MessageSender = MessageSender MessageSenderObj
+derive instance Generic MessageSender _
+instance Show MessageSender where show = genericShow
+instance DecodeJson MessageSender where decodeJson = genericDecodeJson
 
-foreign import onMessageAddListenerImpl :: EffectFn1 (Listener Message) Unit
+foreign import onMessageAddListenerImpl :: EffectFn1 (Listener2 Message MessageSenderJS) Unit
 foreign import runtimeSendMessageImpl :: EffectFn1 Message (Promise Message)
 foreign import connectNativeImpl :: EffectFn1 Application Port
 
-onMessageAddListener ∷ Listener Message → Effect Unit
-onMessageAddListener = runEffectFn1 onMessageAddListenerImpl
+onMessageAddListener ∷ Listener2 Message MessageSender → Effect Unit
+onMessageAddListener f = runEffectFn1 onMessageAddListenerImpl $ mkEffectFn2 decodeAndListen
+  where
+    decodeAndListen m send = case decodeJson @MessageSenderObj send of
+      Right val -> runEffectFn2 f m $ MessageSender val
+      Left l -> error $ printJsonDecodeError l
 
 sendMessage ∷ Message → Effect (Promise Message)
 sendMessage = runEffectFn1 runtimeSendMessageImpl

src/Content.purs

@@ -3,6 +3,7 @@ module ExampleWebExt.Content where
 import Prelude
 
 import Browser.DOM (getBrowserDom)
+import Browser.WebExt.Runtime (MessageSender)
 import Data.Either (Either(..))
 import Effect (Effect)
 import Effect.Class.Console (logShow, warn)
@@ -31,8 +32,8 @@ main = do
 colorAlreadyVisitedOffers ∷ Effect Unit
 colorAlreadyVisitedOffers = log "[content] Coloring of job offers is not implemented yet"
 
-backgroundMessageHandler ∷ RuntimeMessage → Effect Unit
-backgroundMessageHandler = case _ of
+backgroundMessageHandler ∷ RuntimeMessage -> MessageSender → Effect Unit
+backgroundMessageHandler m _ = case m of
   RuntimeMessageRequestPageContent -> extractDataAndSendToBackground
 
   m -> logShow m

src/RuntimeMessage.purs

@@ -2,9 +2,9 @@ module ExampleWebExt.RuntimeMessage where
 
 import Prelude
 
-import Browser.WebExt.Listener (mkListener)
+import Browser.WebExt.Listener (mkListener2)
 import Browser.WebExt.Message (Message, mkMessage, unwrapMessage)
-import Browser.WebExt.Runtime (onMessageAddListener)
+import Browser.WebExt.Runtime (MessageSender, onMessageAddListener)
 import Browser.WebExt.Runtime as Runtime
 import Browser.WebExt.Tabs (TabId)
 import Browser.WebExt.Tabs as Tabs
@@ -46,10 +46,10 @@ decodeRuntimeMessage m =
     Left err -> Left $ printJsonDecodeError err
     Right m' -> Right m'
 
-onRuntimeMessageAddListener ∷ (RuntimeMessage → Effect Unit) → Effect Unit
+onRuntimeMessageAddListener ∷ (RuntimeMessage -> MessageSender → Effect Unit) → Effect Unit
 onRuntimeMessageAddListener f = onMessageAddListener runtimeMessageHandler
   where
-    runtimeMessageHandler = mkListener \m -> do
+    runtimeMessageHandler = mkListener2 \m sender -> do
       case decodeRuntimeMessage m of
         Left err -> log err
-        Right m' -> f m'
+        Right m' -> f m' sender