diff --git a/bower.json b/bower.json
deleted file mode 100644
index 193f164..0000000
--- a/bower.json
+++ /dev/null
@@ -1,27 +0,0 @@
-{
-    "name": "purescript-concur-core",
-    "license": [
-        "MIT"
-    ],
-    "repository": {
-        "type": "git",
-        "url": "https://github.com/purescript-concur/purescript-concur-core"
-    },
-    "ignore": [
-        "**/.*",
-        "node_modules",
-        "bower_components",
-        "output"
-    ],
-    "dependencies": {
-        "purescript-aff": "^v5.1.2",
-        "purescript-arrays": "^v5.3.1",
-        "purescript-avar": "^v3.0.0",
-        "purescript-console": "^v4.2.0",
-        "purescript-foldable-traversable": "^v4.1.1",
-        "purescript-free": "^v5.2.0",
-        "purescript-nonempty": "^v5.0.0",
-        "purescript-profunctor-lenses": "^v6.2.0",
-        "purescript-tailrec": "^v4.1.0"
-    }
-}
diff --git a/spago.dhall b/spago.dhall
index 8877b37..6d8daff 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -5,12 +5,9 @@ You can edit this file as you like.
 { name =
     "concur-core"
 , dependencies =
-    [ "aff"
-    , "arrays"
-    , "avar"
+    [ "arrays"
     , "console"
     , "foldable-traversable"
-    , "free"
     , "nonempty"
     , "profunctor-lenses"
     , "tailrec"
@@ -20,5 +17,5 @@ You can edit this file as you like.
 , packages =
     ./packages.dhall
 , sources =
-    [ "src/**/*.purs", "test/**/*.purs" ]
+    [ "src/**/*.purs" ]
 }
diff --git a/src/Concur/Core.purs b/src/Concur/Core.purs
index 8dedb05..061bee2 100644
--- a/src/Concur/Core.purs
+++ b/src/Concur/Core.purs
@@ -8,19 +8,15 @@ where
 
 import Concur.Core.IsWidget (class IsWidget)
 import Concur.Core.LiftWidget (class LiftWidget, liftWidget)
-import Concur.Core.Types (Widget(..), WidgetStep(..), unWidget)
-import Control.Monad.Free (Free, wrap, resume)
-import Control.Parallel.Class (parallel, sequential)
-import Control.Plus (alt)
-import Data.Either (Either(..))
-import Effect (Effect)
-import Effect.AVar (empty, tryPut) as EVar
-import Effect.Aff.AVar (take) as AVar
-import Effect.Aff.Class (liftAff)
-import Prelude (Unit, bind, map, pure, void, ($))
+import Concur.Core.Types (Widget(..), unWidget)
 
 -- Helpers for some very common use of unsafe blocking io
 
+-- TODO: THIS SHOULD NOT BE EXTRACTED OUT OF THE BACKEND CODE.
+-- EXTRACTING THIS OUT OF THE BACKEND IS CAUSING A RIGID mkNodeWidget TO BE USED
+-- THAT mkNodeWidget IF FORCING "spooky action at a distance". GET RID OF!
+
+{-
 -- | Construct a widget, by wrapping an existing widget in a view event
 mkNodeWidget ::
   forall a v.
@@ -33,27 +29,44 @@ mkNodeWidget mkView (Widget w) = Widget (mkNodeWidget' mkView w)
 mkNodeWidget' :: forall a v. ((a -> Effect Unit) -> v -> v) -> Free (WidgetStep v) a -> Free (WidgetStep v) a
 mkNodeWidget' mkView w = case resume w of
   Right a -> pure a
-  Left (WidgetStepEff eff) -> wrap $ WidgetStepEff do
+  Left x -> case x of
+    WidgetStepEff eff -> wrap $ WidgetStepEff do
       w' <- eff
       pure $ mkNodeWidget' mkView w'
-  Left (WidgetStepView wsr) -> wrap $ WidgetStepEff do
-      var <- EVar.empty
-      let eventHandler = (\a -> void (EVar.tryPut (pure a) var))
-      let cont' = sequential (alt (parallel (liftAff (AVar.take var)))
-                                  (parallel (map (mkNodeWidget' mkView) wsr.cont))
-                             )
-      pure $ wrap $ WidgetStepView
-        { view: mkView eventHandler wsr.view
-        , cont: cont'
-        }
+    WidgetStepView v w' -> do
+-}
+
+  -- Left (WidgetStepCont (Observer f)) -> wrap $ WidgetStepCont $ Observer \cb ->
+  --   f \w' -> cb (mkNodeWidgetInner cb w')
+
+  -- At this point, we don't have a wrapping observer. Create one
+  -- Left (WidgetStepView v a) -> wrap $ WidgetStepCont $ Observer \cb ->
+  --   ob <- mkObserver
+  --   pure $ wrap $ WidgetStepView
+  --     { view: mkView (ob.push <<< pure) wsr.view
+  --     , cont: par [ob.subscribe, wsr.cont]
+  --     }
+
+  -- where
+    -- Special case, view wrapped inside callback
+    -- mkNodeWidgetInner cb w' = case resume w' of
+    --   Right a -> pure a
+    --   Left (WidgetStepEff eff) -> wrap $ WidgetStepEff do
+    --     w'' <- eff
+    --     pure $ mkNodeWidgetInner cb w''
+    --   Left (WidgetStepView v w'') -> wrap $ WidgetStepView (mkView cb v) (mkNodeWidget' mkView w'')
+
+{-
+
 -- | Construct a widget with just props
 mkLeafWidget ::
   forall a v.
   ((a -> Effect Unit) -> v) ->
   Widget v a
 mkLeafWidget mkView = Widget $ wrap $ WidgetStepEff do
-  var <- EVar.empty
+  ob <- mkObserver
   pure $ wrap $ WidgetStepView
-    { view: mkView (\a -> void (EVar.tryPut (pure a) var))
-    , cont: liftAff (AVar.take var)
+    { view: mkView (ob.push <<< pure)
+    , cont: ob.subscribe
     }
+-}
diff --git a/src/Concur/Core/DOM.purs b/src/Concur/Core/DOM.purs
deleted file mode 100644
index aed5709..0000000
--- a/src/Concur/Core/DOM.purs
+++ /dev/null
@@ -1,43 +0,0 @@
-module Concur.Core.DOM where
-
-import Concur.Core (mkLeafWidget, mkNodeWidget)
-import Concur.Core.LiftWidget (class LiftWidget, liftWidget)
-import Concur.Core.Props (Props, mkProp)
-import Concur.Core.Types (Widget)
-import Control.MultiAlternative (class MultiAlternative, orr)
-import Control.ShiftMap (class ShiftMap, shiftMap)
-import Data.Function (($), (<<<))
-import Data.Functor (class Functor, map)
-
--- | Wrap a single widget with a node that can have eventHandlers attached
-el
-  :: forall f p v m a
-  .  ShiftMap (Widget v) m
-  => Functor f
-  => (f p -> v -> v)
-  -> f (Props p a)
-  -> m a
-  -> m a
-el e props = shiftMap (\f w -> mkNodeWidget (\h v -> (e (map (mkProp h <<< map f) props) v)) w)
-
--- | Promote a leaf node to a widget
-elLeaf
-  :: forall f p v m a
-  .  LiftWidget v m
-  => Functor f
-  => (f p -> v)
-  -> f (Props p a)
-  -> m a
-elLeaf e props = liftWidget $ mkLeafWidget \h -> e (map (mkProp h) props)
-
--- | Wrap some widgets with a node that can have eventHandlers attached
-el'
-  :: forall f p v m a
-  .  ShiftMap (Widget v) m
-  => MultiAlternative m
-  => Functor f
-  => (f p -> v -> v)
-  -> f (Props p a)
-  -> Array (m a)
-  -> m a
-el' e props = el e props <<< orr
diff --git a/src/Concur/Core/DevTools.js b/src/Concur/Core/DevTools.js
deleted file mode 100644
index 204b670..0000000
--- a/src/Concur/Core/DevTools.js
+++ /dev/null
@@ -1,62 +0,0 @@
-"use strict";
-
-function hasDevTools() {
-  return (process.env.NODE_ENV === 'development' && window.__REDUX_DEVTOOLS_EXTENSION__);
-}
-
-exports.connectDevTools = function() {
-  if(hasDevTools()) {
-    return window.__REDUX_DEVTOOLS_EXTENSION__.connect();
-  } else {
-    // ??
-    return null;
-  }
-};
-
-exports.disconnectDevTools = function() {
-  if(hasDevTools()) {
-    return window.__REDUX_DEVTOOLS_EXTENSION__.disconnect();
-  } else {
-    // ??
-    return null;
-  }
-};
-
-exports.sendToDevTools = function(connection) {
-  return function(action) {
-    return function(state) {
-      return function() {
-        if(hasDevTools()) {
-          return connection.send(action, state);
-        } else {
-          // ??
-          return null;
-        }
-      };
-    };
-  };
-};
-
-exports.subscribeDevTools = function(connection) {
-  return function(handler) {
-    return function() {
-      if(hasDevTools()) {
-        return connection.subscribe(function(message) {
-          if (message.type === 'DISPATCH' && message.state) {
-            // Extra () due to handler being a State -> Effect
-            handler(message.state)();
-          }
-        });
-      } else {
-        // ??
-        return null;
-      }
-    };
-  };
-};
-
-exports.unsubscribeDevTools = function(connection) {
-  return function() {
-    connection.unsubscribe();
-  };
-};
diff --git a/src/Concur/Core/DevTools.purs b/src/Concur/Core/DevTools.purs
deleted file mode 100644
index 450a05e..0000000
--- a/src/Concur/Core/DevTools.purs
+++ /dev/null
@@ -1,69 +0,0 @@
-module Concur.Core.DevTools where
-
-import Prelude
-
-import Control.Alt (class Alt, (<|>))
-import Data.Either (Either(..))
-import Effect (Effect)
-import Effect.Aff (Aff)
-import Effect.Aff.Class (class MonadAff, liftAff)
-import Effect.Class (liftEffect)
-import Effect.Exception (error)
-
-import Effect.AVar as EVar
-import Effect.Aff.AVar as AVar
-
-data DevToolsConnection
-
-foreign import connectDevTools :: Effect DevToolsConnection
-
-foreign import disconnectDevTools :: Effect Unit
-
-foreign import sendToDevTools :: forall action state. DevToolsConnection -> action -> state -> Effect Unit
-
-data DevToolsSubscription
-
-foreign import subscribeDevTools :: forall state. DevToolsConnection -> (state -> Effect Unit) -> Effect DevToolsSubscription
-
-foreign import unsubscribeDevTools :: DevToolsSubscription -> Effect Unit
-
-data StateSubscription a
-  = StateSubscription DevToolsConnection DevToolsSubscription (EVar.AVar a)
-
-subscribe :: forall a. DevToolsConnection -> Effect (StateSubscription a)
-subscribe conn = do
-  v <- EVar.empty
-  subs <- subscribeDevTools conn \st ->
-    do
-      _ <- EVar.tryPut st v
-      pure unit
-  pure (StateSubscription conn subs v)
-
-unsubscribe :: forall a. StateSubscription a -> Effect Unit
-unsubscribe (StateSubscription _ subs v) = do
-  unsubscribeDevTools subs
-  EVar.kill (error "Unsubscribed") v
-
-awaitState :: forall a. StateSubscription a -> Aff a
-awaitState (StateSubscription _ _ v) = AVar.take v
-
-sendState :: forall a. StateSubscription a -> String -> a -> Effect Unit
-sendState (StateSubscription conn _ _) label st = sendToDevTools conn label st
-
--- Wrap a state getter, so that all outputs from the getter are sent to the devtools
---   And also, any state sent back from the devtools overrides the local state
-withStateful ::
-  forall m a.
-  MonadAff m =>
-  Alt m =>
-  StateSubscription a ->
-  String ->
-  m a ->
-  m a
-withStateful subs label axn = do
-  est <- map Left axn <|> map Right (liftAff (awaitState subs))
-  case est of
-    Left st -> do
-      liftEffect $ sendState subs label st
-      pure st
-    Right st -> pure st
diff --git a/src/Concur/Core/Discharge.purs b/src/Concur/Core/Discharge.purs
index 4475d82..2633ef4 100644
--- a/src/Concur/Core/Discharge.purs
+++ b/src/Concur/Core/Discharge.purs
@@ -2,47 +2,49 @@ module Concur.Core.Discharge where
 
 import Prelude
 
-import Concur.Core.Types (Widget(..), WidgetStep(..), unWidget)
-import Control.Monad.Free (resume, wrap)
+-- import Concur.Core.Types (Widget(..), WidgetStep(..))
+-- import Control.Monad.Free (resume)
 import Data.Either (Either(..))
-import Data.Tuple (Tuple(..))
+import Data.Maybe (Maybe(..))
 import Effect (Effect)
-import Effect.Aff (runAff_)
 import Effect.Exception (Error)
 
--- Widget discharge strategies
--- | Discharge a widget.
--- | 1. Runs the Effect action
--- | 2. Forks the Aff action
--- | 3. Extracts and returns the view
-discharge ::
-  forall a v.
-  Monoid v =>
-  (Either Error (Widget v a) -> Effect Unit) ->
-  Widget v a ->
-  Effect v
-discharge handler (Widget w) = case resume w of
-  Right _ -> pure mempty
-  Left (WidgetStepEff eff) -> do
-      w' <- eff
-      discharge handler (Widget w')
-  Left (WidgetStepView ws) -> do
-      runAff_ (handler <<< map Widget) ws.cont
-      pure ws.view
+-- -- Widget discharge strategies
+-- -- | Discharge a widget.
+-- -- | 1. Runs the Effect action
+-- -- | 2. Forks the Aff action
+-- -- | 3. Extracts and returns the view
+-- discharge ::
+--   forall a v.
+--   Monoid v =>
+--   (Either Error (Widget v a) -> Effect Unit) ->
+--   Widget v a ->
+--   Effect (Maybe v)
+-- discharge handler (Widget w) = case resume w of
+--   Right _ -> pure Nothing
+--   Left x -> case x of
+--     WidgetStepView f ->
+--       f \y -> handler (Right (Widget y))
 
+{-
 -- | Discharge only the top level blocking effect of a widget (if any) to get access to the view
--- | Returns the view, and the remaining widget
+-- | Returns the view if any, and the remaining widget, which could be the same widget.
 dischargePartialEffect ::
   forall a v.
   Monoid v =>
   Widget v a ->
-  Effect (Tuple (Widget v a) v)
+  Effect (Tuple (Widget v a) (Maybe v))
 dischargePartialEffect w = case resume (unWidget w) of
-  Right _ -> pure (Tuple w mempty)
-  Left (WidgetStepEff eff) -> do
+  Right _ -> pure (Tuple w Nothing)
+  Left x -> case x of
+    WidgetStepEff eff -> do
       w' <- eff
       dischargePartialEffect (Widget w')
-  Left (WidgetStepView ws) -> pure (Tuple (Widget (wrap (WidgetStepView ws))) ws.view)
+    -- WidgetStepCont _ -> pure (Tuple w Nothing)
+    WidgetStepStuck -> pure (Tuple w Nothing)
+    WidgetStepView f ->
+      map (Just <<< fromMaybe v) <$> dischargePartialEffect (Widget w')
+-}
 
 {-
 -- | Discharge a widget, forces async resolution of the continuation.
diff --git a/src/Concur/Core/Event.js.bak b/src/Concur/Core/Event.js.bak
new file mode 100644
index 0000000..9fbfbeb
--- /dev/null
+++ b/src/Concur/Core/Event.js.bak
@@ -0,0 +1,108 @@
+"use strict";
+
+exports.random = function() {
+  return "" + Math.floor(Math.random() * 1000);
+};
+
+/*
+// foreign import mkObserver ::
+//   forall a. Effect
+//     { push :: a -> Effect Unit
+//     , subscribe :: (a -> Effect Unit) -> Effect (Effect Unit)
+//     }
+exports.mkObserver = function() {
+    var saveda;
+    var callback;
+    return { push: function(a) {
+               return function() {
+                 if(callback) callback(a)();
+                 else saveda = a;
+               };
+             }
+           , subscribe: function(cb) {
+               return function() {
+                 if(saveda !== null && saveda !== undefined) {
+                   // TODO: Wrap this in a setTimeout???
+                   cb(saveda)();
+                   return function() {};
+                 } else {
+                   callback = cb;
+                   return function() {
+                     console.log("NO MORE CALLBACK", callback);
+                     callback = null;
+                   };
+                 }
+               };
+             }
+           };
+};
+
+
+// foreign import parIndex :: forall a. Array (Observer a) -> Observer ({i::Int, val::a})
+exports.parIndex = function(arr) {
+    return function(cb) {
+      return function() {
+        // Cancelers
+        var cancelers = [];
+        // register all callbacks
+        for(var i=0; i<arr.length;i++) {
+          var f = arr[i];
+          var c = f(function(val) {
+            return function() {
+              // Call the successful one
+              cb({i, val})();
+              // Cancel all others
+              console.log("THERE CAN BE ONLY ONE", cancelers);
+              for(var j=0; j<cancelers.length; j++) {
+                if (j !== i) cancelers[j]();
+              }
+              cancelers = [];
+            };
+          })();
+          // register canceler
+          cancelers.push(c);
+        };
+        return function() {
+         // cancel
+          for(var j=0; j<cancelers.length; j++) {
+            cancelers[j]();
+          }
+        };
+      };
+    };
+};
+
+// foreign import par :: forall a. Array (Observer a) -> Observer a
+exports.par = function(arr) {
+    return function(cb) {
+        return function() {
+            // Cancelers
+            var cancelers = [];
+            // register all callbacks
+            for(var i=0; i<arr.length;i++) {
+                var f = arr[i];
+                var c = f(function(val) {
+                  return function() {
+                    // Call the successful one
+                    cb(val)();
+                    // Cancel all others
+                    console.log("THERE CAN BE ONLY ONE", cancelers);
+                    for(var j=0; j<cancelers.length; j++) {
+                        if (j !== i) cancelers[j]();
+                    }
+                    cancelers = [];
+                  };
+                })();
+                // register canceler
+                cancelers.push(c);
+            };
+            return function() {
+              // cancel
+              for(var j=0; j<cancelers.length; j++) {
+                  cancelers[j]();
+              }
+            };
+        };
+    };
+};
+*/
diff --git a/src/Concur/Core/Event.purs b/src/Concur/Core/Event.purs
new file mode 100644
index 0000000..4c6ca71
--- /dev/null
+++ b/src/Concur/Core/Event.purs
@@ -0,0 +1,80 @@
+module Concur.Core.Event where
+
+import Control.Applicative (pure)
+import Control.Bind (bind, discard, (=<<))
+import Control.Monad (when)
+import Data.Eq ((/=))
+import Data.FoldableWithIndex (traverseWithIndex_)
+import Data.Function (($))
+import Data.Functor (class Functor)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Traversable (sequence_)
+import Data.TraversableWithIndex (traverseWithIndex)
+import Data.Unit (Unit, unit)
+import Effect (Effect)
+import Effect.Ref as Ref
+
+-- TODO: Generalise monad to m
+-- TODO: This is basically ContT, apart from the canceller
+-- Returns a canceller
+newtype Observer a = Observer ((a -> Effect Unit) -> Effect (Effect Unit))
+-- derive instance observeFunctor :: Functor Observer
+instance observeFunctor :: Functor Observer where
+  map f (Observer g) = Observer \cb -> g \a -> cb $ f a
+
+-- Chain an effect onto an observer
+effMap :: forall a b. Observer a -> (a -> Effect b) -> Observer b
+effMap (Observer g) f = Observer \cb -> g \a -> cb =<< f a
+
+-- TODO: Monadic chaining for observer
+-- instance observeApply :: Apply Observer where
+--   -- apply :: forall a b. f (a -> b) -> f a -> f b
+--   apply (Observer f) (Observer a) = Observer \cb -> f \cf' ->
+
+observe :: forall a. Observer a -> (a -> Effect Unit) -> Effect (Effect Unit)
+observe (Observer f) = f
+
+never :: forall a. Observer a
+never = Observer \_ -> pure (pure unit)
+
+dont :: forall a. Pusher a
+dont a = pure unit
+
+-- Push data
+type Pusher a = a -> Effect Unit
+
+
+-----------------------------------------------------------------------
+----------------------- LOOK FOR BUGS HERE ----------------------------
+--- WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ---
+-- BELOW ARE THE ONLY MUTABLE, STATEFUL BITS IN THE ENTIRE FRAMEWORK --
+-----------------------------------------------------------------------
+
+parIndex :: forall a. Array (Observer a) -> Observer ({i::Int, val::a})
+parIndex = par' \i val -> {i, val}
+
+par :: forall a. Array (Observer a) -> Observer a
+par = par' \_ val -> val
+
+par' :: forall a b. (Int -> a -> b) -> Array (Observer a) -> Observer b
+par' g os = Observer \cb -> do
+  ref <- Ref.new []
+  cs <- traverseWithIndex (\i (Observer f) -> f \a -> do
+          cs <- Ref.read ref
+          Ref.write [] ref
+          traverseWithIndex_ (\j -> when (j /= i)) cs
+          cb $ g i a
+    ) os
+  Ref.write cs ref
+  pure do
+    sequence_ cs
+    Ref.write [] ref
+
+mkObserver :: forall a. Effect { push :: Pusher a, subscribe :: Observer a }
+mkObserver = do
+  ref <- Ref.new Nothing
+  let push a = maybe (pure unit) (_ $ a) =<< Ref.read ref
+  let subscribe = Observer \cb -> do
+        Ref.write (Just cb) ref
+        pure do Ref.write Nothing ref
+  pure { push, subscribe}
diff --git a/src/Concur/Core/FRP.purs b/src/Concur/Core/FRP.purs
deleted file mode 100644
index d0a15c3..0000000
--- a/src/Concur/Core/FRP.purs
+++ /dev/null
@@ -1,218 +0,0 @@
-module Concur.Core.FRP where
-
-import Prelude
-
-import Concur.Core.Types (Widget)
-import Control.Alt (class Alt, (<|>))
-import Control.Alternative (class Alternative, class Plus, empty)
-import Control.Cofree (Cofree, mkCofree, tail)
-import Control.Comonad (extract)
-import Data.Either (Either(..), either, hush)
-import Data.Maybe (Maybe(..))
-import Data.Time.Duration (Milliseconds(..))
-import Effect (Effect)
-import Effect.Aff (delay)
-import Effect.Aff.Class (class MonadAff, liftAff)
-import Effect.Class (class MonadEffect, liftEffect)
-
-----------
--- SIGNALS
-----------
--- | Poor man's FRP implementation for Concur.
--- | I am experimenting with the smallest possible amount of FRP which can still be useful.
--- | A Widget can be considered to be a one-shot Event. (There is no stream of events in Concur).
--- | Signals then are never-ending widget loops that allow access to their last return value.
--- | This last produced value allows composition with other widgets even for never-ending widgets.
-type SignalT m a = Cofree m a
-
--- | A Signal specific to Widgets
-type Signal v a = SignalT (Widget v) a
-
--- | Construct a signal from an initial value, and a step widget
-step ::
-  forall m a.
-  a ->
-  m (SignalT m a) ->
-  SignalT m a
-step = mkCofree
-
--- | Display a widget which returns a continuation
-display :: forall m. m (SignalT m Unit) -> SignalT m Unit
-display w = step unit w
-
--- | Fires a widget once then stop. This will reflow when a parent signal reflows
--- | Starts as Nothing. Then switches to `Just returnVal` after the Widget is done
-fireOnce :: forall m a. Monad m => Plus m => m a -> SignalT m (Maybe a)
-fireOnce w = step Nothing do
-  a <- w
-  pure (step (Just a) empty)
-
--- | Similar to `fireOnce`, but discards the return value
-fireOnce_ :: forall m. Monad m => Plus m => m Unit -> SignalT m Unit
-fireOnce_ w = display do w *> empty
-
--- | Wait until we get a `Just` value from a signal
-justWait :: forall m a b.
-            Monad m =>
-            Alternative m =>
-            b -> SignalT m (Maybe a) -> (a -> SignalT m b) -> SignalT m b
-justWait b s f = do
-  m <- s
-  case m of
-    Nothing -> pure b
-    Just a -> f a
-
--- | Run an effectful computation, and do something with the result
-justEffect :: forall m a b. MonadEffect m => Monad m => Alternative m => b -> Effect a -> (a -> SignalT m b) -> SignalT m b
-justEffect b e f = justWait b (fireOnce do liftEffect e) f
-
--- | A constant signal
-always ::
-  forall m a.
-  Monad m =>
-  Alternative m =>
-  a ->
-  SignalT m a
-always = pure
-
--- | Update signal to a new value
-update ::
-  forall m a.
-  SignalT m a ->
-  m (SignalT m a)
-update = tail
-
--- | Construct a signal by polling a signal with a nested widget for values
-poll ::
-  forall m a.
-  Monad m =>
-  SignalT m (m a) ->
-  m (SignalT m a)
-poll b = step <$> extract b <*> (map poll (update b))
-
--- | Create a signal which repeatedly invokes a widget for values.
--- | E.g. `signal False checkbox` will return a signal which reflects the current value of the checkbox.
-hold ::
-  forall m a.
-  Monad m =>
-  a ->
-  m a ->
-  SignalT m a
-hold a w = step a do
-  a' <- w
-  pure (hold a' w)
-
--- | Create a signal which repeatedly invokes a widget function for values, looping in the prev value.
-loopW ::
-  forall m a.
-  Monad m =>
-  a ->
-  (a -> m a) ->
-  SignalT m a
-loopW a f = step a (go <$> f a)
-  where
-  go x = loopW x f
-
--- | Loop a signal so that the return value is passed to the beginning again.
-loopS ::
-  forall m a.
-  Monad m =>
-  a ->
-  (a -> SignalT m a) ->
-  SignalT m a
-loopS a f = step (extract this) do
-  s <- update this
-  pure (loopS (extract s) f)
-  where
-  this = f a
-
--- | Loop a signal so that the return value is passed to the beginning again.
--- loop :: forall m a. Monoid v => (a -> SignalT m (Maybe a)) -> SignalT m a
--- loop f = step (extract this) do
---   s <- update this
---   pure (loopS (extract s) f)
---   where this = f Nothing
--- | Folding signals. Similar to how signals used to work in Elm.
--- | This can be used to implement simple stateful Signals.
--- | e.g. `counter = fold (\n _ -> n+1) 0 clicks`
-foldp ::
-  forall m a b.
-  Functor m =>
-  (a -> b -> a) ->
-  a ->
-  SignalT m b ->
-  SignalT m a
-foldp f a sb = step a' (map (foldp f a') (update sb))
-  where
-  a' = f a (extract sb)
-
--- | Consume a closed signal to make a widget
--- dyn :: forall v. (forall x. SignalT m x) ~> (forall x. m x)
-dyn ::
-  forall m a b.
-  Monad m =>
-  SignalT m a ->
-  m b
-dyn s = update s >>= dyn
-
--- | Run a signal *once* and return its value
-oneShot ::
-  forall m a.
-  Monad m =>
-  SignalT m (Maybe a) ->
-  m a
-oneShot s = case extract s of
-  Nothing -> update s >>= oneShot
-  Just a -> pure a
-
--- Very useful to embed a signal in the middle of a widget
-demand ::
-  forall m a.
-  Monad m =>
-  SignalT m (Maybe a) ->
-  m a
-demand = oneShot
-
-demand' :: forall m a. Monad m => (Maybe a -> SignalT m (Maybe a)) -> m a
-demand' f = oneShot (f Nothing)
-
--- A Common pattern is demand + stateLoopS
-demandLoop ::
-  forall m a s.
-  Monad m =>
-  Alternative m =>
-  s ->
-  (s -> SignalT m (Either s a)) ->
-  m a
-demandLoop def w = demand (stateLoopS def w)
-
--- A generalisation of `loopS` where, you have an inner loop state `s` and a final result `a`
--- The loop continues as long as `Left s` is returned. And ends when `Right a` is returned.
-stateLoopS ::
-  forall m a s.
-  Monad m =>
-  Alternative m =>
-  s ->
-  (s -> SignalT m (Either s a)) ->
-  SignalT m (Maybe a)
-stateLoopS def w = map hush $ loopS (Left def) $ either w (pure <<< Right)
-
-
--- Debounced output from a widget
--- wrapped into a signal
-debounce :: forall m a. Monad m => Alt m => MonadAff m =>
-            Number -> a -> (a -> m a) -> SignalT m a
-debounce timeoutMs ainit winit = go ainit winit
-  where
-    go a w = step a do
-      -- Wait until we have a user input
-      -- before starting the timer
-      a' <- w a
-      go' a' w
-    go' a w = do
-      res <- (Just <$> w a) <|> (Nothing <$ liftAff (delay (Milliseconds timeoutMs)))
-      case res of
-        -- Timeout fired
-        Nothing -> pure (go a w)
-        -- Events fired, but we are still in timeout
-        Just a' -> go' a' w
diff --git a/src/Concur/Core/Gen.purs b/src/Concur/Core/Gen.purs
deleted file mode 100644
index 8137e2b..0000000
--- a/src/Concur/Core/Gen.purs
+++ /dev/null
@@ -1,169 +0,0 @@
-module Concur.Core.Gen where
-
-import Prelude
-
-import Concur.Core.Types (Widget)
-import Control.Alt ((<|>))
-import Control.Monad.Free (Free, hoistFree, liftF, resume, wrap)
-import Data.Array (foldr, snoc)
-import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
-import Data.Tuple (Tuple(..))
-
--- Internal data types
-newtype GenStep v x a
-  = GenStep (GenWidget v x a)
-
-type GenWidget v x a
-  = Widget v {yield :: Maybe x, cont :: a}
-
-instance functorGenStep :: Functor (GenStep v x) where
-  map f (GenStep w) = GenStep (mapContGenWidget f w)
-
--- | A Gen is a widget that also generates things
-type Gen v x a
-  = Free (GenStep v x) a
-
--- | Sometimes it's useful to have Generators that generate Widgets
-type WidgetGen v b a
-  = Gen v (Widget v b) a
-
--- | Yield a value
-yield ::
-  forall v x.
-  x ->
-  Gen v x Unit
-yield = liftF <<< pureYield
-
--- | Run a Widget
-runWidget ::
-  forall v x a.
-  Widget v a ->
-  Gen v x a
-runWidget = liftF <<< widgetYield Nothing
-
--- | Yield a value, and then continue
-yieldAndThen ::
-  forall v x a.
-  x ->
-  Widget v (Gen v x a) ->
-  Gen v x a
-yieldAndThen x = wrap <<< widgetYield (Just x)
-
--- | A map over yielded values (of type X)
--- | The usual map is over the return value
-mapYield ::
-  forall v x y a.
-  (x -> y) ->
-  Gen v x a ->
-  Gen v y a
-mapYield f = hoistFree (\(GenStep w) ->
-  GenStep (mapYieldGenWidget f w))
-
--- | Convert a generator into one that tags its output with successive unique integers
-zipYield ::
-  forall v x a.
-  Gen v x a ->
-  Gen v (Tuple Int x) a
-zipYield = go 0
-  where
-  go n g = case resume g of
-    Right b -> pure b
-    Left (GenStep gw) -> do
-      r <- runWidget gw
-      case r.yield of
-        Nothing -> go n r.cont
-        Just x -> yieldAndThen (Tuple n x) $ pure $ go (n + 1) r.cont
-
--- | Convert a monadic generator into one that tags its output with successive unique integers
--- | Can also be specialised to :: WidgetGen v x a -> WidgetGen v (Tuple Int x) a
-zipWidgetYield ::
-  forall a v m x.
-  Functor m =>
-  Gen v (m x) a ->
-  Gen v (m (Tuple Int x)) a
-zipWidgetYield g = mapYield (\(Tuple x w) ->
-  Tuple x <$> w) $ zipYield g
-
--- TODO: A Widget when generated and injected into a container by a generator,
---       should have some mechanism to dictate its position.
--- TODO: Actually, we need a monad independent layout format.
---       An idea is - view = mapping from { selector -> Widget },
---         where type of selector depends on type of view.
--- | Collapse a Generator into one widget. For containers with dynamic children.
--- | Any new widgets generated are immediately inserted into the parent widget
--- | Returns either (Left b) when Gen ends, or Right a, when one of the children end.
-genOrr ::
-  forall v a b.
-  Monoid v =>
-  WidgetGen v a b ->
-  Widget v (Either b a)
-genOrr wg = case resume wg of
-  Right b -> pure (Left b)
-  Left (GenStep gw) -> do
-    r <- gw
-    case r.yield of
-      Nothing -> genOrr r.cont
-      Just x -> genOrr r.cont <|> (Right <$> x)
-
--- | Like `genOrr`, collapses a Generator into one widget.
--- | However, any values returned by the children are tagged with an id (unique to this generator)
--- | Any new widgets generated are immediately inserted into the parent widget
--- | Returns either (Left b) when Gen ends, or (Tuple Int a), when one of the children end.
-zipGenOrr ::
-  forall v a b.
-  Monoid v =>
-  WidgetGen v a b ->
-  Widget v (Either b (Tuple Int a))
-zipGenOrr = genOrr <<< zipWidgetYield
-
--- | Array to Generator conversion
--- | Sequentially generates all values in the list
-listToGen ::
-  forall v x.
-  Array x ->
-  Gen v x Unit
-listToGen = foldr (bthen <<< yield) (pure unit)
-  where
-  bthen m1 m2 = m1 >>= \_ ->
-    m2
-
--- | Generator to Array conversion. Runs until generator ends, then returns all generated values in an array.
--- | Use it when you want to generate values, and then operate on them in one go
-genToList ::
-  forall v x a.
-  Gen v x a ->
-  Widget v (Array x)
-genToList g = case resume g of
-  Right _ -> pure []
-  Left (GenStep gw) -> do
-    r <- gw
-    rs <- genToList r.cont
-    pure case r.yield of
-      Nothing -> rs
-      Just x -> snoc rs x
-
--- Util
-mapYieldGenWidget ::
-  forall v x y a.
-  (x -> y) ->
-  GenWidget v x a ->
-  GenWidget v y a
-mapYieldGenWidget f = map (\r ->
-  r { yield = map f r.yield })
-
-mapContGenWidget ::
-  forall v x a b.
-  (a -> b) ->
-  GenWidget v x a ->
-  GenWidget v x b
-mapContGenWidget f = map (\r ->
-  r { cont = f r.cont })
-
-pureYield :: forall v x. x -> GenStep v x Unit
-pureYield x = GenStep (pure { yield: Just x, cont: unit })
-
-widgetYield :: forall v x a. Maybe x -> Widget v a -> GenStep v x a
-widgetYield mx w = GenStep do
-  a <- w
-  pure { yield: mx, cont: a }
diff --git a/src/Concur/Core/HostConfig.purs b/src/Concur/Core/HostConfig.purs
new file mode 100644
index 0000000..5d68ec4
--- /dev/null
+++ b/src/Concur/Core/HostConfig.purs
@@ -0,0 +1,22 @@
+module Concur.Core.HostConfig where
+
+import Data.Unit (Unit)
+
+data Props
+
+data ClassInst a
+data FragInst a
+data TextInst a
+
+{-
+class ConcurHost m i f t where
+  createInstance :: String -> Props -> i
+  createDocumentFragment :: f
+  createTextNode :: String -> t
+  createNumberNode :: Number -> t
+  insertBefore :: i -> i -> i -> m Unit
+  appendChild :: i -> Array i -> m Unit
+  removeSelf :: i -> m Unit
+  removeAllChild :: i -> m Unit
+  updateProps :: i -> Props -> Props -> m Unit
+-}
diff --git a/src/Concur/Core/Patterns.purs b/src/Concur/Core/Patterns.purs
index 903fc3f..d8697a2 100644
--- a/src/Concur/Core/Patterns.purs
+++ b/src/Concur/Core/Patterns.purs
@@ -1,17 +1,7 @@
 module Concur.Core.Patterns where
 
 import Prelude
-
-import Control.Alt (class Alt)
-import Control.Plus (class Plus, empty, (<|>))
-import Data.Either (Either(..), either)
-import Data.Lens (Lens')
-import Data.Lens as L
-import Data.Tuple (Tuple(..))
-import Effect.AVar as EVar
-import Effect.Aff.AVar as AVar
-import Effect.Aff.Class (class MonadAff, liftAff)
-import Effect.Class (class MonadEffect, liftEffect)
+import Data.Either (Either(..))
 
 -- | A very useful combinator for widgets with localised state
 loopState ::
@@ -44,59 +34,9 @@ tea s render update = go s
   where
   go st = render st >>= (flip update st >>> go)
 
--- | Separate the effect of the widget from its result
-remoteWidget ::
-  forall m n a void.
-  MonadEffect n =>
-  MonadAff m =>
-  MonadEffect m =>
-  Plus m =>
-  m a ->
-  n (Tuple (m a) (m void))
-remoteWidget axn = do
-  var <- liftEffect $ EVar.empty
-  pure $ Tuple (liftAff (AVar.take var)) do
-    f <- axn
-    _ <- liftEffect $ EVar.tryPut f var
-    empty
-
--- | A common pattern - running a long running action and keeping the GUI responsive
--- | Because the action can't be restarted on every gui event, we must *fork* it off in the beginning
-forkAction ::
-  forall m a b.
-  MonadEffect m =>
-  MonadAff m =>
-  Plus m =>
-  m a ->
-  (m a -> m b) ->
-  m b
-forkAction axn rest = do
-  Tuple axn' background <- remoteWidget axn
-  background <|> rest axn'
-
--- | Another common variant on the `forkAction` pattern.
--- |   The action `m (s->s)` may take a while (should not be restarted) and returns a state modification function
--- |   The gui `s -> m s` takes in the current state, and modifies it on events
--- | Note that `forkActionState axn` has the shape `(s -> m s) -> (s -> m s)`. So it can be "stacked" to fork multiple actions.
--- | e.g. `forkActionState axn1 $ forkActionState axn2 $ forkActionState axn3 $ render initialState`.
-forkActionState ::
-  forall m s.
-  Plus m =>
-  MonadAff m =>
-  m (s -> s) ->
-  (s -> m s) ->
-  (s -> m s)
-forkActionState axn render st = forkAction axn (go st)
-  where
-  go st' axn' = do
-    e <- (Left <$> render st') <|> (Right <$> axn')
-    case e of
-      Left st'' -> go st'' axn'
-      Right f -> render (f st')
-
-
 -- WORKING WITH LOCAL ENVIRONMENTS
 
+{-
 -- | A wire can send values up into a local environment
 type Wire m a = { value :: a, send :: a -> m Void, receive :: m a }
 
@@ -121,3 +61,4 @@ local a f = do
   go wire = do
     res <- (Left <$> f wire) <|> (Right <$> wire.receive)
     either pure (go <<< updateWire wire) res
+-}
diff --git a/src/Concur/Core/Types.purs b/src/Concur/Core/Types.purs
index 814552b..f5666a7 100644
--- a/src/Concur/Core/Types.purs
+++ b/src/Concur/Core/Types.purs
@@ -3,152 +3,148 @@ module Concur.Core.Types where
 import Prelude
 
 import Control.Alternative (class Alternative)
-import Control.Monad.Free (Free, hoistFree, liftF, resume, wrap)
-import Control.Monad.Rec.Class (class MonadRec)
+import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) as Rec
 import Control.MultiAlternative (class MultiAlternative, orr)
-import Control.Parallel.Class (parallel, sequential)
 import Control.Plus (class Alt, class Plus, alt, empty)
 import Control.ShiftMap (class ShiftMap)
+import Data.Array (fold)
 import Data.Array as A
-import Data.Array.NonEmpty (NonEmptyArray)
-import Data.Array.NonEmpty as NEA
-import Data.Either (Either(..))
-import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex)
-import Data.Maybe (Maybe(Nothing, Just), fromMaybe)
-import Data.Semigroup.Foldable (foldMap1)
+import Data.FoldableWithIndex (foldrWithIndex)
+import Data.Maybe (Maybe(Just, Nothing), fromMaybe)
+import Data.Traversable (sequence)
+import Data.TraversableWithIndex (traverseWithIndex)
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
-import Effect.AVar (empty, tryPut, tryTake) as EVar
-import Effect.Aff (Aff, effectCanceler, makeAff, never, runAff_)
-import Effect.Aff.AVar (take) as AVar
-import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect)
-import Effect.Console (log)
-import Effect.Exception (Error)
+import Effect.Ref as Ref
+import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1)
+import Unsafe.Coerce (unsafeCoerce)
+
+data Change a
+class Patch a d where
+  patch :: a -> d -> a
+fromChange :: forall a d. Patch a d => Change a -> d
+fromChange = unsafeCoerce
+toChange :: forall a d. Patch a d => d -> Change a
+toChange = unsafeCoerce
+
+data Step v a
+  = View v
+  | Finish a
+  | Change (Change v)
+
+instance functorStep :: Functor (Step v) where
+  map f (View v) = View v
+  map f (Finish a) = Finish (f a)
+  map f (Change d) = Change d
+
+-- FAQ: What's stopping the widget from calling the handler again after having returned a value (Right a)?
+-- Ans: Discipline.
+type WithHandler v a = (EffectFn1 (Step v a) Unit) -> Effect (Maybe v)
+
+mapViewWithHandler :: forall v1 v2 a. (v1 -> v2) -> WithHandler v1 a -> WithHandler v2 a
+mapViewWithHandler f w1 = \cb -> do
+  v <- w1 $ mkEffectFn1 \eval -> case eval of
+    Change d -> pure unit
+    View v -> runEffectFn1 cb (View (f v))
+    Finish a -> runEffectFn1 cb (Finish a)
+  pure $ f <$> v
+
+-- A Widget is an initial view, followed by a series of async views
+newtype Widget v a = Widget (WithHandler v a)
+
+unWidget :: forall v a. Widget v a -> WithHandler v a
+unWidget (Widget f) = f
+
+unWidgetArray :: forall v a. Array (Widget v a) -> Array (WithHandler v a)
+unWidgetArray arr = unsafeCoerce arr
+
+mkWidgetArray :: forall v a. Array (WithHandler v a) -> Array (Widget v a)
+mkWidgetArray arr = unsafeCoerce arr
+
+instance functorWidget :: Functor (Widget v) where
+  map f (Widget g) = Widget \cb -> g $ mkEffectFn1 \val -> runEffectFn1 cb $ map f val
+
+instance widgetBind :: Bind (Widget v) where
+  bind (Widget f) h = Widget \cb ->
+    f $ mkEffectFn1 $ case _ of
+          View v -> runEffectFn1 cb (View v)
+          Change d -> pure unit
+          Finish a -> do
+            mv <- unWidget (h a) cb
+            case mv of
+              Nothing -> pure unit
+              Just v -> runEffectFn1 cb (View v)
+
+instance widgetApplicative :: Applicative (Widget v) where
+  pure a = Widget \cb -> runEffectFn1 cb (Finish a) *> pure Nothing
+
+instance widgetApply :: Apply (Widget v) where
+  apply x y = do
+    a <- x
+    b <- y
+    pure (a b)
 
-type WidgetStepRecord v a
-  = {view :: v, cont :: Aff a}
-
-data WidgetStep v a
-  = WidgetStepEff (Effect a)
-  | WidgetStepView (WidgetStepRecord v a)
-
--- unWidgetStep ::
---   forall v a.
---   WidgetStep v a ->
---   Either (Effect a) (WidgetStepRecord v a)
--- unWidgetStep (WidgetStep x) = x
-
--- derive instance widgetStepFunctor :: Functor (WidgetStep v)
-instance functorWidgetStep :: Functor (WidgetStep v) where
-  map f (WidgetStepEff e) = WidgetStepEff (map f e)
-  map f (WidgetStepView w) = WidgetStepView (w { cont = map f w.cont })
-
-displayStep :: forall a v. v -> WidgetStep v a
-displayStep v = WidgetStepView { view: v, cont: never }
-
-newtype Widget v a
-  = Widget (Free (WidgetStep v) a)
-
-unWidget :: forall v a. Widget v a -> Free (WidgetStep v) a
-unWidget (Widget w) = w
+instance widgetMonad :: Monad (Widget v)
 
-derive newtype instance widgetFunctor :: Functor (Widget v)
+-- Passthrough instance of monadrec.
+-- The Widget monad is already stack safe since it depends on callbacks
+instance widgetMonadRec :: Rec.MonadRec (Widget v) where
+  tailRecM f a = go =<< f a
+    where
+      go (Rec.Loop a') = Rec.tailRecM f a'
+      go (Rec.Done b) = pure b
 
-derive newtype instance widgetBind :: Bind (Widget v)
+instance widgetShiftMap :: ShiftMap (Widget v) (Widget v) where
+  shiftMap f = f identity
 
-derive newtype instance widgetApplicative :: Applicative (Widget v)
+instance widgetMultiAlternative :: (Monoid v) => MultiAlternative (Widget v) where
+  orr wss = Widget \cb -> do
+    -- Oh the mutation!
+    doneRef <- Ref.new false
+    viewsRef <- Ref.new [Nothing]
+    let
+      -- mkCb :: Int -> Either v a -> Effect Unit
+      mkCb i = mkEffectFn1 \eval -> case eval of
+        Finish a -> do
+          isDone <- Ref.read doneRef
+          when (not isDone) do
+            Ref.write true doneRef
+            runEffectFn1 cb (Finish a)
+        Change d -> do
+          pure unit
+        View v -> do
+          isDone <- Ref.read doneRef
+          when (not isDone) do
+            vs <- Ref.read viewsRef
+            let mvs' = A.updateAt i (Just v) vs
+            case mvs' of
+              Nothing -> pure unit
+              Just vs' -> do
+                Ref.write vs' viewsRef
+                case sequence vs of
+                  Nothing -> pure unit
+                  Just arr -> runEffectFn1 cb $ View $ fold arr
+    vs <- traverseWithIndex (\i f -> f (mkCb i)) (unWidgetArray wss)
+    Ref.write vs viewsRef
+    case sequence vs of
+      Nothing -> pure Nothing
+      Just arr -> pure $ Just $ fold arr
 
-derive newtype instance widgetApply :: Apply (Widget v)
 
-instance widgetMonad :: Monad (Widget v)
+instance widgetSemigroup :: (Monoid v) => Semigroup (Widget v a) where
+  append w1 w2 = orr [w1, w2]
 
-derive newtype instance widgetMonadRec :: MonadRec (Widget v)
+instance widgetMonoid :: (Monoid v) => Monoid (Widget v a) where
+  mempty = empty
 
-instance widgetShiftMap :: ShiftMap (Widget v) (Widget v) where
-  shiftMap f = f identity
+instance widgetAlt :: (Monoid v) => Alt (Widget v) where
+  alt = append
 
--- Util
-flipEither ::
-  forall a b.
-  Either a b ->
-  Either b a
-flipEither (Left a) = Right a
-flipEither (Right b) = Left b
-
-instance widgetMultiAlternative ::
-  ( Monoid v
-  ) =>
-  MultiAlternative (Widget v) where
-  orr wss = case NEA.fromArray wss of
-    Just wsne -> Widget $ combine $ map unWidget wsne
-    Nothing -> empty
-    where
-    combine ::
-      forall v' a.
-      Monoid v' =>
-      NonEmptyArray (Free (WidgetStep v') a) ->
-      Free (WidgetStep v') a
-    combine wfs =
-      let x = NEA.uncons wfs
-      in case resume x.head of
-        Right a -> pure a
-        Left (WidgetStepEff eff) -> wrap $ WidgetStepEff do
-            w <- eff
-            pure $ combine $ NEA.cons' w x.tail
-        Left (WidgetStepView wsr) -> combineInner (NEA.singleton wsr) x.tail
-
-    combineInner ::
-      forall v' a.
-      Monoid v' =>
-      NonEmptyArray (WidgetStepRecord v' (Free (WidgetStep v') a)) ->
-      Array (Free (WidgetStep v') a) ->
-      Free (WidgetStep v') a
-    combineInner ws freeArr = case NEA.fromArray freeArr of
-      -- We have collected all the inner views/conts
-      Nothing -> combineViewsConts ws --wrap $ WidgetStep $ Right wsr
-      Just freeNarr -> combineInner1 ws freeNarr
-
-    combineViewsConts ::
-      forall v' a.
-      Monoid v' =>
-      NonEmptyArray (WidgetStepRecord v' (Free (WidgetStep v') a)) ->
-      Free (WidgetStep v') a
-    combineViewsConts ws = wrap $ WidgetStepView
-      { view: foldMap1 _.view ws
-      , cont: merge ws (map _.cont ws)
-      }
-
-    combineInner1 ::
-      forall v' a.
-      Monoid v' =>
-      NonEmptyArray (WidgetStepRecord v' (Free (WidgetStep v') a)) ->
-      NonEmptyArray (Free (WidgetStep v') a) ->
-      Free (WidgetStep v') a
-    combineInner1 ws freeNarr =
-      let x = NEA.uncons freeNarr
-      in case resume x.head of
-        Right a -> pure a
-        Left (WidgetStepEff eff) -> wrap $ WidgetStepEff do
-            w <- eff
-            pure $ combineInner1 ws $ NEA.cons' w x.tail
-        Left (WidgetStepView wsr) -> combineInner (NEA.snoc ws wsr) x.tail
-
-    merge ::
-      forall v' a.
-      Monoid v' =>
-      NonEmptyArray (WidgetStepRecord v' (Free (WidgetStep v') a)) ->
-      NonEmptyArray (Aff (Free (WidgetStep v') a)) ->
-      Aff (Free (WidgetStep v') a)
-    merge ws wscs = do
-      let wsm = map (wrap <<< WidgetStepView) ws
-      -- TODO: We know the array is non-empty. We need something like foldl1WithIndex.
-      Tuple i e <- sequential (foldlWithIndex (\i r w ->
-        alt (parallel (map (Tuple i) w)) r) empty wscs)
-      -- TODO: All the Aff in ws is already discharged. Use a more efficient way than combine to process it
-      -- TODO: Also, more importantly, we would like to not have to cancel running fibers unless one of them returns a result
-      pure $ combine (fromMaybe wsm (NEA.updateAt i e wsm))
+instance widgetPlus :: (Monoid v) => Plus (Widget v) where
+  empty = Widget \cb -> pure Nothing
 
+instance widgetAlternative :: (Monoid v) => Alternative (Widget v)
 
 -- | Run multiple widgets in parallel until *all* finish, and collect their outputs
 -- | Contrast with `orr`
@@ -167,79 +163,47 @@ andd ws = do
       rest <- andd ws'
       pure $ fromMaybe [] $ A.insertAt i e rest
 
-instance widgetSemigroup :: (Monoid v) => Semigroup (Widget v a) where
-  append w1 w2 = orr [w1, w2]
-
-instance widgetMonoid :: (Monoid v) => Monoid (Widget v a) where
-  mempty = empty
-
-instance widgetAlt :: (Monoid v) => Alt (Widget v) where
-  alt = append
-
-instance widgetPlus :: (Monoid v) => Plus (Widget v) where
-  empty = display mempty
-
-instance widgetAlternative :: (Monoid v) => Alternative (Widget v)
-
--- Pause for a negligible amount of time. Forces continuations to pass through the trampoline.
--- (Somewhat similar to calling `setTimeout` of zero in Javascript)
--- Avoids stack overflows in (pathological) cases where a widget calls itself repeatedly without any intervening widgets or effects.
--- E.g. -
---   BAD  `counter n = if n < 10000 then counter (n+1) else pure n`
---   GOOD `counter n = if n < 10000 then (do pulse; counter (n+1)) else pure n`
-pulse ::
-  forall v.
-  Monoid v =>
-  Widget v Unit
-pulse = effAction (pure unit)
 
 mapView :: forall a v1 v2. (v1 -> v2) -> Widget v1 a -> Widget v2 a
-mapView f (Widget w) = Widget (hoistFree (mapViewStep f) w)
+mapView f (Widget w) = Widget (mapViewWithHandler f w)
 
-mapViewStep :: forall v1 v2 a. (v1 -> v2) -> WidgetStep v1 a -> WidgetStep v2 a
-mapViewStep f (WidgetStepEff e) = WidgetStepEff e
-mapViewStep f (WidgetStepView ws) = WidgetStepView ( ws { view = f ws.view })
-
-display :: forall a v. v -> Widget v a
-display v = Widget (liftF (displayStep v))
+display :: forall v a. v -> Widget v a
+display v = Widget \cb -> pure (Just v)
 
 -- Sync eff
 effAction ::
   forall a v.
   Effect a ->
   Widget v a
-effAction = Widget <<< liftF <<< WidgetStepEff
+effAction eff = Widget \cb -> do
+  a <- eff
+  runEffectFn1 cb (Finish a)
+  pure Nothing
 
 -- Async aff
 affAction ::
   forall a v.
-  v ->
-  Aff a ->
+  WithHandler v a ->
   Widget v a
-affAction v aff = Widget $ wrap $ WidgetStepEff do
-  var <- EVar.empty
-  runAff_ (handler var) aff
-  -- Detect synchronous resolution
-  ma <- EVar.tryTake var
-  pure case ma of
-    Just a -> pure a
-    Nothing -> liftF $ WidgetStepView { view: v, cont: AVar.take var }
-  where
-  -- TODO: allow client code to handle aff failures
-  handler _ (Left e) = log ("Aff failed - " <> show e)
-  handler var (Right a) = void (EVar.tryPut a var)
+affAction = Widget
 
 -- Async callback
-asyncAction ::
-  forall v a.
-  v ->
-  ((Either Error a -> Effect Unit) -> Effect (Effect Unit)) ->
-  Widget v a
-asyncAction v handler = affAction v (makeAff (map effectCanceler <<< handler))
+-- asyncAction
+--   :: forall v a
+--   .  ((a -> Effect Unit) -> Effect (Effect Unit))
+--   -> Widget v a
+-- asyncAction handler = affAction (Observer handler)
 
 instance widgetMonadEff :: (Monoid v) => MonadEffect (Widget v) where
   liftEffect = effAction
 
-instance widgetMonadAff :: (Monoid v) => MonadAff (Widget v) where
-  liftAff = affAction mempty
+-- instance widgetMonadObserver :: (Monoid v) => MonadObserver (Widget v) where
+--   liftObserver = affAction mempty
     -- Widget $ liftF $ WidgetStep $ Right { view: mempty, cont: aff }
+
+mkNodeWidget :: forall v1 v2 a. ((a -> Effect Unit) -> v1 -> v2) -> Widget v1 a -> Widget v2 a
+mkNodeWidget h (Widget f) = Widget \cb ->
+  mapViewWithHandler (h \a -> runEffectFn1 cb (Finish a)) f cb
+
+mkLeafWidget :: forall v a. ((a -> Effect Unit) -> v) -> Widget v a
+mkLeafWidget h = Widget \cb -> pure $ Just $ h \a -> runEffectFn1 cb (Finish a)
diff --git a/src/Concur/Core/delme.purs.bak b/src/Concur/Core/delme.purs.bak
new file mode 100644
index 0000000..9506fc9
--- /dev/null
+++ b/src/Concur/Core/delme.purs.bak
@@ -0,0 +1,227 @@
+module Concur.Core.Types where
+
+import Prelude
+
+import Concur.Core.Event (Observer(..), parIndex)
+import Control.Alternative (class Alternative)
+import Control.Monad.Free (Free, hoistFree, liftF, resume, wrap)
+import Control.Monad.Rec.Class (class MonadRec)
+import Control.MultiAlternative (class MultiAlternative, orr)
+import Control.Plus (class Alt, class Plus, alt, empty)
+import Control.ShiftMap (class ShiftMap)
+import Data.Array as A
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Array.NonEmpty as NEA
+import Data.Either (Either(..))
+import Data.FoldableWithIndex (foldrWithIndex)
+import Data.Maybe (Maybe(Nothing, Just), fromMaybe)
+import Data.Tuple (Tuple(..))
+import Effect (Effect)
+import Effect.Class (class MonadEffect)
+
+data WidgetStep v a
+  = WidgetStepSync (Effect a)
+  | WidgetStepAsync (Observer a)
+  | WidgetStepView ((a -> Effect Unit) -> v)
+  | WidgetStepHalt
+
+-- derive instance widgetStepFunctor :: Functor (WidgetStep v)
+instance functorWidgetStep :: Functor (WidgetStep v) where
+  map f (WidgetStepSync e) = WidgetStepSync (map f e)
+  map f (WidgetStepView g) = WidgetStepView \h -> g (h <<< f)
+  map f (WidgetStepAsync o) = WidgetStepAsync (map f o)
+  map _ WidgetStepHalt = WidgetStepHalt
+
+newtype Widget v a
+  = Widget (Free (WidgetStep v) a)
+
+unWidget :: forall v a. Widget v a -> Free (WidgetStep v) a
+unWidget (Widget w) = w
+
+derive newtype instance widgetFunctor :: Functor (Widget v)
+
+derive newtype instance widgetBind :: Bind (Widget v)
+
+derive newtype instance widgetApplicative :: Applicative (Widget v)
+
+derive newtype instance widgetApply :: Apply (Widget v)
+
+instance widgetMonad :: Monad (Widget v)
+
+derive newtype instance widgetMonadRec :: MonadRec (Widget v)
+
+instance widgetShiftMap :: ShiftMap (Widget v) (Widget v) where
+  shiftMap f = f identity
+
+instance widgetMultiAlternative ::
+  ( Monoid v
+  ) =>
+  MultiAlternative (Widget v) where
+  orr wss = case NEA.fromArray wss of
+    Just wsne -> Widget $ combine wsne
+    Nothing -> empty
+    where
+
+    combine ::
+      forall v' a.
+      Monoid v' =>
+      NonEmptyArray (Widget v' a) ->
+      Free (WidgetStep v') a
+    combine wfs =
+      let x = NEA.uncons wfs
+      in case resume (unWidget x.head) of
+        Right a -> pure a
+        -- TODO: This wrap probably cannot be wished away
+        Left xx -> case xx of
+          WidgetStepSync eff -> wrap $ WidgetStepSync do
+            w <- eff
+            pure $ combine $ NEA.cons' (Widget w) x.tail
+
+          WidgetStepView f -> wrap $ WidgetStepView \h -> combine $ NEA.cons' (Widget w) x.tail
+          WidgetStepAsync o -> combineInnerAsync (NEA.singleton o) x.tail
+          WidgetStepHalt -> unWidget (orr x.tail)
+
+    -- combineInnerAsyncViews ::
+    --   forall v' a.
+    --   Monoid v' =>
+    --   NonEmptyArray (Observer (Free (WidgetStep v') a)) ->
+    --   Array (Widget v' a) ->
+    --   Free (WidgetStep v') a
+
+    combineInnerAsync ::
+      forall v' a.
+      Monoid v' =>
+      NonEmptyArray (Observer (Free (WidgetStep v') a)) ->
+      Array (Widget v' a) ->
+      Free (WidgetStep v') a
+    combineInnerAsync ws freeArr = case NEA.fromArray freeArr of
+      -- We have collected all the inner conts
+      Nothing -> combineAsyncs ws --wrap $ WidgetStep $ Right wsr
+      Just freeNarr -> combineInnerAsync1 ws freeNarr
+
+    combineInnerAsync1 ::
+      forall v' a.
+      Monoid v' =>
+      NonEmptyArray (Observer (Free (WidgetStep v') a)) ->
+      NonEmptyArray (Widget v' a) ->
+      Free (WidgetStep v') a
+    combineInnerAsync1 ws freeNarr =
+      let x = NEA.uncons freeNarr
+      in case resume (unWidget x.head) of
+        Right a -> pure a
+        Left (WidgetStepSync eff) -> wrap $ WidgetStepSync do
+            w <- eff
+            pure $ combineInnerAsync1 ws $ NEA.cons' (Widget w) x.tail
+        Left (WidgetStepView v w) -> wrap $ WidgetStepView v $ combineInnerAsync1 ws (NEA.cons' (Widget w) x.tail)
+        Left (WidgetStepAsync c) -> combineInnerAsync (NEA.snoc ws c) x.tail
+        Left WidgetStepHalt -> combineInnerAsync ws x.tail
+
+    combineAsyncs ::
+      forall v' a.
+      Monoid v' =>
+      NonEmptyArray (Observer (Free (WidgetStep v') a)) ->
+      Free (WidgetStep v') a
+    combineAsyncs ws = wrap $ WidgetStepAsync $ merge ws
+
+    merge ::
+      forall v' a.
+      Monoid v' =>
+      NonEmptyArray (Observer (Free (WidgetStep v') a)) ->
+      Observer (Free (WidgetStep v') a)
+    merge ws = map func obs
+      where
+      wsm = map (Widget <<< wrap <<< WidgetStepAsync) ws
+
+      -- TODO: We know the array is non-empty. We need something like foldl1WithIndex.
+      -- TODO: All the Observer in ws is already discharged. Use a more efficient way than combine to process it
+      -- TODO: Also, more importantly, we would like to not have to cancel running fibers unless one of them returns a result
+      -- MAP OVER OBSERVER. SEE IF WE CAN OPTIMISE THIS (COYONEDA).
+      obs = parIndex (NEA.toArray ws)
+      func {i, val:e} = combine (fromMaybe wsm (NEA.updateAt i (Widget e) wsm))
+
+
+-- | Run multiple widgets in parallel until *all* finish, and collect their outputs
+-- | Contrast with `orr`
+-- TODO: Performance? Don't orr with `empty`.
+andd ::
+  forall v a.
+  Monoid v =>
+  Array (Widget v a) ->
+  Widget v (Array a)
+andd ws = do
+  Tuple i e <- foldrWithIndex (\i w r -> alt (map (Tuple i) w) r) empty ws
+  let ws' = fromMaybe ws $ A.deleteAt i ws
+  if A.length ws' <= 0
+    then pure [e]
+    else do
+      rest <- andd ws'
+      pure $ fromMaybe [] $ A.insertAt i e rest
+
+instance widgetSemigroup :: (Monoid v) => Semigroup (Widget v a) where
+  append w1 w2 = orr [w1, w2]
+
+instance widgetMonoid :: (Monoid v) => Monoid (Widget v a) where
+  mempty = empty
+
+instance widgetAlt :: (Monoid v) => Alt (Widget v) where
+  alt = append
+
+instance widgetPlus :: (Monoid v) => Plus (Widget v) where
+  empty = display mempty
+
+instance widgetAlternative :: (Monoid v) => Alternative (Widget v)
+
+-- Pause for a negligible amount of time. Forces continuations to pass through the trampoline.
+-- (Somewhat similar to calling `setTimeout` of zero in Javascript)
+-- Avoids stack overflows in (pathological) cases where a widget calls itself repeatedly without any intervening widgets or effects.
+-- E.g. -
+--   BAD  `counter n = if n < 10000 then counter (n+1) else pure n`
+--   GOOD `counter n = if n < 10000 then (do pulse; counter (n+1)) else pure n`
+pulse ::
+  forall v.
+  Monoid v =>
+  Widget v Unit
+pulse = effAction (pure unit)
+
+mapView :: forall a v. (v -> v) -> Widget v a -> Widget v a
+mapView f (Widget w) = Widget (hoistFree (mapViewStep f) w)
+
+mapViewStep :: forall v a. (v -> v) -> WidgetStep v a -> WidgetStep v a
+mapViewStep f (WidgetStepSync e) = WidgetStepSync e
+mapViewStep f (WidgetStepAsync c) = WidgetStepAsync c
+mapViewStep f (WidgetStepView v a) = WidgetStepView (f v) a
+mapViewStep f WidgetStepHalt = WidgetStepHalt
+
+halt :: forall v a. Widget v a
+halt = Widget $ liftF WidgetStepHalt
+
+display :: forall v a. v -> Widget v a
+display v = Widget $ wrap $ WidgetStepView v $ unWidget halt
+
+-- Sync eff
+effAction ::
+  forall a v.
+  Effect a ->
+  Widget v a
+effAction = Widget <<< liftF <<< WidgetStepSync
+
+-- Async aff
+affAction ::
+  forall a v.
+  Observer a ->
+  Widget v a
+affAction = Widget <<< liftF <<< WidgetStepAsync
+
+-- Async callback
+asyncAction
+  :: forall v a
+  .  ((a -> Effect Unit) -> Effect (Effect Unit))
+  -> Widget v a
+asyncAction handler = affAction (Observer handler)
+
+instance widgetMonadEff :: (Monoid v) => MonadEffect (Widget v) where
+  liftEffect = effAction
+
+-- instance widgetMonadObserver :: (Monoid v) => MonadObserver (Widget v) where
+--   liftObserver = affAction mempty
+    -- Widget $ liftF $ WidgetStep $ Right { view: mempty, cont: aff }
diff --git a/src/Control/Cofree.purs b/src/Control/Cofree.purs
deleted file mode 100644
index e70414b..0000000
--- a/src/Control/Cofree.purs
+++ /dev/null
@@ -1,258 +0,0 @@
--- | AJ: This is the same as `Control.Comonad.Cofree` from the `purescript-free` package.
--- | However, we need to override the applicative and monad instance, and "probably" due to a Purescript bug it's not working.
--- | The _cofree comonad_ for a `Functor`.
--- | This version also adds `lazyCofree`, `lazyHead`, `lazyTail`, and `mfix`
-module Control.Cofree
-  ( Cofree
-  , (:<)
-  , buildCofree
-  , lazyCofree
-  , deferCofree
-  , explore
-  , exploreM
-  , head
-  , lazyHead
-  , hoistCofree
-  , mkCofree
-  , tail
-  , lazyTail
-  , mfix
-  , unfoldCofree
-  ) where
-
-import Prelude
-
-import Concur.Core.Types (Widget)
-import Control.Alternative (class Alternative, (<|>), empty)
-import Control.Comonad (class Comonad, extract)
-import Control.Extend (class Extend)
-import Control.Lazy as Z
-import Control.Monad.Free (Free, runFreeM)
-import Control.Monad.Rec.Class (class MonadRec)
-import Control.Monad.State (State, StateT(..), runState, runStateT, state)
-import Control.ShiftMap (class ShiftMap)
-import Data.Eq (class Eq1, eq1)
-import Data.Foldable (class Foldable, foldr, foldl, foldMap)
-import Data.Lazy (Lazy, defer, force)
-import Data.Ord (class Ord1, compare1)
-import Data.Traversable (class Traversable, traverse)
-import Data.Tuple (Tuple(..), fst, snd)
-
--- | The `Cofree` `Comonad` for a functor.
--- |
--- | A value of type `Cofree f a` consists of an `f`-branching
--- | tree, annotated with labels of type `a`.
--- |
--- | The `Comonad` instance supports _redecoration_, recomputing
--- | labels from the local context.
-newtype Cofree f a
-  = Cofree (Lazy (Tuple a (f (Cofree f a))))
-
--- | Lazily creates a value of type `Cofree f a` from a label and a
--- | functor-full of "subtrees".
-lazyCofree ::
-  forall f a.
-  Lazy (Tuple a (f (Cofree f a))) ->
-  Cofree f a
-lazyCofree = Cofree
-
--- | Lazily creates a value of type `Cofree f a` from a label and a
--- | functor-full of "subtrees".
-deferCofree ::
-  forall f a.
-  (Unit -> Tuple a (f (Cofree f a))) ->
-  Cofree f a
-deferCofree = Cofree <<< defer
-
--- | Create a value of type `Cofree f a` from a label and a
--- | functor-full of "subtrees".
-mkCofree ::
-  forall f a.
-  a ->
-  f (Cofree f a) ->
-  Cofree f a
-mkCofree a t = Cofree (defer \_ ->
-  Tuple a t)
-
-infixr 5 mkCofree as :<
-
--- | Returns the label for a tree.
-head ::
-  forall f a.
-  Cofree f a ->
-  a
-head (Cofree c) = fst (force c)
-
--- | Returns the "subtrees" of a tree.
-tail ::
-  forall f a.
-  Cofree f a ->
-  f (Cofree f a)
-tail (Cofree c) = snd (force c)
-
--- | Like `head`, but returns a lazy value
-lazyHead ::
-  forall f a.
-  Cofree f a ->
-  (Lazy a)
-lazyHead (Cofree c) = map fst c
-
--- | Like `tail`, but returns a lazy value
-lazyTail ::
-  forall f a.
-  Cofree f a ->
-  (Lazy (f (Cofree f a)))
-lazyTail (Cofree c) = map snd c
-
-
-hoistCofree :: forall f g. Functor f => (f ~> g) -> Cofree f ~> Cofree g
-hoistCofree nat (Cofree c) = Cofree (map (nat <<< map (hoistCofree nat)) <$> c)
-
--- | This signature is deprecated and will be replaced by `buildCofree` in a
--- | future release.
-unfoldCofree ::
-  forall f s a.
-  Functor f =>
-  (s -> a) ->
-  (s -> f s) ->
-  s ->
-  Cofree f a
-unfoldCofree e n = buildCofree (\s ->
-  Tuple (e s) (n s))
-
--- | Recursively unfolds a `Cofree` structure given a seed.
-buildCofree ::
-  forall f s a.
-  Functor f =>
-  (s -> Tuple a (f s)) ->
-  s ->
-  Cofree f a
-buildCofree k s = Cofree (defer \_ ->
-  map (buildCofree k) <$> k s)
-
--- | Explore a value in the cofree comonad by using an expression in a
--- | corresponding free monad.
--- |
--- | The free monad should be built from a functor which pairs with the
--- | functor underlying the cofree comonad.
-explore ::
-  forall f g a b.
-  Functor f =>
-  Functor g =>
-  (forall x y. f (x -> y) -> g x -> y) ->
-  Free f (a -> b) ->
-  Cofree g a ->
-  b
-explore pair m w = case runState (runFreeM step m) w of
-  Tuple f cof -> f (extract cof)
-  where
-  step ::
-    f (Free f (a -> b)) ->
-    State (Cofree g a) (Free f (a -> b))
-  step ff = state \cof ->
-    pair (map Tuple ff) (tail cof)
-
-exploreM ::
-  forall f g a b m.
-  Functor f =>
-  Functor g =>
-  MonadRec m =>
-  (forall x y. f (x -> y) -> g x -> m y) ->
-  Free f (a -> b) ->
-  Cofree g a ->
-  m b
-exploreM pair m w = eval <$> runStateT (runFreeM step m) w
-  where
-  step ::
-    f (Free f (a -> b)) ->
-    StateT (Cofree g a) m (Free f (a -> b))
-  step ff = StateT \cof ->
-    pair (map Tuple ff) (tail cof)
-  eval ::
-    forall x y.
-    Tuple (x -> y) (Cofree g x) ->
-    y
-  eval (Tuple f cof) = f (extract cof)
-
-instance eqCofree :: (Eq1 f, Eq a) => Eq (Cofree f a) where
-  eq x y = head x == head y && tail x `eq1` tail y
-
-instance eq1Cofree :: (Eq1 f) => Eq1 (Cofree f) where
-  eq1 = eq
-
-instance ordCofree :: (Ord1 f, Ord a) => Ord (Cofree f a) where
-  compare x y = case compare (head x) (head y) of
-    EQ -> compare1 (tail x) (tail y)
-    r -> r
-
-instance ord1Cofree :: (Ord1 f) => Ord1 (Cofree f) where
-  compare1 = compare
-
-instance functorCofree :: (Functor f) => Functor (Cofree f) where
-  map f = loop
-    where
-    loop (Cofree fa) = Cofree ((\(Tuple a b) ->
-      Tuple (f a) (loop <$> b)) <$> fa)
-
-instance foldableCofree :: (Foldable f) => Foldable (Cofree f) where
-  foldr f = flip go
-    where
-    go fa b = f (head fa) (foldr go b (tail fa))
-  foldl f = go
-    where
-    go b fa = foldl go (f b (head fa)) (tail fa)
-  foldMap f = go
-    where
-    go fa = f (head fa) <> (foldMap go (tail fa))
-
-instance traversableCofree :: (Traversable f) => Traversable (Cofree f) where
-  sequence = traverse identity
-  traverse f = loop
-    where
-    loop ta = mkCofree <$> f (head ta) <*> (traverse loop (tail ta))
-
-instance extendCofree :: (Functor f) => Extend (Cofree f) where
-  extend f = loop
-    where
-    loop (Cofree fa) = Cofree ((\(Tuple a b) ->
-      Tuple (f (Cofree fa)) (loop <$> b)) <$> fa)
-
-instance comonadCofree :: (Functor f) => Comonad (Cofree f) where
-  extract = head
-
-instance applyCofree :: (Alternative f) => Apply (Cofree f) where
-  apply = ap
-
-instance applicativeCofree :: (Alternative f) => Applicative (Cofree f) where
-  pure a = mkCofree a empty
-
-instance bindCofree :: (Alternative f) => Bind (Cofree f) where
-  -- bind :: forall a b. Signal v a -> (a -> Signal v b) -> Signal v b
-  bind sa' f = go sa'
-    where
-    go sa = go' sa (f (head sa))
-    go' sa sb = let mrestart = go <$> tail sa
-                    msplit = go' sa <$> tail sb
-                in mkCofree (head sb) (mrestart <|> msplit)
-
--- instance bindCofree :: Alternative f => Bind (Cofree f) where
---   bind fa f = loop fa
---     where
---     loop fa' =
---       let fh = f (head fa')
---       in mkCofree (head fh) ((tail fh) <|> (loop <$> tail fa'))
-instance monadCofree :: (Alternative f) => Monad (Cofree f)
-
-instance isLazyCofree :: Z.Lazy (Cofree f a) where
-  defer k = Cofree (defer \_ ->
-    let (Cofree t) = k unit
-    in force t)
-
-instance shiftMapCofree :: Monoid v => ShiftMap (Widget v) (Cofree (Widget v)) where
-  shiftMap f (Cofree l) = deferCofree \_ ->
-    let Tuple a rest = force l
-    in Tuple a (f pure rest)
-
-mfix :: forall f a. (Lazy a -> Cofree f a) -> Cofree f a
-mfix f = Z.fix \res -> f $ lazyHead res
-
diff --git a/src/Control/ShiftMap.purs b/src/Control/ShiftMap.purs
index 3356ce5..4f44449 100644
--- a/src/Control/ShiftMap.purs
+++ b/src/Control/ShiftMap.purs
@@ -10,6 +10,27 @@ import Control.Monad.Writer.Trans (WriterT(..))
 import Data.Either (Either(..))
 import Data.Tuple (Tuple(..))
 
+-- Say you have a function `f` that accepts a value `m a`.
+-- Now you pass it a value `m b` instead. We need to figure
+-- out the various ways in which we can still get the function to
+-- work, by either constraining things, or by passing extra information.
+--
+-- Let's consider functions which combine the passed in value with other
+-- values in some way. For example, if it's a semigroup, then it can
+-- append the `m a` with other `m a`s.
+--
+-- Now that we actually passed in a `m b`, it's not possible to combine it.
+-- But, what if we have a way to convert a `m a` into an `m b`. Then the
+-- function can just convert its internal `m a` into an `m b` and combine them.
+-- For this, it's enough to have an `a -> b` transformation and `map` it
+-- over the `m a`.
+--
+-- This class of functions is captured by the `shiftMap` class.
+--
+-- For Concur, the UIs are monoidal, and shiftMap is used to apply
+-- UI transformations, as long as they only do monoidal operations,
+-- to things other than raw widgets.
+
 -- | Avoiding monad-control for as long as possible
 class ShiftMap s t where
   shiftMap :: forall a. (forall b. (a -> b) -> s b -> s b) -> t a -> t a
diff --git a/test/Test/WidgetSpec.purs b/test/Test/WidgetSpec.purs
new file mode 100644
index 0000000..f7059b6
--- /dev/null
+++ b/test/Test/WidgetSpec.purs
@@ -0,0 +1,62 @@
+module Test.WidgetSpec where
+
+import Prelude
+
+import Concur.Core.Types (affAction)
+import Control.MultiAlternative (orr)
+import Data.Time.Duration (Milliseconds(..))
+import Effect.Aff (delay, never)
+import Effect.Class (liftEffect)
+import Effect.Ref as Ref
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldEqual, shouldReturn)
+import Test.Utils (runWidgetAsAff)
+import Control.Parallel.Class (parallel, sequential)
+import Control.Plus (class Alt, class Plus, alt, empty)
+
+widgetSpec :: Spec Unit
+widgetSpec =
+  describe "Widget" do
+    describe "Aff" do
+      it "Aff cancels running effects" do
+        ref <- liftEffect $ Ref.new ""
+        sequential $ alt
+          (parallel do
+             delay (Milliseconds 100.0)
+             liftEffect $ Ref.write "a" ref)
+          (parallel do
+             delay (Milliseconds 150.0)
+             liftEffect $ Ref.write "b" ref)
+        liftEffect (Ref.read ref) `shouldReturn` "a"
+        delay (Milliseconds 500.0)
+        liftEffect (Ref.read ref) `shouldReturn` "a"
+    describe "orr" do
+      it "should cancel running effects when the widget returns a value" do
+        ref <- liftEffect $ Ref.new ""
+        { views } <- runWidgetAsAff $ orr
+          [ affAction "a" do
+               delay (Milliseconds 100.0)
+               liftEffect $ Ref.write "a" ref
+          , affAction "b" do
+               delay (Milliseconds 150.0)
+               liftEffect $ Ref.write "b" ref
+          ]
+        views `shouldEqual` [ "ab" ]
+        liftEffect (Ref.read ref) `shouldReturn` "a"
+        delay (Milliseconds 100.0)
+        liftEffect (Ref.read ref) `shouldReturn` "a"
+
+      it "should start all the widgets only once" do
+        ref <- liftEffect (Ref.new 0)
+        { result, views } <- runWidgetAsAff $ orr
+          [ do
+               affAction "a0" $ delay (Milliseconds 100.0)
+               affAction "a1" $ delay (Milliseconds 100.0)
+               pure "a"
+          , affAction "b" do
+               liftEffect $ Ref.modify_ (_ + 1) ref
+               never
+          ]
+        result `shouldEqual` "a"
+        views `shouldEqual` [ "a0b", "a1b" ]
+        liftEffect (Ref.read ref) `shouldReturn` 1