packages feed

eve (empty) → 0.1.0

raw patch · 21 files changed

+929/−0 lines, 21 filesdep +basedep +containersdep +data-defaultsetup-changed

Dependencies added: base, containers, data-default, eve, free, hspec, hspec-core, lens, mtl, pipes, pipes-concurrency, pipes-parse

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Chris Penner (c) 2017++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 Chris Penner 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,94 @@+Eve+===++[![Join the chat at https://gitter.im/eve-framework/Lobby](https://badges.gitter.im/eve-framework/Lobby.svg)](https://gitter.im/eve-framework/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)+[![Hackage](https://img.shields.io/badge/hackage-latest-green.svg)](https://hackage.haskell.org/package/eve)++An extensible event-driven application framework in haskell for building embarassingly modular software.++Documentation+-------------+You can find hackage documentation for eve [HERE](https://hackage.haskell.org/package/eve)++Getting started+---------------+### [Building an App in Eve](https://github.com/ChrisPenner/eve/blob/master/docs/Building-An-App.md)++\^ 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).++Core Principles+---------------++Eve's core principle is making it easy to build programs in a modular way.+There are two key concepts in Eve which you should be aware of:++- Events+- State++Eve provides many useful combinators for dispatching events and adding+listeners to events, events are a broad concept in Eve and can be triggered by+user-interaction, file-changes, even network sockets! Anything you can think of+really! Each time an event is fired, your app 'reacts' by running any+associated listeners on the given event. This is quite similar to other event+systems so far; however Eve does a few things differently. This is where the+'State' concept comes in. When writing an App, or an extension for an App, in+Eve, you can specify a state object which you'd like Eve to keep track of for+you, you can run monadic actions over this state and do whatever you want with+it. You can even expose your state-changing combinators to other extensions to+allow them to change the state too! Another nifty thing is that events can be+dispatched on different levels; so for instance in the Rasa text editor which+is built using Eve, there's the notion of 'Global Events' and 'Buffer Events'.+A 'Buffer' is a State object they've defined, and they added the `HasEvents`+typeclass to it, which now allows them to register listeners and dispatch+events to a specific instance of a buffer! Trackable states (and therefore+state-level event listeners) can be nested several levels deep without issue.+Unlike most event systems, Eve also allows Monoidal return values from event+listeners, so you can collect 'responses' from each event you fire if you wish.++When designing applications in Eve; it's crucial to think about how the+state of you application will be stored, and how different components interact.+Eve works best when components are separated and communicate with each-other through+events. This is because it allows those who will eventually write extensions to your+application to 'hook' into those events to add functionality.++There are some definite Pros and Cons to Eve's approach:++### Pros++-   Implementing most core functionality as extensions ensures a powerful and+    elegant extension interface.+-   Flexibility & Adaptability; applications can be written in such a way that+    users can replace entire components with alternate versions.++### Cons++-   Module cross-dependencies makes the community infrastructure more fragile,+-   This architecture takes some getting used-to.+++Contributing+============++Installation+------------++Eve uses Stack for reproducible builds.++1. Install [stack](http://seanhess.github.io/2015/08/04/practical-haskell-getting-started.html)+3. Clone this repo and `cd` into the directory+4. Run `stack build`++Running Tests+-------------++- `stack test`++Contributions+-------------++Chatting about features is a key part of Eve's development; come join us in+the [Chat Room](https://gitter.im/eve-framework/Lobby) to discuss features or +improvements!
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ eve.cabal view
@@ -0,0 +1,61 @@+name:                eve+version:             0.1.0+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+license:             BSD3+license-file:        LICENSE+author:              Chris Penner+maintainer:          christopher.penner@gmail.com+copyright:           2017 Chris Penner+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Eve+                     , Eve.Internal.Testing+                     , Eve.Internal.Actions+                     , Eve.Internal.Async+                     , Eve.Internal.Events+                     , Eve.Internal.Extensions+                     , Eve.Internal.Listeners+                     , Eve.Internal.Run+  build-depends:       base >= 4.7 && < 5+                     , mtl+                     , lens+                     , free+                     , pipes+                     , pipes-parse+                     , pipes-concurrency+                     , data-default+                     , containers+  default-language:    Haskell2010++test-suite eve-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Fixtures+                     , EveSpec+                     , Eve.Internal.AsyncSpec+                     , Eve.Internal.ActionsSpec+                     , Eve.Internal.ExtensionsSpec+                     , Eve.Internal.EventsSpec+                     , Eve.Internal.ListenersSpec+                     , Eve.Internal.RunSpec+  build-depends:       base+                     , eve+                     , hspec+                     , hspec-core+                     , lens+                     , mtl+                     , data-default+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/ChrisPenner/eve
+ src/Eve.hs view
@@ -0,0 +1,44 @@+module Eve+  ( eve++  , App+  , Action+  , liftAction++  , dispatchEvent+  , dispatchEvent_+  , dispatchEventAsync+  , dispatchActionAsync++  , addListener+  , addListener_+  , removeListener++  , onInit+  , afterInit+  , beforeEvent+  , beforeEvent_+  , afterEvent+  , afterEvent_+  , onExit++  , asyncActionProvider+  , asyncEventProvider++  , Listener+  , ListenerId++  , HasExts(..)+  , Exts+  , HasEvents+  , ext++  , runAction+  , exit+  ) where++import Eve.Internal.Run+import Eve.Internal.Actions+import Eve.Internal.Listeners+import Eve.Internal.Async+import Eve.Internal.Extensions
+ src/Eve/Internal/Actions.hs view
@@ -0,0 +1,89 @@+{-# language GeneralizedNewtypeDeriving #-}+{-# language DeriveFunctor #-}+{-# language FlexibleInstances #-}+{-# language MultiParamTypeClasses #-}+{-# language TemplateHaskell #-}+{-# language RankNTypes #-}+{-# language TypeFamilies #-}+{-# language UndecidableInstances #-}+{-# language ScopedTypeVariables #-}+module Eve.Internal.Actions+  ( Action(..)+  , ActionF(..)+  , App+  , execApp++  , AppState(..)+  , asyncQueue++  , liftAction+  , runAction++  , exit+  , isExiting+  , Exiting(..)+  ) where++import Eve.Internal.Extensions+import Data.Default++import Control.Monad.State+import Control.Monad.Trans.Free+import Control.Lens++import Pipes.Concurrent++type App a = Action AppState a+data AppState = AppState+  { _baseExts :: Exts+  , _asyncQueue :: Output (App ())+  }++newtype ActionF next =+  LiftAction (StateT AppState IO 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++instance HasExts AppState where+  exts = baseExts++instance HasEvents AppState where++unLift :: FreeT ActionF (StateT AppState IO) a -> StateT AppState IO 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 = liftF .  LiftAction . unLift . getAction++execApp :: AppState -> Action AppState a -> IO a+execApp appState = flip evalStateT appState . 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++runAction :: Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c+runAction = zoom++newtype Exiting =+  Exiting Bool+  deriving (Show, Eq)++instance Default Exiting where+  def = Exiting False++exit :: App ()+exit = ext .= Exiting True++isExiting :: App Bool+isExiting = do+  Exiting b <- use ext+  return b
+ src/Eve/Internal/Async.hs view
@@ -0,0 +1,33 @@+{-# language FlexibleInstances #-}+{-# language MultiParamTypeClasses #-}+{-# language ExistentialQuantification #-}+{-# language ScopedTypeVariables #-}++module Eve.Internal.Async+  ( dispatchActionAsync+  , asyncActionProvider+  ) where++import Eve.Internal.Actions++import Control.Monad+import Control.Monad.State+import Control.Lens++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++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
+ src/Eve/Internal/Events.hs view
@@ -0,0 +1,13 @@+module Eve.Internal.Events+  ( Init(..)+  , AfterInit(..)+  , BeforeEvent(..)+  , AfterEvent(..)+  , Exit(..)+  ) where++data Init = Init+data AfterInit = AfterInit+data BeforeEvent = BeforeEvent+data AfterEvent = AfterEvent+data Exit = Exit
+ src/Eve/Internal/Extensions.hs view
@@ -0,0 +1,57 @@+{-# 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
@@ -0,0 +1,246 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++module Eve.Internal.Listeners+  ( HasEvents+  , dispatchEvent+  , dispatchEvent_+  , dispatchEventAsync++  , addListener+  , addListener_+  , removeListener+  , asyncEventProvider++  , onInit+  , afterInit+  , beforeEvent+  , beforeEvent_+  , afterEvent+  , afterEvent_+  , onExit++  , Listener+  , ListenerId+  ) where++import Eve.Internal.Extensions+import Eve.Internal.Async+import Eve.Internal.Actions+import Eve.Internal.Events++import Control.Monad.State+import Control.Lens++import Data.Default+import Data.Typeable+import Data.Maybe+import qualified Data.Map as M+++-- | Registers an action to be performed during the Initialization phase.+--+-- This phase occurs exactly ONCE when the app starts up.+-- 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 ())++afterInit :: App a -> App ()+afterInit action = void $ addListener (const (void action) :: AfterInit -> App ())++-- | Registers an action to be performed BEFORE each event phase.+beforeEvent :: App a -> App ListenerId+beforeEvent action = addListener (const (void action) :: BeforeEvent -> App ())++beforeEvent_ :: App a -> App ()+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_ :: App a -> App ()+afterEvent_ = void . afterEvent++onExit :: App a -> App ()+onExit action = void $ addListener (const $ void action :: Exit -> App ())++dispatchEvent+  :: forall result eventType m s.+     (MonadState s m+     ,HasEvents s+     ,Monoid result+     ,Typeable m+     ,Typeable eventType+     ,Typeable result)+  => eventType -> m result+dispatchEvent evt = do+  LocalListeners _ listeners <- use localListeners+  results <-+    traverse ($ evt) (matchingListeners listeners :: [eventType -> m result])+  return (mconcat results :: result)++dispatchEvent_+  :: forall eventType m s.+     (MonadState s m+     ,HasEvents s+     ,Typeable m+     ,Typeable eventType)+  => eventType -> m ()+dispatchEvent_ = dispatchEvent+++addListener+  :: forall result eventType m s.+     (MonadState s m+     ,HasEvents s+     ,Typeable m+     ,Typeable eventType+     ,Typeable result+     ,Monoid result)+  => (eventType -> m result) -> m ListenerId+addListener lFunc = do+  LocalListeners nextListenerId listeners <- use localListeners+  let (listener, listenerId, eventType) = mkListener nextListenerId lFunc+      newListeners = M.insertWith mappend eventType [listener] listeners+  localListeners .= LocalListeners (nextListenerId + 1) newListeners+  return listenerId+  where+    mkListener+      :: forall event r.+         (Typeable event, Typeable r, Monoid r)+      => Int -> (event -> m r) -> (Listener, ListenerId, TypeRep)+    mkListener n listenerFunc =+      let list = Listener (typeOf listenerFunc) listId listenerFunc+          listId = ListenerId n (typeRep (Proxy :: Proxy event))+          prox = typeRep (Proxy :: Proxy event)+      in (list, listId, prox)++addListener_+  :: forall result eventType m s.+     (MonadState s m+     ,HasEvents s+     ,Typeable m+     ,Typeable eventType+     ,Typeable result+     ,Monoid result)+  => (eventType -> m result) -> m ()+addListener_ = void . addListener++removeListener+  :: (MonadState s m, HasEvents s)+  => ListenerId -> m ()+removeListener listenerId@(ListenerId _ eventType) = localListeners %= remover+  where+    remover (LocalListeners nextListenerId listeners) =+      let newListeners =+            listeners & at eventType . _Just %~ filter (notMatch listenerId)+      in LocalListeners nextListenerId newListeners+    notMatch idA (Listener _ idB _) = idA /= idB++-- | This function takes an IO which results in some event, it runs the IO+-- asynchronously and dispatches the event. Note that any listeners which are+-- 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 ()+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) =>+            TypeRep -> ListenerId -> (eventType -> m result) -> Listener++instance Show Listener where+  show (Listener rep (ListenerId n _) _) =+    "<Listener #" ++ show n ++ ", " ++ show rep ++ ">"++-- | An opaque reverence to a specific registered event-listener.+-- A ListenerId is used only to remove listeners later with 'removeListener'.+data ListenerId =+  ListenerId Int+             TypeRep+  deriving (Show)++instance Eq ListenerId where+  ListenerId a _ == ListenerId b _ = a == b++-- | A map of event types to a list of listeners for that event+type Listeners = M.Map TypeRep [Listener]++-- | Store the listeners in extensions+data LocalListeners =+  LocalListeners Int+                 Listeners+  deriving (Show)++instance Default LocalListeners where+  def = LocalListeners 0 M.empty++localListeners+  :: HasExts s+  => Lens' s LocalListeners+localListeners = ext++-- | This extracts all event listeners from a map of listeners which match the type of the provided event.+matchingListeners+  :: forall m eventType result.+     (Typeable m+     ,Typeable eventType+     ,Typeable result)+  => Listeners -> [eventType -> m result]+matchingListeners listeners =+  catMaybes $ (getListener :: Listener -> Maybe (eventType -> m result)) <$>+  (listeners ^. at (typeRep (Proxy :: Proxy eventType)) . _Just)++-- | Extract the listener function from eventType listener+getListener+  :: Typeable expected+  => Listener -> Maybe expected+getListener (Listener _ _ x) = cast x++-- | This is a type alias to make defining your functions for use with 'asyncEventProvider' easier;+-- It represents the function your event provider function will be passed to allow dispatching+-- events. Using this type requires the @RankNTypes@ language pragma.+type Dispatcher = forall event. Typeable event =>+                                event -> IO ()++-- | This allows long-running IO processes to provide Events to the App asyncronously.+--+-- Don't let the type signature confuse you; it's much simpler than it seems.+--+-- Let's break it down:+--+-- Using the 'Dispatcher' type with asyncEventProvider requires the @RankNTypes@ language pragma.+--+-- This type as a whole represents a function which accepts a 'Dispatcher' and returns an 'IO';+-- the dispatcher itself accepts data of ANY 'Typeable' type and emits it as an event.+--+-- When you call 'asyncEventProvider' you pass it a function which accepts a @dispatch@ function as an argument+-- and then calls it with various events within the resulting 'IO'.+--+-- Note that this function calls forkIO internally, so there's no need to do that yourself.+--+-- Here's an example which fires a @Timer@ event every second.+--+-- > {-# language RankNTypes #-}+-- > data Timer = Timer+-- > myTimer :: Dispatcher -> IO ()+-- > myTimer dispatch = forever $ dispatch Timer >> threadDelay 1000000+-- >+-- > myAction :: Action s ()+-- > myAction = onInit $ asyncEventProvider myTimer+asyncEventProvider+  :: (Dispatcher -> IO ()) -> App ()+asyncEventProvider asyncEventProv = asyncActionProvider $ eventsToActions asyncEventProv+  where+    eventsToActions :: (Dispatcher -> IO ()) -> (App () -> IO ()) -> IO ()+    eventsToActions aEventProv dispatcher =+      aEventProv (dispatcher . dispatchEvent)
+ src/Eve/Internal/Run.hs view
@@ -0,0 +1,37 @@+module Eve.Internal.Run+  ( eve+  ) where++import Eve.Internal.Actions+import Eve.Internal.Listeners+import Eve.Internal.Events++import Control.Monad.State+import Data.Maybe++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+    initialize+    dispatchEvent_ Init+    dispatchEvent_ AfterInit+    eventLoop $ fromInput input+    dispatchEvent_ Exit+    get++-- | 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 producer = do+  dispatchEvent_ BeforeEvent+  (mAction, nextProducer) <- liftIO $ PP.runStateT PP.draw producer+  fromMaybe (return ()) mAction+  dispatchEvent_ AfterEvent+  shouldExit <- isExiting+  unless shouldExit $ eventLoop nextProducer
+ src/Eve/Internal/Testing.hs view
@@ -0,0 +1,15 @@+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
+ test/Eve/Internal/ActionsSpec.hs view
@@ -0,0 +1,39 @@+module Eve.Internal.ActionsSpec where++import Test.Hspec++import Fixtures+import Eve+import Eve.Internal.Testing+import Eve.Internal.Actions++import Control.Lens+import Control.Monad.State++appendEx  :: Action String ()+appendEx  = modify (++ "!!")++spec :: Spec+spec = do+  describe "Exiting" $ do+    exiting <- runIO . noEventTest $ exit >> isExiting+    it "Exits" $+      exiting `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!!"++    traversalResult <- runIO . noEventTest $ runAction ext (put $ Just "new") >> runAction (ext._Just) (appendEx >> get)+    it "runs over traversals" $+      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!!"+
+ test/Eve/Internal/AsyncSpec.hs view
@@ -0,0 +1,25 @@+module Eve.Internal.AsyncSpec where++import Test.Hspec++import Fixtures+import Control.Lens+import Eve++asyncActionsTest :: App ()+asyncActionsTest = do+  addListener (const exit :: CustomEvent -> App ())+  asyncActionProvider (\d -> d exit)+  store .= "new"++spec :: Spec+spec = do+  describe "asyncActionProvider" $ do+    asyncState <- runIO $ eve (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+    it "Eventually Runs Provided Actions" $+      (asyncActionsResult ^. store) `shouldBe` "new"
+ test/Eve/Internal/EventsSpec.hs view
@@ -0,0 +1,6 @@+module Eve.Internal.EventsSpec where++import Test.Hspec++spec :: Spec+spec = return ()
+ test/Eve/Internal/ExtensionsSpec.hs view
@@ -0,0 +1,6 @@+module Eve.Internal.ExtensionsSpec where++import Test.Hspec++spec :: Spec+spec = return ()
+ test/Eve/Internal/ListenersSpec.hs view
@@ -0,0 +1,58 @@+{-# language ScopedTypeVariables #-}+module Eve.Internal.ListenersSpec where++import Test.Hspec++import Fixtures+import Eve++import Control.Monad.State+import Control.Lens++testAction :: State ExtState () -> ExtState+testAction = flip execState emptyExts++basicAction :: State ExtState ()+basicAction = do+  addListener (const (store .= "new") :: CustomEvent -> State ExtState ())+  dispatchEvent_ CustomEvent++delayedExit :: App ()+delayedExit = do+  addListener (const exit :: CustomEvent -> App ())+  dispatchEventAsync (return CustomEvent)+  store .= "new"++removeListenersTest :: State ExtState ()+removeListenersTest = do+  listId <- addListener (const (store .= "new") :: CustomEvent -> State ExtState ())+  removeListener listId+  dispatchEvent_ CustomEvent++asyncEventsTest :: App ()+asyncEventsTest = do+  addListener (const exit :: CustomEvent -> App ())+  asyncEventProvider (\d -> d CustomEvent)+  store .= "new"++data OtherEvent = OtherEvent+multiAsyncEventsTest :: App ()+multiAsyncEventsTest = do+  addListener (const exit :: CustomEvent -> App ())+  addListener (const (store .= "new") :: OtherEvent -> App ())+  asyncEventProvider (\d -> d CustomEvent >> d OtherEvent)++spec :: Spec+spec = do+  describe "dispatchEvent/addListener" $+    it "Triggers Listeners" $ (testAction basicAction ^. store) `shouldBe` "new"+  describe "dispatchEventAsync" $ do+    delayedExitState <- runIO $ eve delayedExit+    it "Triggers Listeners Eventually" $ (delayedExitState ^. store) `shouldBe` "new"+  describe "removeListener" $+    it "Removes Listeners" $ (testAction removeListenersTest ^. store) `shouldBe` "default"+  describe "asyncEventProvider" $ do+    asyncEventsResult <- runIO $ eve asyncEventsTest+    it "Provides events eventually" $ (asyncEventsResult ^. store) `shouldBe` "new"+    multiAsyncEventsResult <- runIO $ eve multiAsyncEventsTest+    it "Can provide different event types" $ (multiAsyncEventsResult ^. store) `shouldBe` "new"
+ test/Eve/Internal/RunSpec.hs view
@@ -0,0 +1,25 @@+module Eve.Internal.RunSpec where++import Test.Hspec.Core.Spec (SpecM)+import Test.Hspec+import Fixtures+import Eve+import Eve.Internal.Testing+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"++    asyncState <- runIO $ eve (asyncActionProvider (\d -> d (store .= "new" >> exit)))+    it "Collects Async Actions" $+      (asyncState ^. store) `shouldBe` "new"
+ test/EveSpec.hs view
@@ -0,0 +1,9 @@+module EveSpec where++import Test.Hspec++spec :: Spec+spec = do+  describe "Eve" $ do+    it "runs tests" $+      True `shouldBe` True
+ test/Fixtures.hs view
@@ -0,0 +1,39 @@+{-# language TemplateHaskell #-}+module Fixtures+  ( ExtState(..)+  , store+  , CustomEvent(..)+  , emptyExts+  ) where++import Eve.Internal.Extensions+import Eve.Internal.Listeners++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++data Store = Store +  {_payload :: String+  } deriving (Show, Eq)+makeLenses ''Store++store :: HasExts s => Lens' s String+store = ext.payload++instance Default Store where+  def = Store "default"++data CustomEvent = CustomEvent
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}