diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for bridge
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Ian Davidson (c) 2022
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,171 @@
+# Purview
+
+A framework to build interactive UIs with Haskell.  It's inspired by Phoenix LiveView, React, and Redux + Sagas.
+
+The main points:
+* It's server side rendered and uses websockets to communicate HTML updates and to receive events.
+* State can be broken up into small components.
+* The approach is to provide useful atoms, with the user building up a kind of AST.
+* Attributes flow down to concrete HTML, events bubble up to state handlers.
+
+It's still in early development so expect things to break or be missing!
+
+## What it looks like
+
+Here's what a component looks like (see `experiments/Counter.hs`):
+
+```haskell
+
+module Main where
+
+import Prelude hiding (div)
+import Data.Aeson
+import Data.Aeson.TH
+
+import Purview
+
+data Direction = Up | Down
+
+$(deriveJSON defaultOptions ''Direction)
+
+upButton = onClick Up $ div [ text "up" ]
+downButton = onClick Down $ div [ text "down" ]
+
+handler = messageHandler (0 :: Int) reducer
+  where
+    reducer Up   state = (const $ state + 1, [])
+    reducer Down state = (const $ state - 1, [])
+
+counter state = div
+  [ upButton
+  , text $ "count: " <> show state
+  , downButton
+  ]
+
+view = handler counter
+
+main = Purview.run defaultConfiguration { component=view }
+```
+
+## Overview
+
+### Adding attributes to HTML elements
+
+Attributes flow down to concrete HTML.
+
+For example, if you wanted to add a `style="color: blue;"` to a `div`:
+
+``` haskell
+blue = style "color: blue;"
+
+blueDiv = blue (div [])
+```
+
+Calling `render blueDiv` will produce `<div style="color: blue;"></div>"`
+
+If you wanted to have a blue div that's 50% of the width,
+
+``` haskell
+blue = style "color: blue;"
+halfWidth = style "width: 50%;"
+
+view = blue (halfWidth (div [])
+```
+
+Now `render view` will produce `<div style="color: blue; width: 50%;></div>`
+
+As purview is non-prescriptive in what attributes you can give a `div`, or any other HTML element, you can create your own.
+
+If you need `name` attribute put on `div`s or other HTML, you can do:
+
+``` haskell
+nameAttr = Attribute . Generic "name"
+
+namedDiv = nameAttr "wumbo" (div [])
+```
+
+And `render namedDiv` will produce `<div name="wumbo"></div>`.  Eventually there will be more attributes-by-default like `style`, but for now expect to build up what you need!
+
+### Creating new HTML elements
+
+Just like you can add new attributes, you can also add new html elements.  For example, if you need a button
+
+``` haskell
+button = Html "button"
+
+view = button [ text "click" ]
+```
+
+Now `render view` will produce `<button>click</button>`.  Like all the built in ones, attributes will flow down and be added to the button.
+
+### Events
+
+At the core of Purview are three event handlers, in order of increasing power:
+1. `simpleHandler`: Used for just returning a new state.  No messages or effects.
+2. `messageHandler`: Used when you need to send messages to the component itself or to its parent.
+3. `effectHandler`: Used when you need the above and access to IO / your monad stack / algebraic effects.
+
+The first two are just some sugar around `effectHandler`.
+
+Handlers take an initial state and a reducer.  The reducer receives actions from anywhere below them in the tree, and returns the new state with a list of actions to send either to itself or up the tree to the parent.  The handler passes down the state to its child.  This is the core idea to make it all interactive.
+
+For example, if we wanted to build something that fetched the server time on each click:
+
+``` haskell
+reducer action state = case action of
+  "getTime" -> do
+      time <- getCurrentTime
+      pure (const $ Just time, [])
+
+handler = effectHandler Nothing reducer
+
+view time = div 
+  [ onClick "getTime" $ button [ text "check time" ]
+  , p [ text (show time) ]
+  ]
+  
+component = handler view
+```
+
+Some things to note:
+* The state is passed down to children.
+* Events bubble up to the nearest handler where they are captured.
+* `onClick` can wrap anything -- like other attributes it flows down to concrete HTML.
+* The reducer is run in its own thread when an event is received, so you don't have to worry about slow operations locking the page.
+
+### Overview of how it works
+
+Using the above example of getting the time, here's how events flow when the user clicks "check time"
+
+1. The event is sent from the browser in a form like `
+
+   ```{ event: click, message: "checkTime", location: [0] }```
+2. The event is put onto the channel for the event loop to process
+3. By going down the tree it applies the event to the matched handler
+
+   a. Any HTML changes are sent to the browser, completing the loop
+5. The handler does its work in a green thread, creating a new event that looks like
+   
+   ```{ event: stateChange, fn: state -> state, location: [0] }```
+7. The state change event is put onto the channel for the event loop to process
+8. By going down the tree it applies the state change fn to the latest state in the tree, returning a new tree
+9. Any HTML changes are sent to the browser, completing the loop
+
+### Contributing
+
+Anything is welcome, including examples or patterns you found nice.  There's still a lot to discover.
+
+The roadmap is, loosely, determined by adding things required to build real websites.  The first two site-based goals:
+1. The Purview website itself, which will have more in depth tutorials (so requiring at least navigation)
+2. A stripe-based checkout (requiring communication with javascript)
+
+### Installation
+
+1. Install [stack](https://docs.haskellstack.org/en/stable/README/)
+2. `stack build`
+3. `stack exec purview-exe` for just running the example above
+
+### Running Tests
+
+1. The same as above with stack and build
+2. `stack test`
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/performance/Criterion.hs b/performance/Criterion.hs
new file mode 100644
--- /dev/null
+++ b/performance/Criterion.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Criterion where
+
+import Prelude hiding (div)
+import           Data.Aeson
+import           Data.Aeson.TH
+
+import Criterion.Main hiding (component)
+
+import Purview
+import EventHandling
+import PrepareTree (prepareTree)
+import Control.Concurrent.STM (newTChan)
+
+{-
+
+Using the todo example since it's big
+
+-}
+
+input = Html "input"
+ul = Html "ul"
+li = Html "li"
+
+nameAttr = Attribute . Generic "name"
+typeAttr = Attribute . Generic "type"
+checkedAttr = Attribute . Generic "checked"
+
+data Fields = Fields { description :: String }
+data Actions = Submit Fields | Toggle Int
+
+data Todo = Todo { description :: String, done :: Bool }
+  deriving (Eq)
+
+$(deriveJSON defaultOptions  ''Fields)
+$(deriveJSON defaultOptions  ''Actions)
+$(deriveJSON defaultOptions  ''Todo)
+
+handler = effectHandler [] action
+  where
+    -- hmm, a little ungainly having to specify
+    -- action :: Actions -> [Todo] -> IO ([Todo], [DirectedEvent Actions Actions])
+
+    action (Submit Fields { description }) todos = pure $
+      (const $ todos <> [Todo { description=description, done=False }], [])
+
+    action (Toggle n) todos =
+      let change (index, todo@Todo { done=alreadyDone }) =
+            if index == n
+            then todo { done=not alreadyDone }
+            else todo
+      in pure (const $ fmap change (zip [0..] todos), [])
+
+topStyle = style "font-family: sans-serif"
+
+todoItem (index, Todo { description, done }) = div
+  [ text description
+  , onClick (Toggle index)
+      $ typeAttr "checkbox"
+      $ (if done then checkedAttr "checked" else id)
+      $ input []
+  ]
+
+-- overall view
+container = style "font-size: 24px" . div
+
+view todos = container
+  [ div $ fmap todoItem (zip [0..] todos)
+  , formHandler $ const addNewTodoForm
+  ]
+
+-- submission form
+submitButton = typeAttr "submit" $ button [ text "submit" ]
+
+defaultFields = Fields { description="" }
+
+formHandler = effectHandler ([] :: [String]) action
+  where
+    action newTodo state = pure (const state, [Parent (Submit newTodo)])
+
+addNewTodoForm =
+  div
+    [ onSubmit defaultFields $
+        form
+          [ nameAttr "description" $ input []
+          , submitButton
+          ]
+    ]
+
+component' :: Purview () b IO
+component' = handler view
+
+clickEvent = FromEvent { event="click", message="up", location=Nothing }
+
+newStateEvent = FromEvent { event="newState", message="up", location=Nothing }
+
+main = defaultMain
+  [ bgroup "render"
+        [ bench "todo example"  $ whnf render component' ]
+  , bgroup "prepareTree"
+        [ bench "todo example" $ whnf prepareTree component' ]
+  , bgroup "apply event"
+        [ bench "todo example" $ whnf (runEvent clickEvent) component' ]
+  , bgroup "new state event"
+        [ bench "todo example" $ whnf (applyNewState clickEvent) component' ]
+  ]
diff --git a/purview.cabal b/purview.cabal
new file mode 100644
--- /dev/null
+++ b/purview.cabal
@@ -0,0 +1,142 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           purview
+version:        0.1.0.0
+synopsis:       Build server rendered, interactive websites
+description:    A framework for building server rendered, interactive websites.
+                .
+                The main points:
+                .
+                * It's server side rendered and uses websockets to communicate HTML updates and to receive events.
+                .
+                * State can be broken up into small components.
+                .
+                * The approach is to provide useful atoms, with the user building up a kind of AST.
+                .
+                * Attributes flow down to concrete HTML, events bubble up to state handlers.
+                .
+                It's inspired by Phoenix LiveView, React, Redux, and Redux-Sagas.
+                .
+                For the full readme, please see https://github.com/purview-framework/purview/blob/main/README.md
+category:       Library, Web
+homepage:       https://github.com/purview-framework/purview#readme
+bug-reports:    https://github.com/purview-framework/purview/issues
+author:         Ian Davidson
+maintainer:     bontaq@gmail.com
+copyright:      2022 Ian Davidson
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/purview-framework/purview
+
+library
+  exposed-modules:
+      Purview
+  other-modules:
+      Component
+      Diffing
+      EventHandling
+      EventLoop
+      Events
+      PrepareTree
+      Rendering
+      Wrapper
+      Paths_purview
+  hs-source-dirs:
+      src
+  ghc-options: -Wincomplete-patterns
+  build-depends:
+      aeson >=2.0.3 && <2.1
+    , base >=4.7 && <5
+    , bytestring >=0.10.12.1 && <0.12
+    , raw-strings-qq ==1.1.*
+    , scotty ==0.12.*
+    , stm >=2.5.0 && <2.6
+    , text >=1.2.5 && <1.3
+    , wai >=3.2.3 && <3.3
+    , wai-extra >=3.1.8 && <3.2
+    , wai-websockets >=3.0.1 && <3.1
+    , warp >=3.3.20 && <3.4
+    , websockets >=0.12.7 && <0.13
+  default-language: Haskell2010
+
+test-suite purview-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Component
+      ComponentSpec
+      Diffing
+      DiffingSpec
+      EventHandling
+      EventHandlingSpec
+      EventLoop
+      Events
+      PrepareTree
+      PrepareTreeSpec
+      Purview
+      PurviewSpec
+      Rendering
+      RenderingSpec
+      TreeGenerator
+      Wrapper
+      Paths_purview
+  hs-source-dirs:
+      src
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -main-is Spec
+  build-tool-depends:
+      hspec-discover:hspec-discover ==2.*
+  build-depends:
+      QuickCheck >=2.14.2 && <2.15
+    , aeson >=2.0.3 && <2.1
+    , base >=4.7 && <5
+    , bytestring >=0.10.12.1 && <0.12
+    , hspec >=2.8.5 && <2.10
+    , purview
+    , raw-strings-qq ==1.1.*
+    , scotty ==0.12.*
+    , stm >=2.5.0 && <2.6
+    , text >=1.2.5 && <1.3
+    , time >=1.9.3 && <1.12
+    , wai >=3.2.3 && <3.3
+    , wai-extra >=3.1.8 && <3.2
+    , wai-websockets >=3.0.1 && <3.1
+    , warp >=3.3.20 && <3.4
+    , websockets >=0.12.7 && <0.13
+  default-language: Haskell2010
+
+benchmark purview-perf-test
+  type: exitcode-stdio-1.0
+  main-is: Criterion.hs
+  other-modules:
+      Paths_purview
+  hs-source-dirs:
+      performance
+  ghc-options: -main-is Criterion
+  build-depends:
+      aeson >=2.0.3 && <2.1
+    , base >=4.7 && <5
+    , bytestring >=0.10.12.1 && <0.12
+    , criterion >=1.5.13 && <1.6
+    , purview
+    , raw-strings-qq ==1.1.*
+    , scotty ==0.12.*
+    , stm >=2.5.0 && <2.6
+    , text >=1.2.5 && <1.3
+    , wai >=3.2.3 && <3.3
+    , wai-extra >=3.1.8 && <3.2
+    , wai-websockets >=3.0.1 && <3.1
+    , warp >=3.3.20 && <3.4
+    , websockets >=0.12.7 && <0.13
+  buildable: False
+  default-language: Haskell2010
diff --git a/src/Component.hs b/src/Component.hs
new file mode 100644
--- /dev/null
+++ b/src/Component.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GADTs #-}
+module Component where
+
+import           Data.Aeson
+import           Data.Typeable
+
+import           Events
+
+{-|
+
+Attributes are collected until an 'HTML' constructor is hit, where they
+are applied during rendering.
+
+-}
+data Attributes action where
+  On :: ToJSON action => String -> action -> Attributes action
+  -- ^ part of creating handlers for different events, e.g. On "click"
+  Style :: String -> Attributes action
+  -- ^ inline css
+  Generic :: String -> String -> Attributes action
+  -- ^ for creating new Attributes to put on HTML, e.g. Generic "type" "radio" for type="radio".
+
+instance Eq (Attributes action) where
+  (Style a) == (Style b) = a == b
+  (Style _) == _ = False
+
+  (On kind action) == (On kind' action') = kind == kind' && encode action == encode action'
+  (On _ _) == _ = False
+
+  (Generic name value) == (Generic name' value') = name == name' && value == value'
+  (Generic _ _) == _ = False
+
+type Identifier = Maybe [Int]
+type ParentIdentifier = Identifier
+
+{-|
+
+This is what you end up building using the various helpers.  It's hopefully rare
+that you have to use these directly, but it may be useful to better understand
+what's happening behind the scenes.
+
+-}
+data Purview parentAction action m where
+  Attribute :: Attributes action -> Purview parentAction action m -> Purview parentAction action m
+  Text :: String -> Purview parentAction action m
+  Html :: String -> [Purview parentAction action m] -> Purview parentAction action m
+  Value :: Show a => a -> Purview parentAction action m
+
+  -- | All the handlers boil down to this one.
+  EffectHandler
+    :: ( FromJSON newAction
+       , ToJSON newAction
+       , ToJSON parentAction
+       , FromJSON state
+       , ToJSON state
+       , Typeable state
+       , Eq state
+       )
+    => ParentIdentifier
+    -- ^ The location of the parent effect handler (provided by prepareTree)
+    -> Identifier
+    -- ^ The location of this effect handler (provided by prepareTree)
+    -> state
+    -- ^ The initial state
+    -> (newAction-> state -> m (state -> state, [DirectedEvent parentAction newAction]))
+    -- ^ Receive an action, change the state, and send messages
+    -> (state -> Purview newAction any m)
+    -- ^ Continuation
+    -> Purview parentAction newAction m
+
+  Once
+    :: (ToJSON action)
+    => ((action -> Event) -> Event)
+    -> Bool  -- has run
+    -> Purview parentAction action m
+    -> Purview parentAction action m
+
+  Hide :: Purview parentAction newAction m -> Purview parentAction any m
+
+instance Show (Purview parentAction action m) where
+  show (EffectHandler parentLocation location state _action cont) =
+    "EffectHandler "
+    <> show parentLocation <> " "
+    <> show location <> " "
+    <> show (encode state) <> " "
+    <> show (cont state)
+  show (Once _ hasRun cont) = "Once " <> show hasRun <> " " <> show cont
+  show (Attribute _attrs cont) = "Attr " <> show cont
+  show (Text str) = show str
+  show (Html kind children) =
+    kind <> " [ " <> concatMap ((<>) " " . show) children <> " ] "
+  show (Value value) = show value
+  show (Hide a) = "Hide " <> show a
+
+instance Eq (Purview parentAction action m) where
+  a == b = show a == show b
+
+{-|
+
+This is most straightforward effect handler.  It can't send messages to itself
+or to its parent.
+
+For example, let's say you want to make a button that switches between saying
+"up" or "down":
+
+> view direction = onClick "toggle" $ button [ text direction ]
+>
+> handler = simpleHandler "up" reduce
+>   where reduce "toggle" state = if state == "up" then "down" else "up"
+>
+> component = handler view
+
+-}
+simpleHandler
+  :: ( FromJSON action
+     , FromJSON state
+     , ToJSON action
+     , ToJSON parentAction
+     , ToJSON state
+     , Typeable state
+     , Eq state
+     , Applicative m
+     )
+  => state
+  -- ^ The initial state
+  -> (action -> state -> state)
+  -- ^ The reducer, or how the state should change for an action
+  -> (state -> Purview action any1 m)
+  -- ^ The continuation / component to connect to
+  -> Purview parentAction any2 m
+simpleHandler state handler =
+  effectHandler state (\action state -> pure (const $ handler action state, []))
+
+{-|
+
+More powerful than the 'simpleHandler', it can send messages to itself or its
+parent.  You will also note that instead of just returning the new state, it
+returns a function to transform the state.  This is because handlers run in
+their own threads.
+
+-}
+messageHandler
+  :: ( FromJSON action
+     , FromJSON state
+     , ToJSON action
+     , ToJSON parentAction
+     , ToJSON state
+     , Typeable state
+     , Eq state
+     , Applicative m
+     )
+  => state
+  -- ^ initial state
+  -> (action -> state -> (state -> state, [DirectedEvent parentAction action]))
+  -- ^ reducer
+  -> (state -> Purview action any1 m)
+  -- ^ continuation
+  -> Purview parentAction any2 m
+messageHandler state handler =
+  effectHandler state (\action state -> pure (handler action state))
+
+{-|
+
+This handler gives you access to whichever monad you're running Purview with.
+
+If you wanted to print something on the server every time someone clicked
+a button:
+
+> view direction = onClick "sayHello" $ button [ text "Say hello on the server" ]
+>
+> handler = effectHandler Nothing reduce
+>   where reduce "sayHello" state = do
+>           print "someone on the browser says hello!"
+>           pure (const Nothing, [])
+>
+> component = handler view
+
+-}
+effectHandler
+  :: ( FromJSON action
+     , FromJSON state
+     , ToJSON action
+     , ToJSON parentAction
+     , ToJSON state
+     , Typeable state
+     , Eq state
+     )
+  => state
+  -- ^ initial state
+  -> (action -> state -> m (state -> state, [DirectedEvent parentAction action]))
+  -- ^ reducer (note the m!)
+  -> (state -> Purview action any1 m)
+  -- ^ continuation
+  -> Purview parentAction any2 m
+effectHandler state handler =
+  Hide . EffectHandler Nothing Nothing state handler
+
+{-|
+
+This is for kicking off loading events.  Put it beneath one of your handlers
+to send an event up to it, and it will only be sent once.
+
+-}
+once
+  :: ToJSON action
+  => ((action -> Event) -> Event)
+  -> Purview parentAction action m
+  -> Purview parentAction action m
+once sendAction = Once sendAction False
+
+{-
+
+Helpers
+
+-}
+
+div :: [Purview parentAction action m] -> Purview parentAction action m
+div = Html "div"
+
+span :: [Purview parentAction action m] -> Purview parentAction action m
+span = Html "span"
+
+h1 :: [Purview parentAction action m] -> Purview parentAction action m
+h1 = Html "h1"
+
+h2 :: [Purview parentAction action m] -> Purview parentAction action m
+h2 = Html "h2"
+
+h3 :: [Purview parentAction action m] -> Purview parentAction action m
+h3 = Html "h3"
+
+h4 :: [Purview parentAction action m] -> Purview parentAction action m
+h4 = Html "h4"
+
+p :: [Purview parentAction action m] -> Purview parentAction action m
+p = Html "p"
+
+button :: [Purview parentAction action m] -> Purview parentAction action m
+button = Html "button"
+
+form :: [Purview parentAction action m] -> Purview parentAction action m
+form = Html "form"
+
+input :: [Purview parentAction action m] -> Purview parentAction action m
+input = Html "input"
+
+text :: String -> Purview parentAction action m
+text = Text
+
+{-|
+
+For adding styles
+
+> blue = style "color: \"blue\";"
+> blueButton = blue $ button [ text "I'm blue" ]
+
+-}
+style :: String -> Purview parentAction action m -> Purview parentAction action m
+style = Attribute . Style
+
+{-|
+
+This will send the action to the handler above it whenever "click" is triggered
+on the frontend.  It will be bound to whichever 'HTML' is beneath it.
+
+-}
+onClick :: ToJSON action => action -> Purview parentAction action m -> Purview parentAction action m
+onClick = Attribute . On "click"
+
+{-|
+
+This will send the action to the handler above it whenever "submit" is triggered
+on the frontend.
+
+-}
+onSubmit :: ToJSON action => action -> Purview parentAction action m -> Purview parentAction action m
+onSubmit = Attribute . On "submit"
+
+identifier :: String -> Purview parentAction action m -> Purview parentAction action m
+identifier = Attribute . Generic "id"
+
+classes :: [String] -> Purview parentAction action m -> Purview parentAction action m
+classes xs = Attribute . Generic "class" $ unwords xs
diff --git a/src/ComponentSpec.hs b/src/ComponentSpec.hs
new file mode 100644
--- /dev/null
+++ b/src/ComponentSpec.hs
@@ -0,0 +1,17 @@
+module ComponentSpec where
+
+import Test.Hspec
+
+import Component
+
+spec :: SpecWith ()
+spec = parallel $ do
+
+  describe "placeholder" $ do
+
+    it "holds a place" $ do
+      1 `shouldBe` 1
+
+
+main :: IO ()
+main = hspec spec
diff --git a/src/Diffing.hs b/src/Diffing.hs
new file mode 100644
--- /dev/null
+++ b/src/Diffing.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Diffing where
+
+import GHC.Generics
+import Data.Typeable
+import Data.Aeson
+
+import Component
+import Unsafe.Coerce (unsafeCoerce)
+
+{-
+
+Since actions target specific locations, we can't stop going the tree early
+because changes may have happened beneath the top level.  kind of the
+downside not having a single, passed down, state.
+
+We still need render, but render needs to be targeted to specific locations.
+
+I dunno how it should work lol.
+
+Let's start at the basics, with dumb tests.  If there's a div in the new
+tree, and not one in the old tree, it should produce something saying
+to add that div.
+
+To know where to make a change, I guess you need a location and a command.
+
+-}
+type Location = [Int]
+
+data Change a = Update Location a | Delete Location a | Add Location a
+  deriving (Show, Eq, Generic)
+
+instance ToJSON a => ToJSON (Change a) where
+  toEncoding = genericToEncoding defaultOptions
+
+diff
+  :: Maybe Location
+  -> Location
+  -> Purview parentAction action m
+  -> Purview parentAction action m
+  -> [Change (Purview parentAction action m)]
+diff target location oldGraph newGraph = case (oldGraph, newGraph) of
+
+  (Html kind children, Html kind' children') ->
+    concatMap
+      (\(index, oldChild, newChild) -> diff target (index:location) oldChild newChild)
+      (zip3 [0..] children children')
+
+  (Text str, Text str') ->
+    [Update location (Text str') | str /= str']
+
+  (Html kind children, unknown) ->
+    [Update location newGraph]
+
+  (unknown, Html kind children) ->
+    [Update location newGraph]
+
+  (Hide (EffectHandler _ loc state _ cont), Hide (EffectHandler _ loc' newState _ newCont)) ->
+    case cast state of
+      Just state' ->
+        [Update location newGraph | state' /= newState && loc == loc']
+        -- TODO: this is weak, instead of walking the whole tree it should be targetted
+        --       to specific effect handlers
+
+        -- if we hit the target, we're already saying update the whole tree
+        <> if Just location == target
+           then []
+           else diff target (0:location) (unsafeCoerce cont state) (unsafeCoerce newCont newState)
+
+      -- different kinds of state
+      Nothing ->
+        [Update location newGraph]
+
+  ((Attribute attr a), (Attribute attr' b)) ->
+    [Update location newGraph | attr /= attr']
+
+  ((Value _), _) ->
+    [Update location newGraph]
+
+  ((EffectHandler _ _ _ _ _), _) ->
+    [Update location newGraph]
+
+  (_, _) -> [Update location newGraph]
+
+  -- (a, b) -> error (show a <> "\n" <> show b)
diff --git a/src/DiffingSpec.hs b/src/DiffingSpec.hs
new file mode 100644
--- /dev/null
+++ b/src/DiffingSpec.hs
@@ -0,0 +1,103 @@
+module DiffingSpec where
+
+import Prelude hiding (div)
+import Test.Hspec
+
+import PrepareTree
+import Purview
+import Diffing
+
+type DefaultAction = DirectedEvent String String
+
+spec :: SpecWith ()
+spec = parallel $ do
+
+  describe "diff" $ do
+
+    it "creates an update for differing text" $ do
+      let
+        oldTree = div [ text "night" ]
+        newTree = div [ text "morning" ]
+
+      diff Nothing [] oldTree newTree `shouldBe` [Update [0] (text "morning")]
+
+    it "can do a nested update" $ do
+      let
+        oldTree = div [ div [ text "night" ] ]
+        newTree = div [ div [ text "morning" ] ]
+
+      diff Nothing [] oldTree newTree `shouldBe` [Update [0, 0] (text "morning")]
+
+    it "says to update the whole underlying tree on added div" $ do
+      let
+        oldTree = div [ text "night" ]
+        newTree = div [ div [ text "morning" ] ]
+
+      diff Nothing [] oldTree newTree `shouldBe` [Update [0] (div [ text "morning" ])]
+
+    describe "message handlers" $ do
+--      it "doesn't diff handler children if the state is the same" $ do
+--        let
+--          mkHandler :: (String -> Purview String action IO) -> Purview String action IO
+--          mkHandler = messageHandler "initial state" (\action state -> (state <> action, [] :: [DefaultAction]))
+--          oldTree = div [ mkHandler (const (text "the original")) ]
+--          newTree = div [ mkHandler (const (text "this is different")) ]
+--
+--        diff [] oldTree newTree `shouldBe` []
+
+      it "diffs handler children if the state is different" $ do
+        let
+          handler1 :: (String -> Purview String action IO) -> Purview String action IO
+          handler1 = messageHandler "initial state" (\action state -> (const $ state <> action, [] :: [DefaultAction]))
+          handler2 = messageHandler "different state" (\action state -> (const $ state <> action, [] :: [DefaultAction]))
+          oldTree = div [ handler1 (const (text "the original")) ]
+          newTree = div [ handler2 (const (text "this is different")) ]
+
+        diff Nothing [] oldTree newTree `shouldBe`
+          [ Update [0] (handler2 (const (text "this is different")))
+          , Update [0, 0] (text "this is different")
+          ]
+
+    describe "effect handlers" $ do
+--      it "doesn't diff handler children if the state is the same" $ do
+--        let
+--          mkHandler :: (String -> Purview String action IO) -> Purview String action IO
+--          mkHandler = effectHandler "initial state" (\action state -> pure $ (state <> action, ([] :: [DirectedEvent String String])))
+--          oldTree = div [ mkHandler (const (text "the original")) ]
+--          newTree = div [ mkHandler (const (text "this is different")) ]
+--
+--        diff [] oldTree newTree `shouldBe` []
+
+      it "diffs handler children if the state is different" $ do
+        let
+          handler1 :: (String -> Purview String action IO) -> Purview String action IO
+          handler1 = effectHandler "initial state" (\action state -> pure $ (const $ state <> action, ([] :: [DirectedEvent String String])))
+          handler2 = effectHandler "different state" (\action state -> pure $ (const $ state <> action, ([] :: [DirectedEvent String String])))
+          oldTree = div [ handler1 (const (text "the original")) ]
+          newTree = div [ handler2 (const (text "this is different")) ]
+
+        diff Nothing [] oldTree newTree `shouldBe`
+          [ Update [0] (handler2 (const (text "this is different")))
+          , Update [0, 0] (text "this is different")
+          ]
+
+      it "continues going down the tree even if the state is the same at the top" $ do
+        let
+          handler1 :: (String -> Purview String action IO) -> Purview String action IO
+          handler1 = effectHandler "initial state" (\action state -> pure $ (const $ state <> action, ([] :: [DirectedEvent String String])))
+          handler2 = effectHandler "different state" (\action state -> pure $ (const $ state <> action, ([] :: [DirectedEvent String String])))
+          oldTree = fst . prepareTree $ div [ handler1 . const $ handler1 (const (text "the original")) ]
+          newTree = fst . prepareTree $ div [ handler1 . const $ handler2 (const (text "this is different")) ]
+
+        diff (Just [0, 0]) [] oldTree newTree `shouldBe`
+          [ Update [0, 0] (Hide $ EffectHandler
+                            (Just [0])
+                            (Just [0, 0])
+                            "different state"
+                            (\action state -> pure $ (const $ state <> action, ([] :: [DirectedEvent String String])))
+                            (const (text "this is different")))
+          ]
+
+
+main :: IO ()
+main = hspec spec
diff --git a/src/EventHandling.hs b/src/EventHandling.hs
new file mode 100644
--- /dev/null
+++ b/src/EventHandling.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+module EventHandling where
+
+import           Control.Concurrent.STM.TChan
+import           Data.Aeson
+import           Data.Typeable
+
+import           Events
+import           Component
+
+
+{-|
+
+This is a special case event to assign new state to handlers
+
+-}
+applyNewState
+  :: Event
+  -> Purview parentAction action m
+  -> Purview parentAction action m
+applyNewState fromEvent@(StateChangeEvent newStateFn location) component = case component of
+  EffectHandler ploc loc state handler cont -> case cast newStateFn of
+    Just newStateFn' -> EffectHandler ploc loc (newStateFn' state) handler cont
+    Nothing ->
+      let children = fmap (applyNewState fromEvent) cont
+      in EffectHandler ploc loc state handler children
+
+  Hide x ->
+    let
+      children = applyNewState fromEvent x
+    in
+      Hide children
+
+  Html kind children ->
+    Html kind $ fmap (applyNewState fromEvent) children
+
+  Attribute n cont ->
+    Attribute n (applyNewState fromEvent cont)
+
+  Once fn run cont ->
+    Once fn run $ applyNewState fromEvent cont
+
+  Text x -> Text x
+
+  Value x -> Value x
+applyNewState (Event {}) component = component
+
+
+runEvent :: Monad m => Event -> Purview parentAction action m -> m [Event]
+runEvent (StateChangeEvent _ _) _ = pure []
+runEvent fromEvent@(Event { message, location }) component = case component of
+  EffectHandler parentLocation loc state handler cont -> case fromJSON message of
+    Success parsedAction -> do
+      -- if locations match, we actually run what is in the handler
+      (newStateFn, events) <-
+        if loc == location
+        then handler parsedAction state
+        else pure (const state, [])
+
+      -- although it doesn't break anything, only send this when the
+      -- locations match (cuts down on noise)
+      let newStateEvent = [StateChangeEvent newStateFn loc | loc == location]
+
+      let createMessage directedEvent = case directedEvent of
+            (Parent event) -> Event
+              -- TODO: this should probably be a new kind of event
+              { event = "internal"
+              , message = toJSON event
+              , location = parentLocation
+              }
+            (Self event) -> Event
+              { event = "internal"
+              , message = toJSON event
+              , location = loc
+              }
+
+      -- here we handle sending events returned to either this
+      -- same handler or passing it up the chain
+      -- mapM_ (atomically . writeTChan eventBus . createMessage) events
+      let handlerEvents = fmap createMessage events
+
+      -- ok, right, no where in this function does the tree actually change
+      -- that's handled by the setting state event
+      childEvents <- runEvent fromEvent (cont state)
+
+      -- so we can ignore the results from applyEvent and continue
+      -- pure $ EffectHandler parentLocation loc state handler cont
+      pure $ newStateEvent <> handlerEvents <> childEvents
+
+    Error _err -> runEvent fromEvent (cont state)
+
+  Html kind children -> do
+    childEvents' <- mapM (runEvent fromEvent) children
+    pure $ concat childEvents'
+
+  Attribute n cont -> runEvent fromEvent cont
+
+  Hide x -> runEvent fromEvent x
+
+  Once _ _ cont -> runEvent fromEvent cont
+
+  Text _ -> pure []
+
+  Value _ -> pure []
diff --git a/src/EventHandlingSpec.hs b/src/EventHandlingSpec.hs
new file mode 100644
--- /dev/null
+++ b/src/EventHandlingSpec.hs
@@ -0,0 +1,289 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+module EventHandlingSpec where
+
+import Prelude hiding (div)
+import Control.Concurrent.STM.TChan
+import Control.Monad.STM (atomically)
+import Control.Monad.IO.Class
+import Test.Hspec.QuickCheck
+import Test.Hspec
+import Test.QuickCheck
+import Data.Aeson
+import Data.Aeson.TH
+
+import TreeGenerator
+import Component
+import EventHandling
+import Events
+import PrepareTree
+import Rendering
+
+type Id a = a -> a
+
+data TestAction = Up | Down
+
+$(deriveJSON defaultOptions ''TestAction)
+
+data SingleConstructor = SingleConstructor
+
+$(deriveJSON (defaultOptions{tagSingleConstructors=True}) ''SingleConstructor)
+
+{-
+
+Just to clean up tests a bit. I dunno if this approach would work to clean
+up the main event loop as well, since it calls "runEvent" (re: applying the event)
+in a non-forked fashioned.  If you try void . forkIO you end up back in m a -> IO a
+hell.
+
+-}
+apply :: MonadIO m => TChan Event -> Event -> Purview parentAction action m -> m (Purview parentAction action m)
+apply eventBus newStateEvent@StateChangeEvent {} component =
+  pure $ applyNewState newStateEvent component
+apply eventBus fromEvent@Event {event=eventKind} component =
+  case eventKind of
+    "newState" -> pure $ applyNewState fromEvent component
+    _          -> do
+      events <- runEvent fromEvent component
+      liftIO $ mapM_ (atomically . writeTChan eventBus) events
+      pure component
+
+spec :: SpecWith ()
+spec = parallel $ do
+  describe "apply" $ do
+
+    it "changes state" $ do
+      let
+        actionHandler :: String -> Int -> Int
+        actionHandler "up" _ = 1
+        actionHandler _    _ = 0
+
+        handler :: Purview () a IO
+        handler =
+          simpleHandler (0 :: Int)
+            actionHandler
+            (Text . show)
+
+      render handler
+        `shouldBe`
+        "<div handler=\"null\">0</div>"
+
+      chan <- newTChanIO
+
+      let event' = Event { event="click", message="up", location=Nothing }
+
+      appliedHandler <- apply chan event' handler
+
+      stateEvent <- atomically $ readTChan chan
+
+      show stateEvent `shouldBe` show (StateChangeEvent (id :: Int -> Int) Nothing)
+
+      afterState <- apply chan stateEvent appliedHandler
+
+      render afterState
+        `shouldBe`
+        "<div handler=\"null\">1</div>"
+
+    it "works for clicks across many different trees" $
+      property $ \x -> do
+        let event = Event { event="click", message="up", location=Nothing }
+        chan <- newTChanIO
+
+        component <- apply chan event (x :: Purview String String IO)
+        render component `shouldContain` "always present"
+
+    it "works for setting state across many different trees" $
+      property $ \x -> do
+        let event = Event { event="newState", message="up", location=Just [] }
+        chan <- newTChanIO
+
+        component <- apply chan event (x :: Purview String String IO)
+        -- this tests 2 things
+        -- 1. that it fully goes down the tree
+        -- 2. the component remains the same, since the event doesn't
+        --    have a location that matches anything
+        component `shouldBe` x
+
+    it "works with typed messages" $ do
+      let
+        actionHandler :: TestAction -> Int -> (Id Int, [DirectedEvent String TestAction])
+        actionHandler Up   _ = (const 1, [])
+        actionHandler Down _ = (const 0, [])
+
+        handler =
+          messageHandler (0 :: Int)
+            actionHandler
+            (Text . show)
+
+      render handler
+        `shouldBe`
+        "<div handler=\"null\">0</div>"
+
+      chan <- newTChanIO
+
+      let event' = Event { event="click", message=toJSON Up, location=Nothing }
+
+      appliedHandler <- apply chan event' handler
+
+      stateEvent <- atomically $ readTChan chan
+
+      afterState <- apply chan stateEvent appliedHandler
+
+      render afterState
+        `shouldBe`
+        "<div handler=\"null\">1</div>"
+
+    it "works after sending an event that did not match anything" $ do
+      let
+        actionHandler :: TestAction -> Int -> (Id Int, [DirectedEvent String TestAction])
+        actionHandler Up   _ = (const 1, [])
+        actionHandler Down _ = (const 0, [])
+
+        handler =
+          messageHandler (0 :: Int)
+            actionHandler
+            (Text . show)
+
+      chan <- newTChanIO
+
+      let event0 = Event { event="init", message="init", location=Nothing }
+
+      appliedHandler0 <- apply chan event0 handler
+      render appliedHandler0
+        `shouldBe`
+        "<div handler=\"null\">0</div>"
+
+      let event1 = Event { event="init", message=toJSON Up, location=Nothing }
+
+      appliedHandler1 <- apply chan event1 appliedHandler0
+
+      stateEvent <- atomically $ readTChan chan
+      appliedHandler2 <- apply chan stateEvent appliedHandler1
+
+      render appliedHandler2
+        `shouldBe`
+        "<div handler=\"null\">1</div>"
+
+    it "works with a nested attribute" $ do
+      let
+        childHandler :: TestAction -> Int -> (Id Int, [DirectedEvent String TestAction])
+        childHandler Up   _ = (const 1, [Parent "hello"])
+        childHandler Down _ = (const 0, [])
+
+        parentHandler :: String -> String -> (Id String, [DirectedEvent String String])
+        parentHandler "hello" _ = (const "bye", [])
+        parentHandler "bye" _ = (const "hello", [])
+        parentHandler str _ = (const str, [])
+
+        styledContainer = style "font-size: 10px;" . div
+
+        handler =
+          messageHandler ("" :: String) parentHandler
+            $ \message ->
+                styledContainer
+                [ text message
+                , messageHandler (0 :: Int)
+                    childHandler
+                    (text . show)
+                ]
+
+        component = handler
+
+      chan <- newTChanIO
+
+      let
+        locatedGraph = fst $ prepareTree component
+        event1 = Event { event="click", message=toJSON Up, location=Just [1, 0] }
+
+      afterEvent1 <- apply chan event1 locatedGraph
+
+      receivedEvent1 <- atomically $ readTChan chan
+      show receivedEvent1 `shouldBe` show (StateChangeEvent (id :: Int -> Int) (Just [1, 0]))
+
+      receivedEvent2 <- atomically $ readTChan chan
+      receivedEvent2 `shouldBe` Event {event = "internal", message = String "hello", location = Just []}
+
+    describe "sending events" $ do
+
+      it "can send an event to a parent" $ do
+        let
+          childHandler :: TestAction -> Int -> (Id Int, [DirectedEvent String TestAction])
+          childHandler Up   _ = (const 1, [Parent "hello"])
+          childHandler Down _ = (const 0, [])
+
+          parentHandler :: String -> String -> (Id String, [DirectedEvent String String])
+          parentHandler "hello" _ = (const "bye", [])
+          parentHandler "bye" _ = (const "hello", [])
+          parentHandler str _ = (const str, [])
+
+          handler =
+            messageHandler ("" :: String) parentHandler
+              $ \message ->
+                  div
+                  [ text message
+                  , messageHandler (0 :: Int)
+                      childHandler
+                      (text . show)
+                  ]
+
+        chan <- newTChanIO
+
+        let locatedGraph = fst $ prepareTree handler
+
+        render locatedGraph `shouldBe` "<div handler=\"[]\"><div><div handler=\"[1,0]\">0</div></div></div>"
+
+        let event1 = Event { event="click", message=toJSON Up, location=Just [1, 0] }
+
+        afterEvent1 <- apply chan event1 locatedGraph
+
+        receivedEvent1 <- atomically $ readTChan chan
+        show receivedEvent1 `shouldBe` show (StateChangeEvent (id :: Int -> Int) (Just [1, 0]))
+
+        receivedEvent2 <- atomically $ readTChan chan
+        -- correctly targeted to the parent
+        receivedEvent2 `shouldBe` Event {event = "internal", message = String "hello", location = Just []}
+
+
+      it "can send an event to self" $ do
+        let
+          childHandler :: TestAction -> Int -> (Int -> Int, [DirectedEvent String TestAction])
+          childHandler Up   _ = (const 1, [Self Down])
+          childHandler Down _ = (const 0, [])
+
+          parentHandler :: String -> String -> (String -> String, [DirectedEvent String String])
+          parentHandler "hello" _ = (const "bye", [])
+          parentHandler "bye" _ = (const "hello", [])
+          parentHandler str _ = (const str, [])
+
+          handler =
+            messageHandler ("" :: String) parentHandler
+              $ \message ->
+                  div
+                  [ text message
+                  , messageHandler (0 :: Int)
+                      childHandler
+                      (text . show)
+                  ]
+
+        chan <- newTChanIO
+
+        let locatedGraph = fst $ prepareTree handler
+
+        render locatedGraph `shouldBe` "<div handler=\"[]\"><div><div handler=\"[1,0]\">0</div></div></div>"
+
+        let event1 = Event { event="click", message=toJSON Up, location=Just [1, 0] }
+
+        afterEvent1 <- apply chan event1 locatedGraph
+
+        receivedEvent1 <- atomically $ readTChan chan
+        show receivedEvent1 `shouldBe` show (StateChangeEvent (id :: Int -> Int) (Just [1, 0]))
+
+        receivedEvent2 <- atomically $ readTChan chan
+        -- correctly targeted to self
+        receivedEvent2 `shouldBe` Event {event = "internal", message = String "Down", location = Just [1,0]}
+
+
+main :: IO ()
+main = hspec spec
diff --git a/src/EventLoop.hs b/src/EventLoop.hs
new file mode 100644
--- /dev/null
+++ b/src/EventLoop.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module EventLoop
+ ( eventLoop )
+where
+
+import           Control.Concurrent.STM.TChan
+import           Control.Monad.STM
+import           Control.Monad
+import           Control.Concurrent
+import           Data.Aeson (encode)
+import qualified Network.WebSockets as WebSockets
+
+import           Component
+import           Diffing
+import           EventHandling
+import           Events
+import           PrepareTree
+import           Rendering
+
+type Log m = String -> m ()
+
+--
+-- This is the main event loop of handling messages from the websocket
+--
+-- pretty much just get a message, then run the message via the component
+-- handler, and then send the "setHtml" back downstream to tell it to replace
+-- the html with the new.
+--
+eventLoop
+  :: Monad m
+  => Bool
+  -> (m [Event] -> IO [Event])
+  -> Log IO
+  -> TChan Event
+  -> WebSockets.Connection
+  -> Purview parentAction action m
+  -> IO ()
+eventLoop devMode runner log eventBus connection component = do
+  message <- atomically $ readTChan eventBus
+
+  when devMode $ log $ "received> " <> show message
+
+  let
+    -- this collects any actions that should run once and sets them
+    -- to "run" in the tree, while assigning locations / identifiers
+    -- to the event handlers
+    (newTree, actions) = prepareTree component
+
+  -- if it's special newState event, the state is replaced in the tree
+  let newTree' = case message of
+        Event {} -> newTree
+        stateChangeEvent -> applyNewState stateChangeEvent newTree
+
+  -- this is where handlers are actually called, and their events are sent back into
+  -- this loop
+  void . forkIO $ do
+    newEvents <- runner $ runEvent message newTree'
+    mapM_ (atomically . writeTChan eventBus) newEvents
+
+  mapM_ (atomically . writeTChan eventBus) actions
+
+  let
+    -- collect diffs
+    location = case message of
+      (Event { location }) -> location
+      (StateChangeEvent _ location) -> location
+
+    diffs = diff location [0] component newTree'
+    -- for now it's just "Update", which the javascript handles as replacing
+    -- the html beneath the handler.  I imagine it could be more exact, with
+    -- Delete / Create events.
+    renderedDiffs = fmap (\(Update location graph) -> Update location (render graph)) diffs
+
+  when devMode $ log $ "sending> " <> show renderedDiffs
+
+  WebSockets.sendTextData
+    connection
+    (encode $ ForFrontEndEvent { event = "setHtml", message = renderedDiffs })
+
+  case message of
+    (Event { event }) ->
+      when (devMode && event == "init") $
+        WebSockets.sendTextData
+          connection
+          (encode $ ForFrontEndEvent { event = "setHtml", message = [ Update [] (render newTree') ] })
+    _ -> pure ()
+
+  eventLoop devMode runner log eventBus connection newTree'
diff --git a/src/Events.hs b/src/Events.hs
new file mode 100644
--- /dev/null
+++ b/src/Events.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Events where
+
+import           Data.Text (Text)
+import           Data.Typeable
+import           Data.Aeson
+import           GHC.Generics
+
+{-|
+
+This for events intended for the front end
+
+-}
+data ForFrontEndEvent m = ForFrontEndEvent
+  { event :: Text
+  , message :: m
+  } deriving (Generic, Show)
+
+instance ToJSON m => ToJSON (ForFrontEndEvent m) where
+  toEncoding = genericToEncoding defaultOptions
+
+{-|
+
+These encapsulate events that come from the front end in addition to events
+that are internal.  For example, state changes or messages being sent to
+handlers higher up in the tree.
+
+-}
+data Event where
+  Event ::
+    { event :: Text
+    , message :: Value
+    , location :: Maybe [Int]
+    } -> Event
+
+  StateChangeEvent
+    :: ( Eq state
+       , Typeable state
+       , ToJSON state
+       , FromJSON state)
+    => (state -> state) -> Maybe [Int] -> Event
+
+instance Show Event where
+  show (Event event message location) =
+    show $ "{ event: "
+      <> show event
+      <> ", message: "
+      <> show message
+      <> ", location: "
+      <> show location <> " }"
+  show (StateChangeEvent _ location) =
+    "{ event: \"newState\", location: " <> show location <> " }"
+
+instance Eq Event where
+  (Event { message=messageA, event=eventA, location=locationA })
+    == (Event { message=messageB, event=eventB, location=locationB }) =
+    eventA == eventB && messageA == messageB && locationA == locationB
+  (Event {}) == _ = False
+  (StateChangeEvent _ _) == _ = False
+
+instance FromJSON Event where
+  parseJSON (Object o) =
+      Event <$> o .: "event" <*> (o .: "message") <*> o .: "location"
+  parseJSON _ = error "fail"
+
+{-|
+
+This is for creating events that should go to a parent handler,
+or sent back in to the same handler.
+
+-}
+data DirectedEvent a b = Parent a | Self b
+  deriving (Generic, Show, Eq)
+
+instance (ToJSON a, ToJSON b) => ToJSON (DirectedEvent a b) where
+  toEncoding = genericToEncoding defaultOptions
diff --git a/src/PrepareTree.hs b/src/PrepareTree.hs
new file mode 100644
--- /dev/null
+++ b/src/PrepareTree.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+module PrepareTree where
+
+import Data.Aeson
+
+import Component
+import Events
+
+{-|
+
+This walks through the tree and collects actions that should be run
+only once, and sets their run value to True.  It's up to something
+else to actually send the actions.
+
+It also assigns a location to message and effect handlers.
+
+-}
+
+prepareTree :: Purview parentAction action m -> (Purview parentAction action m, [Event])
+prepareTree = prepareTree' [] []
+
+type Location = [Int]
+
+prepareTree'
+  :: Location
+  -> Location
+  -> Purview parentAction action m
+  -> (Purview parentAction action m, [Event])
+prepareTree' parentLocation location component = case component of
+  Attribute attrs cont ->
+    let result = prepareTree' parentLocation location cont
+    in (Attribute attrs (fst result), snd result)
+
+  Html kind children ->
+    let result = fmap (\(index, child) -> prepareTree' parentLocation (index:location) child) (zip [0..] children)
+    in (Html kind (fmap fst result), concatMap snd result)
+
+  EffectHandler _ploc _loc state handler cont ->
+    let
+      rest = fmap (prepareTree' location (0:location)) cont
+    in
+      ( EffectHandler (Just parentLocation) (Just location) state handler (\state' -> fst (rest state'))
+      , snd (rest state)
+      )
+
+  Once effect hasRun cont ->
+    let send message =
+          Event
+            { event = "once"
+            , message = toJSON message
+            , location = Just location
+            }
+    in if not hasRun then
+        let
+          rest = prepareTree' parentLocation location cont
+        in
+          (Once effect True (fst rest), [effect send] <> (snd rest))
+       else
+        let
+          rest = prepareTree' parentLocation location cont
+        in
+          (Once effect True (fst rest), snd rest)
+
+  Hide x ->
+    let (child, actions) = prepareTree' parentLocation location x
+    in (Hide child, actions)
+
+  Value x -> (Value x, [])
+
+  Text x -> (Text x, [])
diff --git a/src/PrepareTreeSpec.hs b/src/PrepareTreeSpec.hs
new file mode 100644
--- /dev/null
+++ b/src/PrepareTreeSpec.hs
@@ -0,0 +1,136 @@
+module PrepareTreeSpec where
+
+import Prelude hiding (div)
+import Test.Hspec
+import Test.QuickCheck
+import Data.Time
+
+import TreeGenerator
+import Events
+import Component
+import PrepareTree
+
+spec :: SpecWith ()
+spec = parallel $ do
+
+  describe "prepareTree" $ do
+
+    it "works across a variety of trees" $ do
+      property $ \x -> show (fst (prepareTree (x :: Purview String String IO))) `shouldContain` "always present"
+
+    it "sets hasRun to True" $ do
+      let
+        display time = div
+          [ text (show time)
+          , onClick ("setTime" :: String) $ div [ text "check time" ]
+          ]
+
+        startClock cont state = Once (\send -> send ("setTime" :: String)) False (cont state)
+
+        timeHandler = EffectHandler Nothing Nothing Nothing handle
+
+        handle :: String -> Maybe UTCTime -> IO (Maybe UTCTime -> Maybe UTCTime, [DirectedEvent String String])
+        handle "setTime" _     = do
+          time <- getCurrentTime
+          pure (const $ Just time, [])
+        handle _         state = pure (const state, [])
+
+        component = timeHandler (startClock display)
+
+      show (fst (prepareTree component))
+        `shouldBe`
+        "EffectHandler Just [] Just [] \"null\" Once True div [  \"Nothing\" Attr div [  \"check time\" ]  ] "
+
+      length (snd (prepareTree component))
+        `shouldBe`
+        1
+
+    it "stops collecting the action if it has already run" $ do
+      let
+        display time = div
+          [ text (show time)
+          , onClick ("setTime" :: String) $ div [ text "check time" ]
+          ]
+
+        startClock cont state = Once (\send -> send ("setTime" :: String)) False (cont state)
+
+        timeHandler = EffectHandler Nothing Nothing Nothing handle
+
+        handle :: String -> Maybe UTCTime -> IO (Maybe UTCTime -> Maybe UTCTime, [DirectedEvent String String])
+        handle "setTime" _     = do
+          time <- getCurrentTime
+          pure (const $ Just time, [])
+        handle _         state = pure (const state, [])
+
+        component = timeHandler (startClock display)
+
+      let
+        run1 = prepareTree component
+        run2 = prepareTree (fst run1)
+        run3 = prepareTree (fst run2)
+
+      length (snd run1) `shouldBe` 1
+      length (snd run2) `shouldBe` 0
+      length (snd run3) `shouldBe` 0  -- for a bug where it was resetting run
+
+    it "assigns a location to handlers" $ do
+      let
+        timeHandler = effectHandler Nothing handle
+
+        handle :: String -> Maybe UTCTime -> IO (Maybe UTCTime -> Maybe UTCTime, [DirectedEvent String String])
+        handle "setTime" _     = do
+          time <- getCurrentTime
+          pure (const $ Just time, [])
+        handle _         state = pure (const state, [])
+
+        component = timeHandler (const (Text ""))
+
+      component `shouldBe` Hide (EffectHandler Nothing Nothing Nothing handle (const (Text "")))
+
+      let
+        graphWithLocation = fst (prepareTree component)
+
+      graphWithLocation `shouldBe` Hide (EffectHandler (Just []) (Just []) Nothing handle (const (Text "")))
+
+    it "assigns a different location to child handlers" $ do
+      let
+        timeHandler = effectHandler Nothing handle
+
+        handle :: String -> Maybe UTCTime -> IO (Maybe UTCTime -> Maybe UTCTime, [DirectedEvent String String])
+        handle "setTime" _     = do
+          time <- getCurrentTime
+          pure (const $ Just time, [])
+        handle _         state = pure (const state, [])
+
+        component = div
+          [ timeHandler (const (Text ""))
+          , timeHandler (const (Text ""))
+          ]
+
+        graphWithLocation = fst (prepareTree component)
+
+      show graphWithLocation
+        `shouldBe`
+        "div [  Hide EffectHandler Just [] Just [0] \"null\" \"\" Hide EffectHandler Just [] Just [1] \"null\" \"\" ] "
+
+    it "assigns a different location to nested handlers" $ do
+      let
+        timeHandler = effectHandler Nothing handle
+
+        handle :: String -> Maybe UTCTime -> IO (Maybe UTCTime -> Maybe UTCTime, [DirectedEvent String String])
+        handle "setTime" _     = do
+          time <- getCurrentTime
+          pure (const $ Just time, [])
+        handle _         state = pure (const state, [])
+
+        component =
+          timeHandler (const (timeHandler (const (Text ""))))
+
+
+        graphWithLocation = fst (prepareTree component)
+
+      show graphWithLocation `shouldBe` "Hide EffectHandler Just [] Just [] \"null\" Hide EffectHandler Just [] Just [0] \"null\" \"\""
+
+
+main :: IO ()
+main = hspec spec
diff --git a/src/Purview.hs b/src/Purview.hs
new file mode 100644
--- /dev/null
+++ b/src/Purview.hs
@@ -0,0 +1,221 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+{-|
+
+Purview aims to be pretty straightforward to work with.  As an example,
+here's a counter that we'll then go through.
+
+> module Main where
+>
+> import Purview
+>
+> incrementButton = onClick "increment" $ button [ text "+" ]
+> decrementButton = onClick "decrement" $ button [ text "-" ]
+>
+> view count = div
+>   [ p [ text ("count: " <> show count) ]
+>   , incrementButton
+>   , decrementButton
+>   ]
+>
+> handler :: (Integer -> Purview String any IO) -> Purview () any IO
+> handler = simpleHandler (0 :: Integer) reducer
+>
+> reducer action state = case action of
+>   "increment" -> state + 1
+>   "decrement" -> state - 1
+>
+> top = handler view
+>
+> main = run defaultConfiguration { component=top, devMode=True }
+
+First we define two buttons, each which have action producers ('onClick').
+
+When rendered, this tells Purview that when either is clicked it'd like to receive
+a message ('increment' or 'decrement').
+
+Then we define a handler, which takes an initial state ("0"), and a reducer.
+
+The reducer defines how we're supposed to handle the events received, and it passes
+down the new state to components.
+
+Then we put it together ("handler view"), and run it.
+
+Note the "devMode=True": this tells Purview to send the whole
+tree over again when the websocket reconnects.  This is really handy
+if you're re-running the server in ghci, although I really recommend
+using ghcid so you can do:
+
+> ghcid --command 'stack ghci yourProject/Main.hs' --test :main
+
+Which will automatically restart the server on code changes.  It's fast!
+
+For more in depth reading check out the [readme](https://github.com/purview-framework/purview/blob/main/README.md) and
+the [examples](https://github.com/purview-framework/purview/tree/main/examples) folder.
+
+-}
+
+module Purview
+  (
+  -- ** Server
+    run
+  , Configuration (..)
+  , defaultConfiguration
+
+  -- ** Handlers
+  -- | These are how you can catch events sent from things like 'onClick' and
+  -- change state, or in the case of 'effectHandler', make API requests or call
+  -- functions from your project.
+  , simpleHandler
+  , messageHandler
+  , effectHandler
+
+  -- ** HTML helpers
+  , div
+  , span
+  , p
+  , h1
+  , h2
+  , h3
+  , h4
+  , text
+  , button
+  , form
+  , input
+  , style
+
+  -- ** Action producers
+  , onClick
+  , onSubmit
+
+  -- ** For Testing
+  , render
+
+  -- ** AST
+  , Attributes (..)
+  , DirectedEvent (..)
+  , Purview (..)
+  )
+where
+
+import Prelude hiding (div, log, span)
+import qualified Web.Scotty as Sc
+import           Data.Text (pack, Text, all)
+import qualified Data.Text.Lazy as LazyText
+import qualified Network.Wai.Middleware.Gzip as Sc
+import qualified Network.Wai.Handler.WebSockets as WaiWebSocket
+import qualified Network.WebSockets as WebSocket
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
+import           Data.Aeson
+
+import           Control.Monad (when)
+import           Control.Concurrent.STM.TChan
+import           Control.Monad.STM
+import           Control.Concurrent
+
+import           Component
+import           EventLoop
+import           Events
+import           PrepareTree
+import           Rendering
+import           Wrapper
+import Network.Wai.Middleware.RequestLogger (mkRequestLogger)
+
+type Log m = String -> m ()
+
+data Configuration parentAction action m = Configuration
+  { component         :: Purview parentAction action m
+  -- ^ The top level component to put on the page.
+  , interpreter       :: m [Event] -> IO [Event]
+  -- ^ How to run your algebraic effects or other.  This will apply to all `effectHandler`s.
+  , logger            :: String -> IO ()
+  -- ^ Specify what to do with logs
+  , htmlEventHandlers :: [HtmlEventHandler]
+  -- ^ For extending the handled events.  Have a look at 'defaultConfiguration' to see
+  -- how to make your own.
+  , htmlHead          :: Text
+  -- ^ This is placed directly into the \<head\>, so that you can link to external
+  -- CSS etc
+  , devMode           :: Bool
+  -- ^ When enabled, Purview will send the whole tree on websocket reconnection.
+  -- This enables you to use
+  -- "ghcid --command 'stack ghci examples/Main.hs' --test :main`"
+  -- to restart the server on file change, and get a kind of live reloading
+  }
+
+defaultConfiguration :: Configuration parentAction action IO
+defaultConfiguration = Configuration
+  { component         = div []
+  , interpreter       = id
+  , logger            = print
+  , htmlEventHandlers = [clickEventHandler, submitEventHandler]
+  , htmlHead          = ""
+  , devMode           = False
+  }
+
+{-|
+
+This starts up the Scotty server.  As a tiny example, to display some text saying "hello":
+
+> import Purview
+>
+> view = p [ text "hello" ]
+>
+> main = run defaultConfiguration { component=view }
+
+-}
+run :: Monad m => Configuration () any m -> IO ()
+run Configuration { devMode, component, logger, interpreter, htmlEventHandlers, htmlHead } = do
+  let port = 8001
+  let settings = Warp.setPort port Warp.defaultSettings
+  requestHandler' <- requestHandler component htmlHead htmlEventHandlers
+  Warp.runSettings settings
+    $ WaiWebSocket.websocketsOr
+        WebSocket.defaultConnectionOptions
+        (webSocketHandler devMode interpreter logger component)
+        requestHandler'
+
+requestHandler :: Purview parentAction action m -> Text -> [HtmlEventHandler] -> IO Wai.Application
+requestHandler routes htmlHead htmlEventHandlers =
+  Sc.scottyApp $ do
+    Sc.middleware $ Sc.gzip $ Sc.def { Sc.gzipFiles = Sc.GzipCompress }
+
+    Sc.get "/"
+      $ Sc.html
+      $ LazyText.fromStrict
+      $ wrapHtml htmlHead htmlEventHandlers
+      $ Data.Text.pack
+      $ render . fst
+      $ prepareTree routes
+
+webSocketMessageHandler :: TChan Event -> WebSocket.Connection -> IO ()
+webSocketMessageHandler eventBus websocketConnection = do
+  message' <- WebSocket.receiveData websocketConnection
+
+  case decode message' of
+    Just fromEvent -> atomically $ writeTChan eventBus fromEvent
+    Nothing -> pure ()
+
+  webSocketMessageHandler eventBus websocketConnection
+
+webSocketHandler
+  :: Monad m
+  => Bool
+  -> (m [Event] -> IO [Event])
+  -> Log IO
+  -> Purview parentAction action m
+  -> WebSocket.ServerApp
+webSocketHandler devMode runner log component pending = do
+  when devMode $ putStrLn "ws connected"
+  conn <- WebSocket.acceptRequest pending
+
+  eventBus <- newTChanIO
+
+  atomically $ writeTChan eventBus $ Event { event = "init", message = "init", location = Nothing }
+
+  WebSocket.withPingThread conn 30 (pure ()) $ do
+    _ <- forkIO $ webSocketMessageHandler eventBus conn
+    eventLoop devMode runner log eventBus conn component
diff --git a/src/PurviewSpec.hs b/src/PurviewSpec.hs
new file mode 100644
--- /dev/null
+++ b/src/PurviewSpec.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+module PurviewSpec where
+
+import Prelude hiding (div)
+import Test.Hspec
+import Purview
+
+upButton :: Purview parentAction String m
+upButton = onClick ("up" :: String) $ div [ text "up" ]
+
+downButton :: Purview parentAction String m
+downButton = onClick ("down" :: String) $ div [ text "down" ]
+
+handler :: Applicative m => (Int -> Purview String action m) -> Purview String action m
+handler = simpleHandler 0 action
+  where
+    action :: String -> Int -> Int
+    action "up" _ = 1
+    action _    _ = 0
+
+-- counter :: Show a => a -> Purview parentAction action m
+counter state = div
+  [ upButton
+  , text $ "count: " <> show state
+  , downButton
+  ]
+
+component :: Applicative m => Purview String String m
+component = handler counter
+
+event' :: String
+event' = "{\"event\":\"click\",\"message\":\"up\"}"
+
+spec :: SpecWith ()
+spec = parallel $ do
+  describe "applying events" $ do
+    it "works with the event directly" $ do
+--      let applied = handleEvent event' component
+--
+--      render [] applied `shouldNotBe` render [] component
+      (1 :: Integer) `shouldBe` 1
+
+main :: IO ()
+main = hspec spec
diff --git a/src/Rendering.hs b/src/Rendering.hs
new file mode 100644
--- /dev/null
+++ b/src/Rendering.hs
@@ -0,0 +1,74 @@
+module Rendering where
+
+import           Data.Aeson
+import           Data.ByteString.Lazy.Char8 (unpack)
+import           Unsafe.Coerce
+
+import           Component
+
+isOn :: Attributes a -> Bool
+isOn (On _ _) = True
+isOn _        = False
+
+isGeneric :: Attributes a -> Bool
+isGeneric (Generic _ _) = True
+isGeneric _ = False
+
+getStyle :: Attributes a -> String
+getStyle (Style style') = style'
+getStyle _              = ""
+
+renderGeneric :: Attributes a -> String
+renderGeneric attr = case attr of
+  (Generic name value) -> " " <> name <> "=" <> unpack (encode value)
+  _ -> ""
+
+renderAttributes :: [Attributes a] -> String
+renderAttributes attrs =
+  let
+    styles = concatMap getStyle attrs
+    renderedStyle = if not (null styles) then " style=" <> show styles else ""
+
+    listeners = filter isOn attrs
+    renderedListeners = concatMap
+      (\(On name action) -> " action=" <> (unpack $ encode action))
+      listeners
+
+    generics = filter isGeneric attrs
+    renderedGenerics = concatMap renderGeneric generics
+  in
+    renderedStyle <> renderedListeners <> renderedGenerics
+
+{-|
+
+Takes the tree and turns it into HTML.  Attributes are passed down to children until
+they reach a real HTML tag.
+
+-}
+
+render :: Purview parentAction action m -> String
+render = render' []
+
+render' :: [Attributes action] -> Purview parentAction action m -> String
+render' attrs tree = case tree of
+  Html kind rest ->
+    "<" <> kind <> renderAttributes attrs <> ">"
+    <> concatMap (render' []) rest <>
+    "</" <> kind <> ">"
+
+  Text val -> val
+
+  Attribute attr rest ->
+    render' (attr:attrs) rest
+
+  EffectHandler parentLocation location state _ cont ->
+    "<div handler=" <> (show . encode) location <> ">" <>
+      render' attrs (unsafeCoerce cont state) <>
+    "</div>"
+
+  Once _ _hasRun cont ->
+    render' attrs cont
+
+  Value a -> show a
+
+  Hide a -> render' attrs (unsafeCoerce a)
diff --git a/src/RenderingSpec.hs b/src/RenderingSpec.hs
new file mode 100644
--- /dev/null
+++ b/src/RenderingSpec.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE TemplateHaskell #-}
+module RenderingSpec where
+
+import Prelude hiding (div)
+import Data.Aeson.TH
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck hiding (classes, once)
+
+import TreeGenerator
+import Component
+import Events
+import Rendering
+
+data SingleConstructor = SingleConstructor
+
+$(deriveJSON (defaultOptions{tagSingleConstructors=True}) ''SingleConstructor)
+
+
+spec :: SpecWith ()
+spec = parallel $ do
+
+  describe "render" $ do
+
+    it "can render an assortment of different trees" $
+      property $ \x -> render (x :: Purview String String IO) `shouldContain` "always present"
+
+    it "can create a div" $ do
+      let element = Html "div" [Text "hello world"]
+
+      render element `shouldBe` "<div>hello world</div>"
+
+    it "can add an onclick" $ do
+      let element =
+            Attribute (On "click" (1 :: Integer))
+            $ Html "div" [Text "hello world"]
+
+      render element `shouldBe`
+        "<div action=1>hello world</div>"
+
+    it "can add an id" $ do
+      let element = identifier "hello" $ div [text "it's a hello div"]
+      render element `shouldBe` "<div id=\"hello\">it's a hello div</div>"
+
+    it "can add one class" $ do
+      let element =
+            classes ["class1"] $ div [text "it's a hello div"]
+      render element `shouldBe` "<div class=\"class1\">it's a hello div</div>"
+
+    it "can add classes" $ do
+      let element =
+            classes ["class1", "class2", "class3"] $ div [text "it's a hello div"]
+      render element `shouldBe` "<div class=\"class1 class2 class3\">it's a hello div</div>"
+
+    it "can render classes and ids at the same time" $ do
+      let element =
+            classes ["class1", "class2", "class3"]
+            $ identifier "hello"
+            $ div [text "it's a hello div"]
+      render element `shouldBe` "<div id=\"hello\" class=\"class1 class2 class3\">it's a hello div</div>"
+
+    it "can render a form" $ do
+      let
+        named = Attribute . Generic "name"
+        input = Html "input"
+        form = Html "form"
+        component = onSubmit ("initialValue" :: String) $ form [ named "name" $ input [] ]
+
+      render component
+        `shouldBe`
+        "<form action=\"initialValue\"><input name=\"name\"></input></form>"
+
+    it "can render a typed action" $ do
+      let element = onClick SingleConstructor $ div [ text "click" ]
+
+      render element
+        `shouldBe`
+        "<div action=\"SingleConstructor\">click</div>"
+
+    it "can render a style" $ do
+      let element = style "color: blue;" $ div [ text "blue" ]
+
+      render element
+        `shouldBe`
+        "<div style=\"color: blue;\">blue</div>"
+
+    it "can render composed styles" $ do
+      let blue = style "color: blue;"
+          halfSize = style "width: 50%; height: 50%;"
+
+      render (blue . halfSize $ div [ text "box" ])
+        `shouldBe`
+        "<div style=\"width: 50%; height: 50%;color: blue;\">box</div>"
+
+
+
+main :: IO ()
+main = hspec spec
diff --git a/src/Spec.hs b/src/Spec.hs
new file mode 100644
--- /dev/null
+++ b/src/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
diff --git a/src/TreeGenerator.hs b/src/TreeGenerator.hs
new file mode 100644
--- /dev/null
+++ b/src/TreeGenerator.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE FlexibleInstances #-}
+module TreeGenerator where
+
+import Prelude hiding (div)
+import Test.Hspec
+import Test.QuickCheck hiding (once)
+import Control.Monad.IO.Class
+
+import Component
+import Events
+
+{-
+
+This is a helper to generate semi random purview trees
+for tests, and to make sure everything can be combined
+nicely.
+
+-}
+
+testHandler :: (String -> Purview String action IO) -> Purview String action IO
+testHandler = effectHandler ("" :: String) reducer
+  where
+    reducer :: String -> String -> IO (String -> String, [DirectedEvent String String])
+    reducer action state = pure (const "", [])
+
+testOnce = once (\send -> send "")
+
+sizedArbExpr :: Int -> Gen (Purview String String IO)
+sizedArbExpr 0 = do pure $ text "always present"
+sizedArbExpr n = do
+  es <- vectorOf 2 (sizedArbExpr (n-1))
+  elements
+    [ div es
+    , style "" $ div es
+    , testHandler (const $ div es)
+    , testOnce (div es)
+    ]
+
+instance Arbitrary (Purview String String IO) where
+  arbitrary = resize 3 $ sized sizedArbExpr
diff --git a/src/Wrapper.hs b/src/Wrapper.hs
new file mode 100644
--- /dev/null
+++ b/src/Wrapper.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Wrapper where
+
+import           Text.RawString.QQ (r)
+import           Data.Text (Text)
+
+
+data HtmlEventHandler = HtmlEventHandler
+  { eventType :: Text -- eg submit or click
+  , functionName :: Text -- called whenever the event happens
+  , handlingFunction :: Text -- receives the event and sends the event over the websocket
+  }
+
+clickEventHandlingFunction :: Text
+clickEventHandlingFunction = [r|
+  function handleClickEvents(event) {
+    event.stopPropagation();
+
+    var clickValue;
+    try {
+      clickValue = JSON.parse(event.target.getAttribute("action"));
+    } catch (error) {
+      // if the action is just a string, parsing it as JSON would fail
+      clickValue = event.target.getAttribute("action");
+    }
+    var location = JSON.parse(event.currentTarget.getAttribute("handler"))
+
+    if (clickValue) {
+      window.ws.send(JSON.stringify({ "event": "click", "message": clickValue, "location": location }));
+    }
+  }
+|]
+
+clickEventHandler :: HtmlEventHandler
+clickEventHandler = HtmlEventHandler "click" "handleClickEvents" clickEventHandlingFunction
+
+submitEventHandlingFunction :: Text
+submitEventHandlingFunction = [r|
+  function handleFormEvents(event) {
+    event.preventDefault();
+    event.stopPropagation();
+
+    var form = new FormData(event.target);
+    var entries = Object.fromEntries(form.entries());
+    var location = JSON.parse(event.currentTarget.getAttribute("handler"))
+
+    if (entries) {
+      window.ws.send(JSON.stringify({ "event": "submit", "message": entries, "location": location }));
+    }
+  }
+|]
+
+submitEventHandler :: HtmlEventHandler
+submitEventHandler = HtmlEventHandler "submit" "handleFormEvents" submitEventHandlingFunction
+
+defaultHtmlEventHandlers :: [HtmlEventHandler]
+defaultHtmlEventHandlers =
+  [ clickEventHandler
+  , submitEventHandler
+  ]
+
+mkBinding :: HtmlEventHandler -> Text
+mkBinding (HtmlEventHandler kind functionName _) =
+  "item.removeEventListener(\"" <> kind <> "\", " <>  functionName <> ");"
+  <> "item.addEventListener(\"" <> kind <> "\", " <>  functionName <> ");"
+
+mkFunction :: HtmlEventHandler -> Text
+mkFunction (HtmlEventHandler _ _ function) = function
+
+bindEvents :: [HtmlEventHandler] -> Text
+bindEvents htmlEventHandlers =
+  let bindings = foldr (<>) "" $ fmap mkBinding htmlEventHandlers
+      functions = foldr (<>) "" $ fmap mkFunction htmlEventHandlers
+  in
+    functions
+    <> "function bindEvents() {"
+    <> "document.querySelectorAll(\"[handler]\").forEach(item => {"
+    <> bindings
+    <> "});"
+    <> "};"
+
+websocketScript :: Text
+websocketScript = [r|
+  var timeoutTime = -50;
+  function connect() {
+    timeoutTime += 50;
+    var ws = new WebSocket("ws://localhost:8001");
+
+    ws.onopen = () => {
+      ws.send("initial from js");
+      timeoutTime = 0;
+    };
+
+    ws.onmessage = evt => {
+      var m = evt.data;
+      console.log( m );
+      console.log(JSON.parse( m ));
+      var event = JSON.parse(evt.data);
+      if (event.event === "setHtml") {
+        // cool enough for now
+        event.message.map(command => setHtml(command));
+        bindEvents();
+      }
+    };
+
+    ws.onclose = function() {
+      setTimeout(function() {
+        console.debug("Attempting to reconnect");
+        connect();
+      }, timeoutTime);
+    };
+
+    window.onbeforeunload = evt => {
+      ws.close();
+    };
+
+    window.ws = ws;
+  }
+  connect();
+
+  function getNode(location) {
+    let currentNode = document.body;
+    while (location.length > 0) {
+      const index = location.pop();
+      currentNode = currentNode.childNodes[index];
+    }
+    return currentNode;
+  }
+
+  function setHtml(message) {
+    const command = message.message;
+    const [location, newHtml] = message.contents;
+    const targetNode = getNode(location);
+    targetNode.outerHTML = newHtml;
+  }
+|]
+
+wrapHtml :: Text -> [HtmlEventHandler] -> Text -> Text
+wrapHtml htmlHead htmlEventHandlers body =
+  "<html>"
+  <> "<head>"
+  <> "<script>" <> websocketScript <> bindEvents htmlEventHandlers <> "bindEvents();" <> "</script>"
+  <> htmlHead
+  <> "</head>"
+  <> "<body>"<> body <> "</body>"
+  <> "</html>"
