<div dir="ltr"><div><div><div><div>Hi Cafe!!<br><br></div>For my game Nomyx, I am using events that the player can program. For example, the player can register a callback that will be triggered when a new player arrives. He can also program some forms (with buttons, checkboxes, textboxes...) to appear on the W<font>eb GUI. The problem is those events are not composable: he has to create and handle them one by one.<br>
<br></font></div><font>So I'm thinking of making those events composable by making them an instance of Applicative and Alternative.<br></font></div><font>For Applicative, this makes events composable very much like in Applicative-Functors and Reform. I can build neat composed events such as (full program below):<br>
</font><br><font><span style="font-family:courier new,monospace"><font><span style="font-family:courier new,monospace">onInputMyRecord :: Event MyRecord<br></span></font>onInputMyRecord = MyRecord <$> onInputText <*> onInputCheckbox<br>
<br></span>For Alternative, I haven't seen any example</font> of it on the net. The idea is that the first event that fires is used to build the alternative:<br><span style="font-family:courier new,monospace"><br></span><span style="font-family:courier new,monospace"><span style="font-family:courier new,monospace">onInputMyAlternative :: Event Bool</span></span><br>
<span style="font-family:courier new,monospace">onInputMyAlternative = (const True <$> onInputButton) <|> (const False <$> onInputButton)</span><br></div><div><br>Here is an example program:<br><div><span style="font-family:courier new,monospace"><br>
{-# LANGUAGE GADTs #-}<br><br>module ComposableEvents where<br><br>import Control.Applicative<br>import Data.Time<br>import Data.Traversable<br><br>type PlayerNumber = Int<br><br>data Event a where<br>   OnInputText :: PlayerNumber -> Event String   </span><span style="font-family:courier new,monospace"><span style="font-family:courier new,monospace">        </span>-- A textbox will be created for the player. When filled, this event will fire and return the result<br>
   OnInputCheckbox :: PlayerNumber -> Event Bool </span><span style="font-family:courier new,monospace"><span style="font-family:courier new,monospace">        </span>-- Idem with a checkbox<br>   OnInputButton :: PlayerNumber -> Event ()     </span><span style="font-family:courier new,monospace"><span style="font-family:courier new,monospace">        </span>-- Idem with a button<br>
   OnTime :: UTCTime -> Event ()                 </span><span style="font-family:courier new,monospace"><span style="font-family:courier new,monospace">        </span>-- time event<br>   EventSum :: Event a -> Event a -> Event a             -- The first event to fire will be returned<br>
   EventProduct :: Event (a -> b) -> Event a -> Event b  -- both events should fire, and then the result is returned<br>   Fmap :: (a -> b) -> Event a -> Event b  </span><span style="font-family:courier new,monospace"><span style="font-family:courier new,monospace">              </span>-- transforms the value returned by an event.<br>
   Pure :: a -> Event a                                  -- Create a fake event. The result is useable with no delay.<br>   Empty :: Event a                                      -- An event that is never fired. <br><br>
instance Functor Event where<br>   fmap = Fmap<br><br>instance Applicative Event where<br>   pure = Pure<br>   (<*>) = EventProduct<br><br>instance Alternative Event where<br>   (<|>) = EventSum<br>   empty = Empty<br>
<br>onInputText = OnInputText<br>onInputCheckbox = OnInputCheckbox<br>onInputButton = OnInputButton<br>onTime = OnTime<br><br>-- A product type<br>data MyRecord = MyRecord String Bool<br><br>-- A sum type<br>data MyAlternative = A | B<br>
<br>-- Using the Applicative instance, we can build a product type from two separate event results.<br>-- The event callback should be called only when all two events have fired.<br>onInputMyRecord :: Event MyRecord<br>onInputMyRecord = MyRecord <$> onInputText 1 <*> onInputCheckbox 1<br>
<br>-- other possible implementation (given a monad instance)<br>-- onInputMyRecord' = do<br>--    s <- onInputText<br>--    b <- onInputCheckbox<br>--    return $ MyRecord s b<br><br>-- Using the Alternative instance, we build a sum type.<br>
-- The event callback should be called when the first event have fired.<br>onInputMyAlternative :: Event MyAlternative<br>onInputMyAlternative = (const A <$> onInputButton 1) <|> (const B <$> onInputButton 1)<br>
<br>allPlayers = [1 .. 10]<br><br>-- Now complex events can be created, such as voting systems:<br>voteEvent :: UTCTime -> Event ([Maybe Bool])<br>voteEvent time = sequenceA $ map (singleVote time) allPlayers<br><br>singleVote :: UTCTime -> PlayerNumber -> Event (Maybe Bool)<br>
singleVote timeLimit pn = (Just <$> onInputCheckbox pn) <|> (const Nothing <$> onTime timeLimit)<br><br>vote :: UTCTime -> Event Bool<br>vote timeLimit = unanimity <$> (voteEvent timeLimit)<br><br>
unanimity :: [Maybe Bool] -> Bool<br>unanimity = all (== Just True)<br><br><br>--Evaluation<br>--evalEvent :: Event a -> State Game a<br>--evalEvent = undefined<br></span><br></div><div>With this DSL, I can create complex events such as time limited votes very neatly...<br>
</div><div>There is much left to do for a full implem: the way to register callbacks on complex events, the evaluator and the event manager.<br></div><div><span style="font-family:courier new,monospace"></span>Have you heard about a similar implementation? It seems pretty useful. Maybe in FRP frameworks?<br>
</div><div></div><div><br>Thanks a lot!!<br>Corentin<br>PS: I copied this example also in <a href="https://github.com/cdupont/Nomyx-design/blob/master/ComposableEvents.hs">https://github.com/cdupont/Nomyx-design/blob/master/ComposableEvents.hs</a>.<br>
</div></div></div>