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..01ba2c5 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -5,9 +5,7 @@ You can edit this file as you like.
 { name =
     "concur-core"
 , dependencies =
-    [ "aff"
-    , "arrays"
-    , "avar"
+    [ "arrays"
     , "console"
     , "foldable-traversable"
     , "free"
@@ -20,5 +18,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..98917e1 100644
--- a/src/Concur/Core.purs
+++ b/src/Concur/Core.purs
@@ -6,21 +6,23 @@ module Concur.Core
 )
 where
 
+import Concur.Core.Event (Observer(..), mkObserver, par)
 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 Control.Category ((<<<))
+import Control.Monad.Free (Free, resume, wrap)
 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 Prelude (Unit, bind, pure, ($))
 
 -- 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 +35,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..c354b77 100644
--- a/src/Concur/Core/Discharge.purs
+++ b/src/Concur/Core/Discharge.purs
@@ -2,12 +2,11 @@ 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
@@ -20,29 +19,36 @@ discharge ::
   Monoid v =>
   (Either Error (Widget v a) -> Effect Unit) ->
   Widget v a ->
-  Effect v
+  Effect (Maybe v)
 discharge handler (Widget w) = case resume w of
-  Right _ -> pure mempty
-  Left (WidgetStepEff eff) -> do
+  Right _ -> pure Nothing
+  Left x -> case x of
+    WidgetStepEff eff -> do
       w' <- eff
       discharge handler (Widget w')
-  Left (WidgetStepView ws) -> do
-      runAff_ (handler <<< map Widget) ws.cont
-      pure ws.view
+    WidgetStepStuck -> pure Nothing
+    WidgetStepView f ->
+      Just <$> 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.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
index d0a15c3..9887cfc 100644
--- a/src/Concur/Core/FRP.purs
+++ b/src/Concur/Core/FRP.purs
@@ -3,16 +3,12 @@ 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)
 
 ----------
@@ -196,23 +192,3 @@ stateLoopS ::
   (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/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..0c61944 100644
--- a/src/Concur/Core/Types.purs
+++ b/src/Concur/Core/Types.purs
@@ -3,49 +3,39 @@ module Concur.Core.Types where
 import Prelude
 
 import Control.Alternative (class Alternative)
-import Control.Monad.Free (Free, hoistFree, liftF, resume, wrap)
+import Control.Monad.Free (Free, hoistFree, liftF, resume, resume', wrap)
 import Control.Monad.Rec.Class (class MonadRec)
 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 as A
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NEA
 import Data.Either (Either(..))
-import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex)
+import Data.FoldableWithIndex (foldMapWithIndex, foldrWithIndex)
 import Data.Maybe (Maybe(Nothing, Just), fromMaybe)
-import Data.Semigroup.Foldable (foldMap1)
+import Data.Traversable (traverse)
 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)
 
-type WidgetStepRecord v a
-  = {view :: v, cont :: Aff a}
+type WithHandler b a = ((a -> Effect Unit)) -> Effect b
+
+mapWithHandler :: forall a b c. (a -> b) -> WithHandler c a -> WithHandler c b
+mapWithHandler f g = \cb -> g (cb <<< f)
 
 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
+  | WidgetStepView (WithHandler v a)
+  -- TODO
+  -- | WidgetStepViewStuck v
+  | WidgetStepStuck
 
 -- 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 }
+  map f (WidgetStepView v) = WidgetStepView $ mapWithHandler f v
+  map _ WidgetStepStuck = WidgetStepStuck
 
 newtype Widget v a
   = Widget (Free (WidgetStep v) a)
@@ -68,87 +58,86 @@ derive newtype instance widgetMonadRec :: MonadRec (Widget v)
 instance widgetShiftMap :: ShiftMap (Widget v) (Widget v) where
   shiftMap f = f identity
 
--- 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
+    Just wsne -> Widget $ combine 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))
 
