Effector in Elm

Effector.elm

module Data.Effector where

import List exposing (length)


type alias Effector a b = 
  { run : ((a, List b) -> a) -> a -> (a -> a, List b) }

(|>>) : Effector a b -> (a -> (a -> a, List b)) -> Effector a b
(|>>) f g = Effector <|
  \apply x -> let (f', ffx) = f.run apply x
                  (g', gfx) = g x
              in (f' >> g', ffx ++ gfx)

(+>>) : Effector a b -> (a -> (a -> a, List b)) -> Effector a b
(+>>) f g = Effector <|
  \apply x -> let (f', fx) = f.run apply x
              in  g (apply (f' x, fx))

liftFx : (a -> List b) -> Effector a b
liftFx f = Effector <|
  \apply x -> (identity, f x)

fx : Effector a b
fx = Effector <|
  \apply x -> (identity, [])

runEffector f e x = 
  let (g, fx) = e.run f x
  in g (f (x, fx))

EffectorDemo.elm

import List exposing (List, map, filter, unzip)
import Data.Effector exposing (..)

-- Consider a world with two types of people, students and chefs, who both eat
-- one meal per day. Chefs produce three meals per day, which expire after two
-- days. Chefs also produce new student offspring every tenth day, on the dot.
-- Each day the students become older, and when they turn 14 days old, they too
-- become chefs. 
-- From "forced into induced labour" to "induced into labour force" in just two
-- weeks, it's... tough. It's a lot of strain on them. It really is.

-- We model our world as an agent-based, time-step simulation, with a single
-- state object containing the day and lists of all the people and stored food.
type alias World =
  { day       : Int
  , people    : List Person
  , meals     : List Meal
  }
type Person     = Student Int | Chef Int
type alias Meal = Int
type Effect     = Eat | Cook | Birth

world = World 0 [Student 16, Chef 0, Student 17, Chef 0] [Meal 1, Meal 2, Meal 3]

-- Activities during a day in our world happen in phases, and agents can
-- generally only be involved in one kind of activity at a time - but agents
-- of different types may be involved in different activities. Food grows
-- moldy on the shelf while we grow older at our desks. Agents also interact
-- with each other, in acts of consumption, production and birth.
-- 
-- From inside the simulation, activities that occur during the same phase
-- appear to run concurrently. Actually getting them to run concurrently in
-- a web browser is a problem for another day, right now we are merely trying
-- to address two questions:
--
--  1. How can we ensure each agent sees the same 'world' during a simulation
--     phase?
--  2. How can we handle interactions elegantly?
--
-- The solution I have come up with looks like this:

tick : Effector World Effect
tick = fx
 +>> agePopulation
 |>> ageMeals
 +>> expireOldFood
 |>> employGraduatingStudents
 |>> liftFx doBirths
 |>> incrementDay

-- There are a few things going on here. Effector is a type facilitating the
-- composition of functions that operate on some part of the global state
-- and produce effects. They have the signature `s -> (s -> s, [fx])`, which
-- reflects that they do not directly return a new state object, but a function
-- which can be applied to another state object in order to contribute its
-- changes to the specific part it is responsible for.
--
-- The (|>>) operator chains "concurrent" operations such that both functions
-- will see the same `s`, and the lists of effects they return will be
-- concatenated but not acted upon.
--
-- The (+>>) operator chains sequential phases, causing all pending state 
-- transformations on the LHS to be applied in turn, and all pending effects
-- to be dispatched before passing along the resulting state to the RHS.
--
-- Effects are dispatched via a dispatch function `(s, [fx]) -> s`, which is
-- supplied when the effector is run:

run = runEffector tick dispatch world

-- The library also provides two helper functions for constructing effectors,
-- both of which are used in `tick` above:
--
--  1. `fx` is the identity effector, useful for starting a chain.
--  2. `liftFx` constructs an Effector from a function `s -> [fx]` that
--     produces effects without modifying the global state.
--
-- That's it! This gist also contains the actual implementation of Effector
-- in Effector.elm, and the rest of the code in this demo is provided below. 
-- I've modified the example a bit for this gist, so there may be errors, but
-- the Effector implementation should be OK.

agePopulation : World -> (World -> World, List Effect)
agePopulation world =
  let
    step x = case x of Student a -> (Student (a+1), [Eat])
                       Chef a    -> (Chef (a+1),    [Eat, Cook, Cook, Cook])
    (people', fx) = unzip (map step world.people)
  in
    (\world' -> { world' | people <- people' }, fx)

ageMeals : World -> (World -> World, List Effect)
ageMeals world =
  (\world' -> { world' | meals <- map ((+) 1) world.meals }, [])

expireOldFood : World -> (World -> World, List Effect)
expireOldFood world =
  (\world' -> { world' | meals <- filter ((>=) 2) world.meals }, [])

employGraduatingStudents : World -> (World -> World, List Effect)
employGraduatingStudents world =
  let
    step x = case x of Student 14 -> Chef
                       _          -> x
  in
    (\world' -> { world' | people <- map step world.people }, [])

doBirths : World -> List Effect
doBirths world =
  let
    birthdays x acc = case x of Chef x -> if x % 10 == 0 then Birth::acc else acc
                                _      -> acc
  in
    foldl birthdays [] world.people

incrementDay : World -> (World -> World, List Effect)
incrementDay world =
  (\world' -> { world' | day <- world.day + 1 }, [])


dispatch : (World, List Effect) -> World
dispatch (world, xs) = case xs of
  []          -> world
  IncX::xs' -> doFx ({ world | foo <- world.foo + 1}, xs')
  IncY::xs' -> doFx ({ world | bar <- world.bar + 1}, xs')