{-# 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 BasicNetworkTest1_InputTriggerRefs{..} <- inputTriggerRefs -- fire it 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] -- try a different value queueEventTriggerRef _basicNetworkTest1_InputTriggerRefs_intEvTRef 238 a <- fireQueuedEventsAndRead $ sequence =<< readEvent oh liftIO $ a @?= [Just 238] spec :: Spec spec = do fromHUnitTest test_basic fromHUnitTest test_basic_viaReflexTestApp