reflex-test-host 0.1.1.0 → 0.1.2.0

raw patch · 9 files changed

+577/−258 lines, 9 filesdep +lensdep +mtldep +primitivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: lens, mtl, primitive, transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +3/−0
• README.md +1/−1
• reflex-test-host.cabal +14/−3
• src/Reflex/Test/Host.hs +4/−187
• src/Reflex/Test/Monad/Host.hs +197/−0
• src/Reflex/Test/SimpleHost.hs +198/−0
• test/Reflex/Test/HostSpec.hs +0/−67
• test/Reflex/Test/Monad/HostSpec.hs +93/−0
• test/Reflex/Test/SimpleHostSpec.hs +67/−0

@@ -1,5 +1,8 @@ # Changelog for reflex-test-host +## 0.1.2.0+- added `Reflex.Test.Monad.Host`+ ## 0.1.1.0 - generalized reflex constraints - added `PostBuildT` support

@@ -1,4 +1,4 @@-# reflex-test-app+# reflex-test-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). 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f349f220ed538f9eea356a8e92d10740b0397a12f201007808bf995d552a0513+-- hash: 17e1fcd46f7b753b5168f295d2feefbd6f430a25c8ba76ed9af2335ee1bfaff3  name:           reflex-test-host-version:        0.1.1.0+version:        0.1.2.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@@ -30,6 +30,8 @@ library   exposed-modules:       Reflex.Test.Host+      Reflex.Test.SimpleHost+      Reflex.Test.Monad.Host   other-modules:       Paths_reflex_test_host   hs-source-dirs:@@ -39,16 +41,21 @@   build-depends:       base >=4.7 && <5     , dependent-sum+    , lens+    , mtl+    , primitive     , ref-tf     , reflex     , these+    , transformers   default-language: Haskell2010  test-suite reflex-test-host-test   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Reflex.Test.HostSpec+      Reflex.Test.Monad.HostSpec+      Reflex.Test.SimpleHostSpec       Paths_reflex_test_host   hs-source-dirs:       test@@ -60,8 +67,12 @@     , dependent-sum     , hspec     , hspec-contrib+    , lens+    , mtl+    , primitive     , ref-tf     , reflex     , reflex-test-host     , these+    , transformers   default-language: Haskell2010

