packages feed

eve 0.1.0 → 0.1.1

raw patch · 17 files changed

+321/−215 lines, 17 files

Files

README.md view
@@ -17,7 +17,7 @@ \^ That guide will bring you through the process of making your first app!  If you have any issues (and I'm sure there'll be a few; it's a new project!)-please report them [here](https://github.com/ChrisPenner/rasa/issues).+please report them [here](https://github.com/ChrisPenner/eve/issues).  Core Principles ---------------
eve.cabal view
@@ -1,5 +1,5 @@ name:                eve-version:             0.1.0+version:             0.1.1 synopsis: An extensible event framework description: An extensible event-driven application framework in haskell for building embarassingly modular software. homepage:            https://github.com/ChrisPenner/eve#readme@@ -16,11 +16,12 @@ library   hs-source-dirs:      src   exposed-modules:     Eve-                     , Eve.Internal.Testing+                     , Eve.Testing                      , Eve.Internal.Actions+                     , Eve.Internal.AppState                      , Eve.Internal.Async                      , Eve.Internal.Events-                     , Eve.Internal.Extensions+                     , Eve.Internal.States                      , Eve.Internal.Listeners                      , Eve.Internal.Run   build-depends:       base >= 4.7 && < 5
src/Eve.hs view
@@ -1,10 +1,15 @@ module Eve   ( eve+  , eveT    , App   , Action+  , AppT+  , ActionT   , liftAction+  , AppState +  -- * Events   , dispatchEvent   , dispatchEvent_   , dispatchEventAsync@@ -14,6 +19,15 @@   , addListener_   , removeListener +  -- * Working with Async Events/Actions+  , asyncActionProvider+  , asyncEventProvider+  , Dispatcher++  , Listener+  , ListenerId++  -- * Built-in Event Listeners   , onInit   , afterInit   , beforeEvent@@ -22,16 +36,49 @@   , afterEvent_   , onExit -  , asyncActionProvider-  , asyncEventProvider--  , Listener-  , ListenerId--  , HasExts(..)-  , Exts+  -- * Working with State+  -- | All application-provided states are stored in the same+  -- Map; keyed by their 'Data.Typeable.TypeRep'. This means that if more than one state+  -- uses the same type then they'll conflict and overwrite each-other (this is less of a+  -- problem than you're probably thinking). This is easily solved by simply+  -- using a newtype around any types you haven't defined yourself.+  -- For example if your application stores a counter as an Int, wrap it in your own custom+  -- @Counter@ newtype when storing it. If you wish to store multiple copies of a given state+  -- simply store them in a list or map, then store that container as your state.+  --+  -- Because states are stored by their 'Data.Typeable.TypeRep', they must define an+  -- instance of 'Data.Typeable.Typeable', luckily GHC can derive this for you with+  -- @deriving Typeable@.+  --+  -- It is also required for all states to define an instance of+  -- 'Data.Default.Default', this is because accessing an extension which has not+  -- yet been stored will result in the default value.+  --+  -- If there's no default value that makes sense for your type, you can define+  -- a default of 'Data.Maybe.Nothing' and pattern-match on its value when you+  -- access it.+  --+  -- Stored states are accessed by using the `stateLens` lens, this lens is polymorphic+  -- and can return ANY type. GHC infers the needed type and the lens will retrieve the+  -- state that you want from the store of states. It seems a bit complicated, but it all+  -- works fine in practice.+  --+  -- To avoid confusion it's best to rename a version of `stateLens` with a more restrictive+  -- type for each different state type that you store. This helps prevent strange errors and+  -- makes your code much easier to read. For example:+  --+  -- > data MyState = MyState String+  -- > myState :: HasStates s => Lens' s MyState+  -- > myState = stateLens+  -- >+  -- > myAction = do+  -- >   MyState str <- use stateLens+  --+  -- If GHC has trouble inferring the type, rename it and restrict the type as above.+  , HasStates(..)+  , States   , HasEvents-  , ext+  , stateLens    , runAction   , exit@@ -41,4 +88,5 @@ import Eve.Internal.Actions import Eve.Internal.Listeners import Eve.Internal.Async-import Eve.Internal.Extensions+import Eve.Internal.AppState+import Eve.Internal.States
src/Eve/Internal/Actions.hs view
@@ -2,74 +2,77 @@ {-# language DeriveFunctor #-} {-# language FlexibleInstances #-} {-# language MultiParamTypeClasses #-}-{-# language TemplateHaskell #-} {-# language RankNTypes #-} {-# language TypeFamilies #-} {-# language UndecidableInstances #-} {-# language ScopedTypeVariables #-}+{-# language TemplateHaskell #-} module Eve.Internal.Actions-  ( Action(..)-  , ActionF(..)-  , App+  ( ActionF(..)+  , ActionT(..)+  , AppT+  , runApp+  , evalApp   , execApp -  , AppState(..)-  , asyncQueue-   , liftAction   , runAction    , exit   , isExiting+  , asyncQueue   , Exiting(..)   ) where -import Eve.Internal.Extensions-import Data.Default+import Eve.Internal.States  import Control.Monad.State import Control.Monad.Trans.Free import Control.Lens+import Data.Default+import Data.Typeable  import Pipes.Concurrent -type App a = Action AppState a-data AppState = AppState-  { _baseExts :: Exts-  , _asyncQueue :: Output (App ())-  }+type AppT s m a = ActionT s s m a -newtype ActionF next =-  LiftAction (StateT AppState IO next)+newtype ActionF base m next =+  LiftAction (StateT base m next)   deriving (Functor, Applicative) -newtype Action zoomed a = Action-  { getAction :: FreeT ActionF (StateT zoomed IO) a-  } deriving (Functor, Applicative, Monad, MonadIO, MonadState zoomed, MonadFree ActionF)-makeLenses ''AppState+newtype ActionT base zoomed m a = ActionT+  { getAction :: FreeT (ActionF base m) (StateT zoomed m) a+  } deriving (Functor, Applicative, Monad, MonadIO, MonadState zoomed) -instance HasExts AppState where-  exts = baseExts+instance Monad n => MonadFree (ActionF base n) (ActionT base zoomed n) where+  wrap (LiftAction act) = join . ActionT . liftF . LiftAction $ act -instance HasEvents AppState where+instance MonadTrans (ActionT base zoomed) where+  lift = ActionT . lift . lift -unLift :: FreeT ActionF (StateT AppState IO) a -> StateT AppState IO a+unLift :: Monad m => FreeT (ActionF base m) (StateT base m) a -> StateT base m a unLift m = do   step <- runFreeT m   case step of     Pure a -> return a     Free (LiftAction next) -> next >>= unLift -liftAction :: Action AppState a -> Action zoomed a+liftAction :: Monad m => AppT base m a -> ActionT base zoomed m a liftAction = liftF .  LiftAction . unLift . getAction -execApp :: AppState -> Action AppState a -> IO a-execApp appState = flip evalStateT appState . unLift . getAction+runApp :: Monad m => base -> AppT base m a -> m (a, base)+runApp baseState = flip runStateT baseState . unLift . getAction -type instance Zoomed (Action s) = Zoomed (FreeT ActionF (StateT s IO))-instance Zoom (Action s) (Action t) s t where-  zoom l (Action action) = Action $ zoom l action+evalApp :: Monad m => base -> AppT base m a -> m a+evalApp baseState = fmap fst . runApp baseState +execApp :: Monad m => base -> AppT base m a -> m base+execApp baseState = fmap snd . runApp baseState++type instance Zoomed (ActionT base zoomed m) = Zoomed (FreeT (ActionF base m) (StateT zoomed m))+instance Monad m => Zoom (ActionT base s m) (ActionT base t m) s t where+  zoom l (ActionT action) = ActionT $ zoom l action+ runAction :: Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c runAction = zoom @@ -80,10 +83,24 @@ instance Default Exiting where   def = Exiting False -exit :: App ()-exit = ext .= Exiting True+exit :: (Monad m, HasStates s) => ActionT s zoomed m ()+exit = liftAction $ stateLens .= Exiting True -isExiting :: App Bool-isExiting = do-  Exiting b <- use ext+isExiting :: (Monad m, HasStates s) => ActionT s zoomed m Bool+isExiting = liftAction $ do+  Exiting b <- use stateLens   return b++newtype AsyncQueue base m = AsyncQueue+  { _asyncQueue' :: Maybe (Output (AppT base m ()))+  } deriving Typeable+makeLenses ''AsyncQueue++instance Show (AsyncQueue base m) where+  show _ = "Async Queue"++instance Default (AsyncQueue base m) where+  def = AsyncQueue Nothing++asyncQueue :: (HasStates s, Typeable m, Typeable base) => Lens' s (Maybe (Output (AppT base m ())))+asyncQueue = stateLens.asyncQueue'
+ src/Eve/Internal/AppState.hs view
@@ -0,0 +1,27 @@+{-# language TemplateHaskell #-}+module Eve.Internal.AppState+  ( AppState(..)+  , App+  , Action+  ) where++import Eve.Internal.Actions+import Eve.Internal.States+import Control.Lens+import Data.Default++data AppState = AppState+  { _baseStates :: States+  }+makeLenses ''AppState++instance Default AppState where+  def = AppState mempty++instance HasStates AppState where+  states = baseStates++instance HasEvents AppState where++type App a = AppT AppState IO a+type Action s a = ActionT AppState s IO a
src/Eve/Internal/Async.hs view
@@ -9,25 +9,33 @@   ) where  import Eve.Internal.Actions+import Eve.Internal.States  import Control.Monad import Control.Monad.State import Control.Lens+import Data.Typeable  import Pipes import Pipes.Concurrent  dispatchActionAsync-  :: IO (App ()) -> App ()-dispatchActionAsync asyncAction = do-  queue <- use asyncQueue-  let effect = (liftIO asyncAction >>= yield) >-> toOutput queue-  liftIO . void . forkIO $ runEffect effect >> performGC+  :: (MonadIO m, HasStates base, Typeable m, Typeable base) => IO (AppT base m ()) -> ActionT base zoomed m ()+dispatchActionAsync asyncAction = liftAction $ do+  mQueue <- use asyncQueue+  case mQueue of+    Nothing -> return ()+    Just queue -> do+      let effect = (liftIO asyncAction >>= yield) >-> toOutput queue+      liftIO . void . forkIO $ runEffect effect >> performGC -asyncActionProvider :: ((App () -> IO ()) -> IO ()) -> App ()-asyncActionProvider provider = do-  queue <- use asyncQueue-  let dispatcher action =-        let effect = yield action >-> toOutput queue-        in void . forkIO $ runEffect effect >> performGC-  liftIO . void . forkIO $ provider dispatcher+asyncActionProvider :: (MonadIO m, HasStates base, Typeable m, Typeable base) => ((AppT base m () -> IO ()) -> IO ()) -> ActionT base zoomed m ()+asyncActionProvider provider = liftAction $ do+  mQueue <- use asyncQueue+  case mQueue of+    Nothing -> return ()+    Just queue -> do+      let dispatcher action =+            let effect = yield action >-> toOutput queue+            in void . forkIO $ runEffect effect >> performGC+      liftIO . void . forkIO $ provider dispatcher
− src/Eve/Internal/Extensions.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Eve.Internal.Extensions-  ( Exts-  , HasExts(..)-  , HasEvents-  , ext-  ) where--import Control.Lens-import Data.Map-import Unsafe.Coerce-import Data.Maybe-import Data.Typeable-import Data.Default---- | A wrapper to allow storing differing extensions in the same place.-data Ext =-  forall ext. (Typeable ext, Show ext) =>-              Ext ext--instance Show Ext where-  show (Ext a) = show a---- | A map of extension types to their current value.-type Exts = Map TypeRep Ext---- | Represents a state which can be extended.--- 'exts' is a 'Lens'' which points to the state's 'Exts'-class HasExts s  where-  exts :: Lens' s Exts---- | A typeclass to ensure people don't dispatch events to states which shouldn't---   accept them.------ To allow dispatching events in an action over your state simply define the--- empty instance:------ > instance HasEvents MyState where--- -- Don't need anything here.-class (Typeable s, HasExts s) =>-      HasEvents s---- | A polymorphic lens which accesses extensions in the extension state.--- It returns the default value ('def') if a state has not yet been set.-ext-  :: forall a e.-    (Show a, Typeable a, Default a, HasExts e)-  => Lens' e a-ext = lens getter setter-  where-    getter s =-      fromMaybe def $ s ^. exts . at (typeRep (Proxy :: Proxy a)) . mapping coerce-    setter s new =-      set (exts . at (typeRep (Proxy :: Proxy a)) . mapping coerce) (Just new) s-    coerce = iso (\(Ext x) -> unsafeCoerce x) Ext
src/Eve/Internal/Listeners.hs view
@@ -24,9 +24,10 @@    , Listener   , ListenerId+  , Dispatcher   ) where -import Eve.Internal.Extensions+import Eve.Internal.States import Eve.Internal.Async import Eve.Internal.Actions import Eve.Internal.Events@@ -46,28 +47,28 @@ -- Though arbitrary actions may be performed in the configuration block; -- it's recommended to embed such actions in the onInit event listener -- so that all event listeners are registered before any dispatches occur.-onInit :: App result -> App ()-onInit action = void $ addListener (const (void action) :: Init -> App ())+onInit :: forall base zoomed m result. (Monad m, HasEvents zoomed, Typeable m, Typeable base) => ActionT base zoomed m result -> ActionT base zoomed m ()+onInit action = void $ addListener (const (void action) :: Init -> ActionT base zoomed m ()) -afterInit :: App a -> App ()-afterInit action = void $ addListener (const (void action) :: AfterInit -> App ())+afterInit :: forall base zoomed m a. (Monad m, HasEvents zoomed, Typeable m, Typeable base) => ActionT base zoomed m a -> ActionT base zoomed m ()+afterInit action = void $ addListener (const (void action) :: AfterInit -> ActionT base zoomed m ())  -- | Registers an action to be performed BEFORE each event phase.-beforeEvent :: App a -> App ListenerId-beforeEvent action = addListener (const (void action) :: BeforeEvent -> App ())+beforeEvent :: forall base zoomed m a. (Monad m, HasEvents zoomed, Typeable m, Typeable base) => ActionT base zoomed m a -> ActionT base zoomed m ListenerId+beforeEvent action = addListener (const (void action) :: BeforeEvent -> ActionT base zoomed m ()) -beforeEvent_ :: App a -> App ()+beforeEvent_ :: (Monad m, HasEvents zoomed, Typeable m, Typeable base) => ActionT base zoomed m a -> ActionT base zoomed m () beforeEvent_ = void . beforeEvent  -- | Registers an action to be performed BEFORE each event phase.-afterEvent :: App a -> App ListenerId-afterEvent action = addListener (const (void action) :: AfterEvent -> App ())+afterEvent :: forall base zoomed m a. (Monad m, HasEvents zoomed, Typeable m, Typeable base) => ActionT base zoomed m a -> ActionT base zoomed m ListenerId+afterEvent action = addListener (const (void action) :: AfterEvent -> ActionT base zoomed m ()) -afterEvent_ :: App a -> App ()+afterEvent_ :: (Monad m, HasEvents zoomed, Typeable m, Typeable base) => ActionT base zoomed m a -> ActionT base zoomed m () afterEvent_ = void . afterEvent -onExit :: App a -> App ()-onExit action = void $ addListener (const $ void action :: Exit -> App ())+onExit :: forall base zoomed m a. (HasEvents zoomed, Typeable m, Typeable base, Monad m) => ActionT base zoomed m a -> ActionT base zoomed m ()+onExit action = void $ addListener (const $ void action :: Exit -> ActionT base zoomed m ())  dispatchEvent   :: forall result eventType m s.@@ -147,15 +148,18 @@ -- registered for the resulting event will still be run syncronously, only the -- code which generates the event is asynchronous. dispatchEventAsync-  :: (Typeable event)-  => IO event -> App ()+  :: (Typeable event+     ,MonadIO m+     ,Typeable m+     ,HasEvents base+     ) => IO event -> ActionT base zoomed m () dispatchEventAsync ioEvent = dispatchActionAsync $ dispatchEvent <$> ioEvent  -- | A wrapper around event listeners so they can be stored in 'Listeners'. data Listener where         Listener ::             (MonadState s m, Typeable m, Typeable eventType, Typeable result,-             Monoid result, HasExts s) =>+             Monoid result, HasStates s) =>             TypeRep -> ListenerId -> (eventType -> m result) -> Listener  instance Show Listener where@@ -175,7 +179,7 @@ -- | A map of event types to a list of listeners for that event type Listeners = M.Map TypeRep [Listener] --- | Store the listeners in extensions+-- | Store the listeners in the state-map data LocalListeners =   LocalListeners Int                  Listeners@@ -185,9 +189,9 @@   def = LocalListeners 0 M.empty  localListeners-  :: HasExts s+  :: HasStates s   => Lens' s LocalListeners-localListeners = ext+localListeners = stateLens  -- | This extracts all event listeners from a map of listeners which match the type of the provided event. matchingListeners@@ -212,7 +216,7 @@ type Dispatcher = forall event. Typeable event =>                                 event -> IO () --- | This allows long-running IO processes to provide Events to the App asyncronously.+-- | This allows long-running IO processes to provide Events to the ActionT base zoomed m asyncronously. -- -- Don't let the type signature confuse you; it's much simpler than it seems. --@@ -238,9 +242,9 @@ -- > myAction :: Action s () -- > myAction = onInit $ asyncEventProvider myTimer asyncEventProvider-  :: (Dispatcher -> IO ()) -> App ()+  :: (HasEvents base, MonadIO m, Typeable m) => (Dispatcher -> IO ()) -> ActionT base zoomed m () asyncEventProvider asyncEventProv = asyncActionProvider $ eventsToActions asyncEventProv   where-    eventsToActions :: (Dispatcher -> IO ()) -> (App () -> IO ()) -> IO ()+    eventsToActions :: (Monad m, HasEvents base, Typeable m) => (Dispatcher -> IO ()) -> (AppT base m () -> IO ()) -> IO ()     eventsToActions aEventProv dispatcher =       aEventProv (dispatcher . dispatchEvent)
src/Eve/Internal/Run.hs view
@@ -1,22 +1,32 @@ module Eve.Internal.Run   ( eve+  , eveT   ) where  import Eve.Internal.Actions+import Eve.Internal.AppState import Eve.Internal.Listeners import Eve.Internal.Events+import Eve.Internal.States() +import Control.Monad import Control.Monad.State+import Control.Lens+import Data.Default import Data.Maybe+import Data.Typeable  import Pipes import Pipes.Concurrent import qualified Pipes.Parse as PP -eve :: App () -> IO AppState-eve initialize = do-  (output, input) <- spawn unbounded-  execApp (AppState mempty output) $ do+eve :: App () -> IO ()+eve = void . eveT def++eveT :: (MonadIO m, Typeable m, HasEvents base) => base -> AppT base m () -> m base+eveT startState initialize = do+  (output, input) <- liftIO $ spawn unbounded+  execApp (startState & asyncQueue .~ Just output) $ do     initialize     dispatchEvent_ Init     dispatchEvent_ AfterInit@@ -27,7 +37,7 @@ -- | This is the main event loop, it runs recursively forever until something -- sets the exit status. It runs the pre-event listeners, then checks if any -- async events have finished, then runs the post event listeners and repeats.-eventLoop :: Producer (App ()) IO () -> App ()+eventLoop :: (MonadIO m, HasEvents base, Typeable m) => Producer (AppT base m ()) IO () -> AppT base m () eventLoop producer = do   dispatchEvent_ BeforeEvent   (mAction, nextProducer) <- liftIO $ PP.runStateT PP.draw producer
+ src/Eve/Internal/States.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Eve.Internal.States+  ( States+  , HasStates(..)+  , HasEvents+  , stateLens+  ) where++import Control.Lens+import Data.Map+import Unsafe.Coerce+import Data.Maybe+import Data.Typeable+import Data.Default++-- | A wrapper to allow storing types of states in the same place.+data StateWrapper =+  forall s. (Typeable s, Show s) =>+              StateWrapper s++instance Show StateWrapper where+  show (StateWrapper s) = show s++-- | A map of state types to their current value.+type States = Map TypeRep StateWrapper++-- | Represents a state which can itself store more states.+class HasStates s  where+-- | This lens points to a given state's 'States' map.+  states :: Lens' s States++-- | A typeclass to ensure people don't dispatch events to states which shouldn't+--   accept them.+--+-- To allow dispatching events in an action over your state simply define the+-- empty instance:+--+-- > instance HasEvents MyState where+-- -- Don't need anything here.+class (Typeable s, HasStates s) =>+      HasEvents s++-- | A polymorphic lens which accesses stored states.+-- It returns the default value ('def') if a state has not yet been set.+stateLens+  :: forall a e.+    (Show a, Typeable a, Default a, HasStates e)+  => Lens' e a+stateLens = lens getter setter+  where+    getter s =+      fromMaybe def $ s ^. states . at (typeRep (Proxy :: Proxy a)) . mapping coerce+    setter s new =+      set (states . at (typeRep (Proxy :: Proxy a)) . mapping coerce) (Just new) s+    coerce = iso (\(StateWrapper x) -> unsafeCoerce x) StateWrapper
− src/Eve/Internal/Testing.hs 
@@ -1,15 +0,0 @@-module Eve.Internal.Testing-  ( AppState(..)-  , Exiting(..)-  , noEventTest-  ) where--import Eve-import Eve.Internal.Actions-import Eve.Internal.Events-import Pipes.Concurrent--noEventTest :: App a -> IO a-noEventTest test = do-  (output, input) <- spawn unbounded-  execApp (AppState mempty output) $ test
+ src/Eve/Testing.hs view
@@ -0,0 +1,13 @@+module Eve.Testing+  ( noIOTest+  ) where++import Eve.Internal.Actions+import Eve.Internal.Run+import Eve.Internal.AppState++import Control.Monad.Identity+import Data.Default++noIOTest :: AppT AppState Identity a -> (a, AppState)+noIOTest = runIdentity . runApp def
test/Eve/Internal/ActionsSpec.hs view
@@ -4,36 +4,38 @@  import Fixtures import Eve-import Eve.Internal.Testing import Eve.Internal.Actions  import Control.Lens import Control.Monad.State -appendEx  :: Action String ()+appendEx  :: Monad m => ActionT AppState String m () appendEx  = modify (++ "!!") +liftActionTest :: Monad m => ActionT AppState String m String+liftActionTest = do+  put "new"+  liftAction $ runAction stateLens appendEx+  get+ spec :: Spec spec = do   describe "Exiting" $ do-    exiting <- runIO . noEventTest $ exit >> isExiting     it "Exits" $-      exiting `shouldBe` True+      let (didExit, _) = noIOTest (exit >> isExiting)+       in didExit `shouldBe` True    describe "runAction " $ do-    runActionResult <- runIO . noEventTest $ runAction ext (put "new" >> appendEx) >> runAction ext get     it "runs lifted actions to zoomed monad" $-      runActionResult `shouldBe` "new!!"+      let (runActionResult, _) = noIOTest $ runAction stateLens (put "new" >> appendEx) >> runAction stateLens get+       in runActionResult `shouldBe` "new!!" -    traversalResult <- runIO . noEventTest $ runAction ext (put $ Just "new") >> runAction (ext._Just) (appendEx >> get)     it "runs over traversals" $-      traversalResult `shouldBe` "new!!"+      let (traversalResult, _) = noIOTest $ runAction stateLens (put $ Just "new") >> runAction (stateLens._Just) (appendEx >> get)+       in traversalResult `shouldBe` "new!!"    describe "liftAction" $ do-    liftActionResult <- runIO . noEventTest . runAction ext $ do-      put "new" -      liftAction $ runAction ext appendEx-      get     it "runs lifted actions to zoomed monad" $-      liftActionResult `shouldBe` "new!!"+      let (liftActionResult, _) = noIOTest (runAction stateLens liftActionTest :: AppT AppState Identity String)+       in liftActionResult `shouldBe` "new!!"
test/Eve/Internal/AsyncSpec.hs view
@@ -15,11 +15,10 @@ spec :: Spec spec = do   describe "asyncActionProvider" $ do-    asyncState <- runIO $ eve (asyncActionProvider (\d -> d (store .= "new" >> exit)))+    asyncState <- ioTest (asyncActionProvider (\d -> d (store .= "new" >> exit)))     it "Eventually Runs Provided Actions" $       (asyncState ^. store) `shouldBe` "new"   describe "dispatchActionAsync" $ do-    asyncState <- runIO $ eve (asyncActionProvider (\d -> d (store .= "new" >> exit)))-    asyncActionsResult <- runIO $ eve asyncActionsTest+    asyncActionsResult <- ioTest asyncActionsTest     it "Eventually Runs Provided Actions" $       (asyncActionsResult ^. store) `shouldBe` "new"
test/Eve/Internal/ListenersSpec.hs view
@@ -9,13 +9,11 @@ import Control.Monad.State import Control.Lens -testAction :: State ExtState () -> ExtState-testAction = flip execState emptyExts--basicAction :: State ExtState ()+basicAction :: AppT AppState Identity String basicAction = do-  addListener (const (store .= "new") :: CustomEvent -> State ExtState ())+  addListener (const (store .= "new") :: CustomEvent -> AppT AppState Identity ())   dispatchEvent_ CustomEvent+  use store  delayedExit :: App () delayedExit = do@@ -23,11 +21,12 @@   dispatchEventAsync (return CustomEvent)   store .= "new" -removeListenersTest :: State ExtState ()+removeListenersTest :: AppT AppState Identity String removeListenersTest = do-  listId <- addListener (const (store .= "new") :: CustomEvent -> State ExtState ())+  listId <- addListener (const (store .= "new") :: CustomEvent -> AppT AppState Identity ())   removeListener listId   dispatchEvent_ CustomEvent+  use store  asyncEventsTest :: App () asyncEventsTest = do@@ -45,14 +44,14 @@ spec :: Spec spec = do   describe "dispatchEvent/addListener" $-    it "Triggers Listeners" $ (testAction basicAction ^. store) `shouldBe` "new"+    it "Triggers Listeners" $ fst (noIOTest basicAction) `shouldBe` "new"   describe "dispatchEventAsync" $ do-    delayedExitState <- runIO $ eve delayedExit+    delayedExitState <- ioTest delayedExit     it "Triggers Listeners Eventually" $ (delayedExitState ^. store) `shouldBe` "new"   describe "removeListener" $-    it "Removes Listeners" $ (testAction removeListenersTest ^. store) `shouldBe` "default"+    it "Removes Listeners" $ fst (noIOTest removeListenersTest) `shouldBe` "default"   describe "asyncEventProvider" $ do-    asyncEventsResult <- runIO $ eve asyncEventsTest+    asyncEventsResult <- ioTest asyncEventsTest     it "Provides events eventually" $ (asyncEventsResult ^. store) `shouldBe` "new"-    multiAsyncEventsResult <- runIO $ eve multiAsyncEventsTest+    multiAsyncEventsResult <- ioTest multiAsyncEventsTest     it "Can provide different event types" $ (multiAsyncEventsResult ^. store) `shouldBe` "new"
test/Eve/Internal/RunSpec.hs view
@@ -4,22 +4,18 @@ import Test.Hspec import Fixtures import Eve-import Eve.Internal.Testing+import Eve.Internal.Actions import Control.Lens  exiter :: (App () -> IO ()) -> IO () exiter dispatch = dispatch exit -runWithInit :: App () -> SpecM a AppState-runWithInit next = runIO $ eve (next >> asyncActionProvider exiter)- spec :: Spec spec = do   describe "Running App" $ do-    initializeState <- runWithInit (store .= "new")     it "Initializes" $-      (initializeState ^. store) `shouldBe` "new"+      fst (noIOTest (store .= "new" >> use store)) `shouldBe` "new" -    asyncState <- runIO $ eve (asyncActionProvider (\d -> d (store .= "new" >> exit)))+    asyncResult <- ioTest (asyncActionProvider (\d -> d (store .= "new" >> exit)))     it "Collects Async Actions" $-      (asyncState ^. store) `shouldBe` "new"+      (asyncResult ^. store) `shouldBe` "new"
test/Fixtures.hs view
@@ -1,39 +1,36 @@ {-# language TemplateHaskell #-} module Fixtures-  ( ExtState(..)-  , store+  ( store   , CustomEvent(..)-  , emptyExts+  , noIOTest+  , ioTest   ) where -import Eve.Internal.Extensions+import Eve.Testing+import Eve.Internal.States import Eve.Internal.Listeners+import Eve.Internal.Actions+import Eve.Internal.AppState+import Eve.Internal.Run  import Control.Lens import Data.Default -data ExtState = ExtState-  { _testExts :: Exts-  }--makeLenses ''ExtState--instance HasExts ExtState where-  exts = testExts--instance HasEvents ExtState--emptyExts = ExtState mempty+import Test.Hspec.Core.Spec (SpecM)+import Test.Hspec -data Store = Store +data Store = Store   {_payload :: String   } deriving (Show, Eq) makeLenses ''Store -store :: HasExts s => Lens' s String-store = ext.payload+store :: HasStates s => Lens' s String+store = stateLens.payload  instance Default Store where   def = Store "default"  data CustomEvent = CustomEvent++ioTest :: App () -> SpecM m AppState+ioTest = runIO . eveT def