reflex-test-host (empty) → 0.1.0.0

raw patch · 7 files changed

+313/−0 lines, 7 filesdep +HUnitdep +basedep +dependent-sum

Dependencies added: HUnit, base, dependent-sum, hspec, hspec-contrib, ref-tf, reflex, reflex-test-host, these

Files

ChangeLog.md +4/−0
LICENSE +30/−0
README.md +13/−0
reflex-test-host.cabal +67/−0
src/Reflex/Test/Host.hs +151/−0
test/Reflex/Test/HostSpec.hs +46/−0
test/Spec.hs +2/−0

+ ChangeLog.md view

@@ -0,0 +1,4 @@+# Changelog for reflex-test-host++## 0.1.0.0+first release

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,13 @@+# 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/).++- `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`++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).++PRs are welcome. Perhaps you have some ideas to make the interface more useable.

+ reflex-test-host.cabal view

@@ -0,0 +1,67 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 5ed3f299235faa921234096cca2fe127b6f0a9a8b4b49c9ce1178d3205a927b7++name:           reflex-test-host+version:        0.1.0.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+homepage:       https://github.com/pdlla/reflex-test-host#readme+bug-reports:    https://github.com/pdlla/reflex-test-host/issues+author:         pdlla+maintainer:     chippermonky@gmail.com+copyright:      2020 Peter Lu+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/pdlla/reflex-test-host++library+  exposed-modules:+      Reflex.Test.Host+  other-modules:+      Paths_reflex_test_host+  hs-source-dirs:+      src+  default-extensions: ApplicativeDo BangPatterns DataKinds ConstraintKinds DeriveFoldable DeriveFunctor DeriveTraversable DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies EmptyCase ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PatternSynonyms RankNTypes ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators NoImplicitPrelude+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , dependent-sum+    , ref-tf+    , reflex+    , these+  default-language: Haskell2010++test-suite reflex-test-host-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Reflex.Test.HostSpec+      Paths_reflex_test_host+  hs-source-dirs:+      test+  default-extensions: ApplicativeDo BangPatterns DataKinds ConstraintKinds DeriveFoldable DeriveFunctor DeriveTraversable DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies EmptyCase ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PatternSynonyms RankNTypes ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators NoImplicitPrelude+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HUnit+    , base >=4.7 && <5+    , dependent-sum+    , hspec+    , hspec-contrib+    , ref-tf+    , reflex+    , reflex-test-host+    , these+  default-language: Haskell2010

+ src/Reflex/Test/Host.hs view

@@ -0,0 +1,151 @@+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module:+--   Reflex.Test.Host+-- Description:+--   This module contains reflex host methods for testing without external events++module Reflex.Test.Host+  ( AppIn(..)+  , AppOut(..)+  , AppFrame(..)+  , getAppFrame+  , tickAppFrame+  , runAppSimple+  , runApp+  , runApp'+  , runAppB+  )+where++import           Prelude++import           Control.Monad+import           Control.Monad.Ref+import           Data.Dependent.Sum+import           Data.Functor.Identity+import           Data.Maybe            (fromJust)+import           Data.These++import           Reflex+import           Reflex.Host.Class++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_pulseB :: EventTrigger t bIn+    , _appFrame_pulseE :: 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.+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))+  -> bIn+  -> m (AppFrame t bIn eIn bOut eOut m)+getAppFrame app b0 = do+  (appInHoldE, pulseHoldTriggerRef ) <- newEventWithTriggerRef+  (appInE    , pulseEventTriggerRef) <- newEventWithTriggerRef+  appInB                             <- hold b0 appInHoldE+  (out :: AppOut t bOut eOut, FireCommand fire) <-+    hostPerformEventT $ app $ AppIn { _appIn_event    = appInE+                                    , _appIn_behavior = appInB+                                    }+  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_pulseB    = fromJust mpulseB+                  , _appFrame_pulseE    = fromJust 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+  :: (t ~ SpiderTimeline Global)+  => 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+  fire      = _appFrame_fire+  readPhase = _appFrame_readPhase+  pulseB    = _appFrame_pulseB+  pulseE    = _appFrame_pulseE++-- | 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))+  -> 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 -> PerformEventT 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 -> PerformEventT 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 -> PerformEventT 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)

+ test/Reflex/Test/HostSpec.hs view

@@ -0,0 +1,46 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}++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 qualified Data.List                     as L+import           Data.These++++basic_network+  :: forall t m+   . (t ~ SpiderTimeline Global, m ~ SpiderHost Global)+  => (AppIn t Int Int -> PerformEventT 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

+ test/Spec.hs view

@@ -0,0 +1,2 @@+-- hspec auto-discovery stuff+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}