@@ -4,195 +4,12 @@ -- Module: --   Reflex.Test.Host -- Description:---   This module contains reflex host methods for testing without external events+--   DEPRECATED use 'Reflex.Test.SimpleHost' instead+--   reexports 'Reflex.Test.SimpleHost'  module Reflex.Test.Host-  ( TestGuestConstraints-  , TestGuestMonad-  , AppIn(..)-  , AppOut(..)-  , AppFrame(..)-  , getAppFrame-  , tickAppFrame-  , runAppSimple-  , runApp-  , runApp'-  , runAppB+  ( module Reflex.Test.SimpleHost   ) where -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.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-    }--data AppOut t b e = AppOut-    { _appOut_behavior :: Behavior t b-    , _appOut_event    :: Event t e-    }--data AppFrame t bIn eIn bOut eOut m = AppFrame-    { _appFrame_readPhase :: ReadPhase m (bOut, Maybe eOut)-    , _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. This will also fire the 'PostBuild' event if there--- are any subscribers.-getAppFrame-  :: forall t bIn eIn bOut eOut m-   . (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 $ 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-  let readPhase = do-        b      <- sample (_appOut_behavior out)-        frames <- sequence =<< readEvent hnd-        return (b, frames)-  return AppFrame { _appFrame_readPhase = readPhase-                  , _appFrame_mpulseB   = mpulseB-                  , _appFrame_mpulseE   = mpulseE-                  , _appFrame_fire      = fire-                  }---- | Tick an app frame once with optional input behavior and event values.--- Returns behaviors and events from the app's output for each frame that run--- for the input (i.e. 'runWithAdjust' and 'performEvent' may cause several--- frames to run for each input)------ N.B. output behavior will not reflect changes that happen during its frame--- i.e. this is analogous to 'tag' and 'tagPromptlyDyn'. If you need the most--- recent behavior value you can always call 'tickAppFrame' with 'Nothing' as--- input-tickAppFrame-  :: AppFrame t bIn eIn bOut eOut m-  -> Maybe (These bIn eIn)-  -> m [(bOut, Maybe eOut)]-tickAppFrame AppFrame {..} input = r where-  fire      = _appFrame_fire-  readPhase = _appFrame_readPhase-  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 -> TestGuestMonad t m (AppOut t bOut eOut))-  -> bIn-  -> [Maybe (These bIn eIn)]-  -> IO [[(bOut, Maybe eOut)]]-runApp app b0 input = runSpiderHost $ do-  appFrame <- getAppFrame app b0-  forM input $ tickAppFrame appFrame---- | run an app with provided list of input events returns list of results for--- each input. Each result is a list of events from the app's output for each--- frame that run for the input.--- see comments for 'tickAppFrame'-runAppSimple-  :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (Event t eIn -> TestGuestMonad t m (Event t eOut))-  -> [eIn]-  -> IO [[Maybe eOut]]-runAppSimple app input = runApp' app (map Just input)---- | same as runAppSimple except input event for each frame is optional--- see comments for 'tickAppFrame'-runApp'-  :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (Event t eIn -> TestGuestMonad t m (Event t eOut))-  -> [Maybe eIn]-  -> IO [[Maybe eOut]]-runApp' app input = do-  let app' = fmap (AppOut (pure ())) . app-  map (map snd) <$> runApp (app' . _appIn_event) () (map (fmap That) input)---- | same as runApp' except only returns sampled output behavior--- see comments for 'tickAppFrame'-runAppB-  :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)-  => (Event t eIn -> TestGuestMonad t m (Behavior t bOut))-  -> [Maybe eIn]-  -> IO [[bOut]]-runAppB app input = do-  let app' = fmap (flip AppOut never) . app-  map (map fst) <$> runApp (app' . _appIn_event) () (map (fmap That) input)+import           Reflex.Test.SimpleHost

@@ -0,0 +1,197 @@+++++-- |+-- Module:+--   Reflex.Test.Monad.Host+-- Description:+--   This module contains a monad for testing reflex networks++module Reflex.Test.Monad.Host+  ( TestGuestT+  , TestGuestConstraints+  , ReflexTriggerRef++  , MonadReflexTest(..)+  , AppState(..)+  , ReflexTestT(..)+  , runReflexTestT+  , ReflexTestApp(..)+  , runReflexTestApp+  )+where++++import           Prelude+++import           Control.Concurrent.Chan+import           Control.Monad.IO.Class++import           Control.Monad.Primitive+import           Control.Monad.Reader+import           Control.Monad.Ref+import           Control.Monad.State.Strict+import           Data.Dependent.Sum+import           Data.Functor.Identity+import           Data.Kind++import           Reflex+import           Reflex.Class               ()+import           Reflex.Host.Class+++type TestGuestT t (m :: Type -> Type)+  = TriggerEventT t (PostBuildT t (PerformEventT t m))++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+    )++-- | since we work with this type directly a lot, it helps to wrap it around a type synonym+type ReflexTriggerRef t (m :: Type -> Type) a = Ref m (Maybe (EventTrigger t a))++-- |+class MonadReflexTest t m | m -> t  where+  -- | since event subscriptions also happen within the monad, input triggers created via 'newEventWithTriggerRef' may be stuck in the 'Nothing' state as there are no listeners yet+  -- therefore it's necessary to pass in IORefs to the EventTriggers, thus the name of this type+  -- in practice, this will likely be a record containing many trigger refs and the monad user must deref them all+  type InputTriggerRefs m :: Type+  -- | in practice, this will likely be a record containing events and behaviors for the monad user to build a 'ReadPhase' that is passed into 'fireQueuedEventsAndRead'+  type OutputEvents m :: Type+  -- | the inner monad that reflex is running in+  -- likely 'SpiderHost Global'+  type InnerMonad m :: Type -> Type+  -- | see comments for 'InputTriggerRefs'+  inputTriggerRefs :: m (InputTriggerRefs m)+  -- | all queued triggers will fire simultaneous on the next execution of 'fireQueuedEventsAndRead'+  queueEventTrigger :: DSum (EventTrigger t) Identity -> m ()+  -- | same as 'queueEventTrigger' except works with trigger refs+  -- if the trigger ref derefs to 'Nothing', the event does not get queued+  queueEventTriggerRef :: Ref (InnerMonad m) (Maybe (EventTrigger t a)) -> a -> m ()+  -- | see comments for 'OutputEvents'+  outputs :: m (OutputEvents m)+  -- | fire all queued events and run a ReadPhase to produce results from the execution frames+  -- readphase takes place in the inner monad+  fireQueuedEventsAndRead :: ReadPhase (InnerMonad m) a -> m [a]++-- m is 'InnerMonad' from above+data AppState t m = AppState+    { _appState_queuedEvents :: [DSum (EventTrigger t) Identity] -- ^ events to fire in next 'FireCommand'+    -- ^ 'FireCommand' to fire events and run next frame+    , _appState_fire         :: FireCommand t m -- ^ 'FireCommand' to fire events and run next frame+    }++-- | implementation of 'MonadReflexTest'+newtype ReflexTestT t intref out m a = ReflexTestT { unReflexTestM :: ReaderT (intref, out) (StateT (AppState t m) m) a }+  deriving+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadFix+    , MonadReader (intref, out)+    , MonadState (AppState t m))++deriving instance MonadSample t m => MonadSample t (ReflexTestT t intref out m)+deriving instance MonadHold t m => MonadHold t (ReflexTestT t intref out m)+deriving instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ReflexTestT t intref out m)++instance MonadTrans (ReflexTestT t intref out) where+  lift = ReflexTestT . lift . lift++instance (MonadSubscribeEvent t m) => MonadSubscribeEvent t (ReflexTestT t intref out m) where+  subscribeEvent = lift . subscribeEvent++instance (MonadRef m) => MonadReflexTest t (ReflexTestT t intref out m) where+  type InputTriggerRefs (ReflexTestT t intref out m) = intref+  type OutputEvents (ReflexTestT t intref out m) = out+  type InnerMonad (ReflexTestT t intref out m) = m+  inputTriggerRefs = do+    (intref,_) <- ask+    return intref+  queueEventTrigger evt = do+    as <- get+    put $ as { _appState_queuedEvents = evt : _appState_queuedEvents as }+  queueEventTriggerRef ref a = do+    mpulse <- lift $ readRef ref+    case mpulse of+      Nothing    -> return ()+      Just pulse -> do+        as <- get+        put $ as { _appState_queuedEvents = (pulse :=> Identity a) : _appState_queuedEvents as }+  outputs = do+    (_,out) <- ask+    return out+  fireQueuedEventsAndRead rp = do+    as <- get+    lift $ (runFireCommand $ _appState_fire as) (_appState_queuedEvents as) rp++runReflexTestT+  :: forall intref inev out t m a+   . (TestGuestConstraints t m)+  => (inev, intref) -- ^ make sure intref match inev, i.e. return values of newEventWithTriggerRef+  -> (inev -> TestGuestT t m out) -- ^ network to test+  -> ReflexTestT t intref out m a -- ^ test monad to run+  -> m ()+runReflexTestT (input, inputTRefs) app rtm = do+  (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef++  events                           <- liftIO newChan+  (output, fc@(FireCommand fire))  <- do+    hostPerformEventT+      $ flip runPostBuildT    postBuild+      $ flip runTriggerEventT events+      $ app input++  -- handle post build+  -- TODO consider adding some way to test 'PostBuild' results+  mPostBuildTrigger <- readRef postBuildTriggerRef+  _                 <- case mPostBuildTrigger of+    Nothing -> return [()] -- no subscribers+    Just postBuildTrigger ->+      fire [postBuildTrigger :=> Identity ()] $ return ()++  -- TODO maybe find a way to handle trigger events+  -- one solution is to implement non-blocking variant of TriggerEventT+  -- and then pass as part of AppState such that each call to readPhase will fire any trigger events+  -- another option is just to start a thread and output warnings anytime triggerEvs are created+  --triggerEvs <- liftIO $ readChan events++  -- run the test monad+  flip runStateT (AppState [] fc)+    $ flip runReaderT (inputTRefs, output)+      $ unReflexTestM rtm++  return ()++++-- | class to help bind network and types to a 'ReflexTestT'+-- see test/Reflex/Test/Monad/HostSpec.hs for usage example+class ReflexTestApp app t m | app -> t m where+  data AppInputTriggerRefs app :: Type+  data AppInputEvents app :: Type+  data AppOutput app :: Type+  getApp :: AppInputEvents app -> TestGuestT t m (AppOutput app)+  makeInputs :: m (AppInputEvents app, AppInputTriggerRefs app)++runReflexTestApp+  :: (ReflexTestApp app t m, TestGuestConstraints t m)+  => ReflexTestT t (AppInputTriggerRefs app) (AppOutput app) m ()+  -> m ()+runReflexTestApp rtm = do+  i <- makeInputs+  runReflexTestT i getApp rtm

