reflex-test-host 0.1.0.0 → 0.1.1.0

raw patch · 5 files changed

+112/−43 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−1
• README.md +2/−6
• reflex-test-host.cabal +2/−2
• src/Reflex/Test/Host.hs +75/−28
• test/Reflex/Test/HostSpec.hs +27/−6

@@ -1,4 +1,9 @@ # Changelog for reflex-test-host +## 0.1.1.0+- generalized reflex constraints+- added `PostBuildT` support+- fixed a crash that would happen if there were no event subscribers+ ## 0.1.0.0-first release+- first release

@@ -1,12 +1,8 @@ # reflex-test-app -This library contains functionality for writing unit tests for the "model" portion of your reflex-frp apps. Please see `test/Reflex/Test/App.hs` for basic usage example.--Note that the following two reflex class constraints are not supported:--- `PostBuild` could be added easily, but I noticed different hosts have different semantics on how to treat `PostBuild`, i.e. is it something that runs just ONCE after the first setup or after each frame. To avoid confusion, this library does not support the constraint though it could be added easily. For example, see [reflex-basic-host](https://github.com/qfpl/reflex-basic-host/).+This library contains functionality for writing unit tests for the "model" portion of your reflex-frp apps. Please see `test/Reflex/Test/App.hs` for basic usage example. You can find more usage examples in [this project](https://github.com/pdlla/reflex-potatoes?files=1) and [this one](https://github.com/pdlla/reflex-todo-undo-mvc-model). -- `TriggerEvent` could also be added with some effort but breaks the "pureness" of the test (at least from its inputs) so I don't suggest it. You can still test parts of your network that don't require `TriggerEvent`+Note that `TriggerEvent` class constraint is not supported. It could be added with some effort but breaks the "pureness" of the test (at least from its inputs) so I don't suggest it. You can still test parts of your network that don't require `TriggerEvent`.  This library is modified from `test/Test/Run.hs` in the [reflex main repository](https://github.com/reflex-frp/reflex). I'll deprecate this module if the functionality is ever moved into an exposed module which [I think it should be](https://github.com/reflex-frp/reflex/issues/412). 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5ed3f299235faa921234096cca2fe127b6f0a9a8b4b49c9ce1178d3205a927b7+-- hash: f349f220ed538f9eea356a8e92d10740b0397a12f201007808bf995d552a0513  name:           reflex-test-host-version:        0.1.0.0+version:        0.1.1.0 synopsis:       reflex host methods for testing without external events description:    Please see the README on GitHub at <https://github.com/pdlla/reflex-test-host#readme> category:       FRP, Reflex