+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
+      WidgetStepEff eff -> wrap $ WidgetStepEff do
+        w <- eff
+        pure $ combine $ NEA.cons' (Widget w) x.tail
+
+      WidgetStepView o -> combineInner (NEA.singleton o) x.tail
+      WidgetStepStuck -> unWidget (orr x.tail)
+
+combineInner ::
+  forall v' a.
+  Monoid v' =>
+  NonEmptyArray (WithHandler v' (Free (WidgetStep v') a)) ->
+  Array (Widget v' a) ->
+  Free (WidgetStep v') a
+combineInner vs freeArr =
+  case combineInnerGo vs freeArr of
+    Left w -> w
+    Right (Tuple v f) -> combineInner v f
+
+-- Extracted `combineInnerGo` to allow `combineInner` to get Tail Call Optimisation
+combineInnerGo ::
+  forall v' a.
+  Monoid v' =>
+  NonEmptyArray (WithHandler v' (Free (WidgetStep v') a)) ->
+  Array (Widget v' a) ->
+  Either (Free (WidgetStep v') a) (Tuple (NonEmptyArray (WithHandler v' (Free (WidgetStep v') a))) (Array (Widget v' a)))
+combineInnerGo vs freeArr = case A.uncons freeArr of
+  Nothing -> Left $ combineConts vs
+  Just x -> case resume (unWidget x.head) of
+    Right a -> Left $ pure a
+    Left xx -> case xx of
+      WidgetStepEff eff -> Left $ wrap $ WidgetStepEff do
+        w <- eff
+        pure $ combineInner vs $ A.cons (Widget w) x.tail
+      WidgetStepView c -> Right $ Tuple (NEA.snoc vs c) x.tail
+      WidgetStepStuck -> Right $ Tuple vs x.tail
+
+combineConts ::
+  forall v' a.
+  Monoid v' =>
+  NonEmptyArray (WithHandler v' (Free (WidgetStep v') a)) ->
+  Free (WidgetStep v') a
+combineConts ws = wrap $ WidgetStepView $ merge ws
+
+merge ::
+  forall v' a.
+  Monoid v' =>
+  NonEmptyArray (WithHandler v' (Free (WidgetStep v') a)) ->
+  WithHandler v' (Free (WidgetStep v') a)
+merge ws = mapWithHandler (\nea -> combine (map Widget nea)) $ mergeWithHandlers (wrap <<< WidgetStepView) ws
+
+
+mergeWithHandlers
+  :: forall v a
+   . Monoid v
+  => (WithHandler v a -> a)
+  -> NonEmptyArray (WithHandler v a)
+  -> WithHandler v (NEA.NonEmptyArray a)
+mergeWithHandlers mkh vs = \cb ->
+  let mkCb i = \val -> cb (fromMaybe vs' (NEA.updateAt i val vs'))
+  in foldMapWithIndex (\i f -> f (mkCb i)) vs
+  where vs' = map mkh vs
 
 -- | Run multiple widgets in parallel until *all* finish, and collect their outputs
 -- | Contrast with `orr`
@@ -193,15 +182,20 @@ pulse ::
   Widget v Unit
 pulse = effAction (pure unit)
 
-mapView :: forall a v1 v2. (v1 -> v2) -> Widget v1 a -> Widget v2 a
+mapView :: forall a v. (v -> v) -> Widget v a -> Widget v a
 mapView f (Widget w) = Widget (hoistFree (mapViewStep f) w)
 
-mapViewStep :: forall v1 v2 a. (v1 -> v2) -> WidgetStep v1 a -> WidgetStep v2 a
+mapViewStep :: forall v a. (v -> v) -> WidgetStep v a -> WidgetStep v a
 mapViewStep f (WidgetStepEff e) = WidgetStepEff e
-mapViewStep f (WidgetStepView ws) = WidgetStepView ( ws { view = f ws.view })
+mapViewStep f (WidgetStepView v) = WidgetStepView (map f <$> v)
+mapViewStep f WidgetStepStuck = WidgetStepStuck
+
+stuck :: forall v a. Widget v a
+stuck = Widget $ liftF WidgetStepStuck
 
-display :: forall a v. v -> Widget v a
-display v = Widget (liftF (displayStep v))
+display :: forall v a. v -> Widget v a
+-- TODO: Instead of carrying around a callback which will never be called, use a special constructor WidgetStepViewStuck
+display v = Widget $ wrap $ WidgetStepView \cb -> pure v
 
 -- Sync eff
 effAction ::
@@ -213,33 +207,35 @@ effAction = Widget <<< liftF <<< WidgetStepEff
 -- 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 <<< liftF <<< WidgetStepView
 
 -- 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 v a. ((Free (WidgetStep v) a -> Effect Unit) -> v -> v) -> Widget v a -> Widget v a
+mkNodeWidget f (Widget w) = case resume w of
+  Right _ -> Widget w
+  Left x -> case x of
+    WidgetStepStuck -> Widget w
+    WidgetStepEff eff -> Widget $ wrap $ WidgetStepEff do
+      w' <- eff
+      pure $ unWidget $ mkNodeWidget f $ Widget w'
+    WidgetStepView g -> Widget $ wrap $ WidgetStepView \cb -> f cb <$> g cb
+
+mkLeafWidget :: forall v a. ((Free (WidgetStep v) a -> Effect Unit) -> v) -> Widget v a
+mkLeafWidget = Widget <<< wrap <<< WidgetStepView <<< adapter
+  where
+  adapter h cb = pure (h cb)
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