diff --git a/package.json b/package.json index 6327340..515c981 100644 --- a/package.json +++ b/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", diff --git a/packages.dhall b/packages.dhall index 1cd2486..2bc861b 100644 --- a/packages.dhall +++ b/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 = {=} diff --git a/spago.dhall b/spago.dhall index 8877b37..6f9ad4d 100644 --- a/spago.dhall +++ b/spago.dhall @@ -20,5 +20,5 @@ You can edit this file as you like. , packages = ./packages.dhall , sources = - [ "src/**/*.purs", "test/**/*.purs" ] + [ "src/**/*.purs" ] } diff --git a/test.dhall b/test.dhall new file mode 100644 index 0000000..8e7f730 --- /dev/null +++ b/test.dhall @@ -0,0 +1,6 @@ +let conf = ./spago.dhall + +in conf + ⫽ { sources = conf.sources # [ "test/**/*.purs" ] + , dependencies = conf.dependencies # [ "spec" ] + } diff --git a/test/Test/Main.purs b/test/Test/Main.purs new file mode 100644 index 0000000..c2f8ce5 --- /dev/null +++ b/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 diff --git a/test/Test/Utils.purs b/test/Test/Utils.purs new file mode 100644 index 0000000..304d99e --- /dev/null +++ b/test/Test/Utils.purs @@ -0,0 +1,28 @@ +module Test.Utils where + +import Prelude + +import Concur.Core (Widget) +import Concur.Core.Types (WidgetStep(..), unWidget) +import Control.Monad.Free (runFreeM) +import Control.Monad.Writer.Trans (runWriterT, tell) +import Data.Array (singleton) +import Data.Tuple (Tuple(..)) +import Effect.Aff (Aff) +import Effect.Aff.Class (liftAff) +import Effect.Class (liftEffect) + + +-- 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 rec.cont diff --git a/test/Test/WidgetSpec.purs b/test/Test/WidgetSpec.purs new file mode 100644 index 0000000..c859225 --- /dev/null +++ b/test/Test/WidgetSpec.purs @@ -0,0 +1,47 @@ +module Test.WidgetSpec where + +import Prelude + +import Concur.Core.Types (affAction) +import Control.MultiAlternative (orr) +import Data.Time.Duration (Milliseconds(..)) +import Effect.Aff (delay, never) +import Effect.Class (liftEffect) +import Effect.Ref as Ref +import Test.Spec (Spec, describe, it) +import Test.Spec.Assertions (shouldEqual, shouldReturn) +import Test.Utils (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 "" + { views } <- runWidgetAsAff $ orr + [ affAction "a" do + delay (Milliseconds 100.0) + liftEffect $ Ref.write "a" ref + , affAction "b" do + delay (Milliseconds 150.0) + liftEffect $ Ref.write "b" ref + ] + views `shouldEqual` [ "ab" ] + liftEffect (Ref.read ref) `shouldReturn` "a" + delay (Milliseconds 100.0) + liftEffect (Ref.read ref) `shouldReturn` "a" + + it "should start all the widgets only once" do + ref <- liftEffect (Ref.new 0) + { result, views } <- runWidgetAsAff $ orr + [ do + affAction "a0" $ delay (Milliseconds 100.0) + affAction "a1" $ delay (Milliseconds 100.0) + pure "a" + , affAction "b" do + liftEffect $ Ref.modify_ (_ + 1) ref + never + ] + result `shouldEqual` "a" + views `shouldEqual` [ "a0b", "a1b" ] + liftEffect (Ref.read ref) `shouldReturn` 1