Move most native message code into the module and add support for log

src/Background.purs

@@ -4,26 +4,21 @@ import Prelude
 
 import Browser.WebExt.BrowserAction (onClickedAddListener)
 import Browser.WebExt.Listener (mkListener)
-import Browser.WebExt.Message (Message)
-import Browser.WebExt.Port (postMessage)
-import Browser.WebExt.Port as Port
 import Browser.WebExt.Runtime (onMessageAddListener)
 import Browser.WebExt.Tabs (Tab)
-import Data.Argonaut.Core (stringify)
-import Data.Argonaut.Encode.Encoders (encodeString)
 import Effect (Effect)
 import Effect.Class (class MonadEffect)
 import Effect.Class.Console (log, logShow)
-import ExampleWebExt.NativeMessage (connectToNativeApplication)
+import ExampleWebExt.NativeMessage (NativeMessage(..), connectToNativeApplication, onNativeMessageAddListener, sendMessageToNative)
 import ExampleWebExt.RuntimeMessage (RuntimeMessage(..), mkRuntimeMessageHandler, sendMessageToContent)
 
 main :: Effect Unit
 main = do
   log "[bg] starting up"
   port <- connectToNativeApplication "job_search_writer"
-  Port.onMessageAddListener port $ mkListener nativeMessageHandler
+  onNativeMessageAddListener port nativeMessageHandler
 
-  postMessage port $ encodeString "hello"
+  sendMessageToNative port $ NativeMessageBackground "hello"
 
   onClickedAddListener $ mkListener browserActionOnClickedHandler
   onMessageAddListener $ mkRuntimeMessageHandler contentScriptMessageHandler
@@ -37,5 +32,5 @@ browserActionOnClickedHandler tab = do
 contentScriptMessageHandler ∷ ∀ m. MonadEffect m => RuntimeMessage → m Unit
 contentScriptMessageHandler m = logShow m
 
-nativeMessageHandler ∷ ∀ m. MonadEffect m ⇒ Message → m Unit
-nativeMessageHandler m = log $ "[bg] Got message from native : " <> stringify m
+nativeMessageHandler ∷ ∀ m. MonadEffect m ⇒ NativeMessage → m Unit
+nativeMessageHandler m = logShow m

src/NativeMessage.purs

@@ -2,12 +2,58 @@ module ExampleWebExt.NativeMessage where
 
 import Prelude
 
-import Browser.WebExt.Port (Port)
+import Browser.WebExt.Listener (mkListener)
+import Browser.WebExt.Message (Message, mkMessage, unwrapMessage)
+import Browser.WebExt.Port (Port, onMessageAddListener)
+import Browser.WebExt.Port as Port
 import Browser.WebExt.Runtime (Application, connectNative)
+import Data.Argonaut.Core (Json)
+import Data.Argonaut.Decode (class DecodeJson, JsonDecodeError, decodeJson, printJsonDecodeError)
+import Data.Argonaut.Decode.Generic (genericDecodeJson)
+import Data.Argonaut.Encode (class EncodeJson)
+import Data.Argonaut.Encode.Generic (genericEncodeJson)
+import Data.Either (Either(..))
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
 import Effect (Effect)
+import Effect.Class.Console (log)
 
 data NativeMessage =
-  NativeMessageBackgroundInit
+  NativeMessageBackground String
+  | NativeMessageLog {level :: String, content :: String}
+
+type NativePythonMessage m = {tag :: String | m}
+type NativePythonMessageLog = NativePythonMessage (level :: String, content :: String)
+
+derive instance Generic NativeMessage _
+instance Show NativeMessage where show = genericShow
+instance EncodeJson NativeMessage where encodeJson a = genericEncodeJson a
+instance DecodeJson NativeMessage where
+  decodeJson json = case decodeNative json of
+    Right {level, content} -> Right (NativeMessageLog {level, content})
+    Left _ -> genericDecodeJson json
+    where
+      decodeNative :: Json -> Either JsonDecodeError NativePythonMessageLog
+      decodeNative = decodeJson
 
 connectToNativeApplication ∷ Application → Effect Port
 connectToNativeApplication = connectNative
+
+decodeNativeMessage ∷ Message → Either String NativeMessage
+decodeNativeMessage m =
+  case unwrapMessage m of
+    Left err -> Left $ printJsonDecodeError err
+    Right m' -> Right m'
+
+onNativeMessageAddListener ∷ Port → (NativeMessage → Effect Unit) → Effect Unit
+onNativeMessageAddListener port f = onMessageAddListener port $ runtimeMessageHandler
+  where
+    runtimeMessageHandler = mkListener \m -> do
+      case decodeNativeMessage m of
+        Left err -> log err
+        Right m' -> f m'
+
+sendMessageToNative :: Port -> NativeMessage -> Effect Unit
+sendMessageToNative port msg = do
+  _ <- Port.postMessage port $ mkMessage msg
+  pure unit