packages feed

eve 0.1.2 → 0.1.9.0

raw patch · 15 files changed

Files

README.md view
@@ -12,9 +12,10 @@  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!+### [Building A Game in Eve](https://github.com/ChrisPenner/eve/blob/master/examples/tunnel-crawler/README.md)+[Here's](https://github.com/ChrisPenner/eve/blob/master/examples/tunnel-crawler/README.md) a guide which+walks you through building your first application in Eve from start to finish, it's quite thorough and it's a great+place to start!  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/eve/issues).@@ -28,26 +29,140 @@ - Events - State +## Events 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.+associated listeners on the given event.  +The functions you need to know are (with simplified types, see the real type in+the [hackage docs](https://hackage.haskell.org/package/eve/docs/Eve.html)):++- `dispatchEvent :: forall eventType result m. (Monad m, Monoid result) => eventType -> m result`+- `addListener :: forall eventType result m. (Monad m, Monoid result) (eventType -> m result) -> m ListenerId`++As I mention above, these types are simplified a bit (and yet they still look+complicated!). Actually, the types look so complex so that they're simpler to+use! The `forall` makes it so that you can call `dispatchEvent` with ANY+Typeable type and it will run the proper event listeners which were registered+by `addListener`; those listeners can alter app state, or even dispatch more+events! If the listeners return some (monoidal) value then the results from all+listeners are combined with `mappend` and are returned. That's pretty much it!++Here's a quick example for those who need to see some code:++```haskell+import Eve+import Data.Monoid++-- Define an event to listen for, in this case we don't even need any data alongside it.+data ComputeScore = ComputeScore++-- Define some computations which calculate some aspect of score.+-- We accept an argument of 'ComputeScore' to define what this is a listener for+scoreContributor1, scoreContributor2 :: ComputeScore -> App (Sum Int)+scoreContributor1 _ = do+  ... -- do some calculation over app state to determine one aspect of score+  return (Sum score)++scoreContributor2 _ = do+  ... -- Calculate some other aspect of the score+  return (Sum score)++-- In eve's initialization block we register the listeners, we could add these listeners anywhere+main :: IO ()+main = eve_ $ do+  ... -- other initialization (e.g. key listeners, etc.)+  addListener_ scoreContributor1+  addListener_ scoreContributor2++  -- This dispatches the triggering event and monoidally sums all the individual score components!+computeTotalScore :: App (Sum Int)+computeTotalScore = do+  Sum score <- dispatchEvent ComputeScore+  return score+```++## State++Next we see how Eve handles state. Eve seeks to be as extensible as possible so+it makes very few assumptions about the type of state that you (or your+extensions) plan to store. You can define a type of state yourself using `data`+and then provide actions which alter that state using a `MonadState` instance+(from mtl). Don't worry if you don't know what that means, here's a real quick+example which uses the combinators from the [lens+library](https://hackage.haskell.org/package/lens) to make a few simple state+changes.++```haskell+import Eve+import Control.Lens+data MyState = MyState+  { _myInt :: Int+  , _myString :: String+  }+makeLenses ''MyState++-- This alters some state and returns the old string for some reason.+doSomething :: Action MyState String+doSomething = do+  oldString <- use myString+  myString .= "Hi!"+  myInt += 1+  return oldString+```++So what does this gain us? Well now if we have a `MyState` somewhere in our app we+can run that Action on it! We can also register that Action as a listener for some+event!++Now for the interesting part; handling state for extensions. This is usually a bit+tricky since the types that an extension might use aren't known by you (the app author).+Eve takes care of this by providing an interface for extensions to store and keep track+of arbitrary types, while still allowing other extensions to run actions that it exports.+This is where the `HasStates` typeclass comes in; here's the honest to goodness implementation:++```haskell+class HasStates s  where+  states :: Lens' s States+```++If your state implements that typeclass, then extensions can store their own states inside it!+It's pretty easy to implement too, let's add it to our `MyState`.++```haskell+import Eve+import Control.Lens+data MyState = MyState+  { _myInt :: Int+  , _myString :: String+  , _myStates :: States+  }+makeLenses ''MyState++instance HasStates MyState where+    states = myStates+```++Done! We added a new field which has the type `States` which is exported by Eve.+Then we just took the **lens** created by `makeLenses` and used it in our instance.+That's it! Now extensions can store their own state inside `Action MyState` by+using the `stateLens`; check out the [hackage docs](https://hackage.haskell.org/package/eve/docs/Eve.html) +on that for more info on how to do it!++Those are the basics, but you can do much more than that if you like!+Eve also lets you add listeners and dispatch events on an Object specific basis!+If you have a copy of some state (let's say a single instance of an Enemy in a game)+you can dispatch events over that enemy individually and any registered (Action Enemy)+callbacks will be run without affecting any other enemies! Check out `HasEvents`+to see how that works.++One last cool feature is that event listeners can return information! If your event+listener results in a return value that's a Monoid (like a list, or string for example)+you can collect the responses of all the listeners when you call `dispatchEvent`. This+is a great way for your application to 'ask' extensions about their state.+ 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@@ -58,8 +173,7 @@  ### Pros --   Implementing most core functionality as extensions ensures a powerful and-    elegant extension interface.+-   Implementing most core functionality using the event system your app remains extensible. -   Flexibility & Adaptability; applications can be written in such a way that     users can replace entire components with alternate versions. @@ -68,7 +182,6 @@ -   Module cross-dependencies makes the community infrastructure more fragile, -   This architecture takes some getting used-to. - Contributing ============ @@ -92,3 +205,8 @@ 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!++Related Works+=============++- [Emulating traditional imperative event loops with functional paradigms](./paper/functional-event-loops.pdf)
eve.cabal view
@@ -1,5 +1,5 @@ name:                eve-version:             0.1.2+version:             0.1.9.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@@ -8,7 +8,7 @@ author:              Chris Penner maintainer:          christopher.penner@gmail.com copyright:           2017 Chris Penner-category:            Web+category:            Framework build-type:          Simple extra-source-files:  README.md cabal-version:       >=1.10@@ -24,16 +24,14 @@                      , Eve.Internal.States                      , Eve.Internal.Listeners                      , Eve.Internal.Run-  build-depends:       base >= 4.7 && < 5+  build-depends:       base >= 4.9 && < 5                      , mtl                      , lens                      , free-                     , pipes-                     , pipes-parse-                     , pipes-concurrency                      , data-default                      , containers   default-language:    Haskell2010+  ghc-options:         -Wall  test-suite eve-test   type:                exitcode-stdio-1.0@@ -43,7 +41,7 @@                      , EveSpec                      , Eve.Internal.AsyncSpec                      , Eve.Internal.ActionsSpec-                     , Eve.Internal.ExtensionsSpec+                     , Eve.Internal.StatesSpec                      , Eve.Internal.EventsSpec                      , Eve.Internal.ListenersSpec                      , Eve.Internal.RunSpec
src/Eve.hs view
@@ -1,36 +1,51 @@ module Eve   (-  -- * Running your App-  eve+  -- | This documentation is split into parts based on complexity.+  -- For most applications you'll need only the Simple section. You'll+  -- find useful tools in the Advanced section once you've got a simple app+  -- up and running. -  -- * Working with Actions+  -- * Simple+  -- | Eve allows you to build your applications incrementally, adding more+  -- complexity as you need it. For this reason, many of the types are more+  -- general than you'll likely need. This can be a bit confusing, but here's+  -- a few tips:+  --+  --    * Both 'Action' and 'App' unify with 'ActionT'. You may use them in place of+  --    'ActionT'. When in doubt, use 'App'.+  --    * When you see vague references to monads @m@ or @n@, you can use 'App' or 'Action' in its place.+  --    * Simple Apps assume that you use the provided 'AppState' and it is+  --      "baked in" to the 'Action' and 'App' types. Wherever you see @'HasStates' s@+  --      you can mentally replace @s@ with 'AppState'.++  -- ** Running your App+  eve_++  -- ** Working with Actions   , App   , Action-  , AppT-  , ActionT-  , liftApp+  , runApp   , runAction   , exit -  -- * Dispatching Events+  -- ** Dispatching Events   , dispatchEvent   , dispatchEvent_-  , dispatchEventAsync-  , dispatchActionAsync -  -- * Event Listeners+  -- ** Event Listeners   , addListener   , addListener_+   , removeListener+   , Listener   , ListenerId -  -- * Asynchronous Helpers-  , asyncActionProvider+  -- ** Asynchronous Helpers   , asyncEventProvider-  , Dispatcher+  , EventDispatcher -  -- * Built-in Event Listeners+  -- ** Built-in Event Listeners   , afterInit   , beforeEvent   , beforeEvent_@@ -38,7 +53,7 @@   , afterEvent_   , onExit -  -- * Working with State+  -- ** 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@@ -48,9 +63,9 @@   -- @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@.+  -- Because states are stored by their 'Data.Typeable.TypeRep', they must+  -- define an instance of 'Data.Typeable.Typeable', In most cases it's+  -- unnecessary, but 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@@ -60,28 +75,58 @@   -- 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:+  -- Here's an example of defining your own state:   ---  -- > data MyState = MyState String-  -- > myState :: HasStates s => Lens' s MyState-  -- > myState = stateLens+  -- > data SimpleState = SimpleState+  -- >   { _myString :: String+  -- >   }+  -- > makeLenses ''SimpleState   -- >-  -- > myAction = do-  -- >   MyState str <- use stateLens-  ---  -- If GHC has trouble inferring the type, rename it and restrict the type as above.+  -- > instance Default SimpleState where+  -- >   def = SimpleState "default"+  , makeStateLens+  , AppState++  -- * Advanced+  -- | This section provides tools which become relevant when working on more+  -- complex apps. You can customize which states you operate over, embed events+  -- in nested states, and choose a custom base monad for the mtl stack.++  , eve+  -- ** Actions+  , AppT+  , ActionT+  , runActionOver++  -- ** States   , HasStates(..)   , States-  , HasEvents   , stateLens-  , AppState++  -- ** Local Events++  -- | The local versions of the event functions are the same as the others ('dispatchEvent',+  -- 'addListener', 'removeListener') however they operate on a per-state basis.+  -- This means that if you define a custom state which implements 'HasEvents'+  -- then you may use these functions inside an `Action CustomState` to dispatch events+  -- to ONLY the listners within that specific instance of that state. Note that+  -- these listeners and events are distinct on the value level, not just the type level,+  -- so if you have multiple copies of CustomState in your app, they each have their+  -- own disjoint event listeners.+  , HasEvents+  , dispatchLocalEvent+  , dispatchLocalEvent_++  , addLocalListener+  , addLocalListener_++  , removeLocalListener++  -- ** Async+  , asyncActionProvider++  , dispatchEventAsync+  , dispatchActionAsync   ) where  import Eve.Internal.Run
src/Eve/Internal/Actions.hs view
@@ -1,6 +1,7 @@ {-# language GeneralizedNewtypeDeriving #-} {-# language DeriveFunctor #-} {-# language FlexibleInstances #-}+{-# language FlexibleContexts #-} {-# language MultiParamTypeClasses #-} {-# language RankNTypes #-} {-# language TypeFamilies #-}@@ -11,24 +12,29 @@   , ActionT(..)   , AppT -  , runApp-  , evalApp-  , execApp+  , runEve+  , evalEve+  , execEve -  , liftApp+  , runApp   , runAction+  , runActionOver   ) where +import Eve.Internal.States import Control.Monad.State import Control.Monad.Trans.Free import Control.Lens+import Data.Typeable+import Data.Default+import Data.Semigroup  -- | An 'App' has the same base and zoomed values. type AppT s m a = ActionT s s m a  -- | A Free Functor for storing lifted App actions. newtype AppF base m next =-  LiftApp (StateT base m next)+  RunApp (StateT base m next)   deriving (Functor, Applicative)  -- | Base Action type. Allows paramaterization over application state, zoomed state@@ -37,8 +43,18 @@   { getAction :: FreeT (AppF base m) (StateT zoomed m) a   } deriving (Functor, Applicative, Monad, MonadIO, MonadState zoomed) +instance (Semigroup a,Monad m) => Semigroup (ActionT base zoomed m a) where+  a <> b = do+    a' <- a+    b' <- b+    return $ a' <> b'++instance (Monoid a, Monad m) => Monoid (ActionT base zoomed m a) where+  mempty = return mempty+  mappend = (<>)+ instance Monad n => MonadFree (AppF base n) (ActionT base zoomed n) where-  wrap (LiftApp act) = join . ActionT . liftF . LiftApp $ act+  wrap (RunApp act) = join . ActionT . liftF . RunApp $ act  instance MonadTrans (ActionT base zoomed) where   lift = ActionT . lift . lift@@ -49,33 +65,39 @@   step <- runFreeT m   case step of     Pure a -> return a-    Free (LiftApp next) -> next >>= unLift+    Free (RunApp next) -> next >>= unLift  -- | Allows 'zoom'ing 'Action's. type instance Zoomed (ActionT base zoomed m) = Zoomed (FreeT (AppF 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 --- | Given a 'Lens' or 'Traversal' or something similar from "Control.Lens"+-- | This runs an @'Action' MyState a@ over the MyState which is+-- stored in the currently focused state and returns the result.+-- Use 'runActionOver' if you'd like to specify a particular @MyState@+-- which is accessed by a 'Lens' or 'Traversal'.+runAction :: (HasStates t, Functor (Zoomed m c), Default s, Typeable s, Zoom m n s t) => m c -> n c+runAction = zoom stateLens++-- | Given a 'Lens' or 'Traversal' or LensLike from "Control.Lens" -- which focuses the state (t) of an 'Action' from a base state (s),--- this will convert @Action t a -> Action s a@.------ Given a lens @HasStates s => Lens' s t@ it can also convert @Action t a -> App a@-runAction :: Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c-runAction = zoom+-- this will convert @Action t a -> Action s a@ so that it may be run+-- in an @Action s a@+runActionOver :: Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c+runActionOver = zoom --- | Allows you to run an 'App' or 'AppM' inside of an 'Action' or 'ActionM'-liftApp :: Monad m => AppT base m a -> ActionT base zoomed m a-liftApp = liftF .  LiftApp . unLift . getAction+-- | Allows you to run an 'App' inside of an 'Action'+runApp :: Monad m => AppT base m a -> ActionT base zoomed m a+runApp = liftF .  RunApp . unLift . getAction  -- | Runs an application and returns the value and state.-runApp :: Monad m => base -> AppT base m a -> m (a, base)-runApp baseState = flip runStateT baseState . unLift . getAction+runEve :: Monad m => base -> AppT base m a -> m (a, base)+runEve baseState = flip runStateT baseState . unLift . getAction  -- | Runs an application and returns the resulting value.-evalApp :: Monad m => base -> AppT base m a -> m a-evalApp baseState = fmap fst . runApp baseState+evalEve :: Monad m => base -> AppT base m a -> m a+evalEve baseState = fmap fst . runEve baseState  -- | Runs an application and returns the resulting state.-execApp :: Monad m => base -> AppT base m a -> m base-execApp baseState = fmap snd . runApp baseState+execEve :: Monad m => base -> AppT base m a -> m base+execEve baseState = fmap snd . runEve baseState
src/Eve/Internal/AppState.hs view
@@ -17,7 +17,7 @@ import Control.Lens import Data.Default import Data.Typeable-import Pipes.Concurrent+import Control.Concurrent.Chan  -- | A basic default state which underlies 'App' Contains only a map of 'States'. data AppState = AppState@@ -34,23 +34,19 @@ instance HasEvents AppState where  newtype AsyncQueue base m = AsyncQueue-  { _asyncQueue' :: Maybe (Output (AppT base m ()))+  { _asyncQueue' :: Maybe (Chan (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  -- | Accesses a queue for dispatching async actions.-asyncQueue :: (HasStates s, Typeable m, Typeable base) => Lens' s (Maybe (Output (AppT base m ())))+asyncQueue :: (HasStates s, Typeable m, Typeable base) => Lens' s (Maybe (Chan (AppT base m ()))) asyncQueue = stateLens.asyncQueue'  newtype Exiting =   Exiting Bool-  deriving (Show, Eq)  instance Default Exiting where   def = Exiting False@@ -58,25 +54,26 @@ -- | Tells the application to quit. This triggers 'onExit' listeners -- following the current event loop. exit :: (Monad m, HasStates s) => ActionT s zoomed m ()-exit = liftApp $ stateLens .= Exiting True+exit = runApp $ stateLens .= Exiting True  -- | Checks whether we're in the process of exiting. isExiting :: (Monad m, HasStates s) => ActionT s zoomed m Bool-isExiting = liftApp $ do+isExiting = runApp $ do   Exiting b <- use stateLens   return b  --- | An App is a base level monad which operates over your main application+-- | An 'App' is a base level monad which operates over your main application -- state. You may call 'runAction' inside an app to run 'Action's over other states.--- need to specify your own custom base state. type App a = AppT AppState IO a --- | An Action is a monad over some zoomed in state, they are run inside 'App' using--- 'runAction'. For example an Action which operates over a String somewhere in your app state+-- | An 'Action' is a monad over some zoomed in state, they are run inside 'App' using+-- 'runAction'. For example an 'Action' which operates over a String somewhere in your app state -- would be written as: ----- alterString :: Action String ()+-- @+-- alterString :: 'Action' String ()+-- @ type Action state a = ActionT AppState state IO a  -- | A more general version of 'App' which lets you specify the underlying monad.
src/Eve/Internal/Async.hs view
@@ -12,43 +12,49 @@ import Eve.Internal.AppState import Eve.Internal.States +import Control.Concurrent import Control.Monad import Control.Monad.State import Control.Lens import Data.Typeable -import Pipes-import Pipes.Concurrent- -- | Dispatch an action which is generated by some IO. Note that state of the application may have changed -- between calling 'dispatchActionAsync' and running the resulting 'Action' dispatchActionAsync   :: (MonadIO m, HasStates base, Typeable m, Typeable base) => IO (AppT base m ()) -> ActionT base zoomed m ()-dispatchActionAsync asyncAction = liftApp $ do+dispatchActionAsync asyncAction = runApp $ 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+    Just queue -> liftIO . void . forkIO $ asyncAction >>= writeChan queue  -- | This allows long-running IO processes to provide 'Action's to the application asyncronously.+-- +-- 'asyncEventProvider' is simpler to use, however 'asyncActionProvider' provides+-- more power and expressivity. When in doubt, 'asyncEventProvider' probably meets+-- your needs. -- -- Don't let the type signature confuse you; it's much simpler than it seems. -- -- Let's break it down: -- -- When you call 'asyncActionProvider' you pass it a function which accepts a @dispatch@ function as an argument--- and then calls it with various 'Action's within the resulting 'IO'.+-- and then calls it with various 'Action's within the resulting 'IO'. The+-- @dispatch@ function it is passed will have type @(App () -> IO ())@ -- -- Note that this function calls forkIO internally, so there's no need to do that yourself.+--+-- Here's an example:+--+-- > data Timer = Timer+-- > myTimer :: (App () -> IO ()) -> IO ()+-- > myTimer dispatch = forever $ dispatch (myInt += 1) >> threadDelay 1000000+-- >+-- > myInit :: App ()+-- > myInit = asyncActionProvider myTimer asyncActionProvider :: (MonadIO m, HasStates base, Typeable m, Typeable base) => ((AppT base m () -> IO ()) -> IO ()) -> ActionT base zoomed m ()-asyncActionProvider provider = liftApp $ do+asyncActionProvider provider = runApp $ 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+    Just queue -> liftIO . void . forkIO $ provider (writeChan queue)  where
src/Eve/Internal/Listeners.hs view
@@ -7,11 +7,18 @@   ( HasEvents   , dispatchEvent   , dispatchEvent_+  , dispatchLocalEvent+  , dispatchLocalEvent_   , dispatchEventAsync    , addListener   , addListener_+  , addLocalListener+  , addLocalListener_+   , removeListener+  , removeLocalListener+   , asyncEventProvider    , afterInit@@ -23,7 +30,7 @@    , Listener   , ListenerId-  , Dispatcher+  , EventDispatcher   ) where  import Eve.Internal.States@@ -42,29 +49,55 @@ -- | Registers an action to be performed directly following the Initialization phase. -- -- At this point any listeners in the initialization block have run, so you may 'dispatchEvent's here.-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 ())+afterInit :: forall base m a. (Monad m, HasEvents base, Typeable m) => AppT base m a -> AppT base m ()+afterInit action = addListener_ (const (void action) :: AfterInit -> AppT base m ())  -- | Registers an action to be performed BEFORE each async event is processed phase.-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 :: forall base zoomed m a. (Monad m, HasEvents base, Typeable m) => AppT base m a -> ActionT base zoomed m ListenerId+beforeEvent action = addListener (const (void action) :: BeforeEvent -> AppT base m ()) -beforeEvent_ :: (Monad m, HasEvents zoomed, Typeable m, Typeable base) => ActionT base zoomed m a -> ActionT base zoomed m ()+beforeEvent_ :: (Monad m, HasEvents base, Typeable m) => AppT base m a -> ActionT base zoomed m () beforeEvent_ = void . beforeEvent  -- | Registers an action to be performed AFTER each event phase.-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 :: forall base zoomed m a. (Monad m, HasEvents base, Typeable m) => AppT base m a -> ActionT base zoomed m ListenerId+afterEvent action = addListener (const (void action) :: AfterEvent -> AppT base m ()) -afterEvent_ :: (Monad m, HasEvents zoomed, Typeable m, Typeable base) => ActionT base zoomed m a -> ActionT base zoomed m ()+afterEvent_ :: (Monad m, HasEvents base, Typeable m) => AppT base m a -> ActionT base zoomed m () afterEvent_ = void . afterEvent  -- | Registers an action to be run before shutdown. Any asynchronous combinators used in this block will NOT be run.-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 ())+onExit :: forall base zoomed m a. (HasEvents base, Typeable m, Monad m) => AppT base m a -> ActionT base zoomed m ()+onExit action = addListener_ (const (void action) :: Exit -> AppT base m ()) --- | Given an Event of any type, this runs any listeners registered for that event type with the provided event.--- Events may also contain data pertaining to the event and it will be passed to the listeners.+-- | A local version of 'dispatchEvent'.+-- The local version dispatches the event in the context of the current 'Action',+-- If you don't know what this means, you probably want 'dispatchEvent' instead+dispatchLocalEvent+  :: forall result eventType m s.+     (MonadState s m+     ,HasEvents s+     ,Monoid result+     ,Typeable m+     ,Typeable eventType+     ,Typeable result)+  => eventType -> m result+dispatchLocalEvent evt = do+  LocalListeners _ listeners <- use localListeners+  results <-+    traverse ($ evt) (matchingListeners listeners :: [eventType -> m result])+  return (mconcat results :: result)++dispatchLocalEvent_+  :: forall eventType m s.+     (MonadState s m+     ,HasEvents s+     ,Typeable m+     ,Typeable eventType)+  => eventType -> m ()+dispatchLocalEvent_ = dispatchLocalEvent++-- | Runs any listeners registered for the provided event with the provided event; -- -- You can also 'query' listeners and receive a ('Monoid'al) result. --@@ -89,37 +122,28 @@ -- >   liftIO $ print lastNames -- >   -- ["Smith", "Jenkins"] dispatchEvent-  :: forall result eventType m s.-     (MonadState s m-     ,HasEvents s+  :: forall result eventType m base zoomed.+     (HasEvents base      ,Monoid result+     ,Monad m      ,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)+    => eventType -> ActionT base zoomed m result+dispatchEvent evt = runApp $ dispatchLocalEvent evt  dispatchEvent_-  :: forall eventType m s.-     (MonadState s m-     ,HasEvents s+  :: forall eventType m base zoomed.+     (HasEvents base+     ,Monad m      ,Typeable m      ,Typeable eventType)-  => eventType -> m ()+    => eventType -> ActionT base zoomed m () dispatchEvent_ = dispatchEvent --- | Registers an 'Action' or 'App' to respond to an event.------ For a given use: @addListener myListener@, @myListener@ might have the type @MyEvent -> App a@--- it will register the function @myListener@ to be run in response to a @dispatchEvent (MyEvent eventInfo)@--- and will be provided @(MyEvent eventInfo)@ as an argument.------ This returns a 'ListenerId' which corresponds to the registered listener for use with 'removeListener'-addListener+-- | The local version of 'addListener'. It will register a listener within an 'Action's local event+-- context. If you don't know what this means you probably want 'addListener' instead.+addLocalListener   :: forall result eventType m s.      (MonadState s m      ,HasEvents s@@ -128,7 +152,7 @@      ,Typeable result      ,Monoid result)   => (eventType -> m result) -> m ListenerId-addListener lFunc = do+addLocalListener lFunc = do   LocalListeners nextListenerId listeners <- use localListeners   let (listener, listenerId, eventType) = mkListener nextListenerId lFunc       newListeners = M.insertWith mappend eventType [listener] listeners@@ -145,7 +169,7 @@           prox = typeRep (Proxy :: Proxy event)       in (list, listId, prox) -addListener_+addLocalListener_   :: forall result eventType m s.      (MonadState s m      ,HasEvents s@@ -154,13 +178,44 @@      ,Typeable result      ,Monoid result)   => (eventType -> m result) -> m ()+addLocalListener_ = void . addLocalListener++-- | Registers an 'Action' or 'App' to respond to an event.+--+-- For a given use: @addListener myListener@, @myListener@ might have the type @MyEvent -> App a@+-- it will register the function @myListener@ to be run in response to a @dispatchEvent (MyEvent eventInfo)@+-- and will be provided @(MyEvent eventInfo)@ as an argument.+--+-- This returns a 'ListenerId' which corresponds to the registered listener for use with 'removeListener'+addListener+  :: forall result eventType m base zoomed.+     (HasEvents base+     ,Monad m+     ,Typeable m+     ,Typeable eventType+     ,Typeable result+     ,Monoid result)+    => (eventType -> AppT base m result) -> ActionT base zoomed m ListenerId+addListener = runApp . addLocalListener++addListener_+  :: forall result eventType m base zoomed.+     (HasEvents base+     ,Monad m+     ,Typeable m+     ,Typeable eventType+     ,Typeable result+     ,Monoid result)+    => (eventType -> AppT base m result) -> ActionT base zoomed m () addListener_ = void . addListener --- | Unregisters a listener referred to by the provided 'ListenerId'-removeListener+-- | The local version of 'removeListener'.+-- This removes a listener from an 'Action's event context. If you don't+-- know what this means you probably want 'removeListener' instead.+removeLocalListener   :: (MonadState s m, HasEvents s)   => ListenerId -> m ()-removeListener listenerId@(ListenerId _ eventType) = localListeners %= remover+removeLocalListener listenerId@(ListenerId _ eventType) = localListeners %= remover   where     remover (LocalListeners nextListenerId listeners) =       let newListeners =@@ -168,6 +223,13 @@       in LocalListeners nextListenerId newListeners     notMatch idA (Listener _ idB _) = idA /= idB +-- | Unregisters a listener referred to by the provided 'ListenerId'+removeListener+  :: (HasEvents base+     ,Monad m)+    => ListenerId -> ActionT base zoomed m ()+removeListener = runApp . removeLocalListener+ -- | This function takes an IO which results in some event, it runs the IO -- asynchronously, THEN dispatches the event. Note that only the -- code which generates the event is asynchronous, not any responses to the event@@ -187,16 +249,11 @@              Monoid result, HasStates 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@@ -208,7 +265,6 @@ data LocalListeners =   LocalListeners Int                  Listeners-  deriving (Show)  instance Default LocalListeners where   def = LocalListeners 0 M.empty@@ -238,7 +294,7 @@ -- | 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 =>+type EventDispatcher = forall event. Typeable event =>                                 event -> IO ()  -- | This allows long-running IO processes to provide Events to the application asyncronously.@@ -247,9 +303,9 @@ -- -- Let's break it down: ----- Using the 'Dispatcher' type with asyncEventProvider requires the @RankNTypes@ language pragma.+-- Using the 'EventDispatcher' type with asyncEventProvider requires the @RankNTypes@ language pragma. ----- This type as a whole represents a function which accepts a 'Dispatcher' and returns an 'IO';+-- This type as a whole represents a function which accepts an 'EventDispatcher' 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@@ -261,15 +317,15 @@ -- -- > {-# language RankNTypes #-} -- > data Timer = Timer--- > myTimer :: Dispatcher -> IO ()+-- > myTimer :: EventDispatcher -> IO () -- > myTimer dispatch = forever $ dispatch Timer >> threadDelay 1000000 -- > -- > myInit :: App () -- > myInit = asyncEventProvider myTimer asyncEventProvider-  :: (HasEvents base, MonadIO m, Typeable m) => (Dispatcher -> IO ()) -> ActionT base zoomed m ()+  :: (HasEvents base, MonadIO m, Typeable m) => (EventDispatcher -> IO ()) -> ActionT base zoomed m () asyncEventProvider asyncEventProv = asyncActionProvider $ eventsToActions asyncEventProv   where-    eventsToActions :: (Monad m, HasEvents base, Typeable m) => (Dispatcher -> IO ()) -> (AppT base m () -> IO ()) -> IO ()+    eventsToActions :: (Monad m, HasEvents base, Typeable m) => (EventDispatcher -> IO ()) -> (AppT base m () -> IO ()) -> IO ()     eventsToActions aEventProv dispatcher =       aEventProv (dispatcher . dispatchEvent)
src/Eve/Internal/Run.hs view
@@ -9,16 +9,26 @@ import Eve.Internal.States() import Eve.Internal.AppState +import Control.Concurrent.Chan 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+-- | This runs your application like 'eve_',+-- It is polymorphic in the Monad it operates over, so you may use it with any+-- custom base monad which implements 'MonadIO'. Upon termination of the app it+-- returns the final 'AppState'.+eve :: (MonadIO m, Typeable m) => AppT AppState m () -> m AppState+eve initialize = do+  chan <- liftIO newChan+  execEve (def & asyncQueue .~ Just chan) $ do+    initialize+    dispatchEvent_ Init+    dispatchEvent_ AfterInit+    eventLoop chan+    dispatchEvent_ Exit  -- | This runs your application. It accepts an initialization block (which -- is the same as any other 'App' or 'Action' block, which@@ -26,44 +36,27 @@ -- block should use 'dispatchEvent' since it is possible that not all listeners -- have yet been registered. You can use the 'afterInit' trigger to dispatch -- any events you'd like to run at start-up.------ It is polymorphic in the Monad it operates over, so you may use it with any --- custom base monad which implements 'MonadIO'.------ If you don't need this functionality; the easiest way to get started is to simply--- cally it like so:+-- Here's a simple example: -- -- > import Eve -- > -- > initialize = App () -- > initialize = do--- >   addListener ...--- >   ...+-- >   addListener_ myListener+-- >   asyncEventProvider myProvider -- > -- > startApp :: IO () -- > startApp = eve_ initialize-eve :: (MonadIO m, Typeable m) => AppT AppState m () -> m AppState-eve initialize = do-  (output, input) <- liftIO $ spawn unbounded-  execApp (def & asyncQueue .~ Just output) $ do-    initialize-    dispatchEvent_ Init-    dispatchEvent_ AfterInit-    eventLoop $ fromInput input-    dispatchEvent_ Exit---- | 'eve' with '()' as its return value.-eve_ :: (MonadIO m, Typeable m) => AppT AppState m () -> m ()+eve_ :: App () -> IO () eve_ = void . eve  -- | 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 :: (MonadIO m, HasEvents base, Typeable m) => Producer (AppT base m ()) IO () -> AppT base m ()-eventLoop producer = do+eventLoop :: (MonadIO m, HasEvents base, Typeable m) => Chan (AppT base m ()) -> AppT base m ()+eventLoop chan = do   dispatchEvent_ BeforeEvent-  (mAction, nextProducer) <- liftIO $ PP.runStateT PP.draw producer-  fromMaybe (return ()) mAction+  join . liftIO $ readChan chan   dispatchEvent_ AfterEvent   shouldExit <- isExiting-  unless shouldExit $ eventLoop nextProducer+  unless shouldExit $ eventLoop chan
src/Eve/Internal/States.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# language RankNTypes #-}  module Eve.Internal.States   ( States   , HasStates(..)   , HasEvents   , stateLens+  , makeStateLens   ) where  import Control.Lens@@ -17,12 +19,9 @@  -- | A wrapper to allow storing types of states in the same place. data StateWrapper =-  forall s. (Typeable s, Show s) =>+  forall s. (Typeable 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 @@ -38,7 +37,7 @@ -- empty instance: -- -- > instance HasEvents MyState where--- -- Don't need anything here.+-- > -- Don't need anything here. class (Typeable s, HasStates s) =>       HasEvents s @@ -46,7 +45,7 @@ -- 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)+    (Typeable a, Default a, HasStates e)   => Lens' e a stateLens = lens getter setter   where@@ -55,3 +54,35 @@     setter s new =       set (states . at (typeRep (Proxy :: Proxy a)) . mapping coerce) (Just new) s     coerce = iso (\(StateWrapper x) -> unsafeCoerce x) StateWrapper++-- | A utility which creates a state-nested version of a lens.+-- If you pass this function a lens from your state to one of its fields,+-- it will return a lens which can be used within an 'App' or 'Action'.+--+-- The resulting lens will be of type: @newLens :: HasStates s => Lens' s MyState@+-- Or if you prefer, you may wish to specify the state it operates over more specifically+-- to prevent using the lens where it was not originally planned. For instance:+-- @newLens :: Lens' AppState MyState@+--+-- > data SimpleState = SimpleState+-- >   { _myString :: String+-- >   }+-- > makeLenses ''SimpleState+-- >+-- > instance Default SimpleState where+-- >   def = SimpleState "default"+-- >+-- > myStringStateLens :: HasStates s => Lens' s String+-- > myStringStateLens = makeStateLens myString+-- >+-- > myAction :: App ()+-- > myAction = do+-- >   myStringStateLens .= "Hi!"+-- >   str <- use myStringStateLens+-- >   liftIO $ print str+-- > -- "Hi!"+--+-- For more complex Prisms or Traversals you can write your own using+-- 'stateLens'+makeStateLens :: (HasStates s, Typeable myState, Default myState) => Lens' myState a -> Lens' s a+makeStateLens = (stateLens .)
src/Eve/Testing.hs view
@@ -9,4 +9,4 @@ import Data.Default  noIOTest :: AppT AppState Identity a -> (a, AppState)-noIOTest = runIdentity . runApp def+noIOTest = runIdentity . runEve def
test/Eve/Internal/ActionsSpec.hs view
@@ -1,3 +1,4 @@+{-# language TemplateHaskell #-} module Eve.Internal.ActionsSpec where  import Test.Hspec@@ -8,16 +9,40 @@  import Control.Lens import Control.Monad.State+import Data.Default  appendEx  :: Monad m => ActionT AppState String m () appendEx  = modify (++ "!!") -liftAppTest :: Monad m => ActionT AppState String m String-liftAppTest = do+runAppTest :: Monad m => ActionT AppState String m String+runAppTest = do   put "new"-  liftApp $ runAction stateLens appendEx+  runApp $ runAction appendEx   get +data SimpleState = SimpleState+  { _myInt :: Int+  , _myString :: String+  }+makeLenses ''SimpleState++instance Default SimpleState where+  def = SimpleState 0 "default"++alterSimpleState :: ActionT AppState SimpleState Identity String+alterSimpleState = do+  myString .= "Hello!"+  use myString++monoidTest :: ActionT AppState SimpleState Identity (String, [Int])+monoidTest = do+  result <- one `mappend` two+  str <- use myString+  return (str, result)+  where+    one = myString .= "first" >> return [1]+    two = myString <>= "second" >> return [2]+ spec :: Spec spec = do   describe "Exiting" $ do@@ -25,17 +50,31 @@       let (didExit, _) = noIOTest (exit >> isExiting)        in didExit `shouldBe` True -  describe "runAction " $ do+  describe "runAction" $ do     it "runs lifted actions to zoomed monad" $-      let (runActionResult, _) = noIOTest $ runAction stateLens (put "new" >> appendEx) >> runAction stateLens get+      let (runActionResult, _) = noIOTest $ runAction (put "new" >> appendEx) >> runAction get        in runActionResult `shouldBe` "new!!" +  describe "runActionOver" $ do+    it "runs lifted actions to zoomed monad" $+      let (runActionOverResult, _) = noIOTest $ runActionOver stateLens (put "new" >> appendEx) >> runActionOver stateLens get+       in runActionOverResult `shouldBe` "new!!"+     it "runs over traversals" $-      let (traversalResult, _) = noIOTest $ runAction stateLens (put $ Just "new") >> runAction (stateLens._Just) (appendEx >> get)+      let (traversalResult, _) = noIOTest $ runActionOver stateLens (put $ Just "new") >> runActionOver (stateLens._Just) (appendEx >> get)        in traversalResult `shouldBe` "new!!" -  describe "liftApp" $ do+  describe "runApp" $ do     it "runs lifted actions to zoomed monad" $-      let (liftAppResult, _) = noIOTest (runAction stateLens liftAppTest :: AppT AppState Identity String)-       in liftAppResult `shouldBe` "new!!"+      let (runAppResult, _) = noIOTest (runAction runAppTest :: AppT AppState Identity String)+       in runAppResult `shouldBe` "new!!" +  describe "Can run actions over non-HasStates states" $ do+    it "compiles" $+      let (alterationResult, _) = noIOTest (runAction alterSimpleState :: AppT AppState Identity String)+       in alterationResult `shouldBe` "Hello!"++  describe "is a Monoid" $ do+    it "combines results and effects" $+      let (monoidResult, _) = noIOTest (runAction monoidTest :: AppT AppState Identity (String, [Int]))+       in monoidResult `shouldBe` ("firstsecond", [1, 2])
− test/Eve/Internal/ExtensionsSpec.hs 
@@ -1,6 +0,0 @@-module Eve.Internal.ExtensionsSpec where--import Test.Hspec--spec :: Spec-spec = return ()
test/Eve/Internal/ListenersSpec.hs view
@@ -34,22 +34,53 @@   asyncEventProvider (\d -> d CustomEvent)   store .= "new" +localStateIsolationTest :: ActionT AppState NestedStates Identity String+localStateIsolationTest = do+  addLocalListener (const (nestedString .= "new") :: CustomEvent -> ActionT AppState NestedStates Identity ())+  dispatchEvent_ CustomEvent+  use nestedString++globalStateIsolationTest :: AppT AppState Identity String+globalStateIsolationTest = do+  addListener (const (store .= "new") :: CustomEvent -> AppT AppState Identity ())+  runActionOver nestedStates $ do+    dispatchLocalEvent_ CustomEvent+  use store++listenerPassThroughTest :: AppT AppState Identity String+listenerPassThroughTest = do+  let nestedAction :: ActionT AppState NestedStates Identity ()+      nestedAction = do+        addListener (const (store .= "new") :: CustomEvent -> AppT AppState Identity ())+        dispatchEvent CustomEvent+  runActionOver nestedStates nestedAction+  use store++ data OtherEvent = OtherEvent multiAsyncEventsTest :: App () multiAsyncEventsTest = do   addListener (const exit :: CustomEvent -> App ())   addListener (const (store .= "new") :: OtherEvent -> App ())-  asyncEventProvider (\d -> d CustomEvent >> d OtherEvent)+  asyncEventProvider (\d -> d OtherEvent >> d CustomEvent)  spec :: Spec spec = do   describe "dispatchEvent/addListener" $     it "Triggers Listeners" $ fst (noIOTest basicAction) `shouldBe` "new"++  describe "local events" $ do+    it "local state is isolated from global events" $ fst (noIOTest $ runAction localStateIsolationTest) `shouldBe` "default"+    it "global state is isolated from local events" $ fst (noIOTest globalStateIsolationTest) `shouldBe` "default"+    it "global event actions pass through from local state" $ fst (noIOTest listenerPassThroughTest) `shouldBe` "new"+   describe "dispatchEventAsync" $ do     delayedExitState <- ioTest delayedExit     it "Triggers Listeners Eventually" $ (delayedExitState ^. store) `shouldBe` "new"+   describe "removeListener" $     it "Removes Listeners" $ fst (noIOTest removeListenersTest) `shouldBe` "default"+   describe "asyncEventProvider" $ do     asyncEventsResult <- ioTest asyncEventsTest     it "Provides events eventually" $ (asyncEventsResult ^. store) `shouldBe` "new"
+ test/Eve/Internal/StatesSpec.hs view
@@ -0,0 +1,32 @@+{-# language TemplateHaskell #-}+module Eve.Internal.StatesSpec where++import Test.Hspec+import Fixtures+import Eve++import Control.Lens+import Data.Default++data SimpleState = SimpleState+  { _myString :: String+  }+makeLenses ''SimpleState++instance Default SimpleState where+  def = SimpleState "default"++myStringStateLens :: HasStates s => Lens' s String+myStringStateLens = makeStateLens myString++makeStateLensTest :: AppT AppState Identity String+makeStateLensTest = do+  myStringStateLens .= "new"+  use (stateLens.myString)++spec :: Spec+spec = do+  describe "makeStateLens" $ do+    it "creates a lens which accesses state from States" $+      let (makeStateLensResult, _) = noIOTest makeStateLensTest+       in makeStateLensResult `shouldBe` "new"
test/Fixtures.hs view
@@ -4,6 +4,9 @@   , CustomEvent(..)   , noIOTest   , ioTest+  , NestedStates+  , nestedString+  , nestedStates   ) where  import Eve.Testing@@ -19,9 +22,26 @@ import Test.Hspec.Core.Spec (SpecM) import Test.Hspec +data NestedStates = NestedStates+  { _nestedStates' :: States+  , _nestedString :: String+  }+makeLenses ''NestedStates++instance Default NestedStates where+  def = NestedStates mempty "default"++instance HasStates NestedStates where+  states = nestedStates'++instance HasEvents NestedStates++nestedStates :: HasStates s => Lens' s NestedStates+nestedStates = stateLens+ data Store = Store   {_payload :: String-  } deriving (Show, Eq)+  } makeLenses ''Store  store :: HasStates s => Lens' s String