eve 0.1.2 → 0.1.6

raw patch · 14 files changed

+402/−106 lines, 14 filesdep −pipesdep −pipes-concurrencydep −pipes-parsedep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: pipes, pipes-concurrency, pipes-parse

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +134/−21
• eve.cabal +2/−5
• src/Eve.hs +13/−0
• src/Eve/Internal/Actions.hs +17/−6
• src/Eve/Internal/AppState.hs +3/−7
• src/Eve/Internal/Async.hs +3/−11
• src/Eve/Internal/Listeners.hs +73/−24
• src/Eve/Internal/Run.hs +9/−14
• src/Eve/Internal/States.hs +33/−5
• test/Eve/Internal/ActionsSpec.hs +30/−5
• test/Eve/Internal/ExtensionsSpec.hs +0/−6
• test/Eve/Internal/ListenersSpec.hs +32/−1
• test/Eve/Internal/StatesSpec.hs +32/−0
• test/Fixtures.hs +21/−1

@@ -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 dispatchers 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. @@ -67,7 +181,6 @@  -   Module cross-dependencies makes the community infrastructure more fragile, -   This architecture takes some getting used-to.-  Contributing ============

@@ -1,5 +1,5 @@ name:                eve-version:             0.1.2+version:             0.1.6 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@@ -28,9 +28,6 @@                      , mtl                      , lens                      , free-                     , pipes-                     , pipes-parse-                     , pipes-concurrency                      , data-default                      , containers   default-language:    Haskell2010@@ -43,7 +40,7 @@                      , EveSpec                      , Eve.Internal.AsyncSpec                      , Eve.Internal.ActionsSpec-                     , Eve.Internal.ExtensionsSpec+                     , Eve.Internal.StatesSpec                      , Eve.Internal.EventsSpec                      , Eve.Internal.ListenersSpec                      , Eve.Internal.RunSpec

@@ -2,6 +2,7 @@   (   -- * Running your App   eve+  , eve_    -- * Working with Actions   , App@@ -10,18 +11,29 @@   , ActionT   , liftApp   , runAction+  , runActionOver   , exit    -- * Dispatching Events   , dispatchEvent   , dispatchEvent_++  , dispatchLocalEvent+  , dispatchLocalEvent_+   , dispatchEventAsync   , dispatchActionAsync    -- * Event Listeners   , addListener   , addListener_++  , addLocalListener+  , addLocalListener_+   , removeListener+  , removeLocalListener+   , Listener   , ListenerId @@ -81,6 +93,7 @@   , States   , HasEvents   , stateLens+  , makeStateLens   , AppState   ) where 

