├── .gitignore ├── Eventual.hs ├── README.md ├── example1.hs └── example2.hs /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *.o 3 | 4 | *.hi 5 | -------------------------------------------------------------------------------- /Eventual.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, GADTs #-} 2 | 3 | module Eventual 4 | (Wait 5 | ,EventualGetter 6 | ,EventualUpdate 7 | ,TriggerID 8 | ,tryGetNow 9 | ,updateNow 10 | ,EventualMapKey 11 | ,EventualMapUpdate 12 | ,eventualKey 13 | ,mapUpdate 14 | ,Eventual 15 | ,EventualState 16 | ,eventualState 17 | ,storageNow 18 | ,waitGet 19 | ,update 20 | ,runEventual 21 | ,allTasksComplete) 22 | where 23 | 24 | import qualified Data.Map as Map 25 | import Data.Maybe (fromMaybe) 26 | 27 | class (Ord (TriggerID w)) => Wait w where 28 | type EventualGetter w :: * -> * 29 | type EventualUpdate w :: * 30 | type TriggerID w :: * 31 | 32 | tryGetNow :: EventualGetter w v -> w -> Either (TriggerID w) v 33 | updateNow :: EventualUpdate w -> w -> (w, TriggerID w) 34 | 35 | data EventualMapKey k v a where 36 | EventualMapKey :: k -> EventualMapKey k v v 37 | 38 | eventualKey :: k -> EventualMapKey k v v 39 | eventualKey = EventualMapKey 40 | 41 | data EventualMapUpdate k v 42 | = EventualMapUpdate k v 43 | 44 | mapUpdate :: k -> v -> EventualMapUpdate k v 45 | mapUpdate = EventualMapUpdate 46 | 47 | instance (Ord k) => Wait (Map.Map k v) where 48 | type EventualGetter (Map.Map k v) = EventualMapKey k v 49 | type EventualUpdate (Map.Map k v) = EventualMapUpdate k v 50 | type TriggerID (Map.Map k v) = k 51 | 52 | tryGetNow (EventualMapKey k) m = 53 | case (Map.lookup k m) of 54 | Just val -> Right val 55 | Nothing -> Left k 56 | 57 | updateNow (EventualMapUpdate k v) m = (Map.insert k v m, k) 58 | 59 | data EventualTask w a where 60 | EventualTask :: (Wait w) => TriggerID w -> Eventual w a -> EventualTask w a 61 | 62 | data Eventual w a 63 | = Eventual (EventualState w -> (EventualState w, Either (EventualTask w a) a)) 64 | 65 | data EventualState w where 66 | EventualState :: (Wait w) => w -> (Map.Map (TriggerID w) [Eventual w ()]) -> EventualState w 67 | 68 | eventualState :: (Wait w) => w -> EventualState w 69 | eventualState storage = EventualState storage Map.empty 70 | 71 | storageNow :: EventualState w -> w 72 | storageNow (EventualState storage _) = storage 73 | 74 | waitGet :: (Wait w) => EventualGetter w v -> Eventual w v 75 | waitGet g = cont where 76 | cont = Eventual $ \state -> 77 | let result = case tryGetNow g (storageNow state) of 78 | Left trigger -> Left $ EventualTask trigger cont 79 | Right val -> Right val 80 | in (state, result) 81 | 82 | update :: (Wait w) => EventualUpdate w -> Eventual w () 83 | update u = Eventual $ \state -> 84 | let 85 | (storage', trigger) = updateNow u (storageNow state) 86 | EventualState _ tasks = state 87 | toTrigger = fromMaybe [] $ Map.lookup trigger tasks 88 | state' = EventualState storage' $ Map.delete trigger tasks 89 | state'' = foldr runEventual state' toTrigger 90 | in (state'', Right ()) 91 | 92 | runEventual :: Eventual w () -> EventualState w -> EventualState w 93 | runEventual (Eventual f) state = 94 | let (state', result) = f state 95 | in case result of 96 | Left (EventualTask trigger cont) -> 97 | let 98 | EventualState storage tasks = state' 99 | taskList = fromMaybe [] $ Map.lookup trigger tasks 100 | taskList' = cont : taskList 101 | tasks' = Map.insert trigger taskList' tasks 102 | in EventualState storage tasks' 103 | Right () -> state' 104 | 105 | allTasksComplete :: EventualState w -> Bool 106 | allTasksComplete state = 107 | let EventualState _ tasks = state 108 | in Map.null tasks 109 | 110 | instance Monad (Eventual w) where 111 | return x = Eventual $ \state -> (state, Right x) 112 | 113 | (Eventual f1) >>= f2 = Eventual $ \state -> 114 | case f1 state of 115 | (state', Left (EventualTask trigger cont)) -> (state', Left (EventualTask trigger $ cont >>= f2)) 116 | (state', Right val) -> 117 | let Eventual f3 = f2 val 118 | in f3 state' 119 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # The `Eventual` Monad 2 | 3 | This is a very small, very simple, and in my opnion quite useful library for automatically managing runtime data dependencies in Haskell. 4 | 5 | ## What does that mean? 6 | 7 | In some domains, like when writing compilers, it's common to run into annoying situations where you need to delay processing of some data until some other data has already been processed. For example, let's think about the steps needed to compile the following program (written in [Blub](http://c2.com/cgi/wiki?BlubParadox)): 8 | 9 | func foo() -> Int { 10 | print(bar(1 + 1)); 11 | } 12 | 13 | func bar(x: Int) -> Int { 14 | return x + x; 15 | } 16 | 17 | When compiling the body of `foo`, the compiler must, among other things, perform type checking. This requires knowing the argument and return types of `bar`, to ensure that `print(bar(1 + 1))` is semantically valid. However, in a naive implementation, the compiler would have not yet reached or processed the definition of `bar` at this point in the file, because it comes after `foo`, and would therefore not yet know `bar`'s argument or return types. 18 | 19 | To fix this, nearly all compilers do multiple passes through the source code they're processing, building up the information for the next pass on a whole-program level every time. In this case, the compiler would first process `foo` and `bar`'s type signatures, then type-check their bodies in a second pass using that knowledge. For handling more complex features of the language you're compiling, like templates/generics, managing all of these passes and figuring out their proper ordering can be quite irritating, and involve a lot of boilerplate code and intermediate data structures. 20 | 21 | ## `Eventual` saves the day! 22 | 23 | **The `Eventual` monad lets you perform operations which are allowed to depend on elements of a data structure which have not yet been defined.** When you request an element which has not yet been defined (such as, in the above case, the type signature of `bar`), the monad automatically "queues up" the code which requested that element, suspending its execution. When the data does finally become available, all of the suspended operations which depended on it are automatically executed. When compiling the program above, the operation to type-check `foo` would be initially suspended, and run as soon as `bar`'s type signature was set. 24 | 25 | ## A simple example 26 | 27 | Let's take a look at how this actually works in practice. Keep in mind that this is a *Haskell* library, and this example assumes a familiarity with the language. If you don't know Haskell, but this all sounds very useful to you, I recommend that you learn it! Writing code in Haskell is a great time, and it lets you do all sorts of neat little things like this. I would not recommend trying to implement `Eventual` in C++ (although in a langauge with coroutines, like Lua, you might be able to do it). 28 | 29 | Without further ado, here's about the simplest program you can write using `Eventual`: 30 | 31 | ```Haskell 32 | module Main where 33 | 34 | import qualified Eventual as Eventual -- imported qualified to make it clear what functions are from Eventual. 35 | import qualified Data.Map as Map 36 | 37 | op1 :: Eventual.Eventual (Map.Map String Int) () 38 | op1 = do 39 | fooVal <- Eventual.waitGet $ Eventual.eventualKey "foo" 40 | Eventual.update $ Eventual.mapUpdate "bar" (fooVal * fooVal) 41 | 42 | op2 :: Eventual.Eventual (Map.Map String Int) () 43 | op2 = Eventual.update $ Eventual.mapUpdate "foo" 4 44 | 45 | main = do 46 | let state0 = Eventual.eventualState Map.empty 47 | let state1 = Eventual.runEventual op1 state0 48 | putStrLn "After running op1:" 49 | print $ Eventual.storageNow state1 50 | let state2 = Eventual.runEventual op2 state1 51 | putStrLn "After running op2:" 52 | print $ Eventual.storageNow state2 53 | ``` 54 | 55 | This program outputs 56 | 57 | After running op1: 58 | fromList [] 59 | After running op2: 60 | fromList [("foo",4),("bar",16)] 61 | 62 | Woah! That was a lot of new stuff. 63 | 64 | In Haskell, figuring out the types of everythig is usually the best place to start. Here, we have two "eventual operations" in our little program: `op1` and `op2`. The type of an eventual operation contains information about what type of "context" it operates in; in our case, `op1` and `op2` both operate within a `Map.Map String Int`. Any `Map.Map` can be used as a context for eventual values. `op1` and `op2` both produce no useful value when they finish executing, so their "monad return type" is `()` (this is analogous to the use of `()` in `IO ()`). The general form of an eventual operation is 65 | 66 | ```Haskell 67 | Eventual ContextType ProducedValue 68 | ``` 69 | 70 | Putting this all together, it should make sense that both `op1` and `op2`, which are eventual operations operating within a context which maps strings to integers, and which produce no value, have the type: 71 | 72 | ```Haskell 73 | Eventual (Map.Map String Int) () 74 | ``` 75 | 76 | To actually define `op1` and `op2`, we use two important `Eventual` primitives: `Eventual.waitGet` and `Eventual.update`. `Eventual.waitGet` is a monadic operation which gets an eventual value from the eventual context, which may involve suspending execution until the value is defined. `Eventual.update` simply sets a value in the context. 77 | 78 | To accomodate more complex contexts than `Map.Map`, and to provide a layer of encapsulation and abstraction which allows more robust guarantees to be made about the semantics of `Eventual`, `waitGet` and `update` both take "eventual getter" and "eventual update" values, whose specific types vary between context types. You don't really have to worry about this unless you're implementing your own eventual contexts, so for now, just keep in mind that `eventualKey` can be used to construct a getter suitable for usage with `waitGet`, and `mapUpdate` can be used to produce an updater suitable for use in `update`. 79 | 80 | To actually run these eventual operations, we need a context for them to run inside. We can create one with `eventualState`. Our storage context is a `Map.Map`, and we want it to start empty, so we can initialize our state with the following: 81 | 82 | ```Haskell 83 | let 84 | state0 :: EventualState (Map.Map String Int) -- included for clarity 85 | state0 = Eventual.eventualState Map.empty 86 | ``` 87 | 88 | Importantly, an `EventualState` keeps track of not just the storage context in which eventual operations can occur, but also the queued operations which are currently waiting for new data. `Eventual` operations are performed using the function `runEventual`, which is similar to `runState` and friends from other monads. `runEventual` applies an `Eventual` operation to an `EventualState`, producing a new context. Its type is: 89 | 90 | ```Haskell 91 | runEventual :: Eventual w () -> EventualState w -> EventualState w 92 | ``` 93 | 94 | To demonstrate how operations can be suspended when they request undefined data, we start by running `op1`, which depends on the undefined value for key "foo": 95 | 96 | ```Haskell 97 | let state1 = Eventual.runEventual op1 state0 98 | ``` 99 | 100 | At this point, no values have been set in `state1`'s storage context; the only `update` operations which has been "run" actually depends on the value associated with `"foo"`, and is therefore queued. To trigger it, we provide a definition for `"foo"`: 101 | 102 | ```Haskell 103 | let state2 = Eventual.runEventual op2 state1 104 | ``` 105 | 106 | Not only does this set `"foo"` to `100` in the new state, it also triggers the execution of `op1`, which was previously suspended. `op1` is then free to continue execution to the end, at which point it `update`s the value associated with `"bar"` 107 | -------------------------------------------------------------------------------- /example1.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Eventual as Eventual -- imported qualified to make it clear what functions are from Eventual. 4 | import qualified Data.Map as Map 5 | 6 | op1 :: Eventual.Eventual (Map.Map String Int) () 7 | op1 = do 8 | fooVal <- Eventual.waitGet $ Eventual.eventualKey "foo" 9 | Eventual.update $ Eventual.mapUpdate "bar" (fooVal * fooVal) 10 | 11 | op2 :: Eventual.Eventual (Map.Map String Int) () 12 | op2 = Eventual.update $ Eventual.mapUpdate "foo" 4 13 | 14 | main = do 15 | let state0 = Eventual.eventualState Map.empty 16 | let state1 = Eventual.runEventual op1 state0 17 | putStrLn "After running op1:" 18 | print $ Eventual.storageNow state1 -- prints: fromList [] 19 | let state2 = Eventual.runEventual op2 state1 20 | putStrLn "After running op2:" 21 | print $ Eventual.storageNow state2 -- prints: fromList [("bar",16),("foo",4)] 22 | -------------------------------------------------------------------------------- /example2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies, FlexibleContexts, GADTs #-} 2 | 3 | -- This example demonstrates how to create your own 4 | -- instances of the Wait typeclass, to implement custom 5 | -- eventual contexts. 6 | 7 | module Main where 8 | 9 | import Eventual 10 | 11 | data MyContext = MyContext (Maybe String) (Maybe Int) deriving (Show) 12 | 13 | data MyContextEventualGetter v where 14 | EventualFirst :: MyContextEventualGetter String 15 | EventualSecond :: MyContextEventualGetter Int 16 | 17 | data MyContextEventualUpdate 18 | = UpdateFirst String 19 | | UpdateSecond Int 20 | 21 | data MyContextTrigger 22 | = TriggerFirst 23 | | TriggerSecond deriving (Ord, Eq) 24 | 25 | instance Wait MyContext where 26 | type EventualGetter MyContext = MyContextEventualGetter 27 | type EventualUpdate MyContext = MyContextEventualUpdate 28 | type TriggerID MyContext = MyContextTrigger 29 | 30 | tryGetNow EventualFirst (MyContext (Just first) _) = Right first 31 | tryGetNow EventualFirst (MyContext Nothing _) = Left TriggerFirst 32 | 33 | tryGetNow EventualSecond (MyContext _ (Just second)) = Right second 34 | tryGetNow EventualSecond (MyContext _ Nothing) = Left TriggerSecond 35 | 36 | updateNow (UpdateFirst first) (MyContext _ second) = (MyContext (Just first) second, TriggerFirst) 37 | updateNow (UpdateSecond second) (MyContext first _) = (MyContext first (Just second), TriggerSecond) 38 | 39 | op1 :: Eventual MyContext () 40 | op1 = do 41 | meaningOfLife <- waitGet $ EventualSecond 42 | let message = "The meaning of life is: " ++ (show meaningOfLife) 43 | update $ UpdateFirst message 44 | 45 | op2 :: Eventual MyContext () 46 | op2 = update $ UpdateSecond 42 47 | 48 | main = do 49 | let state0 = eventualState $ MyContext Nothing Nothing 50 | let state1 = runEventual op1 state0 51 | putStrLn "After op1:" 52 | print $ storageNow state1 -- prints: MyContext Nothing Nothing 53 | let state2 = runEventual op2 state1 54 | putStrLn "After op2:" 55 | print $ storageNow state2 -- prints: MyContext (Just "The meaning of life is: 42") (Just 42) 56 | --------------------------------------------------------------------------------