diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -77,7 +77,7 @@ addListener_ scoreContributor1 addListener_ scoreContributor2 - -- This dispatchers the triggering event and monoidally sums all the individual score components! + -- This dispatches the triggering event and monoidally sums all the individual score components! computeTotalScore :: App (Sum Int) computeTotalScore = do Sum score <- dispatchEvent ComputeScore diff --git a/eve.cabal b/eve.cabal --- a/eve.cabal +++ b/eve.cabal @@ -1,5 +1,5 @@ name: eve -version: 0.1.6 +version: 0.1.7 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,13 +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 , data-default , containers default-language: Haskell2010 + ghc-options: -Wall test-suite eve-test type: exitcode-stdio-1.0 diff --git a/src/Eve.hs b/src/Eve.hs --- a/src/Eve.hs +++ b/src/Eve.hs @@ -1,48 +1,51 @@ module Eve ( - -- * Running your App - eve - , 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 - , runActionOver , exit - -- * Dispatching Events + -- ** Dispatching Events , dispatchEvent , dispatchEvent_ - , dispatchLocalEvent - , dispatchLocalEvent_ - - , dispatchEventAsync - , dispatchActionAsync - - -- * Event Listeners + -- ** Event Listeners , addListener , addListener_ - , addLocalListener - , addLocalListener_ - , removeListener - , removeLocalListener , Listener , ListenerId - -- * Asynchronous Helpers - , asyncActionProvider + -- ** Asynchronous Helpers , asyncEventProvider - , Dispatcher + , EventDispatcher - -- * Built-in Event Listeners + -- ** Built-in Event Listeners , afterInit , beforeEvent , beforeEvent_ @@ -50,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 @@ -60,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 @@ -72,29 +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 - , makeStateLens - , 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 diff --git a/src/Eve/Internal/Actions.hs b/src/Eve/Internal/Actions.hs --- a/src/Eve/Internal/Actions.hs +++ b/src/Eve/Internal/Actions.hs @@ -12,11 +12,11 @@ , ActionT(..) , AppT - , runApp - , evalApp - , execApp + , runEve + , evalEve + , execEve - , liftApp + , runApp , runAction , runActionOver ) where @@ -33,7 +33,7 @@ -- | 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 @@ -43,7 +43,7 @@ } deriving (Functor, Applicative, Monad, MonadIO, MonadState zoomed) 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 @@ -54,7 +54,7 @@ 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)) @@ -75,18 +75,18 @@ 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 diff --git a/src/Eve/Internal/AppState.hs b/src/Eve/Internal/AppState.hs --- a/src/Eve/Internal/AppState.hs +++ b/src/Eve/Internal/AppState.hs @@ -54,25 +54,24 @@ -- | 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. diff --git a/src/Eve/Internal/Async.hs b/src/Eve/Internal/Async.hs --- a/src/Eve/Internal/Async.hs +++ b/src/Eve/Internal/Async.hs @@ -22,24 +22,38 @@ -- 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 -> 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 () diff --git a/src/Eve/Internal/Listeners.hs b/src/Eve/Internal/Listeners.hs --- a/src/Eve/Internal/Listeners.hs +++ b/src/Eve/Internal/Listeners.hs @@ -30,7 +30,7 @@ , Listener , ListenerId - , Dispatcher + , EventDispatcher ) where import Eve.Internal.States @@ -49,52 +49,30 @@ -- | 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 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 ()) +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 base, Typeable m, Typeable base) => AppT base m a -> ActionT base zoomed m ListenerId +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 base, Typeable m, Typeable base) => AppT base 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 base, Typeable m, Typeable base) => AppT base m a -> ActionT base zoomed m ListenerId +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 base, Typeable m, Typeable base) => AppT base 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 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 ()) +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. --- --- You can also 'query' listeners and receive a ('Monoid'al) result. --- --- > data RequestNames = GetFirstName | GetLastName --- > provideName1, provideName2 :: RequestNames -> App [String] --- > provideName1 GetFirstNames = return ["Bob"] --- > provideName1 GetLastNames = return ["Smith"] --- > provideName2 GetFirstNames = return ["Sally"] --- > provideName2 GetLastNames = return ["Jenkins"] --- > --- > -- Note that if we registered an action of type 'GetFirstName -> ()' it would NOT --- > -- be run in response to the following 'dispatchEvent', since it's type doesn't match. --- > --- > greetNames :: App [String] --- > greetNames = do --- > addListener_ provideName1 --- > addListener_ provideName2 --- > firstNames <- dispatchEvent GetFirstName --- > lastNames <- dispatchEvent GetLastName --- > liftIO $ print firstNames --- > -- ["Bob", "Sally"] --- > liftIO $ print lastNames --- > -- ["Smith", "Jenkins"] +-- | 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 @@ -119,6 +97,30 @@ => 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. +-- +-- > data RequestNames = GetFirstName | GetLastName +-- > provideName1, provideName2 :: RequestNames -> App [String] +-- > provideName1 GetFirstNames = return ["Bob"] +-- > provideName1 GetLastNames = return ["Smith"] +-- > provideName2 GetFirstNames = return ["Sally"] +-- > provideName2 GetLastNames = return ["Jenkins"] +-- > +-- > -- Note that if we registered an action of type 'GetFirstName -> ()' it would NOT +-- > -- be run in response to the following 'dispatchEvent', since it's type doesn't match. +-- > +-- > greetNames :: App [String] +-- > greetNames = do +-- > addListener_ provideName1 +-- > addListener_ provideName2 +-- > firstNames <- dispatchEvent GetFirstName +-- > lastNames <- dispatchEvent GetLastName +-- > liftIO $ print firstNames +-- > -- ["Bob", "Sally"] +-- > liftIO $ print lastNames +-- > -- ["Smith", "Jenkins"] dispatchEvent :: forall result eventType m base zoomed. (HasEvents base @@ -128,7 +130,7 @@ ,Typeable eventType ,Typeable result) => eventType -> ActionT base zoomed m result -dispatchEvent evt = liftApp $ dispatchLocalEvent evt +dispatchEvent evt = runApp $ dispatchLocalEvent evt dispatchEvent_ :: forall eventType m base zoomed. @@ -139,13 +141,8 @@ => 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' +-- | 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 @@ -183,6 +180,13 @@ => (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 @@ -192,7 +196,7 @@ ,Typeable result ,Monoid result) => (eventType -> AppT base m result) -> ActionT base zoomed m ListenerId -addListener = liftApp . addLocalListener +addListener = runApp . addLocalListener addListener_ :: forall result eventType m base zoomed. @@ -205,7 +209,9 @@ => (eventType -> AppT base m result) -> ActionT base zoomed m () addListener_ = void . addListener --- | Unregisters a listener referred to by the provided 'ListenerId' +-- | 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 () @@ -217,11 +223,12 @@ 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 = liftApp . removeLocalListener +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 @@ -287,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. @@ -296,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 @@ -310,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) diff --git a/src/Eve/Internal/Run.hs b/src/Eve/Internal/Run.hs --- a/src/Eve/Internal/Run.hs +++ b/src/Eve/Internal/Run.hs @@ -16,40 +16,38 @@ import Data.Default import Data.Typeable +-- | 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 -- registers event listeners and event providers. Note that nothing in this -- 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 --- call 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 - chan <- liftIO newChan - execApp (def & asyncQueue .~ Just chan) $ do - initialize - dispatchEvent_ Init - dispatchEvent_ AfterInit - eventLoop chan - 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 diff --git a/src/Eve/Internal/States.hs b/src/Eve/Internal/States.hs --- a/src/Eve/Internal/States.hs +++ b/src/Eve/Internal/States.hs @@ -37,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 @@ -58,8 +58,11 @@ -- | 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 diff --git a/src/Eve/Testing.hs b/src/Eve/Testing.hs --- a/src/Eve/Testing.hs +++ b/src/Eve/Testing.hs @@ -9,4 +9,4 @@ import Data.Default noIOTest :: AppT AppState Identity a -> (a, AppState) -noIOTest = runIdentity . runApp def +noIOTest = runIdentity . runEve def diff --git a/test/Eve/Internal/ActionsSpec.hs b/test/Eve/Internal/ActionsSpec.hs --- a/test/Eve/Internal/ActionsSpec.hs +++ b/test/Eve/Internal/ActionsSpec.hs @@ -14,10 +14,10 @@ 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 appendEx + runApp $ runAction appendEx get data SimpleState = SimpleState @@ -55,10 +55,10 @@ 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 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" $