@@ -1,6 +1,7 @@ {-# language GeneralizedNewtypeDeriving #-} {-# language DeriveFunctor #-} {-# language FlexibleInstances #-}+{-# language FlexibleContexts #-} {-# language MultiParamTypeClasses #-} {-# language RankNTypes #-} {-# language TypeFamilies #-}@@ -17,11 +18,15 @@    , liftApp   , 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  -- | An 'App' has the same base and zoomed values. type AppT s m a = ActionT s s m a@@ -56,13 +61,19 @@ 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

@@ -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

@@ -12,14 +12,12 @@ 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@@ -28,9 +26,7 @@   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. --@@ -47,8 +43,4 @@   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

@@ -7,11 +7,18 @@   ( HasEvents   , dispatchEvent   , dispatchEvent_+  , dispatchLocalEvent+  , dispatchLocalEvent_   , dispatchEventAsync    , addListener   , addListener_+  , addLocalListener+  , addLocalListener_+   , removeListener+  , removeLocalListener+   , asyncEventProvider    , afterInit@@ -42,26 +49,26 @@ -- | 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, Typeable base) => AppT base m a -> AppT base m ()+afterInit action = void $ 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, Typeable base) => 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, Typeable base) => 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, Typeable base) => 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, Typeable base) => 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, Typeable base, Monad m) => AppT base m a -> ActionT base zoomed m ()+onExit action = void $ 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.@@ -88,7 +95,7 @@ -- >   -- ["Bob", "Sally"] -- >   liftIO $ print lastNames -- >   -- ["Smith", "Jenkins"]-dispatchEvent+dispatchLocalEvent   :: forall result eventType m s.      (MonadState s m      ,HasEvents s@@ -97,19 +104,39 @@      ,Typeable eventType      ,Typeable result)   => eventType -> m result-dispatchEvent evt = do+dispatchLocalEvent evt = do   LocalListeners _ listeners <- use localListeners   results <-     traverse ($ evt) (matchingListeners listeners :: [eventType -> m result])   return (mconcat results :: result) -dispatchEvent_+dispatchLocalEvent_   :: forall eventType m s.      (MonadState s m      ,HasEvents s      ,Typeable m      ,Typeable eventType)   => eventType -> m ()+dispatchLocalEvent_ = dispatchLocalEvent++dispatchEvent+  :: forall result eventType m base zoomed.+     (HasEvents base+     ,Monoid result+     ,Monad m+     ,Typeable m+     ,Typeable eventType+     ,Typeable result)+    => eventType -> ActionT base zoomed m result+dispatchEvent evt = liftApp $ dispatchLocalEvent evt++dispatchEvent_+  :: forall eventType m base zoomed.+     (HasEvents base+     ,Monad m+     ,Typeable m+     ,Typeable eventType)+    => eventType -> ActionT base zoomed m () dispatchEvent_ = dispatchEvent  -- | Registers an 'Action' or 'App' to respond to an event.@@ -119,7 +146,7 @@ -- and will be provided @(MyEvent eventInfo)@ as an argument. -- -- This returns a 'ListenerId' which corresponds to the registered listener for use with 'removeListener'-addListener+addLocalListener   :: forall result eventType m s.      (MonadState s m      ,HasEvents s@@ -128,7 +155,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 +172,7 @@           prox = typeRep (Proxy :: Proxy event)       in (list, listId, prox) -addListener_+addLocalListener_   :: forall result eventType m s.      (MonadState s m      ,HasEvents s@@ -154,13 +181,35 @@      ,Typeable result      ,Monoid result)   => (eventType -> m result) -> m ()+addLocalListener_ = void . 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 ListenerId+addListener = liftApp . 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+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 +217,12 @@       in LocalListeners nextListenerId newListeners     notMatch idA (Listener _ idB _) = idA /= idB +removeListener+  :: (HasEvents base+     ,Monad m)+    => ListenerId -> ActionT base zoomed m ()+removeListener = liftApp . 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 +242,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 +258,6 @@ data LocalListeners =   LocalListeners Int                  Listeners-  deriving (Show)  instance Default LocalListeners where   def = LocalListeners 0 M.empty

@@ -9,17 +9,13 @@ 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. It accepts an initialization block (which -- is the same as any other 'App' or 'Action' block, which -- registers event listeners and event providers. Note that nothing in this@@ -31,7 +27,7 @@ -- 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:+-- call it like so: -- -- > import Eve -- >@@ -44,12 +40,12 @@ -- > 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+  chan <- liftIO newChan+  execApp (def & asyncQueue .~ Just chan) $ do     initialize     dispatchEvent_ Init     dispatchEvent_ AfterInit-    eventLoop $ fromInput input+    eventLoop chan     dispatchEvent_ Exit  -- | 'eve' with '()' as its return value.@@ -59,11 +55,10 @@ -- | 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

@@ -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 @@ -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,32 @@     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@+--+-- > 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 .)

@@ -1,3 +1,4 @@+{-# language TemplateHaskell #-} module Eve.Internal.ActionsSpec where  import Test.Hspec@@ -8,6 +9,7 @@  import Control.Lens import Control.Monad.State+import Data.Default  appendEx  :: Monad m => ActionT AppState String m () appendEx  = modify (++ "!!")@@ -15,9 +17,23 @@ liftAppTest :: Monad m => ActionT AppState String m String liftAppTest = do   put "new"-  liftApp $ runAction stateLens appendEx+  liftApp $ 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+ spec :: Spec spec = do   describe "Exiting" $ do@@ -25,17 +41,26 @@       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     it "runs lifted actions to zoomed monad" $-      let (liftAppResult, _) = noIOTest (runAction stateLens liftAppTest :: AppT AppState Identity String)+      let (liftAppResult, _) = noIOTest (runAction liftAppTest :: AppT AppState Identity String)        in liftAppResult `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!"

@@ -1,6 +0,0 @@-module Eve.Internal.ExtensionsSpec where--import Test.Hspec--spec :: Spec-spec = return ()

@@ -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"

@@ -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"

@@ -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