Adds test for purescript-concur-react #45 issue

Author: kamoii

package.json

@@ -10,7 +10,8 @@
   },
   "files": [],
   "scripts": {
-    "build": "spago build"
+    "build": "spago build",
+    "test": "spago -x test.dhall test"
   },
   "devDependencies": {
     "parcel-bundler": "^1.12.4",

packages.dhall

@@ -108,11 +108,8 @@ let additions =
 -------------------------------
 -}
 
-let mkPackage =
-      https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190626/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57
-
 let upstream =
-      https://github.com/purescript/package-sets/releases/download/psc-0.13.4-20191110/packages.dhall sha256:563a7f694e18e6399f7f6d01f5b7e3c3345781655d99945768f48e458feb93a4
+      https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200507/packages.dhall sha256:9c1e8951e721b79de1de551f31ecb5a339e82bbd43300eb5ccfb1bf8cf7bbd62
 
 let overrides = {=}
 

spago.dhall

@@ -18,5 +18,5 @@ You can edit this file as you like.
 , packages =
     ./packages.dhall
 , sources =
-    [ "src/**/*.purs", "test/**/*.purs" ]
+    [ "src/**/*.purs" ]
 }

test.dhall

@@ -0,0 +1,6 @@
+let conf = ./spago.dhall
+
+in    conf
+    ⫽ { sources = conf.sources # [ "test/**/*.purs" ]
+      , dependencies = conf.dependencies # [ "aff", "spec", "js-timers" ]
+      }

test/Test/Main.purs

@@ -0,0 +1,15 @@
+module Test.Main where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Test.Spec (describe)
+import Test.Spec.Reporter.Console (consoleReporter)
+import Test.Spec.Runner (runSpec)
+import Test.WidgetSpec (widgetSpec)
+
+main :: Effect Unit
+main = launchAff_ $ runSpec [consoleReporter] do
+  describe "Concur.Core" do
+    widgetSpec

test/Test/Utils.purs

@@ -0,0 +1,48 @@
+module Test.Utils where
+
+import Prelude
+
+import Concur.Core (Widget)
+import Concur.Core.Event (Observer(..))
+import Concur.Core.Types (WidgetStep(..), unWidget)
+import Control.Monad.Free (runFreeM)
+import Control.Monad.Writer.Trans (runWriterT, tell)
+import Data.Array (singleton)
+import Data.Either (Either(..))
+import Data.Int (round)
+import Data.Newtype (wrap)
+import Data.Time.Duration (Milliseconds(..))
+import Data.Tuple (Tuple(..))
+import Effect.Aff (Aff, makeAff)
+import Effect.Aff.Class (liftAff)
+import Effect.Class (liftEffect)
+import Effect.Timer (clearTimeout, setTimeout)
+
+-- Evalutates Widget to Aff
+-- Be carefull that never ending Widget will convert to never ending Aff.
+runWidgetAsAff :: forall v a. Widget v a -> Aff { result :: a, views :: Array v }
+runWidgetAsAff widget = do
+  Tuple result views <- runWriterT $ runFreeM interpret (unWidget widget)
+  pure { result, views }
+  where
+    interpret (WidgetStepEff eff) =
+      liftEffect eff
+
+    interpret (WidgetStepView rec) = do
+      tell $ singleton rec.view
+      liftAff $ observerToAff rec.cont
+
+-- Converts an Observer to an Aff.
+-- Observer can't return an Error, so we always wrap with Right.
+observerToAff :: forall a. Observer a -> Aff a
+observerToAff (Observer ob) =
+  makeAff \cont -> do
+    obsCanceller <- ob (cont <<< Right)
+    affCanceller <- pure $ wrap $ const $ liftEffect obsCanceller
+    pure affCanceller
+
+delayObserver :: Milliseconds -> Observer Unit
+delayObserver (Milliseconds msec) =
+  Observer \cont -> do
+    timeoutId <- setTimeout (round msec) (cont unit)
+    pure $ clearTimeout timeoutId

test/Test/WidgetSpec.purs

@@ -0,0 +1,28 @@
+module Test.WidgetSpec where
+
+import Prelude
+
+import Concur.Core.Event (effMap)
+import Concur.Core.Types (affAction)
+import Control.MultiAlternative (orr)
+import Data.Time.Duration (Milliseconds(..))
+import Effect.Aff (delay)
+import Effect.Class (liftEffect)
+import Effect.Ref as Ref
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldReturn)
+import Test.Utils (delayObserver, runWidgetAsAff)
+
+widgetSpec :: Spec Unit
+widgetSpec =
+  describe "Widget" do
+    describe "orr" do
+      it "should cancel running effects when the widget returns a value" do
+        ref <- liftEffect (Ref.new "")
+        _ <- runWidgetAsAff $ orr
+          [ affAction "a" $ delayObserver (Milliseconds 100.0) `effMap` const (Ref.write "a" ref)
+          , affAction "b" $ delayObserver (Milliseconds 150.0) `effMap` const (Ref.write "b" ref)
+          ]
+        liftEffect (Ref.read ref) `shouldReturn` "a"
+        delay (Milliseconds 100.0)
+        liftEffect (Ref.read ref) `shouldReturn` "a"