@@ -7,7 +7,9 @@ --   This module contains reflex host methods for testing without external events  module Reflex.Test.Host-  ( AppIn(..)+  ( TestGuestConstraints+  , TestGuestMonad+  , AppIn(..)   , AppOut(..)   , AppFrame(..)   , getAppFrame@@ -22,15 +24,35 @@ import           Prelude  import           Control.Monad+import           Control.Monad.Fix+import           Control.Monad.IO.Class import           Control.Monad.Ref import           Data.Dependent.Sum import           Data.Functor.Identity-import           Data.Maybe            (fromJust)+import           Data.Kind import           Data.These  import           Reflex import           Reflex.Host.Class ++-- TODO some of these constraints can be dropped probably+type TestGuestConstraints t (m :: Type -> Type)+  = ( MonadReflexHost t m+    , MonadHold t m+    , MonadSample t m+    , Ref m ~ Ref IO+    , MonadRef m+    , MonadRef (HostFrame t)+    , Ref (HostFrame t) ~ Ref IO+    , MonadIO (HostFrame t)+  --, PrimMonad (HostFrame t)+    , MonadIO m+    , MonadFix m+    )++type TestGuestMonad t (m :: Type -> Type) = PostBuildT t (PerformEventT t m)+ data AppIn t b e = AppIn     { _appIn_behavior :: Behavior t b     , _appIn_event    :: Event t e@@ -43,28 +65,50 @@  data AppFrame t bIn eIn bOut eOut m = AppFrame     { _appFrame_readPhase :: ReadPhase m (bOut, Maybe eOut)-    , _appFrame_pulseB :: EventTrigger t bIn-    , _appFrame_pulseE :: EventTrigger t eIn+    , _appFrame_mpulseB :: Maybe (EventTrigger t bIn)+    , _appFrame_mpulseE :: Maybe (EventTrigger t eIn)     , _appFrame_fire :: forall a .   [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m [a]     }  -- | make an 'AppFrame' that takes an input behavior and event and returns an--- output behavior and event.+-- output behavior and event. This will also fire the 'PostBuild' event if there+-- are any subscribers. getAppFrame   :: forall t bIn eIn bOut eOut m-   . (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (AppIn t bIn eIn -> PerformEventT t m (AppOut t bOut eOut))+   . (TestGuestConstraints t m)+  => (AppIn t bIn eIn -> TestGuestMonad t m (AppOut t bOut eOut))   -> bIn   -> m (AppFrame t bIn eIn bOut eOut m) getAppFrame app b0 = do++  -- Create the "post-build" event and associated trigger. This event fires+  -- once, when the application starts.+  (postBuild , postBuildTriggerRef ) <- newEventWithTriggerRef+++  -- Create input behavior, events, and  assosciated triggers.   (appInHoldE, pulseHoldTriggerRef ) <- newEventWithTriggerRef   (appInE    , pulseEventTriggerRef) <- newEventWithTriggerRef   appInB                             <- hold b0 appInHoldE++  -- Setup the app and obtain its output events and 'FireCommand'   (out :: AppOut t bOut eOut, FireCommand fire) <--    hostPerformEventT $ app $ AppIn { _appIn_event    = appInE-                                    , _appIn_behavior = appInB-                                    }+    hostPerformEventT $ flip runPostBuildT postBuild $ app $ AppIn+      { _appIn_event    = appInE+      , _appIn_behavior = appInB+      }+++  -- Read the trigger reference for the post-build event. This will be+  -- 'Nothing' if the guest application hasn't subscribed to this event.+  mPostBuildTrigger <- readRef postBuildTriggerRef++  -- When there is a subscriber to the post-build event, fire the event.+  forM_ mPostBuildTrigger+    $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()++  --   hnd :: EventHandle t eOut <- subscribeEvent (_appOut_event out)   mpulseB                   <- readRef pulseHoldTriggerRef   mpulseE                   <- readRef pulseEventTriggerRef@@ -73,8 +117,8 @@         frames <- sequence =<< readEvent hnd         return (b, frames)   return AppFrame { _appFrame_readPhase = readPhase-                  , _appFrame_pulseB    = fromJust mpulseB-                  , _appFrame_pulseE    = fromJust mpulseE+                  , _appFrame_mpulseB   = mpulseB+                  , _appFrame_mpulseE   = mpulseE                   , _appFrame_fire      = fire                   } @@ -88,28 +132,31 @@ -- recent behavior value you can always call 'tickAppFrame' with 'Nothing' as -- input tickAppFrame-  :: (t ~ SpiderTimeline Global)-  => AppFrame t bIn eIn bOut eOut m+  :: AppFrame t bIn eIn bOut eOut m   -> Maybe (These bIn eIn)   -> m [(bOut, Maybe eOut)]-tickAppFrame AppFrame {..} input = case input of-  Nothing -> fire [] $ readPhase-  Just i  -> case i of-    This b' -> fire [pulseB :=> Identity b'] $ readPhase-    That e' -> fire [pulseE :=> Identity e'] $ readPhase-    These b' e' ->-      fire [pulseB :=> Identity b', pulseE :=> Identity e'] $ readPhase- where+tickAppFrame AppFrame {..} input = r where   fire      = _appFrame_fire   readPhase = _appFrame_readPhase-  pulseB    = _appFrame_pulseB-  pulseE    = _appFrame_pulseE+  mpulseB   = _appFrame_mpulseB+  mpulseE   = _appFrame_mpulseE+  makeFiring mpulse v = case mpulse of+    Just pulse -> [pulse :=> Identity v]+    Nothing    -> []+  firings = case input of+    Nothing -> []+    Just i  -> case i of+      This b'     -> makeFiring mpulseB b'+      That e'     -> makeFiring mpulseE e'+      These b' e' -> makeFiring mpulseB b' <> makeFiring mpulseE e'+  r = fire firings readPhase + -- | calls 'tickAppFrame' for each input in a list and returns collected results -- see comments for 'tickAppFrame' runApp   :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (AppIn t bIn eIn -> PerformEventT t m (AppOut t bOut eOut))+  => (AppIn t bIn eIn -> TestGuestMonad t m (AppOut t bOut eOut))   -> bIn   -> [Maybe (These bIn eIn)]   -> IO [[(bOut, Maybe eOut)]]@@ -123,7 +170,7 @@ -- see comments for 'tickAppFrame' runAppSimple   :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (Event t eIn -> PerformEventT t m (Event t eOut))+  => (Event t eIn -> TestGuestMonad t m (Event t eOut))   -> [eIn]   -> IO [[Maybe eOut]] runAppSimple app input = runApp' app (map Just input)@@ -132,7 +179,7 @@ -- see comments for 'tickAppFrame' runApp'   :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (Event t eIn -> PerformEventT t m (Event t eOut))+  => (Event t eIn -> TestGuestMonad t m (Event t eOut))   -> [Maybe eIn]   -> IO [[Maybe eOut]] runApp' app input = do@@ -143,7 +190,7 @@ -- see comments for 'tickAppFrame' runAppB   :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (Event t eIn -> PerformEventT t m (Behavior t bOut))+  => (Event t eIn -> TestGuestMonad t m (Behavior t bOut))   -> [Maybe eIn]   -> IO [[bOut]] runAppB app input = do

@@ -1,5 +1,5 @@+{-# LANGUAGE RankNTypes      #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE RankNTypes #-}  module Reflex.Test.HostSpec   ( spec@@ -9,23 +9,43 @@ import           Prelude  import           Test.Hspec-import           Test.Hspec.Contrib.HUnit       ( fromHUnitTest )+import           Test.Hspec.Contrib.HUnit (fromHUnitTest) import           Test.HUnit  import           Reflex import           Reflex.Test.Host -import           Control.Monad                  ( forM_ )-import           Control.Monad.IO.Class         ( liftIO )-import qualified Data.List                     as L+import           Control.Monad            (forM_)+import           Control.Monad.IO.Class   (liftIO)+import           Data.Functor+import qualified Data.List                as L import           Data.These  +-- | network that ensures postbuild event was triggered+postbuild_network+  :: forall t m+   . (t ~ SpiderTimeline Global, m ~ SpiderHost Global)+  => (AppIn t () () -> TestGuestMonad t m (AppOut t Bool ()))+postbuild_network AppIn {..} = do+  pbev            <- getPostBuild+  didPBTriggerBeh <- hold False (pbev $> True)+  return AppOut { _appOut_behavior = didPBTriggerBeh, _appOut_event = never } +test_postbuild :: Test+test_postbuild = TestLabel "postbuild" $ TestCase $ runSpiderHost $ do+  appFrame <- getAppFrame postbuild_network ()+  -- tick the appFrame once which will give us the output behavior value of the previous frame (which triggered the postbuild event)+  out      <- tickAppFrame appFrame (Just (That ()))+  liftIO $ out @?= [(True, Nothing)]+++-- | Basic network that flips returns a behavior that is the input behavior flipped+-- and an event that is the input behavior's value added to the input events value. basic_network   :: forall t m    . (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (AppIn t Int Int -> PerformEventT t m (AppOut t Int Int))+  => (AppIn t Int Int -> TestGuestMonad t m (AppOut t Int Int)) basic_network AppIn {..} = return AppOut   { _appOut_behavior = fmap (* (-1)) _appIn_behavior   , _appOut_event    = fmap (\(b, e) -> e + b)@@ -44,3 +64,4 @@ spec :: Spec spec = describe "Reflex.Test.App" $ do   fromHUnitTest test_basic+  fromHUnitTest test_postbuild