Implement minimal listener, emitter, and subscriptions

Author: thomashoneyman

package.json

@@ -0,0 +1,12 @@
+{
+  "private": true,
+  "scripts": {
+    "build": "spago build --purs-args '--censor-lib --strict'",
+    "test": "spago -x test/test.dhall test"
+  },
+  "devDependencies": {
+    "purescript": "^0.14.0",
+    "purescript-psa": "^0.8.2",
+    "spago": "^0.19.1"
+  }
+}

spago.dhall

@@ -1,5 +1,13 @@
 { name = "halogen-emitter"
-, dependencies = [ "effect" ]
+, dependencies =
+  [ "arrays"
+  , "effect"
+  , "foldable-traversable"
+  , "functors"
+  , "refs"
+  , "safe-coerce"
+  , "unsafe-reference"
+  ]
 , packages = ./packages.dhall
-, sources = [ "src/**/*.purs", "test/**/*.purs" ]
+, sources = [ "src/**/*.purs" ]
 }

src/Halogen/Emitter.purs

@@ -0,0 +1,73 @@
+module Halogen.Emitter
+  ( EmitIO(..)
+  , Listener
+  , notify
+  , Emitter
+  , create
+  , makeEmitter
+  , Subscription
+  , subscribe
+  , unsubscribe
+  ) where
+
+import Prelude
+
+import Data.Array (deleteBy)
+import Data.Foldable (traverse_)
+import Data.Functor.Contravariant (class Contravariant)
+import Effect (Effect)
+import Effect.Ref as Ref
+import Safe.Coerce (coerce)
+import Unsafe.Reference (unsafeRefEq)
+
+type EmitIO a =
+  { listener :: Listener a
+  , emitter :: Emitter a
+  }
+
+newtype Listener a = Listener (a -> Effect Unit)
+
+instance contravariantListener :: Contravariant Listener where
+  cmap f (Listener g) = Listener (g <<< f)
+
+notify :: forall a. a -> Listener a -> Effect Unit
+notify a (Listener f) = f a
+
+newtype Emitter a = Emitter ((a -> Effect Unit) -> Effect Subscription)
+
+instance functorEmitter :: Functor Emitter where
+  map f (Emitter e) = Emitter \k -> e (k <<< f)
+
+create :: forall a. Effect (EmitIO a)
+create = do
+  subscribers <- Ref.new []
+  pure
+    { emitter: Emitter \k -> do
+        _ <- Ref.modify (_ <> [k]) subscribers
+        pure $ Subscription do
+          _ <- Ref.modify (deleteBy unsafeRefEq k) subscribers
+          pure unit
+    , listener: Listener \a -> do
+        Ref.read subscribers >>= traverse_ \k -> k a
+    }
+
+makeEmitter
+  :: forall a
+   . ((a -> Effect Unit) -> Effect (Effect Unit))
+  -> Emitter a
+makeEmitter = coerce
+
+newtype Subscription = Subscription (Effect Unit)
+
+derive newtype instance semigroupSubscription :: Semigroup Subscription
+derive newtype instance monoidSubscription :: Monoid Subscription
+
+subscribe
+  :: forall r a
+   . Emitter a
+  -> (a -> Effect r)
+  -> Effect Subscription
+subscribe (Emitter e) k = e (void <<< k)
+
+unsubscribe :: Subscription -> Effect Unit
+unsubscribe (Subscription unsub) = unsub

src/Main.purs

@@ -0,0 +1,6 @@
+let conf = ../spago.dhall
+
+in conf // {
+  sources = conf.sources # [ "test/**/*.purs" ],
+  dependencies = conf.dependencies # [ "assert", "console" ]
+}