purescript_linked_in/src/Browser/Runtime.purs

module Browser.Runtime (Port, connect, onConnectAddListener, portOnDisconnect, postMessage, postMessageJson, onMessageAddListener, onMessageJsonAddListener, onMessageRemoveListener) where

import Browser.Utils (mkListenerOne, Listener, UnregisteredListener)
import Control.Alt (map)
import Control.Monad.Except (runExcept)
import Data.Array (intercalate)
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 :: 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

  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 onMessageRemoveListener :: forall a. Port -> Listener a -> Effect Unit