@@ -0,0 +1,198 @@+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module:+--   Reflex.Test.SimpleHost+-- Description:+--   This module contains reflex host methods for testing without external events++module Reflex.Test.SimpleHost+  ( TestGuestConstraints+  , TestGuestT+  , AppIn(..)+  , AppOut(..)+  , AppFrame(..)+  , getAppFrame+  , tickAppFrame+  , runAppSimple+  , runApp+  , runApp'+  , runAppB+  )+where++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.Kind+import           Data.These++import           Reflex+import           Reflex.Host.Class+++type TestGuestT t (m :: Type -> Type) = PostBuildT t (PerformEventT t m)++-- 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+    )++data AppIn t b e = AppIn+    { _appIn_behavior :: Behavior t b+    , _appIn_event    :: Event t e+    }++data AppOut t b e = AppOut+    { _appOut_behavior :: Behavior t b+    , _appOut_event    :: Event t e+    }++data AppFrame t bIn eIn bOut eOut m = AppFrame+    { _appFrame_readPhase :: ReadPhase m (bOut, Maybe eOut)+    , _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. This will also fire the 'PostBuild' event if there+-- are any subscribers.+getAppFrame+  :: forall t bIn eIn bOut eOut m+   . (TestGuestConstraints t m)+  => (AppIn t bIn eIn -> TestGuestT 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 $ 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+  let readPhase = do+        b      <- sample (_appOut_behavior out)+        frames <- sequence =<< readEvent hnd+        return (b, frames)+  return AppFrame { _appFrame_readPhase = readPhase+                  , _appFrame_mpulseB   = mpulseB+                  , _appFrame_mpulseE   = mpulseE+                  , _appFrame_fire      = fire+                  }++-- | Tick an app frame once with optional input behavior and event values.+-- Returns behaviors and events from the app's output for each frame that run+-- for the input (i.e. 'runWithAdjust' and 'performEvent' may cause several+-- frames to run for each input)+--+-- N.B. output behavior will not reflect changes that happen during its frame+-- i.e. this is analogous to 'tag' and 'tagPromptlyDyn'. If you need the most+-- recent behavior value you can always call 'tickAppFrame' with 'Nothing' as+-- input+tickAppFrame+  :: AppFrame t bIn eIn bOut eOut m+  -> Maybe (These bIn eIn)+  -> m [(bOut, Maybe eOut)]+tickAppFrame AppFrame {..} input = r where+  fire      = _appFrame_fire+  readPhase = _appFrame_readPhase+  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 -> TestGuestT t m (AppOut t bOut eOut))+  -> bIn+  -> [Maybe (These bIn eIn)]+  -> IO [[(bOut, Maybe eOut)]]+runApp app b0 input = runSpiderHost $ do+  appFrame <- getAppFrame app b0+  forM input $ tickAppFrame appFrame++-- | run an app with provided list of input events returns list of results for+-- each input. Each result is a list of events from the app's output for each+-- frame that run for the input.+-- see comments for 'tickAppFrame'+runAppSimple+  :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)+  => (Event t eIn -> TestGuestT t m (Event t eOut))+  -> [eIn]+  -> IO [[Maybe eOut]]+runAppSimple app input = runApp' app (map Just input)++-- | same as runAppSimple except input event for each frame is optional+-- see comments for 'tickAppFrame'+runApp'+  :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)+  => (Event t eIn -> TestGuestT t m (Event t eOut))+  -> [Maybe eIn]+  -> IO [[Maybe eOut]]+runApp' app input = do+  let app' = fmap (AppOut (pure ())) . app+  map (map snd) <$> runApp (app' . _appIn_event) () (map (fmap That) input)++-- | same as runApp' except only returns sampled output behavior+-- see comments for 'tickAppFrame'+runAppB+  :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)+  => (Event t eIn -> TestGuestT t m (Behavior t bOut))+  -> [Maybe eIn]+  -> IO [[bOut]]+runAppB app input = do+  let app' = fmap (flip AppOut never) . app+  map (map fst) <$> runApp (app' . _appIn_event) () (map (fmap That) input)

@@ -1,67 +0,0 @@-{-# LANGUAGE RankNTypes      #-}-{-# LANGUAGE RecordWildCards #-}--module Reflex.Test.HostSpec-  ( spec-  )-where--import           Prelude--import           Test.Hspec-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           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 -> 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)-                         $ attach _appIn_behavior _appIn_event-  }--test_basic :: Test-test_basic = TestLabel "basic" $ TestCase $ runSpiderHost $ do-  let b  = 10 :: Int-      es = [1 .. 10] :: [Int]-  appFrame <- getAppFrame basic_network b-  forM_ es $ \e -> do-    out <- tickAppFrame appFrame (Just (That e))-    liftIO $ L.last out @?= (-b, Just (b + e))--spec :: Spec-spec = describe "Reflex.Test.App" $ do-  fromHUnitTest test_basic-  fromHUnitTest test_postbuild

@@ -0,0 +1,93 @@+{-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE RecordWildCards      #-}+{-# LANGUAGE UndecidableInstances #-}++module Reflex.Test.Monad.HostSpec+  ( spec+  )+where++import           Prelude++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit (fromHUnitTest)+import           Test.HUnit++import           Control.Monad.IO.Class   (liftIO)+import           Data.Kind++import           Reflex+import           Reflex.Host.Class+import           Reflex.Test.Monad.Host+++-- | a very basic test network, simple passes on the input event to its observed outputs+basic_network :: forall t m. (ReflexHost t)+  => (Event t Int -> TestGuestT t m (Event t Int))+basic_network ev = return ev++-- | test 'basic_network'+test_basic :: Test+test_basic = TestLabel "basic" $ TestCase $ runSpiderHost $ do+  ins <- newEventWithTriggerRef+  runReflexTestT ins basic_network $ do++    -- get our app's output events and subscribe to them+    oh                               <- subscribeEvent =<< outputs+    -- get our input trigger ref, dereference it, queue it and fire it+    intref                           <- inputTriggerRefs++    -- example of how to manually dereferences our input trigger+    {-+    mh :: Maybe (EventTrigger T Int) <- liftIO $ readRef intref+    case mh of+      Just h  -> queueEventTrigger $ (h :=> Identity 0)+      Nothing -> error "no subscribers to h"+    -}++    -- simpler version that uses 'queueEventTriggerRef'+    queueEventTriggerRef intref 123++    -- fire the events and read from our output handle+    a <- fireQueuedEventsAndRead $ sequence =<< readEvent oh++    -- validate results+    liftIO $ a @?= [Just 123]++data BasicNetworkTest1 t (m :: Type -> Type)++instance (TestGuestConstraints t m) => ReflexTestApp (BasicNetworkTest1 t m) t m where+  data AppInputTriggerRefs (BasicNetworkTest1 t m) =+    BasicNetworkTest1_InputTriggerRefs { _basicNetworkTest1_InputTriggerRefs_intEvTRef :: ReflexTriggerRef t m Int }+  data AppInputEvents (BasicNetworkTest1 t m) =+    BasicNetworkTest1_InputEvents { _basicNetworkTest1_InputEvents_intEv :: Event t Int }+  data AppOutput (BasicNetworkTest1 t m) =+    BasicNetworkTest1_Output { _basicNetworkTest1_Output_intEv :: Event t Int }+  getApp ev = basic_network (_basicNetworkTest1_InputEvents_intEv ev) >>= return . BasicNetworkTest1_Output+  makeInputs = do+    (inev, intref) <- newEventWithTriggerRef+    return (BasicNetworkTest1_InputEvents inev, BasicNetworkTest1_InputTriggerRefs intref)++test_basic_viaReflexTestApp :: Test+test_basic_viaReflexTestApp = TestLabel "basic_viaReflexTestApp" $ TestCase $ runSpiderHost $+  runReflexTestApp @ (BasicNetworkTest1 (SpiderTimeline Global) (SpiderHost Global)) $ do+    -- get our app's output events and subscribe to them+    BasicNetworkTest1_Output {..} <- outputs+    oh                            <- subscribeEvent _basicNetworkTest1_Output_intEv+    -- get our input trigger ref, dereference it, queue it and fire it+    BasicNetworkTest1_InputTriggerRefs{..}                           <- inputTriggerRefs++    -- simpler version that uses 'queueEventTriggerRef'+    queueEventTriggerRef _basicNetworkTest1_InputTriggerRefs_intEvTRef 123++    -- fire the events and read from our output handle+    a <- fireQueuedEventsAndRead $ sequence =<< readEvent oh++    -- validate results+    liftIO $ a @?= [Just 123]+++spec :: Spec+spec = do+  fromHUnitTest test_basic+  fromHUnitTest test_basic_viaReflexTestApp

@@ -0,0 +1,67 @@+{-# LANGUAGE RankNTypes      #-}+{-# LANGUAGE RecordWildCards #-}++module Reflex.Test.SimpleHostSpec+  ( spec+  )+where++import           Prelude++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit (fromHUnitTest)+import           Test.HUnit++import           Reflex+import           Reflex.Test.SimpleHost++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 () () -> TestGuestT 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 -> TestGuestT t m (AppOut t Int Int))+basic_network AppIn {..} = return AppOut+  { _appOut_behavior = fmap (* (-1)) _appIn_behavior+  , _appOut_event    = fmap (\(b, e) -> e + b)+                         $ attach _appIn_behavior _appIn_event+  }++test_basic :: Test+test_basic = TestLabel "basic" $ TestCase $ runSpiderHost $ do+  let b  = 10 :: Int+      es = [1 .. 10] :: [Int]+  appFrame <- getAppFrame basic_network b+  forM_ es $ \e -> do+    out <- tickAppFrame appFrame (Just (That e))+    liftIO $ L.last out @?= (-b, Just (b + e))++spec :: Spec+spec = do+  fromHUnitTest test_basic+  fromHUnitTest test_postbuild