plzwrk 0.0.0.2 → 0.0.0.3

raw patch · 11 files changed

+1848/−1381 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• README.md +2/−2
• kitchen-sink/Main.hs +2/−2
• plzwrk.cabal +1/−1
• src/Web/Framework/Plzwrk.hs +15/−0
• src/Web/Framework/Plzwrk/Asterius.hs +158/−100
• src/Web/Framework/Plzwrk/Browserful.hs +74/−39
• src/Web/Framework/Plzwrk/Domify.hs +483/−481
• src/Web/Framework/Plzwrk/MockJSVal.hs +693/−519
• src/Web/Framework/Plzwrk/Util.hs +303/−140
• test/Spec.hs +112/−97

@@ -1,5 +1,10 @@ # Changelog for plzwrk +## 0.0.0.3++- Adds bindings for `fetch`+- Simplifies `Browserful` API to only contain primitives and uses utility functions to build on top of the primitives.+ ## 0.0.0.2  - Adds server side rendering via `toHTML` and `plzwrkSSR`.

@@ -85,9 +85,9 @@ 
 > If you are using the Asterius backend, callback functions are still quite fragile and subject to breakage. The less third-party libraries you use in them, the better. For example, avoid using `Data.Text` and `aeson` if possible.
 
-## Static site rendering
+## Server side rendering
 
-Plzwrk supports static site rendering. To do this, you have to compile your site twice:
+Plzwrk supports server side rendering. To do this, you have to compile your site twice:
 - once using `ahc-cabal` using the procedure above to create any JavaScript you need (ie event handlers), and
 - once using plain old `cabal` to create the inital HTML.
 

@@ -66,11 +66,11 @@       (wId "incr" <.> wClass "dim" <.> wOnClick
         (\e s -> do
           (eventTargetBlur browser) e
-          (consoleLog browser) $ "Here is the current state " <> show s
+          (consoleLogS browser) $ "Here is the current state " <> show s
           concept    <- randAbstract (mathRandom browser)
           comparedTo <- randConcrete (mathRandom browser)
           let newS = s { _abstractToConcrete = (concept, comparedTo) : a2c }
-          (consoleLog browser) $ "Here is the new state " <> show newS
+          (consoleLogS browser) $ "Here is the new state " <> show newS
           return $ newS
         )
       )

@@ -7,7 +7,7 @@ -- hash: 8099ceb0d406f862d89306de053aba4c75999a9e0d74ac6a502458d503e7dcc1  name:           plzwrk-version:        0.0.0.2+version:        0.0.0.3 category:       Web synopsis:       A front-end framework description:    Please see the README on GitHub at <https://github.com/meeshkan/plzwrk#readme>

@@ -45,6 +45,21 @@   , eventPreventDefault
   , eventTargetBlur
   , eventTargetValue
+  , elementSetAttribute
+  , elementTagName
+  , eventTargetAddEventListener
+  , eventTargetRemoveEventListener
+  , getPropertyAsBool
+  , getPropertyAsDouble
+  , getPropertyAsInt
+  , getPropertyAsString
+  , htmlElemenetClick
+  , consoleLogS
+  , nodeAppendChild
+  , nodeChildNodes
+  , nodeInsertBefore
+  , nodeRemoveChild
+  , nodeTextContent
   )
 where
 

@@ -23,59 +23,51 @@ import           Asterius.Aeson
 import           Asterius.ByteString
 import           Asterius.Types
+import           Data.ByteString.Internal       ( ByteString )
 import qualified Data.ByteString               as BS
 import           Data.ByteString.Unsafe
+import           Data.HashMap.Strict as HM
 import           Data.Coerce
 import           Foreign.Ptr
 import           Web.Framework.Plzwrk.Browserful
 
 asteriusBrowser :: IO (Browserful JSVal)
 asteriusBrowser = return Browserful
-  { eventTargetAddEventListener    = _eventTargetAddEventListener
-  , nodeAppendChild                = _nodeAppendChild
-  , htmlElemenetClick              = _htmlElemenetClick
+  { 
+    castToArray                    = _castToArray
+  , castToBool                     = _castToBool
+  , castToByteString               = _castToByteString
+  , castToDouble                   = _castToDouble
+  , castToInt                      = _castToInt
+  , castToString                   = _castToString
   , consoleLog                     = _consoleLog
-  , consoleLog'                    = _consoleLog'
+  , defaultRequestInit             = _defaultRequestInit
   , documentCreateElement          = _documentCreateElement
   , documentCreateTextNode         = _documentCreateTextNode
   , documentBody                   = _documentBody
   , documentGetElementById         = _documentGetElementById
   , documentHead                   = _documentHead
+  , fetch                          = _fetch
   , _freeCallback                  = __freeCallback
-  , getPropertyAsBool              = _getPropertyAsBool
-  , getPropertyAsDouble            = _getPropertyAsDouble
-  , getPropertyAsInt               = _getPropertyAsInt
   , getPropertyAsOpaque            = _getPropertyAsOpaque
-  , getPropertyAsString            = _getString
-  , elementTagName                 = _elementTagName
-  , nodeInsertBefore               = _nodeInsertBefore
+  , jsValFromArray                 = _jsValFromArray
+  , jsValFromBool                  = _jsValFromBool
+  , jsValFromByteString            = _jsValFromByteString
+  , jsValFromDouble                = _jsValFromDouble
+  , jsValFromInt                   = _jsValFromInt
+  , jsValFromString                = _jsValFromString
   , invokeOn0                      = _invokeOn0
+  , makeObject                     = _makeObject
+  , setValue                       = _setValue
+  , invokeOn1                      = _invokeOn1
+  , invokeOn2                      = _invokeOn2
   , _makeHaskellCallback           = __makeHaskellCallback
-  , nodeChildNodes                 = _nodeChildNodes
   , mathRandom                     = _mathRandom
-  , nodeRemoveChild                = _nodeRemoveChild
-  , eventTargetRemoveEventListener = _eventTargetRemoveEventListener
-  , elementSetAttribute            = _elementSetAttribute
-  , nodeTextContent                = _nodeTextContent
   }
 
 _documentCreateElement :: String -> IO JSVal
 _documentCreateElement = js_documentCreateElement . toJSString
 
-_elementTagName :: JSVal -> IO String
-_elementTagName x = do
-  v <- js_elementTagName x
-  return $ fromJSString v
-
-_nodeTextContent :: JSVal -> IO String
-_nodeTextContent x = do
-  v <- js_nodeTextContent x
-  return $ fromJSString v
-
-_elementSetAttribute :: JSVal -> String -> String -> IO ()
-_elementSetAttribute e k v =
-  js_elementSetAttribute e (toJSString k) (toJSString v)
-
 _getPropertyAsOpaque :: JSVal -> String -> IO (Maybe JSVal)
 _getPropertyAsOpaque n k = do
   isUndef <- js_null_or_undef n
@@ -88,57 +80,106 @@         if isUndef' then pure Nothing else pure (Just v)
       )
 
-_getString :: JSVal -> String -> IO (Maybe String)
-_getString n k =
-  _getGeneric (\v -> (jsonFromJSVal v) :: Either String String) n k
+_castToString :: JSVal -> IO (Maybe String)
+_castToString v = pure $ (Just . fromJSString . JSString) v
 
-_getPropertyAsBool :: JSVal -> String -> IO (Maybe Bool)
-_getPropertyAsBool n k =
-  _getGeneric (\v -> (jsonFromJSVal v) :: Either String Bool) n k
+_castToByteString :: JSVal -> IO (Maybe ByteString)
+_castToByteString v = pure $ (Just . byteStringFromJSUint8Array . JSUint8Array) v
 
-_getPropertyAsInt :: JSVal -> String -> IO (Maybe Int)
-_getPropertyAsInt n k =
-  _getGeneric (\v -> (jsonFromJSVal v) :: Either String Int) n k
+_castToBool :: JSVal -> IO (Maybe Bool)
+_castToBool n =
+  _castGeneric (\v -> (jsonFromJSVal v) :: Either String Bool) n
 
-_getPropertyAsDouble :: JSVal -> String -> IO (Maybe Double)
-_getPropertyAsDouble n k =
-  _getGeneric (\v -> (jsonFromJSVal v) :: Either String Double) n k
+_castToInt :: JSVal -> IO (Maybe Int)
+_castToInt n =
+  _castGeneric (\v -> (jsonFromJSVal v) :: Either String Int) n
 
-_getGeneric :: (JSVal -> Either String a) -> JSVal -> String -> IO (Maybe a)
-_getGeneric f n k = do
-  isUndef <- js_null_or_undef n
-  if isUndef
+_castToDouble :: JSVal -> IO (Maybe Double)
+_castToDouble n =
+  _castGeneric (\v -> (jsonFromJSVal v) :: Either String Double) n
+
+_castGeneric :: (JSVal -> Either String a) -> JSVal -> IO (Maybe a)
+_castGeneric f v = do
+  isUndef' <- js_null_or_undef v
+  if isUndef'
     then pure Nothing
-    else
-      (do
-        v        <- _js_getPropertyAsOpaque n (toJSString k)
-        isUndef' <- js_null_or_undef v
-        if isUndef'
-          then pure Nothing
-          else (let q = f v in either (\_ -> pure Nothing) (pure . Just) q)
-      )
+    else (let q = f v in either (\_ -> pure Nothing) (pure . Just) q)
 
-_consoleLog :: String -> IO ()
-_consoleLog t = _js_consoleLog (toJSString t)
+_defaultRequestInit = RequestInit {
+    _ri_method      = Nothing
+  , _ri_headers     = Nothing
+  , _ri_body        = Nothing
+  , _ri_mode        = Nothing
+  , _ri_credentials = Nothing
+  , _ri_cache       = Nothing
+  , _ri_redirect    = Nothing
+  , _ri_referrer    = Nothing 
+  , _ri_integrity   = Nothing
+}
 
-_consoleLog' :: JSVal -> IO ()
-_consoleLog' v = _js_consoleLog' v
+_s2v :: JSString -> JSVal
+_s2v (JSString v) = v
 
+_b2v :: JSUint8Array -> JSVal
+_b2v (JSUint8Array v) = v
 
-_eventTargetAddEventListener :: JSVal -> String -> JSVal -> IO ()
-_eventTargetAddEventListener target event callback =
-  js_eventTargetAddEventListener target (toJSString event) callback
 
-_eventTargetRemoveEventListener :: JSVal -> String -> JSVal -> IO ()
-_eventTargetRemoveEventListener target event callback =
-  js_eventTargetRemoveEventListener target (toJSString event) callback
+makeBody :: FetchBody JSVal -> IO JSVal
+makeBody (FormDataBody formData) = do
+  _fd <- _formData
+  mapM (\(x, y) -> _invokeOn2 _fd "append" (_s2v . toJSString $ x) y) (HM.toList formData)
+  return _fd
+makeBody (StringBody str) = pure (_s2v . toJSString $ str)
+makeBody (BlobBody blob) = pure blob
+makeBody (URLSearchParamsBody searchParams) = do
+  _usp <- _urlSearchParams
+  mapM (\(x, y) -> _invokeOn2 _usp "append" (_s2v . toJSString $ x) (_s2v . toJSString $ y)) (HM.toList searchParams)
+  return _usp
+makeBody (Uint8Array bs) = pure $ (_b2v . byteStringToJSUint8Array $ bs)
 
+kvToJSVal :: (String, String) -> IO (JSVal, JSVal)
+kvToJSVal (k, v) = do
+  _k <- _jsValFromString k
+  _v <- _jsValFromString v
+  return $ (_k, _v)
+
+requestInitToJSVal :: RequestInit JSVal -> IO JSVal
+requestInitToJSVal ri = do
+  obj <- _makeObject
+  maybe (pure ()) (_setValue' obj "method") (_ri_method ri)
+  maybe (pure ()) (\hds -> do 
+    __headers <- _headers
+    kvs <- mapM kvToJSVal (HM.toList hds)
+    mapM (\(x, y) -> _invokeOn2 __headers "append" x y) kvs
+    _setValue obj "headers" __headers) (_ri_headers ri)
+  maybe (pure ()) (\body -> do 
+    _body <- makeBody body
+    _setValue obj "body" _body) (_ri_body ri)
+  maybe (pure ()) (_setValue' obj "mode") (_ri_mode ri)
+  maybe (pure ()) (_setValue' obj "credentials") (_ri_credentials ri)
+  maybe (pure ()) (_setValue' obj "cache") (_ri_cache ri)
+  maybe (pure ()) (_setValue' obj "redirect") (_ri_redirect ri)
+  maybe (pure ()) (_setValue' obj "referrer") (_ri_referrer ri)
+  maybe (pure ()) (_setValue' obj "integrity") (_ri_integrity ri)
+  return obj
+
+_fetch :: String -> RequestInit JSVal -> IO JSVal
+_fetch url ri = do
+  _ri <- requestInitToJSVal ri
+  _js_fetch (toJSString url) _ri
+
 _documentCreateTextNode :: String -> IO JSVal
 _documentCreateTextNode = js_documentCreateTextNode . toJSString
 
 _invokeOn0 :: JSVal -> String -> IO JSVal
 _invokeOn0 e s = _js_invokeOn0 e (toJSString s)
 
+_invokeOn1 :: JSVal -> String -> JSVal -> IO JSVal
+_invokeOn1 e s v0 = _js_invokeOn1 e (toJSString s) v0
+
+_invokeOn2 :: JSVal -> String -> JSVal -> JSVal -> IO JSVal
+_invokeOn2 e s v0 v1 = _js_invokeOn2 e (toJSString s) v0 v1
+
 _documentGetElementById :: String -> IO (Maybe JSVal)
 _documentGetElementById k = do
   v <- js_documentGetElementById (toJSString k)
@@ -148,6 +189,27 @@ getJSVal :: JSFunction -> JSVal
 getJSVal (JSFunction x) = x
 
+_castToArray :: JSVal -> IO (Maybe [JSVal])
+_castToArray v = pure $ (Just . fromJSArray . JSArray) v
+
+_jsValFromString :: String -> IO JSVal
+_jsValFromString v = pure $ (x . toJSString) v
+  where x (JSString s) = s
+
+_jsValFromByteString :: ByteString -> IO JSVal
+_jsValFromByteString v = pure $ (x . byteStringToJSUint8Array) v
+  where x (JSUint8Array bs) = bs
+
+_jsValFromArray :: [JSVal] -> IO JSVal
+_jsValFromArray v = pure $ (x . toJSArray) v
+  where x (JSArray bs) = bs
+
+_setValue :: JSVal -> String -> JSVal -> IO ()
+_setValue a b c = _js_setValue a (toJSString b) c
+
+_setValue' :: JSVal -> String -> String -> IO ()
+_setValue' a b c = _js_setValue a (toJSString b) $ _s2v (toJSString c)
+
 __makeHaskellCallback :: (JSVal -> IO ()) -> IO JSVal
 __makeHaskellCallback a = do
   x <- makeHaskellCallback1 a
@@ -156,20 +218,46 @@ __freeCallback :: JSVal -> IO ()
 __freeCallback v = freeHaskellCallback (JSFunction v)
 
-_nodeChildNodes :: JSVal -> IO [JSVal]
-_nodeChildNodes x = do
-  v <- _js_nodeChildNodes x
-  return $ fromJSArray v
+foreign import javascript "{}"
+  _makeObject :: IO JSVal
 
-foreign import javascript "console.log($1)"
-  _js_consoleLog :: JSString -> IO ()
+foreign import javascript "new Headers()"
+  _headers :: IO JSVal
 
+foreign import javascript "new URLSearchParams()"
+  _urlSearchParams :: IO JSVal
+
+foreign import javascript "new FormData()"
+  _formData :: IO JSVal
+
+
+foreign import javascript "$1[$2]=$3"
+  _js_setValue :: JSVal -> JSString -> JSVal -> IO ()
+
+foreign import javascript "$1"
+  _jsValFromBool :: Bool -> IO JSVal
+
+foreign import javascript interruptible "fetch($1, $2)"
+  _js_fetch :: JSString -> JSVal -> IO JSVal
+
+foreign import javascript "$1"
+  _jsValFromInt :: Int -> IO JSVal
+
+foreign import javascript "$1"
+  _jsValFromDouble :: Double -> IO JSVal
+
 foreign import javascript "console.log($1)"
-  _js_consoleLog' :: JSVal -> IO ()
+  _consoleLog :: JSVal -> IO ()
 
 foreign import javascript "$1[$2]()"
   _js_invokeOn0 :: JSVal -> JSString -> IO JSVal
 
+foreign import javascript "$1[$2]($3)"
+  _js_invokeOn1 :: JSVal -> JSString -> JSVal -> IO JSVal
+
+foreign import javascript "$1[$2]($3,$4)"
+  _js_invokeOn2 :: JSVal -> JSString -> JSVal -> JSVal -> IO JSVal
+
 foreign import javascript "$1[$2]"
   _js_getPropertyAsOpaque :: JSVal -> JSString -> IO JSVal
 
@@ -185,38 +273,8 @@ foreign import javascript "document.head"
   _documentHead :: IO JSVal
 
-foreign import javascript "$1.tagName"
-  js_elementTagName :: JSVal -> IO JSString
-
-foreign import javascript "$1.textContent"
-  js_nodeTextContent :: JSVal -> IO JSString
-
-foreign import javascript "$1.setAttribute($2,$3)"
-  js_elementSetAttribute :: JSVal -> JSString -> JSString -> IO ()
-
-foreign import javascript "$1.appendChild($2)"
-  _nodeAppendChild :: JSVal -> JSVal -> IO ()
-
 foreign import javascript "($1 == null) || ($1 == undefined)"
   js_null_or_undef :: JSVal -> IO Bool
-
-foreign import javascript "$1.childNodes"
-  _js_nodeChildNodes :: JSVal -> IO JSArray
-
-foreign import javascript "$1.click()"
-  _htmlElemenetClick :: JSVal -> IO ()
-
-foreign import javascript "$1.insertBefore($2,$3)"
-  _nodeInsertBefore :: JSVal -> JSVal -> JSVal -> IO ()
-
-foreign import javascript "$1.removeChild($2)"
-  _nodeRemoveChild :: JSVal -> JSVal -> IO ()
-
-foreign import javascript "$1.addEventListener($2,$3)"
-  js_eventTargetAddEventListener :: JSVal -> JSString -> JSVal -> IO ()
-
-foreign import javascript "$1.removeEventListener($2,$3)"
-  js_eventTargetRemoveEventListener :: JSVal -> JSString -> JSVal -> IO ()
 
 foreign import javascript "document.createTextNode($1)"
   js_documentCreateTextNode :: JSString -> IO JSVal

@@ -1,8 +1,13 @@ module Web.Framework.Plzwrk.Browserful
   ( Browserful(..)
+  , RequestInit(..)
+  , FetchBody(..)
   )
 where
 
+import           Data.ByteString.Internal  ( ByteString )
+import qualified Data.HashMap.Strict      as HM
+
 -- | A data class holding functions that operate on opaque
 -- JavaScript types, parameterized by @jsval@. When possible,
 -- the real names of browser functions like 'addEventListener'
@@ -16,12 +21,30 @@ 
 data Browserful jsval = Browserful
   {
-    -- | Logs a string. See [Console.log](https://developer.mozilla.org/en-US/docs/Web/API/Console/log)
-    consoleLog                     :: String -> IO ()
+    -- | Casts a value to an array of jsvals
+    castToArray                  :: jsval -> IO (Maybe [jsval])
 
+    -- | Casts a value to a bool
+  , castToBool                    :: jsval -> IO (Maybe Bool)
+
+    -- | Casts a value to a bool
+  , castToByteString              :: jsval -> IO (Maybe ByteString)
+
+    -- | Casts a value to a double
+  , castToDouble                  :: jsval -> IO (Maybe Double)
+
+    -- | Casts a value to an int
+  , castToInt                     :: jsval -> IO (Maybe Int)
+
+    -- | Casts a value to a string
+  , castToString                  :: jsval -> IO (Maybe String)
+
     -- | Logs an opaque JavaScript value. See [Console.log](https://developer.mozilla.org/en-US/docs/Web/API/Console/log)
-  , consoleLog'                    :: jsval -> IO ()
+  , consoleLog                     :: jsval -> IO ()
 
+    -- | A default request init
+  , defaultRequestInit             :: RequestInit jsval
+
     -- | The body of the document. See [Document.body](https://developer.mozilla.org/en-US/docs/Web/API/Document/body)
   , documentBody                   :: IO jsval
 
@@ -37,56 +60,47 @@     -- | Gets the head of a document. See [Document.head](https://developer.mozilla.org/en-US/docs/Web/API/Document/head)
   , documentHead                   :: IO jsval
 
-    -- | Sets on an element an attribute. See [Element.setAttribute](https://developer.mozilla.org/en-US/docs/Web/API/Element/setAttribute)
-  , elementSetAttribute            :: jsval -> String -> String -> IO ()
+    -- | Calls the browser's fetch command
+  , fetch                          :: String -> (RequestInit jsval) -> IO jsval
 
-    -- | Gets the tag name of an element.  See [Element.tagName](https://developer.mozilla.org/en-US/docs/Web/API/Element/tagName)
-  , elementTagName                 :: jsval -> IO String
+    -- | Gets a JavaScript property, returning @Nothing@ if the object being called is null or undefined.
+  , getPropertyAsOpaque            :: jsval -> String -> IO (Maybe jsval)
 
-    -- | Takes a target and an event name and adds a listener. See [EventTarget.addEventListener](https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/addEventListener)
-  , eventTargetAddEventListener    :: jsval -> String -> jsval -> IO ()
+    -- | Invokes on target a function with 0 arguments.
+  , invokeOn0                      :: jsval -> String -> IO jsval
 
-    -- | Takes a target and an event name and removes a listener. See [EventTarget.removeEventListener](https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/removeEventListener)
-  , eventTargetRemoveEventListener :: jsval -> String -> jsval -> IO ()
+    -- | Invokes on target a function with 1 argument.
+  , invokeOn1                      :: jsval -> String -> jsval -> IO jsval
 
-    -- | Gets a JavaScript property as a bool, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to a bool.
-  , getPropertyAsBool              :: jsval -> String -> IO (Maybe Bool)
+    -- | Invokes on target a function with 2 arguments.
+  , invokeOn2                      :: jsval -> String -> jsval -> jsval -> IO jsval
 
-    -- | Gets a JavaScript property as a double, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to a double.
-  , getPropertyAsDouble            :: jsval -> String -> IO (Maybe Double)
+    -- | jsval from an array of jsvals
+  , jsValFromArray                 :: [jsval] -> IO jsval
 
-    -- | Gets a JavaScript property as an int, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to an int.
-  , getPropertyAsInt               :: jsval -> String -> IO (Maybe Int)
+    -- | jsval from a bool
+  , jsValFromBool                  :: Bool -> IO jsval
 
-    -- | Gets a JavaScript property, returning @Nothing@ if the object being called is null or undefined.
-  , getPropertyAsOpaque            :: jsval -> String -> IO (Maybe jsval)
+    -- | jsval from a byte string
+  , jsValFromByteString            :: ByteString -> IO jsval
 
-    -- | Gets a JavaScript property as a string, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to a string.
-  , getPropertyAsString            :: jsval -> String -> IO (Maybe String)
+    -- | jsval from a double
+  , jsValFromDouble                :: Double -> IO jsval
 
-    -- | Takes an element and clicks it. Useful for testing. See [HTMLElement.click](https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/click)
-  , htmlElemenetClick              :: jsval -> IO ()
+    -- | jsval from an int
+  , jsValFromInt                   :: Int -> IO jsval
 
-    -- | Invokes on target a function with 0 arguments.
-  , invokeOn0                      :: jsval -> String -> IO jsval
+    -- | jsval from a string
+  , jsValFromString                :: String -> IO jsval
 
+    -- | Creates an object
+  , makeObject                     :: IO jsval
+
     -- | Generate a random double between 0 and 1. See [Math.random](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/random)
   , mathRandom                     :: IO Double
 
-    -- | Takes a node and appends a child. See [Node.appendChild](https://developer.mozilla.org/en-US/docs/Web/API/Node/appendChild)
-  , nodeAppendChild                :: jsval -> jsval -> IO ()
-
-    -- | Get the children of a node. See [Node.childNodes](https://developer.mozilla.org/en-US/docs/Web/API/Node/childNodes)
-  , nodeChildNodes                 :: jsval -> IO [jsval]
-
-    -- | Insert into an element a new node before a reference node.  See [Node.insertBefore](https://developer.mozilla.org/en-US/docs/Web/API/Node/insertBefore)
-  , nodeInsertBefore               :: jsval -> jsval -> jsval -> IO ()
-
-    -- | From a node remove a child. See [Node.removeChild](https://developer.mozilla.org/en-US/docs/Web/API/Node/removeChild)
-  , nodeRemoveChild                :: jsval -> jsval -> IO ()
-
-    -- | Gets the text content of a node. See [Node.textContent](https://developer.mozilla.org/en-US/docs/Web/API/Node/textContent)
-  , nodeTextContent                :: jsval -> IO String
+    -- | Sets on an object a value
+  , setValue                       :: jsval -> String -> jsval -> IO ()
 
     -- | Frees a callback. Should only be called in advanced cases. In most usage, callbacks are freed automatically by plzwrk.
   , _freeCallback                  :: jsval -> IO ()
@@ -94,3 +108,24 @@     -- | Makes a haskell callback. Should only be called in advanced cases. In most usage, callbacks are created automatically by plzwrk.
   , _makeHaskellCallback           :: (jsval -> IO ()) -> IO jsval
   }
+
+-- |The body of a fetch request or response
+data FetchBody jsval =
+    FormDataBody (HM.HashMap String jsval) -- ^ From form data, ie @multipart/form-data@ or @application/x-www-form-urlencoded@
+  | StringBody   String -- ^ A string, ie @text/plain@ or @application/json@
+  | BlobBody     jsval -- ^ A single file
+  | URLSearchParamsBody (HM.HashMap String String) -- ^ Useful for @application/x-www-form-urlencoded@
+  | Uint8Array   ByteString
+
+-- | Initialization parameters for a request made with fetch
+data RequestInit jsval = RequestInit {
+    _ri_method      :: Maybe String -- ^ The request method, e.g., GET, POST. The default is GET.
+  , _ri_headers     :: Maybe (HM.HashMap String String) -- ^ Any headers you want to add to your request, contained within a Headers object or an object literal with ByteString values.
+  , _ri_body        :: Maybe (FetchBody jsval) -- ^ Any body that you want to add to your request: this can be a Blob, BufferSource, FormData, URLSearchParams, USVString, or ReadableStream object. Note that a request using the GET or HEAD method cannot have a body.
+  , _ri_mode        :: Maybe String -- ^ The mode you want to use for the request, e.g., cors, no-cors, same-origin, or navigate. The default is cors.
+  , _ri_credentials :: Maybe String -- ^ The request credentials you want to use for the request: omit, same-origin, or include. The default is same-origin.
+  , _ri_cache       :: Maybe String -- ^ The cache mode you want to use for the request.
+  , _ri_redirect    :: Maybe String -- ^ The redirect mode to use: follow, error, or manual. The default is follow.
+  , _ri_referrer    :: Maybe String -- ^ A USVString specifying no-referrer, client, or a URL. The default is about:client.
+  , _ri_integrity   :: Maybe String -- ^ Contains the subresource integrity value of the request (e.g., sha256-BpfBw7ivV8q2jLiT13fxDYAe2tJllusRSZ273h2nFSE=).
+}

@@ -1,481 +1,483 @@-module Web.Framework.Plzwrk.Domify-  ( plzwrk-  , plzwrk'-  , plzwrk'_-  , plzwrkSSR-  , plzwrkSSR'-  , plzwrkSSR'_-  )-where--import           Control.Applicative-import           Control.Monad-import           Control.Monad.Reader-import           Control.Monad.Trans-import           Control.Monad.Trans.Maybe-import qualified Data.HashMap.Strict           as HM-import           Data.IORef-import           Data.Maybe                     ( catMaybes )-import qualified Data.Set                      as S-import           Web.Framework.Plzwrk.Base-import           Web.Framework.Plzwrk.Browserful--data DomifiedAttributes jsval = MkDomifiedAttributes-  { _d_style     :: HM.HashMap String String-  , _d_class     :: S.Set String-  , _d_simple    :: HM.HashMap String String-  , _d_handlers  :: HM.HashMap String jsval-  }--data DomifiedNode jsval = DomifiedElement-    { _dom_tag  :: String-    , _dom_attr :: (DomifiedAttributes jsval)-    , _dom_kids :: [DomifiedNode jsval]-    , _dom_ptr  :: jsval-    }-    | DomifiedTextNode String jsval--data OldStuff state jsval = OldStuff {-  _oldState :: state,-  _oldDom :: Maybe (DomifiedNode jsval)-}------------ reader functions-----freeAttrFunctions-  :: DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()-freeAttrFunctions (MkDomifiedAttributes _ _ _ __d_handlers) = do-  __freeCallback <- asks _freeCallback-  liftIO $ void (mapM __freeCallback (HM.elems __d_handlers))--freeFunctions :: DomifiedNode jsval -> ReaderT (Browserful jsval) IO ()-freeFunctions (DomifiedElement _ b c _) = do-  freeAttrFunctions b-  mapM_ freeFunctions c-freeFunctions _ = pure ()--nodesEq-  :: String-  -> String-  -> DomifiedAttributes jsval-  -> Attributes state jsval-  -> Bool-nodesEq t0 t1 (MkDomifiedAttributes __d_style __d_class __d_simple _) (MkAttributes __style __class __simple _)-  = (t0 == t1)-    && (__d_style == __style)-    && (__d_class == __class)-    && (__d_simple == __simple)--padr :: Int -> a -> [a] -> [a]-padr i v l = if (length l >= i) then l else padr i v (l ++ [v])--reconcile-  :: Bool-  -> IORef (OldStuff state jsval)-  -> (state -> Node state jsval)-  -> jsval-  -> jsval-  -> Maybe (DomifiedNode jsval)-  -> Maybe (HydratedNode state jsval)-  -> ReaderT-       (Browserful jsval)-       IO-       (Maybe (DomifiedNode jsval))-reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedElement currentTag currentAttributes currentChildren currentNode)) (Just maybeNewNode@(HydratedElement maybeNewTag maybeNewAttributes maybeNewChildren))-  = if (nodesEq currentTag maybeNewTag currentAttributes maybeNewAttributes)-    then-      (do-        let maxlen = max (length maybeNewChildren) (length currentChildren)-        newChildren <- sequence $ getZipList-          (   (reconcile touchDOM-                         refToOldStuff-                         domCreationF-                         currentNode-                         topLevelNode-              )-          <$> (ZipList (padr maxlen Nothing (fmap Just currentChildren)))-          <*> (ZipList (padr maxlen Nothing (fmap Just maybeNewChildren)))-          )-        currentAttributes <- hydratedAttrsToDomifiedAttrs refToOldStuff-                                                          domCreationF-                                                          parentNode-                                                          maybeNewAttributes-        if touchDOM-          then-            (do-              removeEventHandlers currentNode currentAttributes-              setEventHandlers currentNode currentAttributes-            )-          else (pure ())-        return $ Just-          (DomifiedElement currentTag-                           currentAttributes-                           (catMaybes newChildren)-                           currentNode-          )-      )-    else-      (do-        res <- domify touchDOM-                      refToOldStuff-                      domCreationF-                      parentNode-                      topLevelNode-                      (Just currentNode)-                      maybeNewNode-        return $ Just res-      )-reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode (Just currentDomifiedString@(DomifiedTextNode currentString currentNode)) (Just maybeNewNode@(HydratedTextNode maybeNewString))-  = if (currentString == maybeNewString)-    then pure (Just currentDomifiedString)-    else-      (do-        res <- domify touchDOM-                      refToOldStuff-                      domCreationF-                      parentNode-                      topLevelNode-                      (Just currentNode)-                      maybeNewNode-        return $ Just res-      )-reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedElement _ _ _ currentNode)) (Just maybeNewNode@(HydratedTextNode _))-  = do-    res <- domify touchDOM-                  refToOldStuff-                  domCreationF-                  parentNode-                  topLevelNode-                  (Just currentNode)-                  maybeNewNode-    return $ Just res-reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedTextNode _ currentNode)) (Just maybeNewNode@(HydratedElement _ _ _))-  = do-    res <- domify touchDOM-                  refToOldStuff-                  domCreationF-                  parentNode-                  topLevelNode-                  (Just currentNode)-                  maybeNewNode-    return $ Just res-reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode Nothing (Just maybeNewNode)-  = do-    res <- domify touchDOM-                  refToOldStuff-                  domCreationF-                  parentNode-                  topLevelNode-                  Nothing-                  maybeNewNode-    return $ Just res-reconcile touchDOM refToOldStuff domCreationF parentNode _ (Just (DomifiedElement _ _ _ currentNode)) Nothing-  = if (touchDOM)-    then-      (do-        _nodeRemoveChild <- asks nodeRemoveChild-        liftIO $ _nodeRemoveChild parentNode currentNode-        return Nothing-      )-    else (pure Nothing)-reconcile touchDOM refToOldStuff domCreationF parentNode _ (Just (DomifiedTextNode _ currentNode)) Nothing-  = if (touchDOM)-    then-      (do-        _nodeRemoveChild <- asks nodeRemoveChild-        liftIO $ _nodeRemoveChild parentNode currentNode-        return Nothing-      )-    else (pure Nothing)-reconcile _ _ _ _ _ _ _ = error "Inconsistent state"--reconcileAndAdd = reconcile True--cbMaker-  :: IORef (OldStuff state jsval)-  -> (state -> Node state jsval)-  -> jsval-  -> (jsval -> state -> IO state)-  -> Browserful jsval-  -> jsval-  -> IO ()-cbMaker refToOldStuff domCreationF topLevelNode eventToState env event = do-  oldStuff <- readIORef refToOldStuff-  let oldDom   = _oldDom oldStuff-  let oldState = _oldState oldStuff-  newState <- eventToState event oldState-  let newHydratedDom = hydrate newState domCreationF-  newDom <- runReaderT-    (reconcileAndAdd refToOldStuff-                     domCreationF-                     topLevelNode-                     topLevelNode-                     oldDom-                     (Just newHydratedDom)-    )-    env-  maybe (pure ()) (\x -> runReaderT (freeFunctions x) env) oldDom-  writeIORef refToOldStuff (OldStuff newState newDom)--eventable-  :: IORef (OldStuff state jsval)-  -> (state -> Node state jsval)-  -> jsval-  -> (jsval -> state -> IO state)-  -> ReaderT (Browserful jsval) IO jsval-eventable refToOldStuff domCreationF topLevelNode eventToState = do-  __makeHaskellCallback <- asks _makeHaskellCallback-  env                   <- ask-  liftIO $ __makeHaskellCallback-    (cbMaker refToOldStuff domCreationF topLevelNode eventToState env)--hydratedAttrsToDomifiedAttrs-  :: IORef (OldStuff state jsval)-  -> (state -> Node state jsval)-  -> jsval-  -> Attributes state jsval-  -> ReaderT (Browserful jsval) IO (DomifiedAttributes jsval)-hydratedAttrsToDomifiedAttrs refToOldStuff domCreationF topLevelNode (MkAttributes __style __class __simple __handlers)-  = do-    handlers <- mapM-      (\(k, v) -> do-        func <- eventable refToOldStuff domCreationF topLevelNode v-        return $ (k, func)-      )-      (HM.toList __handlers)-    return-      $ MkDomifiedAttributes __style __class __simple (HM.fromList handlers)--setAtts :: jsval -> DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()-setAtts currentNode domifiedAttributes@(MkDomifiedAttributes __style __class __simple _)-  = do-    _elementSetAttribute <- asks elementSetAttribute-    liftIO $ if (HM.null __style)-      then (pure ())-      else (_elementSetAttribute currentNode "style") . cssToStyle $ __style-    liftIO $ if (S.null __class)-      then (pure ())-      else-        ((_elementSetAttribute currentNode "class") . unwords . S.toList)-          $ __class-    liftIO $ mapM_ (\x -> _elementSetAttribute currentNode (fst x) (snd x))-                   (HM.toList __simple)-    setEventHandlers currentNode domifiedAttributes--handleOnlyEventListeners-  :: (jsval -> String -> jsval -> IO ())-  -> jsval-  -> DomifiedAttributes jsval-  -> IO ()-handleOnlyEventListeners eventListenerHandlerF currentNode domifiedAttributes =-  void $ mapM (\(k, v) -> eventListenerHandlerF currentNode k v)-              (HM.toList . _d_handlers $ domifiedAttributes)--setEventHandlers-  :: jsval -> DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()-setEventHandlers currentNode domifiedAttributes = do-  _eventTargetAddEventListener <- asks eventTargetAddEventListener-  liftIO $ handleOnlyEventListeners _eventTargetAddEventListener-                                    currentNode-                                    domifiedAttributes--removeEventHandlers-  :: jsval -> DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()-removeEventHandlers currentNode domifiedAttributes = do-  _eventTargetRemoveEventListener <- asks eventTargetRemoveEventListener-  liftIO $ handleOnlyEventListeners _eventTargetRemoveEventListener-                                    currentNode-                                    domifiedAttributes--domify-  :: Bool-  -> IORef (OldStuff state jsval)-  -> (state -> Node state jsval)-  -> jsval-  -> jsval-  -> Maybe jsval-  -> HydratedNode state jsval-  -> ReaderT (Browserful jsval) IO (DomifiedNode jsval)-domify touchDOM refToOldStuff domCreationF parentNode topLevelNode replacing (HydratedElement tag attrs children)-  = do-    _documentCreateElement <- asks documentCreateElement-    _nodeAppendChild       <- asks nodeAppendChild-    _nodeInsertBefore      <- asks nodeInsertBefore-    _nodeRemoveChild       <- asks nodeRemoveChild-    newNode                <- liftIO $ _documentCreateElement tag-    newAttributes          <- hydratedAttrsToDomifiedAttrs refToOldStuff-                                                           domCreationF-                                                           topLevelNode-                                                           attrs-    if touchDOM then (setAtts newNode newAttributes) else (pure ())-    newChildren <- mapM-      (domify touchDOM refToOldStuff domCreationF newNode topLevelNode Nothing)-      children-    if touchDOM-      then-        (do-          maybe-            (liftIO $ _nodeAppendChild parentNode newNode)-            (\x -> do-              liftIO $ _nodeInsertBefore parentNode newNode x-              liftIO $ _nodeRemoveChild parentNode x-            )-            replacing-        )-      else (pure ())-    liftIO $ return (DomifiedElement tag newAttributes newChildren newNode)-domify touchDOM _ _ parentNode topLevelNode replacing (HydratedTextNode text) =-  do-    _documentCreateElement  <- asks documentCreateElement-    _nodeAppendChild        <- asks nodeAppendChild-    _nodeInsertBefore       <- asks nodeInsertBefore-    _nodeRemoveChild        <- asks nodeRemoveChild-    _documentCreateTextNode <- asks documentCreateTextNode-    newTextNode             <- liftIO $ _documentCreateTextNode text-    if touchDOM-      then-        (do-          maybe-            (liftIO $ _nodeAppendChild parentNode newTextNode)-            (\x -> do-              liftIO $ _nodeInsertBefore parentNode newTextNode x-              liftIO $ _nodeRemoveChild parentNode x-            )-            replacing-        )-      else (pure ())-    liftIO $ return (DomifiedTextNode text newTextNode)--getChildren :: DomifiedNode jsval -> [DomifiedNode jsval]-getChildren (DomifiedElement _ _ x _) = x-getChildren _                         = []--setEventHandlers_-  :: jsval -> DomifiedNode jsval -> ReaderT (Browserful jsval) IO ()-setEventHandlers_ v (DomifiedElement _ a _ _) = setEventHandlers v a-setEventHandlers_ _ _                         = liftIO $ pure ()--transformFromCurrentDom-  :: jsval-  -> [DomifiedNode jsval]-  -> ReaderT (Browserful jsval) IO [DomifiedNode jsval]-transformFromCurrentDom parentNode children = do-  _nodeChildNodes <- asks nodeChildNodes-  kids            <- liftIO $ _nodeChildNodes parentNode-  newChildren     <- sequence $ getZipList-    (   transformFromCurrentDom-    <$> (ZipList kids)-    <*> (ZipList $ fmap getChildren children)-    )-  sequence-    $ getZipList (setEventHandlers_ <$> (ZipList kids) <*> (ZipList children))-  return $ getZipList-    (   (\cur chldrn ptr -> cur { _dom_kids = chldrn, _dom_ptr = ptr })-    <$> (ZipList children)-    <*> (ZipList newChildren)-    <*> (ZipList kids)-    )--addHandlers-  :: jsval-  -> DomifiedNode jsval-  -> ReaderT (Browserful jsval) IO (DomifiedNode jsval)-addHandlers parentNode curDom = do-  transformed <- transformFromCurrentDom parentNode [curDom]-  return $ (transformed !! 0)--__plzwrk-  :: Bool-  -> (state -> Node state jsval)-  -> state-  -> jsval-  -> Browserful jsval-  -> IO (Maybe (DomifiedNode jsval))-__plzwrk cleanDOM domF state parentNode env = do-  refToOldStuff <- newIORef (OldStuff state Nothing)-  newDom        <- runReaderT-    (reconcile cleanDOM-               refToOldStuff-               domF-               parentNode-               parentNode-               Nothing-               (Just $ hydrate state domF)-    )-    env-  writeIORef refToOldStuff (OldStuff state newDom)-  if (not cleanDOM)-    then-      (maybe-        (pure Nothing)-        (\y -> do-          withHandlers <- runReaderT (addHandlers parentNode y) env-          writeIORef refToOldStuff (OldStuff state (Just y))-          return $ Just withHandlers-        )-        newDom-      )-    else pure newDom--_plzwrk-  :: Bool-  -> (state -> Node state jsval)-  -> state-  -> Browserful jsval-  -> String-  -> IO (Maybe (DomifiedNode jsval))-_plzwrk cleanDOM domF state env nodeId = do-  parentNode <- (documentGetElementById env) nodeId-  maybe (error ("Node with id not in DOM: " <> show nodeId))-        (\x -> __plzwrk cleanDOM domF state x env)-        parentNode----- |The main function that makes a web app.-plzwrk-  :: (state -> Node state jsval) -- ^ A function that takes a state and produces a DOM-  -> state -- ^ An initial state-  -> Browserful jsval -- ^ A browser implementation, ie Asterius or the mock browser-  -> String -- ^ The id of the element into which the DOM is inserted. Note that plzwrk manages all children under this element. Touching the managed elements can break plzwrk.-  -> IO () -- ^ Returns nothing-plzwrk domF state env nodeId = void $ _plzwrk True domF state env nodeId---- |A variant of plzwrk that acts on a node already rendered to the DOM,--- ie by server-side rendering. It assumes the node has been rendered--- with the same state-to-node function as well as the same state.-plzwrkSSR-  :: (state -> Node state jsval) -- ^ A function that takes a state and produces a DOM-  -> state -- ^ An initial state-  -> Browserful jsval -- ^ A browser implementation, ie Asterius or the mock browser-  -> String -- ^ The id of the element into which the DOM is inserted. Note that plzwrk manages all children under this element. Touching the managed elements can break plzwrk.-  -> IO () -- ^ Returns nothing-plzwrkSSR domF state env nodeId = void $ _plzwrk False domF state env nodeId--_plzwrk'-  :: Bool-  -> (state -> Node state jsval)-  -> state-  -> Browserful jsval-  -> IO (Maybe (DomifiedNode jsval))-_plzwrk' cleanDOM domF state env = do-  parentNode <- (documentBody env)-  __plzwrk cleanDOM domF state parentNode env---- |A variation of plzwrk that inserts the node as a child of the document's body.-plzwrk' :: (state -> Node state jsval) -> state -> Browserful jsval -> IO ()-plzwrk' domF state env = void $ _plzwrk' True domF state env---- |A variation of plzwrk that inserts the node as a child of the document's body.-plzwrkSSR' :: (state -> Node state jsval) -> state -> Browserful jsval -> IO ()-plzwrkSSR' domF state env = void $ _plzwrk' False domF state env---- |A variation of plzwrk that takes no state.-plzwrk'_ :: (() -> Node () jsval) -> Browserful jsval -> IO ()-plzwrk'_ domF env = plzwrk' domF () env---- |A variation of plzwrkSSR that takes no state.-plzwrkSSR'_ :: (() -> Node () jsval) -> Browserful jsval -> IO ()-plzwrkSSR'_ domF env = plzwrkSSR' domF () env+module Web.Framework.Plzwrk.Domify
+  ( plzwrk
+  , plzwrk'
+  , plzwrk'_
+  , plzwrkSSR
+  , plzwrkSSR'
+  , plzwrkSSR'_
+  )
+where
+
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.Reader
+import           Control.Monad.Trans
+import           Control.Monad.Trans.Maybe
+import qualified Data.HashMap.Strict           as HM
+import           Data.IORef
+import           Data.Maybe                     ( catMaybes )
+import qualified Data.Set                      as S
+import           Web.Framework.Plzwrk.Base
+import           Web.Framework.Plzwrk.Browserful
+import           Web.Framework.Plzwrk.Util
+
+data DomifiedAttributes jsval = MkDomifiedAttributes
+  { _d_style     :: HM.HashMap String String
+  , _d_class     :: S.Set String
+  , _d_simple    :: HM.HashMap String String
+  , _d_handlers  :: HM.HashMap String jsval
+  }
+
+data DomifiedNode jsval = DomifiedElement
+    { _dom_tag  :: String
+    , _dom_attr :: (DomifiedAttributes jsval)
+    , _dom_kids :: [DomifiedNode jsval]
+    , _dom_ptr  :: jsval
+    }
+    | DomifiedTextNode String jsval
+
+data OldStuff state jsval = OldStuff {
+  _oldState :: state,
+  _oldDom :: Maybe (DomifiedNode jsval)
+}
+
+---------- reader functions
+
+
+
+
+freeAttrFunctions
+  :: DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()
+freeAttrFunctions (MkDomifiedAttributes _ _ _ __d_handlers) = do
+  __freeCallback <- asks _freeCallback
+  liftIO $ void (mapM __freeCallback (HM.elems __d_handlers))
+
+freeFunctions :: DomifiedNode jsval -> ReaderT (Browserful jsval) IO ()
+freeFunctions (DomifiedElement _ b c _) = do
+  freeAttrFunctions b
+  mapM_ freeFunctions c
+freeFunctions _ = pure ()
+
+nodesEq
+  :: String
+  -> String
+  -> DomifiedAttributes jsval
+  -> Attributes state jsval
+  -> Bool
+nodesEq t0 t1 (MkDomifiedAttributes __d_style __d_class __d_simple _) (MkAttributes __style __class __simple _)
+  = (t0 == t1)
+    && (__d_style == __style)
+    && (__d_class == __class)
+    && (__d_simple == __simple)
+
+padr :: Int -> a -> [a] -> [a]
+padr i v l = if (length l >= i) then l else padr i v (l ++ [v])
+
+reconcile
+  :: Bool
+  -> IORef (OldStuff state jsval)
+  -> (state -> Node state jsval)
+  -> jsval
+  -> jsval
+  -> Maybe (DomifiedNode jsval)
+  -> Maybe (HydratedNode state jsval)
+  -> ReaderT
+       (Browserful jsval)
+       IO
+       (Maybe (DomifiedNode jsval))
+reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedElement currentTag currentAttributes currentChildren currentNode)) (Just maybeNewNode@(HydratedElement maybeNewTag maybeNewAttributes maybeNewChildren))
+  = if (nodesEq currentTag maybeNewTag currentAttributes maybeNewAttributes)
+    then
+      (do
+        let maxlen = max (length maybeNewChildren) (length currentChildren)
+        newChildren <- sequence $ getZipList
+          (   (reconcile touchDOM
+                         refToOldStuff
+                         domCreationF
+                         currentNode
+                         topLevelNode
+              )
+          <$> (ZipList (padr maxlen Nothing (fmap Just currentChildren)))
+          <*> (ZipList (padr maxlen Nothing (fmap Just maybeNewChildren)))
+          )
+        currentAttributes <- hydratedAttrsToDomifiedAttrs refToOldStuff
+                                                          domCreationF
+                                                          parentNode
+                                                          maybeNewAttributes
+        if touchDOM
+          then
+            (do
+              removeEventHandlers currentNode currentAttributes
+              setEventHandlers currentNode currentAttributes
+            )
+          else (pure ())
+        return $ Just
+          (DomifiedElement currentTag
+                           currentAttributes
+                           (catMaybes newChildren)
+                           currentNode
+          )
+      )
+    else
+      (do
+        res <- domify touchDOM
+                      refToOldStuff
+                      domCreationF
+                      parentNode
+                      topLevelNode
+                      (Just currentNode)
+                      maybeNewNode
+        return $ Just res
+      )
+reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode (Just currentDomifiedString@(DomifiedTextNode currentString currentNode)) (Just maybeNewNode@(HydratedTextNode maybeNewString))
+  = if (currentString == maybeNewString)
+    then pure (Just currentDomifiedString)
+    else
+      (do
+        res <- domify touchDOM
+                      refToOldStuff
+                      domCreationF
+                      parentNode
+                      topLevelNode
+                      (Just currentNode)
+                      maybeNewNode
+        return $ Just res
+      )
+reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedElement _ _ _ currentNode)) (Just maybeNewNode@(HydratedTextNode _))
+  = do
+    res <- domify touchDOM
+                  refToOldStuff
+                  domCreationF
+                  parentNode
+                  topLevelNode
+                  (Just currentNode)
+                  maybeNewNode
+    return $ Just res
+reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedTextNode _ currentNode)) (Just maybeNewNode@(HydratedElement _ _ _))
+  = do
+    res <- domify touchDOM
+                  refToOldStuff
+                  domCreationF
+                  parentNode
+                  topLevelNode
+                  (Just currentNode)
+                  maybeNewNode
+    return $ Just res
+reconcile touchDOM refToOldStuff domCreationF parentNode topLevelNode Nothing (Just maybeNewNode)
+  = do
+    res <- domify touchDOM
+                  refToOldStuff
+                  domCreationF
+                  parentNode
+                  topLevelNode
+                  Nothing
+                  maybeNewNode
+    return $ Just res
+reconcile touchDOM refToOldStuff domCreationF parentNode _ (Just (DomifiedElement _ _ _ currentNode)) Nothing
+  = if (touchDOM)
+    then
+      (do
+        _nodeRemoveChild <- asks nodeRemoveChild
+        liftIO $ _nodeRemoveChild parentNode currentNode
+        return Nothing
+      )
+    else (pure Nothing)
+reconcile touchDOM refToOldStuff domCreationF parentNode _ (Just (DomifiedTextNode _ currentNode)) Nothing
+  = if (touchDOM)
+    then
+      (do
+        _nodeRemoveChild <- asks nodeRemoveChild
+        liftIO $ _nodeRemoveChild parentNode currentNode
+        return Nothing
+      )
+    else (pure Nothing)
+reconcile _ _ _ _ _ _ _ = error "Inconsistent state"
+
+reconcileAndAdd = reconcile True
+
+cbMaker
+  :: IORef (OldStuff state jsval)
+  -> (state -> Node state jsval)
+  -> jsval
+  -> (jsval -> state -> IO state)
+  -> Browserful jsval
+  -> jsval
+  -> IO ()
+cbMaker refToOldStuff domCreationF topLevelNode eventToState env event = do
+  oldStuff <- readIORef refToOldStuff
+  let oldDom   = _oldDom oldStuff
+  let oldState = _oldState oldStuff
+  newState <- eventToState event oldState
+  let newHydratedDom = hydrate newState domCreationF
+  newDom <- runReaderT
+    (reconcileAndAdd refToOldStuff
+                     domCreationF
+                     topLevelNode
+                     topLevelNode
+                     oldDom
+                     (Just newHydratedDom)
+    )
+    env
+  maybe (pure ()) (\x -> runReaderT (freeFunctions x) env) oldDom
+  writeIORef refToOldStuff (OldStuff newState newDom)
+
+eventable
+  :: IORef (OldStuff state jsval)
+  -> (state -> Node state jsval)
+  -> jsval
+  -> (jsval -> state -> IO state)
+  -> ReaderT (Browserful jsval) IO jsval
+eventable refToOldStuff domCreationF topLevelNode eventToState = do
+  __makeHaskellCallback <- asks _makeHaskellCallback
+  env                   <- ask
+  liftIO $ __makeHaskellCallback
+    (cbMaker refToOldStuff domCreationF topLevelNode eventToState env)
+
+hydratedAttrsToDomifiedAttrs
+  :: IORef (OldStuff state jsval)
+  -> (state -> Node state jsval)
+  -> jsval
+  -> Attributes state jsval
+  -> ReaderT (Browserful jsval) IO (DomifiedAttributes jsval)
+hydratedAttrsToDomifiedAttrs refToOldStuff domCreationF topLevelNode (MkAttributes __style __class __simple __handlers)
+  = do
+    handlers <- mapM
+      (\(k, v) -> do
+        func <- eventable refToOldStuff domCreationF topLevelNode v
+        return $ (k, func)
+      )
+      (HM.toList __handlers)
+    return
+      $ MkDomifiedAttributes __style __class __simple (HM.fromList handlers)
+
+setAtts :: jsval -> DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()
+setAtts currentNode domifiedAttributes@(MkDomifiedAttributes __style __class __simple _)
+  = do
+    _elementSetAttribute <- asks elementSetAttribute
+    liftIO $ if (HM.null __style)
+      then (pure ())
+      else (_elementSetAttribute currentNode "style") . cssToStyle $ __style
+    liftIO $ if (S.null __class)
+      then (pure ())
+      else
+        ((_elementSetAttribute currentNode "class") . unwords . S.toList)
+          $ __class
+    liftIO $ mapM_ (\x -> _elementSetAttribute currentNode (fst x) (snd x))
+                   (HM.toList __simple)
+    setEventHandlers currentNode domifiedAttributes
+
+handleOnlyEventListeners
+  :: (jsval -> String -> jsval -> IO ())
+  -> jsval
+  -> DomifiedAttributes jsval
+  -> IO ()
+handleOnlyEventListeners eventListenerHandlerF currentNode domifiedAttributes =
+  void $ mapM (\(k, v) -> eventListenerHandlerF currentNode k v)
+              (HM.toList . _d_handlers $ domifiedAttributes)
+
+setEventHandlers
+  :: jsval -> DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()
+setEventHandlers currentNode domifiedAttributes = do
+  _eventTargetAddEventListener <- asks eventTargetAddEventListener
+  liftIO $ handleOnlyEventListeners _eventTargetAddEventListener
+                                    currentNode
+                                    domifiedAttributes
+
+removeEventHandlers
+  :: jsval -> DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()
+removeEventHandlers currentNode domifiedAttributes = do
+  _eventTargetRemoveEventListener <- asks eventTargetRemoveEventListener
+  liftIO $ handleOnlyEventListeners _eventTargetRemoveEventListener
+                                    currentNode
+                                    domifiedAttributes
+
+domify
+  :: Bool
+  -> IORef (OldStuff state jsval)
+  -> (state -> Node state jsval)
+  -> jsval
+  -> jsval
+  -> Maybe jsval
+  -> HydratedNode state jsval
+  -> ReaderT (Browserful jsval) IO (DomifiedNode jsval)
+domify touchDOM refToOldStuff domCreationF parentNode topLevelNode replacing (HydratedElement tag attrs children)
+  = do
+    _documentCreateElement <- asks documentCreateElement
+    _nodeAppendChild       <- asks nodeAppendChild
+    _nodeInsertBefore      <- asks nodeInsertBefore
+    _nodeRemoveChild       <- asks nodeRemoveChild
+    newNode                <- liftIO $ _documentCreateElement tag
+    newAttributes          <- hydratedAttrsToDomifiedAttrs refToOldStuff
+                                                           domCreationF
+                                                           topLevelNode
+                                                           attrs
+    if touchDOM then (setAtts newNode newAttributes) else (pure ())
+    newChildren <- mapM
+      (domify touchDOM refToOldStuff domCreationF newNode topLevelNode Nothing)
+      children
+    if touchDOM
+      then
+        (do
+          maybe
+            (liftIO $ _nodeAppendChild parentNode newNode)
+            (\x -> do
+              liftIO $ _nodeInsertBefore parentNode newNode x
+              liftIO $ _nodeRemoveChild parentNode x
+            )
+            replacing
+        )
+      else (pure ())
+    liftIO $ return (DomifiedElement tag newAttributes newChildren newNode)
+domify touchDOM _ _ parentNode topLevelNode replacing (HydratedTextNode text) =
+  do
+    _documentCreateElement  <- asks documentCreateElement
+    _nodeAppendChild        <- asks nodeAppendChild
+    _nodeInsertBefore       <- asks nodeInsertBefore
+    _nodeRemoveChild        <- asks nodeRemoveChild
+    _documentCreateTextNode <- asks documentCreateTextNode
+    newTextNode             <- liftIO $ _documentCreateTextNode text
+    if touchDOM
+      then
+        (do
+          maybe
+            (liftIO $ _nodeAppendChild parentNode newTextNode)
+            (\x -> do
+              liftIO $ _nodeInsertBefore parentNode newTextNode x
+              liftIO $ _nodeRemoveChild parentNode x
+            )
+            replacing
+        )
+      else (pure ())
+    liftIO $ return (DomifiedTextNode text newTextNode)
+
+getChildren :: DomifiedNode jsval -> [DomifiedNode jsval]
+getChildren (DomifiedElement _ _ x _) = x
+getChildren _                         = []
+
+setEventHandlers_
+  :: jsval -> DomifiedNode jsval -> ReaderT (Browserful jsval) IO ()
+setEventHandlers_ v (DomifiedElement _ a _ _) = setEventHandlers v a
+setEventHandlers_ _ _                         = liftIO $ pure ()
+
+transformFromCurrentDom
+  :: jsval
+  -> [DomifiedNode jsval]
+  -> ReaderT (Browserful jsval) IO [DomifiedNode jsval]
+transformFromCurrentDom parentNode children = do
+  _nodeChildNodes <- asks nodeChildNodes
+  _kids            <- liftIO $ _nodeChildNodes parentNode
+  let kids = maybe [] id _kids
+  newChildren     <- sequence $ getZipList
+    (   transformFromCurrentDom
+    <$> (ZipList kids)
+    <*> (ZipList $ fmap getChildren children)
+    )
+  sequence
+    $ getZipList (setEventHandlers_ <$> (ZipList kids) <*> (ZipList children))
+  return $ getZipList
+    (   (\cur chldrn ptr -> cur { _dom_kids = chldrn, _dom_ptr = ptr })
+    <$> (ZipList children)
+    <*> (ZipList newChildren)
+    <*> (ZipList kids)
+    )
+
+addHandlers
+  :: jsval
+  -> DomifiedNode jsval
+  -> ReaderT (Browserful jsval) IO (DomifiedNode jsval)
+addHandlers parentNode curDom = do
+  transformed <- transformFromCurrentDom parentNode [curDom]
+  return $ (transformed !! 0)
+
+__plzwrk
+  :: Bool
+  -> (state -> Node state jsval)
+  -> state
+  -> jsval
+  -> Browserful jsval
+  -> IO (Maybe (DomifiedNode jsval))
+__plzwrk cleanDOM domF state parentNode env = do
+  refToOldStuff <- newIORef (OldStuff state Nothing)
+  newDom        <- runReaderT
+    (reconcile cleanDOM
+               refToOldStuff
+               domF
+               parentNode
+               parentNode
+               Nothing
+               (Just $ hydrate state domF)
+    )
+    env
+  writeIORef refToOldStuff (OldStuff state newDom)
+  if (not cleanDOM)
+    then
+      (maybe
+        (pure Nothing)
+        (\y -> do
+          withHandlers <- runReaderT (addHandlers parentNode y) env
+          writeIORef refToOldStuff (OldStuff state (Just y))
+          return $ Just withHandlers
+        )
+        newDom
+      )
+    else pure newDom
+
+_plzwrk
+  :: Bool
+  -> (state -> Node state jsval)
+  -> state
+  -> Browserful jsval
+  -> String
+  -> IO (Maybe (DomifiedNode jsval))
+_plzwrk cleanDOM domF state env nodeId = do
+  parentNode <- (documentGetElementById env) nodeId
+  maybe (error ("Node with id not in DOM: " <> show nodeId))
+        (\x -> __plzwrk cleanDOM domF state x env)
+        parentNode
+
+
+-- |The main function that makes a web app.
+plzwrk
+  :: (state -> Node state jsval) -- ^ A function that takes a state and produces a DOM
+  -> state -- ^ An initial state
+  -> Browserful jsval -- ^ A browser implementation, ie Asterius or the mock browser
+  -> String -- ^ The id of the element into which the DOM is inserted. Note that plzwrk manages all children under this element. Touching the managed elements can break plzwrk.
+  -> IO () -- ^ Returns nothing
+plzwrk domF state env nodeId = void $ _plzwrk True domF state env nodeId
+
+-- |A variant of plzwrk that acts on a node already rendered to the DOM,
+-- ie by server-side rendering. It assumes the node has been rendered
+-- with the same state-to-node function as well as the same state.
+plzwrkSSR
+  :: (state -> Node state jsval) -- ^ A function that takes a state and produces a DOM
+  -> state -- ^ An initial state
+  -> Browserful jsval -- ^ A browser implementation, ie Asterius or the mock browser
+  -> String -- ^ The id of the element into which the DOM is inserted. Note that plzwrk manages all children under this element. Touching the managed elements can break plzwrk.
+  -> IO () -- ^ Returns nothing
+plzwrkSSR domF state env nodeId = void $ _plzwrk False domF state env nodeId
+
+_plzwrk'
+  :: Bool
+  -> (state -> Node state jsval)
+  -> state
+  -> Browserful jsval
+  -> IO (Maybe (DomifiedNode jsval))
+_plzwrk' cleanDOM domF state env = do
+  parentNode <- (documentBody env)
+  __plzwrk cleanDOM domF state parentNode env
+
+-- |A variation of plzwrk that inserts the node as a child of the document's body.
+plzwrk' :: (state -> Node state jsval) -> state -> Browserful jsval -> IO ()
+plzwrk' domF state env = void $ _plzwrk' True domF state env
+
+-- |A variation of plzwrk that inserts the node as a child of the document's body.
+plzwrkSSR' :: (state -> Node state jsval) -> state -> Browserful jsval -> IO ()
+plzwrkSSR' domF state env = void $ _plzwrk' False domF state env
+
+-- |A variation of plzwrk that takes no state.
+plzwrk'_ :: (() -> Node () jsval) -> Browserful jsval -> IO ()
+plzwrk'_ domF env = plzwrk' domF () env
+
+-- |A variation of plzwrkSSR that takes no state.
+plzwrkSSR'_ :: (() -> Node () jsval) -> Browserful jsval -> IO ()
+plzwrkSSR'_ domF env = plzwrkSSR' domF () env

@@ -1,519 +1,693 @@-{-|-Module      : Web.Framework.Plzwrk.MockJSVal-Description : Mock browser for testing-Copyright   : (c) Mike Solomon 2020-License     : GPL-3-Maintainer  : mike@meeshkan.com-Stability   : experimental-Portability : POSIX, Windows--This module exports a mock browser called-@defaultInternalBrowser@ used in plzwrk's tests-and that can be used in your unit tests as well.--}-module Web.Framework.Plzwrk.MockJSVal-  ( MockJSVal(..)-  , makeMockBrowser-  , defaultInternalBrowser-  , makeMockBrowserWithContext-  )-where--import           Data.Aeson                     ( FromJSON )-import           Data.HashMap.Strict     hiding ( foldr-                                                , null-                                                )-import           Data.IORef-import           Data.List                      ( elemIndex )-import           Prelude                 hiding ( lookup )-import           System.Random-import           Web.Framework.Plzwrk.Base-import           Web.Framework.Plzwrk.Browserful--data LogEvent = ListenerReceived String Int-    | AddedAsListenerTo Int-    | AttributeReceived String String-    | ChildReceived Int-    | AddedAsChildTo Int-    | RemovedNode Int-    | RemovedAsNodeFrom Int-    | RemovedListener String Int-    | RemovedAsListenerFrom Int-    | CreatedElement Int-    | CreatedTextNode Int-    | InsertedChildBefore Int Int-    | InsertedAsChildBefore Int Int-    | ElementAddedBefore Int-    | GotElementById-    | MadeCallback Int-    | FreeCallback Int-    deriving (Show, Eq)---data MockAttributes = MockAttributes-  { _d_attrs  :: HashMap String String-  , _d_events :: HashMap String MockJSVal-  }-  deriving Show--data MockJSVal = MockJSElement Int String MockAttributes [MockJSVal] [LogEvent]-    | MockJSTextNode Int String [LogEvent]-    | MockJSFunction Int (MockJSVal -> IO ()) [LogEvent]-    | MockJSObject Int (HashMap String MockJSVal) [LogEvent]-    | MockJSString Int String [LogEvent]-    | MockJSNumber Int Double [LogEvent]-    | MockJSArray Int [MockJSVal] [LogEvent]-    | MockMouseEvent Int--instance Show MockJSVal where-  show (MockJSElement a b c d e) =-    show a-      <> " "-      <> " "-      <> show b-      <> " "-      <> show c-      <> " "-      <> show d-      <> " "-      <> show e-  show (MockJSTextNode a b c) = show a <> " " <> show b <> " " <> show c-  show (MockJSFunction a _ c) = show a <> " " <> show c-  show (MockJSObject   a b c) = show a <> " " <> show b <> " " <> show c-  show (MockJSString   a b c) = show a <> " " <> show b <> " " <> show c-  show (MockJSNumber   a b c) = show a <> " " <> show b <> " " <> show c-  show (MockJSArray    a b c) = show a <> " " <> show b <> " " <> show c-  show (MockMouseEvent a    ) = show a--_withNewLog :: MockJSVal -> [LogEvent] -> MockJSVal-_withNewLog (MockJSElement a b c d _) log = MockJSElement a b c d log-_withNewLog (MockJSTextNode a b _   ) log = MockJSTextNode a b log-_withNewLog (MockJSFunction a b _   ) log = MockJSFunction a b log-_withNewLog (MockJSObject   a b _   ) log = MockJSObject a b log-_withNewLog (MockJSString   a b _   ) log = MockJSString a b log-_withNewLog (MockJSNumber   a b _   ) log = MockJSNumber a b log-_withNewLog (MockJSArray    a b _   ) log = MockJSArray a b log--_withNewAttrs :: MockJSVal -> MockAttributes -> MockJSVal-_withNewAttrs (MockJSElement n tg _ chlds log) newat =-  MockJSElement n tg newat chlds log-_withNewAttrs a _ = a--_withNewKids :: MockJSVal -> [MockJSVal] -> MockJSVal-_withNewKids (MockJSElement n tg attrs _ log) newKids =-  MockJSElement n tg attrs newKids log-_withNewKids a _ = a--_ptr :: MockJSVal -> Int-_ptr (MockJSElement a _ _ _ _) = a-_ptr (MockJSTextNode a _ _   ) = a-_ptr (MockJSFunction a _ _   ) = a-_ptr (MockJSObject   a _ _   ) = a-_ptr (MockJSString   a _ _   ) = a-_ptr (MockJSNumber   a _ _   ) = a-_ptr (MockJSArray    a _ _   ) = a--_eventTargetAddEventListener-  :: MockJSVal-  -> String-  -> MockJSVal-  -> IO (MockAttributes, [LogEvent], [LogEvent])-_eventTargetAddEventListener (MockJSElement n _ (MockAttributes atts lstns) _ logn) evt fn@(MockJSFunction m _ logm)-  = pure-    $ ( MockAttributes atts $ insert evt fn lstns-      , logn <> [ListenerReceived evt m]-      , logm <> [AddedAsListenerTo n]-      )-_eventTargetAddEventListener _ _ _ =-  error "Can only add event listener to element"--_elementSetAttribute-  :: MockJSVal -> String -> String -> IO (MockAttributes, [LogEvent])-_elementSetAttribute (MockJSElement n _ (MockAttributes atts lstns) _ logn) nm attr-  = pure-    $ ( MockAttributes (insert nm attr atts) lstns-      , logn <> [AttributeReceived nm attr]-      )-_elementSetAttribute _ _ _ = error "Can only add event listener to element"--_nodeAppendChild-  :: MockJSVal -> MockJSVal -> IO ([MockJSVal], [LogEvent], [LogEvent])-_nodeAppendChild (MockJSElement n _ _ kids logn) kid@(MockJSElement m _ _ _ logm)-  = pure-    $ (kids <> [kid], logn <> [ChildReceived m], logm <> [AddedAsChildTo n])-_nodeAppendChild (MockJSElement n _ _ kids logn) kid@(MockJSTextNode m _ logm)-  = pure-    $ (kids <> [kid], logn <> [ChildReceived m], logm <> [AddedAsChildTo n])-_nodeAppendChild _ _ = error "Can only append element to element"--__nodeRemoveChild-  :: Int-  -> [MockJSVal]-  -> [LogEvent]-  -> MockJSVal-  -> Int-  -> [LogEvent]-  -> IO ([MockJSVal], [LogEvent], [LogEvent])-__nodeRemoveChild n kids logn kid m logm = maybe-  (error ("Existing item " <> show m <> " not child of " <> show n))-  (\x ->-    pure-      $ ( take x kids <> drop (x + 1) kids-        , logn <> [RemovedNode m]-        , logm <> [RemovedAsNodeFrom n]-        )-  )-  (elemIndex (_ptr kid) (fmap _ptr kids))--_nodeRemoveChild-  :: MockJSVal -> MockJSVal -> IO ([MockJSVal], [LogEvent], [LogEvent])-_nodeRemoveChild (MockJSElement n _ _ kids logn) kid@(MockJSElement m _ _ _ logm)-  = __nodeRemoveChild n kids logn kid m logm-_nodeRemoveChild (MockJSElement n _ _ kids logn) kid@(MockJSTextNode m _ logm)-  = __nodeRemoveChild n kids logn kid m logm-_nodeRemoveChild _ _ = error "Can only remove element from element"--_eventTargetRemoveEventListener-  :: MockJSVal-  -> String-  -> MockJSVal-  -> IO (MockAttributes, [LogEvent], [LogEvent])-_eventTargetRemoveEventListener (MockJSElement n _ (MockAttributes atts lstns) _ logn) evt fn@(MockJSFunction m _ logm)-  = maybe-    (error ("Listener " <> show m <> " not child of " <> show n))-    (\x ->-      pure-        $ ( MockAttributes atts $ delete evt lstns-          , logn <> [RemovedListener evt m]-          , logm <> [RemovedAsListenerFrom n]-          )-    )-    (lookup evt lstns)-_eventTargetRemoveEventListener _ _ _ =-  error "Can only add event listener to element"--_nodeInsertBeforeInternal-  :: Int-  -> [MockJSVal]-  -> [LogEvent]-  -> MockJSVal-  -> Int-  -> [LogEvent]-  -> MockJSVal-  -> Int-  -> [LogEvent]-  -> IO-       ( [MockJSVal]-       , [LogEvent]-       , [LogEvent]-       , [LogEvent]-       )-_nodeInsertBeforeInternal n kids logn newI m logm existingI l logl = maybe-  (error ("Existing item " <> show l <> " not child of " <> show n))-  (\x ->-    pure-      $ ( take x kids <> [newI] <> drop x kids-        , logn <> [InsertedChildBefore m l]-        , logm <> [InsertedAsChildBefore n l]-        , logl <> [ElementAddedBefore m]-        )-  )-  (elemIndex (_ptr existingI) (fmap _ptr kids))---_nodeInsertBefore-  :: MockJSVal-  -> MockJSVal-  -> MockJSVal-  -> IO ([MockJSVal], [LogEvent], [LogEvent], [LogEvent])-_nodeInsertBefore (MockJSElement n _ _ kids logn) newI@(MockJSElement m _ _ _ logm) existingI@(MockJSElement l _ _ _ logl)-  = _nodeInsertBeforeInternal n kids logn newI m logm existingI l logl-_nodeInsertBefore (MockJSElement n _ _ kids logn) newI@(MockJSTextNode m _ logm) existingI@(MockJSElement l _ _ _ logl)-  = _nodeInsertBeforeInternal n kids logn newI m logm existingI l logl-_nodeInsertBefore (MockJSElement n _ _ kids logn) newI@(MockJSElement m _ _ _ logm) existingI@(MockJSTextNode l _ logl)-  = _nodeInsertBeforeInternal n kids logn newI m logm existingI l logl-_nodeInsertBefore (MockJSElement n _ _ kids logn) newI@(MockJSTextNode m _ logm) existingI@(MockJSTextNode l _ logl)-  = _nodeInsertBeforeInternal n kids logn newI m logm existingI l logl-_nodeInsertBefore _ _ _ = error "Can only append element to element"--_elementTagName :: MockJSVal -> IO String-_elementTagName (MockJSElement _ tag _ _ _) = return tag-_elementTagName _ = error "Can only get tag of element"--_nodeTextContent :: MockJSVal -> IO String-_nodeTextContent (MockJSTextNode _ txt _) = return txt-_nodeTextContent _ = error "Can only get text content of text node"---_nodeChildNodes :: MockJSVal -> IO [Int]-_nodeChildNodes (MockJSElement _ _ _ kids _) = return $ fmap _ptr kids-_nodeChildNodes _ = error "Can only get children of element"--__freeCallback :: MockJSVal -> IO [LogEvent]-__freeCallback (MockJSFunction n _ log) = pure (log <> [FreeCallback n])-__freeCallback _                        = error "Can only free function"--dummyClick :: MockJSVal -> IO ()--- todo give real number---dummyClick (MockJSFunction _ f _) = f $ MockMouseEvent (-1)---_htmlElemenetClick :: MockJSVal -> IO ()-_htmlElemenetClick (MockJSElement _ _ (MockAttributes _ evts) _ _) = do-  let oc = lookup "click" evts-  maybe (pure ()) (\x -> dummyClick x) oc--_htmlElemenetClick _ = error "Can only free function"---------------------data MockBrowserInternal = MockBrowserInternal-  { unBrowser :: HashMap Int MockJSVal-  , unCtr     :: Int-  }-  deriving Show--look :: IORef MockBrowserInternal -> Int -> IO MockJSVal-look env elt = do-  r <- readIORef env-  let bz = unBrowser r-  maybe (error $ "Cannot find object pointer in env: " <> (show elt))-        (\x -> return x)-        (lookup elt bz)--incr :: IORef MockBrowserInternal -> IO Int-incr env = do-  r <- readIORef env-  let ctr = unCtr r-  writeIORef env $ r { unCtr = ctr + 1 }-  return ctr---wrt :: IORef MockBrowserInternal -> Int -> MockJSVal -> IO ()-wrt env elt v = do-  r <- readIORef env-  let bz = unBrowser r-  writeIORef env $ r { unBrowser = insert elt v bz }--_'eventTargetAddEventListener-  :: IORef MockBrowserInternal -> Int -> String -> Int -> IO ()-_'eventTargetAddEventListener env elt evt fn = do-  _elt                            <- look env elt-  _fn                             <- look env fn-  (newAttrs, newLogElt, newLogFn) <- _eventTargetAddEventListener _elt evt _fn-  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLogElt-  wrt env fn $ _withNewLog _fn newLogFn--_'nodeAppendChild :: IORef MockBrowserInternal -> Int -> Int -> IO ()-_'nodeAppendChild env parent kid = do-  _parent                            <- look env parent-  _kid                               <- look env kid-  (newKids, newLogParent, newLogKid) <- _nodeAppendChild _parent _kid-  wrt env parent $ _withNewLog (_withNewKids _parent newKids) newLogParent-  wrt env kid $ _withNewLog _kid newLogKid--_'documentCreateElement :: IORef MockBrowserInternal -> String -> IO Int-_'documentCreateElement env tg = do-  i <- incr env-  let elt =-        MockJSElement i tg (MockAttributes empty empty) [] [CreatedElement i]-  wrt env i elt-  return i--_'mathRandom :: IORef MockBrowserInternal -> IO Double-_'mathRandom _ = pure 0.5--_'consoleLog :: IORef MockBrowserInternal -> String -> IO ()-_'consoleLog _ txt = print txt--_'consoleLog' :: IORef MockBrowserInternal -> Int -> IO ()-_'consoleLog' _ v = print (show v)---_'documentCreateTextNode :: IORef MockBrowserInternal -> String -> IO Int-_'documentCreateTextNode env txt = do-  i <- incr env-  let elt = MockJSTextNode i txt [CreatedTextNode i]-  wrt env i elt-  return i--_'getPropertyAsString-  :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe String)-_'getPropertyAsString env _ _ = pure Nothing -- not implemented yet---_'getPropertyAsBool-  :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Bool)-_'getPropertyAsBool env _ _ = pure Nothing -- not implemented yet---_'getPropertyAsInt-  :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Int)-_'getPropertyAsInt env _ _ = pure Nothing -- not implemented yet---_'getPropertyAsDouble-  :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Double)-_'getPropertyAsDouble env _ _ = pure Nothing -- not implemented yet---_'getPropertyAsOpaque-  :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Int)-_'getPropertyAsOpaque env _ _ = pure Nothing -- not implemented yet----_'invokeOn0 :: IORef MockBrowserInternal -> Int -> String -> IO Int-_'invokeOn0 env _ _ = pure 0 -- not implemented yet----_'elementTagName :: IORef MockBrowserInternal -> Int -> IO String-_'elementTagName env elt = do-  _elt <- look env elt-  _elementTagName _elt--_'nodeChildNodes :: IORef MockBrowserInternal -> Int -> IO [Int]-_'nodeChildNodes env elt = do-  _elt <- look env elt-  _nodeChildNodes _elt--_'nodeTextContent :: IORef MockBrowserInternal -> Int -> IO String-_'nodeTextContent env elt = do-  _elt <- look env elt-  _nodeTextContent _elt--_'freeCallback :: IORef MockBrowserInternal -> Int -> IO ()-_'freeCallback env fn = do-  _fn    <- look env fn-  newLog <- __freeCallback _fn-  wrt env fn $ _withNewLog _fn newLog--_'htmlElemenetClick :: IORef MockBrowserInternal -> Int -> IO ()-_'htmlElemenetClick env elt = do-  _elt <- look env elt-  _htmlElemenetClick _elt--idEq :: String -> MockJSVal -> Bool-idEq txt (MockJSElement _ _ (MockAttributes atts _) _ _) =-  Just txt == (lookup "id" atts)-idEq _ _ = False--_'documentBody :: IORef MockBrowserInternal -> IO Int-_'documentBody ref = do-  mb <- readIORef ref-  let browser = unBrowser mb-  pt <- maybe (error "No body.") (\x -> pure $ _ptr x) $ lookup 0 browser-  return pt--_'documentHead :: IORef MockBrowserInternal -> IO Int-_'documentHead ref = pure (-1) -- need to implement in mock?---_documentGetElementByIdInternal :: MockJSVal -> String -> [Int]-_documentGetElementByIdInternal jsv@(MockJSElement _ _ _ ch _) txt =-  if (idEq txt jsv)-    then [_ptr jsv]-    else (foldr (++) [] $ fmap (\x -> _documentGetElementByIdInternal x txt) ch)-_documentGetElementByIdInternal _ _ = []--_'documentGetElementById-  :: IORef MockBrowserInternal -> String -> IO (Maybe Int)-_'documentGetElementById env txt = do-  body  <- _'documentBody env-  _body <- look env body-  let elts = _documentGetElementByIdInternal _body txt-  return $ if (null elts) then (Nothing) else (Just $ head elts)--_'nodeInsertBefore :: IORef MockBrowserInternal -> Int -> Int -> Int -> IO ()-_'nodeInsertBefore env parent newItem existingItem = do-  _parent       <- look env parent-  _newItem      <- look env newItem-  _existingItem <- look env existingItem-  (newKids, newLogParent, newLogNewItem, newLogExistingItem) <--    _nodeInsertBefore _parent _newItem _existingItem-  wrt env parent $ _withNewLog (_withNewKids _parent newKids) newLogParent-  wrt env newItem $ _withNewLog _newItem newLogNewItem-  wrt env existingItem $ _withNewLog _existingItem newLogExistingItem--_'makeHaskellCallback :: IORef MockBrowserInternal -> (Int -> IO ()) -> IO Int-_'makeHaskellCallback env cb = do-  i <- incr env-  let elt = MockJSFunction i (\x -> cb $ _ptr x) [MadeCallback i]-  wrt env i elt-  return i--_'nodeRemoveChild :: IORef MockBrowserInternal -> Int -> Int -> IO ()-_'nodeRemoveChild env parent kid = do-  _parent                            <- look env parent-  _kid                               <- look env kid-  (newKids, newLogParent, newLogKid) <- _nodeRemoveChild _parent _kid-  wrt env parent $ _withNewLog (_withNewKids _parent newKids) newLogParent-  wrt env kid $ _withNewLog _kid newLogKid--_'eventTargetRemoveEventListener-  :: IORef MockBrowserInternal -> Int -> String -> Int -> IO ()-_'eventTargetRemoveEventListener env elt evt fn = do-  _elt                            <- look env elt-  _fn                             <- look env fn-  (newAttrs, newLogElt, newLogFn) <- _eventTargetRemoveEventListener _elt-                                                                     evt-                                                                     _fn-  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLogElt-  wrt env fn $ _withNewLog _fn newLogFn--_'elementSetAttribute-  :: IORef MockBrowserInternal -> Int -> String -> String -> IO ()-_'elementSetAttribute env elt nm attr = do-  _elt               <- look env elt-  (newAttrs, newLog) <- _elementSetAttribute _elt nm attr-  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLog--makeMockBrowserWithContext :: IORef MockBrowserInternal -> IO (Browserful Int)-makeMockBrowserWithContext r = return Browserful-  { eventTargetAddEventListener    = _'eventTargetAddEventListener r-  , nodeAppendChild                = _'nodeAppendChild r-  , consoleLog                     = _'consoleLog r-  , consoleLog'                    = _'consoleLog' r-  , htmlElemenetClick              = _'htmlElemenetClick r-  , documentCreateElement          = _'documentCreateElement r-  , documentCreateTextNode         = _'documentCreateTextNode r-  , documentBody                   = _'documentBody r-  , documentGetElementById         = _'documentGetElementById r-  , documentHead                   = _'documentHead r-  , _freeCallback                  = _'freeCallback r-  , getPropertyAsBool              = _'getPropertyAsBool r-  , getPropertyAsDouble            = _'getPropertyAsDouble r-  , getPropertyAsInt               = _'getPropertyAsInt r-  , getPropertyAsOpaque            = _'getPropertyAsOpaque r-  , getPropertyAsString            = _'getPropertyAsString r-  , elementTagName                 = _'elementTagName r-  , nodeInsertBefore               = _'nodeInsertBefore r-  , invokeOn0                      = _'invokeOn0 r-  , _makeHaskellCallback           = _'makeHaskellCallback r-  , nodeChildNodes                 = _'nodeChildNodes r-  , mathRandom                     = _'mathRandom r-  , nodeRemoveChild                = _'nodeRemoveChild r-  , eventTargetRemoveEventListener = _'eventTargetRemoveEventListener r-  , elementSetAttribute            = _'elementSetAttribute r-  , nodeTextContent                = _'nodeTextContent r-  }--defaultInternalBrowser :: IO (IORef MockBrowserInternal)-defaultInternalBrowser = do-  let body = MockJSElement 0-                           "body"-                           (MockAttributes empty empty)-                           []-                           [CreatedElement 0]-  newIORef MockBrowserInternal { unBrowser = singleton 0 body, unCtr = 1 }--makeMockBrowser :: IO (Browserful Int)-makeMockBrowser = do-  rf <- defaultInternalBrowser-  makeMockBrowserWithContext rf+{-|
+Module      : Web.Framework.Plzwrk.MockJSVal
+Description : Mock browser for testing
+Copyright   : (c) Mike Solomon 2020
+License     : GPL-3
+Maintainer  : mike@meeshkan.com
+Stability   : experimental
+Portability : POSIX, Windows
+
+This module exports a mock browser called
+@defaultInternalBrowser@ used in plzwrk's tests
+and that can be used in your unit tests as well.
+-}
+module Web.Framework.Plzwrk.MockJSVal
+  ( MockJSVal(..)
+  , makeMockBrowser
+  , defaultInternalBrowser
+  , makeMockBrowserWithContext
+  )
+where
+
+import           Data.Aeson                     ( FromJSON )
+import           Data.ByteString.Internal       ( ByteString )
+import           Data.HashMap.Strict     hiding ( foldr
+                                                , null
+                                                )
+import           Data.IORef
+import           Data.List                      ( elemIndex )
+import           Prelude                 hiding ( lookup )
+import           System.Random
+import           Web.Framework.Plzwrk.Base
+import           Web.Framework.Plzwrk.Browserful
+
+data LogEvent = ListenerReceived String Int
+    | AddedAsListenerTo Int
+    | AttributeReceived String String
+    | ChildReceived Int
+    | AddedAsChildTo Int
+    | RemovedNode Int
+    | RemovedAsNodeFrom Int
+    | RemovedListener String Int
+    | RemovedAsListenerFrom Int
+    | CreatedElement Int
+    | CreatedTextNode Int
+    | InsertedChildBefore Int Int
+    | InsertedAsChildBefore Int Int
+    | ElementAddedBefore Int
+    | GotElementById
+    | MadeCallback Int
+    | FreeCallback Int
+    deriving (Show, Eq)
+
+
+data MockAttributes = MockAttributes
+  { _d_attrs  :: HashMap String String
+  , _d_events :: HashMap String MockJSVal
+  }
+  deriving Show
+
+data MockJSVal = MockJSElement Int String MockAttributes [MockJSVal] [LogEvent]
+    | MockJSTextNode Int String [LogEvent]
+    | MockJSFunction Int (MockJSVal -> IO ()) [LogEvent]
+    | MockJSObject Int (HashMap String Int) [LogEvent]
+    | MockJSString Int String [LogEvent]
+    | MockJSDouble Int Double [LogEvent]
+    | MockJSInt Int Int [LogEvent]
+    | MockJSBool Int Bool [LogEvent]
+    | MockJSByteString Int ByteString [LogEvent]
+    | MockJSArray Int [Int] [LogEvent]
+    | MockMouseEvent Int
+
+instance Show MockJSVal where
+  show (MockJSElement a b c d e) =
+    show a
+      <> " "
+      <> " "
+      <> show b
+      <> " "
+      <> show c
+      <> " "
+      <> show d
+      <> " "
+      <> show e
+  show (MockJSTextNode   a b c) = show a <> " " <> show b <> " " <> show c
+  show (MockJSFunction   a _ c) = show a <> " " <> show c
+  show (MockJSObject     a b c) = show a <> " " <> show b <> " " <> show c
+  show (MockJSString     a b c) = show a <> " " <> show b <> " " <> show c
+  show (MockJSDouble     a b c) = show a <> " " <> show b <> " " <> show c
+  show (MockJSInt        a b c) = show a <> " " <> show b <> " " <> show c
+  show (MockJSBool       a b c) = show a <> " " <> show b <> " " <> show c
+  show (MockJSByteString a b c) = show a <> " " <> show b <> " " <> show c
+  show (MockJSArray      a b c) = show a <> " " <> show b <> " " <> show c
+  show (MockMouseEvent a      ) = show a
+
+_withNewLog :: MockJSVal -> [LogEvent] -> MockJSVal
+_withNewLog (MockJSElement a b c d _) log = MockJSElement a b c d log
+_withNewLog (MockJSTextNode   a b _ ) log = MockJSTextNode a b log
+_withNewLog (MockJSFunction   a b _ ) log = MockJSFunction a b log
+_withNewLog (MockJSObject     a b _ ) log = MockJSObject a b log
+_withNewLog (MockJSString     a b _ ) log = MockJSString a b log
+_withNewLog (MockJSDouble     a b _ ) log = MockJSDouble a b log
+_withNewLog (MockJSBool       a b _ ) log = MockJSBool a b log
+_withNewLog (MockJSInt        a b _ ) log = MockJSInt a b log
+_withNewLog (MockJSByteString a b _ ) log = MockJSByteString a b log
+_withNewLog (MockJSArray      a b _ ) log = MockJSArray a b log
+
+_withNewAttrs :: MockJSVal -> MockAttributes -> MockJSVal
+_withNewAttrs (MockJSElement n tg _ chlds log) newat =
+  MockJSElement n tg newat chlds log
+_withNewAttrs a _ = a
+
+_withNewKids :: MockJSVal -> [MockJSVal] -> MockJSVal
+_withNewKids (MockJSElement n tg attrs _ log) newKids =
+  MockJSElement n tg attrs newKids log
+_withNewKids a _ = a
+
+_ptr :: MockJSVal -> Int
+_ptr (MockJSElement a _ _ _ _) = a
+_ptr (MockJSTextNode   a _ _ ) = a
+_ptr (MockJSFunction   a _ _ ) = a
+_ptr (MockJSObject     a _ _ ) = a
+_ptr (MockJSString     a _ _ ) = a
+_ptr (MockJSDouble     a _ _ ) = a
+_ptr (MockJSBool       a _ _ ) = a
+_ptr (MockJSInt        a _ _ ) = a
+_ptr (MockJSByteString a _ _ ) = a
+_ptr (MockJSArray      a _ _ ) = a
+
+_eventTargetAddEventListener
+  :: MockJSVal
+  -> String
+  -> MockJSVal
+  -> IO (MockAttributes, [LogEvent], [LogEvent])
+_eventTargetAddEventListener (MockJSElement n _ (MockAttributes atts lstns) _ logn) evt fn@(MockJSFunction m _ logm)
+  = pure
+    $ ( MockAttributes atts $ insert evt fn lstns
+      , logn <> [ListenerReceived evt m]
+      , logm <> [AddedAsListenerTo n]
+      )
+_eventTargetAddEventListener _ _ _ =
+  error "Can only add event listener to element"
+
+_elementSetAttribute
+  :: MockJSVal -> String -> String -> IO (MockAttributes, [LogEvent])
+_elementSetAttribute (MockJSElement n _ (MockAttributes atts lstns) _ logn) nm attr
+  = pure
+    $ ( MockAttributes (insert nm attr atts) lstns
+      , logn <> [AttributeReceived nm attr]
+      )
+_elementSetAttribute _ _ _ = error "Can only add event listener to element"
+
+_nodeAppendChild
+  :: MockJSVal -> MockJSVal -> IO ([MockJSVal], [LogEvent], [LogEvent])
+_nodeAppendChild (MockJSElement n _ _ kids logn) kid@(MockJSElement m _ _ _ logm)
+  = pure
+    $ (kids <> [kid], logn <> [ChildReceived m], logm <> [AddedAsChildTo n])
+_nodeAppendChild (MockJSElement n _ _ kids logn) kid@(MockJSTextNode m _ logm)
+  = pure
+    $ (kids <> [kid], logn <> [ChildReceived m], logm <> [AddedAsChildTo n])
+_nodeAppendChild _ _ = error "Can only append element to element"
+
+__nodeRemoveChild
+  :: Int
+  -> [MockJSVal]
+  -> [LogEvent]
+  -> MockJSVal
+  -> Int
+  -> [LogEvent]
+  -> IO ([MockJSVal], [LogEvent], [LogEvent])
+__nodeRemoveChild n kids logn kid m logm = maybe
+  (error ("Existing item " <> show m <> " not child of " <> show n))
+  (\x ->
+    pure
+      $ ( take x kids <> drop (x + 1) kids
+        , logn <> [RemovedNode m]
+        , logm <> [RemovedAsNodeFrom n]
+        )
+  )
+  (elemIndex (_ptr kid) (fmap _ptr kids))
+
+_nodeRemoveChild
+  :: MockJSVal -> MockJSVal -> IO ([MockJSVal], [LogEvent], [LogEvent])
+_nodeRemoveChild (MockJSElement n _ _ kids logn) kid@(MockJSElement m _ _ _ logm)
+  = __nodeRemoveChild n kids logn kid m logm
+_nodeRemoveChild (MockJSElement n _ _ kids logn) kid@(MockJSTextNode m _ logm)
+  = __nodeRemoveChild n kids logn kid m logm
+_nodeRemoveChild _ _ = error "Can only remove element from element"
+
+_eventTargetRemoveEventListener
+  :: MockJSVal
+  -> String
+  -> MockJSVal
+  -> IO (MockAttributes, [LogEvent], [LogEvent])
+_eventTargetRemoveEventListener (MockJSElement n _ (MockAttributes atts lstns) _ logn) evt fn@(MockJSFunction m _ logm)
+  = maybe
+    (error ("Listener " <> show m <> " not child of " <> show n))
+    (\x ->
+      pure
+        $ ( MockAttributes atts $ delete evt lstns
+          , logn <> [RemovedListener evt m]
+          , logm <> [RemovedAsListenerFrom n]
+          )
+    )
+    (lookup evt lstns)
+_eventTargetRemoveEventListener _ _ _ =
+  error "Can only add event listener to element"
+
+_nodeInsertBeforeInternal
+  :: Int
+  -> [MockJSVal]
+  -> [LogEvent]
+  -> MockJSVal
+  -> Int
+  -> [LogEvent]
+  -> MockJSVal
+  -> Int
+  -> [LogEvent]
+  -> IO
+       ( [MockJSVal]
+       , [LogEvent]
+       , [LogEvent]
+       , [LogEvent]
+       )
+_nodeInsertBeforeInternal n kids logn newI m logm existingI l logl = maybe
+  (error ("Existing item " <> show l <> " not child of " <> show n))
+  (\x ->
+    pure
+      $ ( take x kids <> [newI] <> drop x kids
+        , logn <> [InsertedChildBefore m l]
+        , logm <> [InsertedAsChildBefore n l]
+        , logl <> [ElementAddedBefore m]
+        )
+  )
+  (elemIndex (_ptr existingI) (fmap _ptr kids))
+
+
+_nodeInsertBefore
+  :: MockJSVal
+  -> MockJSVal
+  -> MockJSVal
+  -> IO ([MockJSVal], [LogEvent], [LogEvent], [LogEvent])
+_nodeInsertBefore (MockJSElement n _ _ kids logn) newI@(MockJSElement m _ _ _ logm) existingI@(MockJSElement l _ _ _ logl)
+  = _nodeInsertBeforeInternal n kids logn newI m logm existingI l logl
+_nodeInsertBefore (MockJSElement n _ _ kids logn) newI@(MockJSTextNode m _ logm) existingI@(MockJSElement l _ _ _ logl)
+  = _nodeInsertBeforeInternal n kids logn newI m logm existingI l logl
+_nodeInsertBefore (MockJSElement n _ _ kids logn) newI@(MockJSElement m _ _ _ logm) existingI@(MockJSTextNode l _ logl)
+  = _nodeInsertBeforeInternal n kids logn newI m logm existingI l logl
+_nodeInsertBefore (MockJSElement n _ _ kids logn) newI@(MockJSTextNode m _ logm) existingI@(MockJSTextNode l _ logl)
+  = _nodeInsertBeforeInternal n kids logn newI m logm existingI l logl
+_nodeInsertBefore _ _ _ = error "Can only append element to element"
+
+_elementTagName :: MockJSVal -> IO String
+_elementTagName (MockJSElement _ tag _ _ _) = return tag
+_elementTagName _ = error "Can only get tag of element"
+
+_nodeTextContent :: MockJSVal -> IO String
+_nodeTextContent (MockJSTextNode _ txt _) = return txt
+_nodeTextContent _ = error "Can only get text content of text node"
+
+
+_nodeChildNodes :: MockJSVal -> IO [Int]
+_nodeChildNodes (MockJSElement _ _ _ kids _) = return $ fmap _ptr kids
+_nodeChildNodes _ = error "Can only get children of element"
+
+__freeCallback :: MockJSVal -> IO [LogEvent]
+__freeCallback (MockJSFunction n _ log) = pure (log <> [FreeCallback n])
+__freeCallback _                        = error "Can only free function"
+
+dummyClick :: MockJSVal -> IO ()
+-- todo give real number
+
+
+dummyClick (MockJSFunction _ f _) = f $ MockMouseEvent (-1)
+
+
+_htmlElemenetClick :: MockJSVal -> IO ()
+_htmlElemenetClick (MockJSElement _ _ (MockAttributes _ evts) _ _) = do
+  let oc = lookup "click" evts
+  maybe (pure ()) (\x -> dummyClick x) oc
+
+_htmlElemenetClick _ = error "Can only free function"
+
+
+--------------
+
+
+
+data MockBrowserInternal = MockBrowserInternal
+  { unBrowser :: HashMap Int MockJSVal
+  , unCtr     :: Int
+  }
+  deriving Show
+
+look :: IORef MockBrowserInternal -> Int -> IO MockJSVal
+look env elt = do
+  r <- readIORef env
+  let bz = unBrowser r
+  maybe (error $ "Cannot find object pointer in env: " <> (show elt))
+        (\x -> return x)
+        (lookup elt bz)
+
+incr :: IORef MockBrowserInternal -> IO Int
+incr env = do
+  r <- readIORef env
+  let ctr = unCtr r
+  writeIORef env $ r { unCtr = ctr + 1 }
+  return ctr
+
+
+wrt :: IORef MockBrowserInternal -> Int -> MockJSVal -> IO ()
+wrt env elt v = do
+  r <- readIORef env
+  let bz = unBrowser r
+  writeIORef env $ r { unBrowser = insert elt v bz }
+
+_'eventTargetAddEventListener
+  :: IORef MockBrowserInternal -> Int -> String -> Int -> IO ()
+_'eventTargetAddEventListener env elt evt fn = do
+  _elt                            <- look env elt
+  _fn                             <- look env fn
+  (newAttrs, newLogElt, newLogFn) <- _eventTargetAddEventListener _elt evt _fn
+  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLogElt
+  wrt env fn $ _withNewLog _fn newLogFn
+
+_'nodeAppendChild :: IORef MockBrowserInternal -> Int -> Int -> IO ()
+_'nodeAppendChild env parent kid = do
+  _parent                            <- look env parent
+  _kid                               <- look env kid
+  (newKids, newLogParent, newLogKid) <- _nodeAppendChild _parent _kid
+  wrt env parent $ _withNewLog (_withNewKids _parent newKids) newLogParent
+  wrt env kid $ _withNewLog _kid newLogKid
+
+_'documentCreateElement :: IORef MockBrowserInternal -> String -> IO Int
+_'documentCreateElement env tg = do
+  i <- incr env
+  let elt =
+        MockJSElement i tg (MockAttributes empty empty) [] [CreatedElement i]
+  wrt env i elt
+  return i
+
+----------------------
+_jsValFrom
+  :: (Int -> s -> [LogEvent] -> MockJSVal)
+  -> IORef MockBrowserInternal
+  -> s
+  -> IO Int
+_jsValFrom trans env toConv = do
+  i <- incr env
+  let elt = trans i toConv []
+  wrt env i elt
+  return i
+
+_'jsValFromArray = _jsValFrom MockJSArray
+_'jsValFromBool = _jsValFrom MockJSBool
+_'jsValFromByteString = _jsValFrom MockJSByteString
+_'jsValFromDouble = _jsValFrom MockJSDouble
+_'jsValFromInt = _jsValFrom MockJSInt
+_'jsValFromString = _jsValFrom MockJSString
+
+----------------------
+
+_'mathRandom :: IORef MockBrowserInternal -> IO Double
+_'mathRandom _ = pure 0.5
+
+_'consoleLog :: IORef MockBrowserInternal -> Int -> IO ()
+_'consoleLog env v = do
+  _v <- look env v
+  print v
+
+
+_'documentCreateTextNode :: IORef MockBrowserInternal -> String -> IO Int
+_'documentCreateTextNode env txt = do
+  i <- incr env
+  let elt = MockJSTextNode i txt [CreatedTextNode i]
+  wrt env i elt
+  return i
+
+_'getPropertyAsOpaque
+  :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Int)
+_'getPropertyAsOpaque env i s
+  | s == "tagName" = do
+    tn <- _'elementTagName env i
+    _v <- _'jsValFromString env tn
+    (return . Just) $ _v
+  | s == "textContent" = do
+    tc <- _'nodeTextContent env i
+    _v <- _'jsValFromString env tc
+    (return . Just) $ _v
+  | s == "childNodes" = do
+    cn <- _'nodeChildNodes env i
+    _v <-_'jsValFromArray env cn
+    (return . Just) $ _v
+  | otherwise =  error
+  $  "This property is not implemented yet in MockJSVal: "
+  <> s
+
+_'invokeOn0 :: IORef MockBrowserInternal -> Int -> String -> IO Int
+_'invokeOn0 env i s
+  | s == "click" = do
+    _'htmlElementClick env i
+    return (negate 1)
+  | otherwise =  error
+  $  "This function is not implemented yet in MockJSVal: "
+  <> s
+
+_'invokeOn1 :: IORef MockBrowserInternal -> Int -> String -> Int -> IO Int
+_'invokeOn1 env i s v
+  | s == "appendChild" = do
+    _'nodeAppendChild env i v
+    return (negate 1)
+  | s == "removeChild" = do
+    _'nodeRemoveChild env i v
+    return (negate 1)
+  | otherwise =  error
+  $  "This function is not implemented yet in MockJSVal: "
+  <> s
+
+_'invokeOn2
+  :: IORef MockBrowserInternal -> Int -> String -> Int -> Int -> IO Int
+_'invokeOn2 env i s k v
+  | s == "setAttribute" = do
+    _k <- _'castToString env k
+    _v <- _'castToString env v
+    maybe
+      (error "key not a string")
+      (\__k -> maybe
+        (error "value not a string")
+        (\__v -> do
+          _'elementSetAttribute env i __k __v
+          return (negate 1)
+        )
+        _v
+      )
+      _k
+  | s == "addEventListener" = do
+    _k <- _'castToString env k
+    maybe
+      (error "key not a string")
+      (\__k -> do
+        _'eventTargetAddEventListener env i __k v
+        return (negate 1)
+      )
+      _k
+  | s == "removeEventListener" = do
+    _k <- _'castToString env k
+    maybe
+      (error "key not a string")
+      (\__k -> do
+        _'eventTargetRemoveEventListener env i __k v
+        return (negate 1)
+      )
+      _k
+  | s == "insertBefore" = do
+    _'nodeInsertBefore env i k v
+    return (negate 1)
+  | otherwise =  error
+  $  "This function is not implemented yet in MockJSVal: "
+  <> s
+
+_'setValue :: IORef MockBrowserInternal -> Int -> String -> Int -> IO ()
+_'setValue env o k v = do
+  _o <- _'castToObject env o
+  maybe
+    (error "Not an object")
+    (\x -> do
+      __o <- look env o
+      let (MockJSObject _ _ lg) = __o
+      wrt env o $ MockJSObject o (insert k v x) lg
+    )
+    _o
+
+
+_'fetch :: IORef MockBrowserInternal -> String -> RequestInit Int -> IO Int
+_'fetch env _ _ = do
+  _o <- _'makeObject env
+  return _o -- return an empty object for now
+
+_'elementTagName :: IORef MockBrowserInternal -> Int -> IO String
+_'elementTagName env elt = do
+  _elt <- look env elt
+  _elementTagName _elt
+
+_'nodeChildNodes :: IORef MockBrowserInternal -> Int -> IO [Int]
+_'nodeChildNodes env elt = do
+  _elt <- look env elt
+  _nodeChildNodes _elt
+
+_'nodeTextContent :: IORef MockBrowserInternal -> Int -> IO String
+_'nodeTextContent env elt = do
+  _elt <- look env elt
+  _nodeTextContent _elt
+
+_'_freeCallback :: IORef MockBrowserInternal -> Int -> IO ()
+_'_freeCallback env fn = do
+  _fn    <- look env fn
+  newLog <- __freeCallback _fn
+  wrt env fn $ _withNewLog _fn newLog
+
+_'htmlElementClick :: IORef MockBrowserInternal -> Int -> IO ()
+_'htmlElementClick env elt = do
+  _elt <- look env elt
+  _htmlElemenetClick _elt
+
+idEq :: String -> MockJSVal -> Bool
+idEq txt (MockJSElement _ _ (MockAttributes atts _) _ _) =
+  Just txt == (lookup "id" atts)
+idEq _ _ = False
+
+_'documentBody :: IORef MockBrowserInternal -> IO Int
+_'documentBody ref = do
+  mb <- readIORef ref
+  let browser = unBrowser mb
+  pt <- maybe (error "No body.") (\x -> pure $ _ptr x) $ lookup 0 browser
+  return pt
+
+_'documentHead :: IORef MockBrowserInternal -> IO Int
+_'documentHead ref = pure (-1) -- need to implement in mock?
+
+
+_documentGetElementByIdInternal :: MockJSVal -> String -> [Int]
+_documentGetElementByIdInternal jsv@(MockJSElement _ _ _ ch _) txt =
+  if (idEq txt jsv)
+    then [_ptr jsv]
+    else (foldr (++) [] $ fmap (\x -> _documentGetElementByIdInternal x txt) ch)
+_documentGetElementByIdInternal _ _ = []
+
+_'documentGetElementById
+  :: IORef MockBrowserInternal -> String -> IO (Maybe Int)
+_'documentGetElementById env txt = do
+  body  <- _'documentBody env
+  _body <- look env body
+  let elts = _documentGetElementByIdInternal _body txt
+  return $ if (null elts) then (Nothing) else (Just $ head elts)
+
+_'nodeInsertBefore :: IORef MockBrowserInternal -> Int -> Int -> Int -> IO ()
+_'nodeInsertBefore env parent newItem existingItem = do
+  _parent       <- look env parent
+  _newItem      <- look env newItem
+  _existingItem <- look env existingItem
+  (newKids, newLogParent, newLogNewItem, newLogExistingItem) <-
+    _nodeInsertBefore _parent _newItem _existingItem
+  wrt env parent $ _withNewLog (_withNewKids _parent newKids) newLogParent
+  wrt env newItem $ _withNewLog _newItem newLogNewItem
+  wrt env existingItem $ _withNewLog _existingItem newLogExistingItem
+
+_'_makeHaskellCallback :: IORef MockBrowserInternal -> (Int -> IO ()) -> IO Int
+_'_makeHaskellCallback env cb = do
+  i <- incr env
+  let elt = MockJSFunction i (\x -> cb $ _ptr x) [MadeCallback i]
+  wrt env i elt
+  return i
+
+_'makeObject :: IORef MockBrowserInternal -> IO Int
+_'makeObject env = do
+  i <- incr env
+  let elt = MockJSObject i empty []
+  wrt env i elt
+  return i
+
+
+_'nodeRemoveChild :: IORef MockBrowserInternal -> Int -> Int -> IO ()
+_'nodeRemoveChild env parent kid = do
+  _parent                            <- look env parent
+  _kid                               <- look env kid
+  (newKids, newLogParent, newLogKid) <- _nodeRemoveChild _parent _kid
+  wrt env parent $ _withNewLog (_withNewKids _parent newKids) newLogParent
+  wrt env kid $ _withNewLog _kid newLogKid
+
+_'eventTargetRemoveEventListener
+  :: IORef MockBrowserInternal -> Int -> String -> Int -> IO ()
+_'eventTargetRemoveEventListener env elt evt fn = do
+  _elt                            <- look env elt
+  _fn                             <- look env fn
+  (newAttrs, newLogElt, newLogFn) <- _eventTargetRemoveEventListener _elt
+                                                                     evt
+                                                                     _fn
+  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLogElt
+  wrt env fn $ _withNewLog _fn newLogFn
+
+_'elementSetAttribute
+  :: IORef MockBrowserInternal -> Int -> String -> String -> IO ()
+_'elementSetAttribute env elt nm attr = do
+  _elt               <- look env elt
+  (newAttrs, newLog) <- _elementSetAttribute _elt nm attr
+  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLog
+
+_castable
+  :: (MockJSVal -> IO v) -> IORef MockBrowserInternal -> Int -> IO (Maybe v)
+_castable cst env elt = do
+  _elt <- look env elt
+  v    <- cst _elt
+  pure $ Just v
+
+_assertByteString :: MockJSVal -> IO ByteString
+_assertByteString (MockJSByteString _ v _) = pure v
+_assertByteString _                        = error "Not a ByteString"
+
+_'castToByteString = _castable _assertByteString
+
+_assertBool :: MockJSVal -> IO Bool
+_assertBool (MockJSBool _ v _) = pure v
+_assertBool _                  = error "Not a bool"
+
+_'castToBool = _castable _assertBool
+
+_assertDouble :: MockJSVal -> IO Double
+_assertDouble (MockJSDouble _ v _) = pure v
+_assertDouble _                    = error "Not a double"
+
+_'castToDouble = _castable _assertDouble
+
+_assertInt :: MockJSVal -> IO Int
+_assertInt (MockJSInt _ v _) = pure v
+_assertInt _                 = error "Not an int"
+
+_'castToInt = _castable _assertInt
+
+_assertArray :: MockJSVal -> IO [Int]
+_assertArray (MockJSArray _ v _) = pure v
+_assertArray _                   = error "Not an array"
+
+_'castToArray = _castable _assertArray
+
+_assertString :: MockJSVal -> IO String
+_assertString (MockJSString _ v _) = pure v
+_assertString _                    = error "Not an array"
+
+_'castToString = _castable _assertString
+
+_assertObject :: MockJSVal -> IO (HashMap String Int)
+_assertObject (MockJSObject _ v _) = pure v
+_assertObject _                    = error "Not an array"
+
+_'castToObject = _castable _assertObject
+
+
+_'defaultRequestInit = RequestInit { _ri_method      = Nothing
+                                   , _ri_headers     = Nothing
+                                   , _ri_body        = Nothing
+                                   , _ri_mode        = Nothing
+                                   , _ri_credentials = Nothing
+                                   , _ri_cache       = Nothing
+                                   , _ri_redirect    = Nothing
+                                   , _ri_referrer    = Nothing
+                                   , _ri_integrity   = Nothing
+                                   }
+
+makeMockBrowserWithContext :: IORef MockBrowserInternal -> IO (Browserful Int)
+makeMockBrowserWithContext r = return Browserful
+  { castToArray            = _'castToArray r
+  , castToBool             = _'castToBool r
+  , castToByteString       = _'castToByteString r
+  , castToDouble           = _'castToDouble r
+  , castToInt              = _'castToInt r
+  , castToString           = _'castToString r
+  , consoleLog             = _'consoleLog r
+  , defaultRequestInit     = _'defaultRequestInit
+  , documentCreateElement  = _'documentCreateElement r
+  , documentCreateTextNode = _'documentCreateTextNode r
+  , documentBody           = _'documentBody r
+  , documentGetElementById = _'documentGetElementById r
+  , documentHead           = _'documentHead r
+  , fetch                  = _'fetch r
+  , _freeCallback          = _'_freeCallback r
+  , getPropertyAsOpaque    = _'getPropertyAsOpaque r
+  , jsValFromArray         = _'jsValFromArray r
+  , jsValFromBool          = _'jsValFromBool r
+  , jsValFromByteString    = _'jsValFromByteString r
+  , jsValFromDouble        = _'jsValFromDouble r
+  , jsValFromInt           = _'jsValFromInt r
+  , jsValFromString        = _'jsValFromString r
+  , invokeOn0              = _'invokeOn0 r
+  , makeObject             = _'makeObject r
+  , setValue               = _'setValue r
+  , invokeOn1              = _'invokeOn1 r
+  , invokeOn2              = _'invokeOn2 r
+  , _makeHaskellCallback   = _'_makeHaskellCallback r
+  , mathRandom             = _'mathRandom r
+  }
+
+defaultInternalBrowser :: IO (IORef MockBrowserInternal)
+defaultInternalBrowser = do
+  let body = MockJSElement 0
+                           "body"
+                           (MockAttributes empty empty)
+                           []
+                           [CreatedElement 0]
+  newIORef MockBrowserInternal { unBrowser = singleton 0 body, unCtr = 1 }
+
+makeMockBrowser :: IO (Browserful Int)
+makeMockBrowser = do
+  rf <- defaultInternalBrowser
+  makeMockBrowserWithContext rf

@@ -1,140 +1,303 @@-module Web.Framework.Plzwrk.Util-  ( (<.>)-  , wStyle-  , wStyle'-  , wStyles-  , wStyles'-  , wClass-  , wClass'-  , wClasses-  , wClasses'-  , wOnClick-  , wOnClick'-  , wId-  , wId'-  , wOnInput-  , wOnInput'-  , wAttr-  , wAttr'-  , wAttrs-  , wAttrs'-  , eventTargetValue-  , eventPreventDefault-  , eventTargetBlur-  )-where--import           Control.Monad-import           Data.HashMap.Strict           as HM-import           Data.Set                      as S-import           Web.Framework.Plzwrk.Base      ( dats-                                                , dats'-                                                , Attributes(..)-                                                )-import           Web.Framework.Plzwrk.Browserful--merge :: Attributes s opq -> Attributes s opq -> Attributes s opq-merge a b = MkAttributes { _style    = HM.union (_style a) (_style b)-                         , _class    = S.union (_class a) (_class b)-                         , _simple   = HM.union (_simple a) (_simple b)-                         , _handlers = HM.union (_handlers a) (_handlers b)-                         }---- |Merges two 'Attributes'-(<.>)-  :: (s -> Attributes s opq)-  -> (s -> Attributes s opq)-  -> (s -> Attributes s opq)-a <.> b = (\s -> merge (a s) (b s))---- |Constrcts a stateful 'Attributes' applicative functor from a single style.-wStyle :: String -> String -> (s -> Attributes s opq)-wStyle k v = (\s -> dats' { _style = HM.singleton k v })---- |Constrcts an 'Attributes' from a single style.-wStyle' :: String -> String -> Attributes s opq-wStyle' k v = dats' { _style = HM.singleton k v }---- |Constrcts a stateful 'Attributes' applicative functor from a list of styles.-wStyles :: [(String, String)] -> (s -> Attributes s opq)-wStyles kvs = (\s -> dats' { _style = HM.fromList kvs })---- |Constrcts an 'Attributes' from a list of styles.-wStyles' :: [(String, String)] -> Attributes s opq-wStyles' kvs = dats' { _style = HM.fromList kvs }---- |Constrcts a stateful 'Attributes' applicative functor from a single class.-wClass :: String -> (s -> Attributes s opq)-wClass k = (\s -> dats' { _class = S.singleton k })---- |Constrcts an 'Attributes' from a single class.-wClass' :: String -> Attributes s opq-wClass' k = dats' { _class = S.singleton k }---- |Constrcts a stateful 'Attributes' applicative functor from a list of clases.-wClasses :: [String] -> (s -> Attributes s opq)-wClasses ks = (\s -> dats' { _class = S.fromList ks })---- |Constrcts an 'Attributes' from a list of classes.-wClasses' :: [String] -> Attributes s opq-wClasses' ks = dats' { _class = S.fromList ks }---- |Constrcts a stateful 'Attributes' applicative functor with a given id.-wId :: String -> (s -> Attributes s opq)-wId v = (\s -> dats' { _simple = HM.singleton "id" v })---- |Constrcts an 'Attributes' with a given id.-wId' :: String -> Attributes s opq-wId' v = dats' { _simple = HM.singleton "id" v }---- |Constrcts a stateful 'Attributes' applicative functor from an @onClick@ callback.-wOnClick :: (opq -> s -> IO s) -> (s -> Attributes s opq)-wOnClick v = (\s -> dats' { _handlers = HM.singleton "click" v })---- |Constrcts an 'Attributes' from an @onClick@ callback.-wOnClick' :: (opq -> s -> IO s) -> Attributes s opq-wOnClick' v = dats' { _handlers = HM.singleton "click" v }---- |Constrcts a stateful 'Attributes' applicative functor from an @onInput@ callback.-wOnInput :: (opq -> s -> IO s) -> (s -> Attributes s opq)-wOnInput v = (\s -> dats' { _handlers = HM.singleton "input" v })---- |Constrcts an 'Attributes' from an @onInput@ callback.-wOnInput' :: (opq -> s -> IO s) -> Attributes s opq-wOnInput' v = dats' { _handlers = HM.singleton "input" v }---- |Constrcts a stateful 'Attributes' applicative functor from a single attribute.-wAttr :: String -> String -> (s -> Attributes s opq)-wAttr k v = (\s -> dats' { _simple = HM.singleton k v })---- |Constrcts an 'Attributes' from a single attribute.-wAttr' :: String -> String -> Attributes s opq-wAttr' k v = dats' { _simple = HM.singleton k v }---- |Constrcts a stateful 'Attributes' applicative functor from a list of attributes.-wAttrs :: [(String, String)] -> (s -> Attributes s opq)-wAttrs kvs = (\s -> dats' { _simple = HM.fromList kvs })---- |Constrcts an 'Attributes' from a list of attributes.-wAttrs' :: [(String, String)] -> Attributes s opq-wAttrs' kvs = dats' { _simple = HM.fromList kvs }------------------------------------ events---- |From an event, gets the target's value.-eventTargetValue :: Browserful jsval -> jsval -> IO (Maybe String)-eventTargetValue browser e = do-  opq <- (getPropertyAsOpaque browser) e "target"-  maybe (pure Nothing) (\y -> (getPropertyAsString browser) y "value") opq---- |From an event, takes the target and blurs it.-eventTargetBlur :: Browserful jsval -> jsval -> IO ()-eventTargetBlur browser e = do-  opq <- (getPropertyAsOpaque browser) e "target"-  maybe (pure ()) (\y -> void $ (invokeOn0 browser) y "blur") opq---- |Take an event and prevent the default.-eventPreventDefault :: Browserful jsval -> jsval -> IO ()-eventPreventDefault browser e = do-  void $ (invokeOn0 browser) e "preventDefault"+module Web.Framework.Plzwrk.Util
+  ( (<.>)
+  , wStyle
+  , wStyle'
+  , wStyles
+  , wStyles'
+  , wClass
+  , wClass'
+  , wClasses
+  , wClasses'
+  , wOnClick
+  , wOnClick'
+  , wId
+  , wId'
+  , wOnInput
+  , wOnInput'
+  , wAttr
+  , wAttr'
+  , wAttrs
+  , wAttrs'
+  , eventTargetValue
+  , eventPreventDefault
+  , eventTargetBlur
+  , elementSetAttribute
+  , elementTagName
+  , eventTargetAddEventListener
+  , eventTargetRemoveEventListener
+  , getPropertyAsBool
+  , getPropertyAsDouble
+  , getPropertyAsInt
+  , getPropertyAsString
+  , htmlElemenetClick
+  , consoleLogS
+  , nodeAppendChild
+  , nodeChildNodes
+  , nodeInsertBefore
+  , nodeRemoveChild
+  , nodeTextContent
+  )
+where
+
+import           Control.Monad
+import           Data.HashMap.Strict           as HM
+import           Data.Set                      as S
+import           Web.Framework.Plzwrk.Base      ( dats
+                                                , dats'
+                                                , Attributes(..)
+                                                )
+import           Web.Framework.Plzwrk.Browserful
+
+merge :: Attributes s opq -> Attributes s opq -> Attributes s opq
+merge a b = MkAttributes { _style    = HM.union (_style a) (_style b)
+                         , _class    = S.union (_class a) (_class b)
+                         , _simple   = HM.union (_simple a) (_simple b)
+                         , _handlers = HM.union (_handlers a) (_handlers b)
+                         }
+
+-- |Merges two 'Attributes'
+(<.>)
+  :: (s -> Attributes s opq)
+  -> (s -> Attributes s opq)
+  -> (s -> Attributes s opq)
+a <.> b = (\s -> merge (a s) (b s))
+
+-- |Constrcts a stateful 'Attributes' applicative functor from a single style.
+wStyle :: String -> String -> (s -> Attributes s opq)
+wStyle k v = (\s -> dats' { _style = HM.singleton k v })
+
+-- |Constrcts an 'Attributes' from a single style.
+wStyle' :: String -> String -> Attributes s opq
+wStyle' k v = dats' { _style = HM.singleton k v }
+
+-- |Constrcts a stateful 'Attributes' applicative functor from a list of styles.
+wStyles :: [(String, String)] -> (s -> Attributes s opq)
+wStyles kvs = (\s -> dats' { _style = HM.fromList kvs })
+
+-- |Constrcts an 'Attributes' from a list of styles.
+wStyles' :: [(String, String)] -> Attributes s opq
+wStyles' kvs = dats' { _style = HM.fromList kvs }
+
+-- |Constrcts a stateful 'Attributes' applicative functor from a single class.
+wClass :: String -> (s -> Attributes s opq)
+wClass k = (\s -> dats' { _class = S.singleton k })
+
+-- |Constrcts an 'Attributes' from a single class.
+wClass' :: String -> Attributes s opq
+wClass' k = dats' { _class = S.singleton k }
+
+-- |Constrcts a stateful 'Attributes' applicative functor from a list of clases.
+wClasses :: [String] -> (s -> Attributes s opq)
+wClasses ks = (\s -> dats' { _class = S.fromList ks })
+
+-- |Constrcts an 'Attributes' from a list of classes.
+wClasses' :: [String] -> Attributes s opq
+wClasses' ks = dats' { _class = S.fromList ks }
+
+-- |Constrcts a stateful 'Attributes' applicative functor with a given id.
+wId :: String -> (s -> Attributes s opq)
+wId v = (\s -> dats' { _simple = HM.singleton "id" v })
+
+-- |Constrcts an 'Attributes' with a given id.
+wId' :: String -> Attributes s opq
+wId' v = dats' { _simple = HM.singleton "id" v }
+
+-- |Constrcts a stateful 'Attributes' applicative functor from an @onClick@ callback.
+wOnClick :: (opq -> s -> IO s) -> (s -> Attributes s opq)
+wOnClick v = (\s -> dats' { _handlers = HM.singleton "click" v })
+
+-- |Constrcts an 'Attributes' from an @onClick@ callback.
+wOnClick' :: (opq -> s -> IO s) -> Attributes s opq
+wOnClick' v = dats' { _handlers = HM.singleton "click" v }
+
+-- |Constrcts a stateful 'Attributes' applicative functor from an @onInput@ callback.
+wOnInput :: (opq -> s -> IO s) -> (s -> Attributes s opq)
+wOnInput v = (\s -> dats' { _handlers = HM.singleton "input" v })
+
+-- |Constrcts an 'Attributes' from an @onInput@ callback.
+wOnInput' :: (opq -> s -> IO s) -> Attributes s opq
+wOnInput' v = dats' { _handlers = HM.singleton "input" v }
+
+-- |Constrcts a stateful 'Attributes' applicative functor from a single attribute.
+wAttr :: String -> String -> (s -> Attributes s opq)
+wAttr k v = (\s -> dats' { _simple = HM.singleton k v })
+
+-- |Constrcts an 'Attributes' from a single attribute.
+wAttr' :: String -> String -> Attributes s opq
+wAttr' k v = dats' { _simple = HM.singleton k v }
+
+-- |Constrcts a stateful 'Attributes' applicative functor from a list of attributes.
+wAttrs :: [(String, String)] -> (s -> Attributes s opq)
+wAttrs kvs = (\s -> dats' { _simple = HM.fromList kvs })
+
+-- |Constrcts an 'Attributes' from a list of attributes.
+wAttrs' :: [(String, String)] -> Attributes s opq
+wAttrs' kvs = dats' { _simple = HM.fromList kvs }
+
+-----------------------------
+---- events
+
+-- |From an event, gets the target's value.
+eventTargetValue
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the event
+  -> IO (Maybe String) -- ^ the target value, or nothing if it doesn't exist
+eventTargetValue browser e = do
+  opq <- (getPropertyAsOpaque browser) e "target"
+  maybe (pure Nothing) (\y -> (getPropertyAsString browser) y "value") opq
+
+-- |From an event, takes the target and blurs it.
+eventTargetBlur
+  :: Browserful jsval -- ^ the browser
+  -> jsval  -- ^ the event
+  -> IO () -- ^ returns nothing
+eventTargetBlur browser e = do
+  opq <- (getPropertyAsOpaque browser) e "target"
+  maybe (pure ()) (\y -> void $ (invokeOn0 browser) y "blur") opq
+
+-- |Take an event and prevent the default.
+eventPreventDefault
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the event
+  -> IO () -- ^ returns nothing
+eventPreventDefault browser e = do
+  void $ (invokeOn0 browser) e "preventDefault"
+
+-----------
+
+-- | Sets on an element an attribute. See [Element.setAttribute](https://developer.mozilla.org/en-US/docs/Web/API/Element/setAttribute)
+elementSetAttribute
+  :: Browserful jsval -- ^ The browser
+  -> jsval -- ^ the node
+  -> String -- ^ the attribute name
+  -> String -- ^ the attribute
+  -> IO () -- ^ returns nothing
+elementSetAttribute b e k v = do
+  _k <- (jsValFromString b) k
+  _v <- (jsValFromString b) v
+  void $ (invokeOn2 b) e "setAttribute" _k _v
+
+-- | Gets the tag name of an element.  See [Element.tagName](https://developer.mozilla.org/en-US/docs/Web/API/Element/tagName)
+elementTagName
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the element
+  -> IO (Maybe String) -- ^ Returns the tag name
+elementTagName b v = do
+  _o <- (getPropertyAsOpaque b) v "tagName"
+  maybe (pure Nothing) (\x -> (castToString b) x) _o
+
+-- | Takes a target and an event name and adds a listener. See [EventTarget.addEventListener](https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/addEventListener)
+eventTargetAddEventListener
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the element
+  -> String -- ^ the listener name. note that this should be "click" or "input", not "onclick" nor "oninput"
+  -> jsval -- ^ the listener
+  -> IO () -- ^ returns nothing
+eventTargetAddEventListener b e k v = do
+  _k <- (jsValFromString b) k
+  void $ (invokeOn2 b) e "addEventListener" _k v
+
+-- | Takes a target and an event name and removes a listener. See [EventTarget.removeEventListener](https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/removeEventListener)
+eventTargetRemoveEventListener
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the element
+  -> String -- ^ the listener name. note that this should be "click" or "input", not "onclick" nor "oninput"
+  -> jsval -- ^ the listener
+  -> IO () -- ^ returns nothing
+eventTargetRemoveEventListener b e k v = do
+  _k <- (jsValFromString b) k
+  void $ (invokeOn2 b) e "removeEventListener" _k v
+
+-- | Gets a JavaScript property as a bool, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to a bool.
+getPropertyAsBool
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the object containing the property
+  -> String -- ^ the property name
+  -> IO (Maybe Bool) -- ^ the response if the property is a bool, else Nothing
+getPropertyAsBool b o k = do
+  _v <- (getPropertyAsOpaque b) o k
+  maybe (pure Nothing) (\x -> (castToBool b) x) _v
+
+-- | Gets a JavaScript property as a double, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to a double.
+getPropertyAsDouble
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the object containing the property
+  -> String -- ^ the property name
+  -> IO (Maybe Double) -- ^ the response if the property is a double, else Nothing
+getPropertyAsDouble b o k = do
+  _v <- (getPropertyAsOpaque b) o k
+  maybe (pure Nothing) (\x -> (castToDouble b) x) _v
+
+-- | Gets a JavaScript property as an int, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to an int.
+getPropertyAsInt
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the object containing the property
+  -> String -- ^ the property name
+  -> IO (Maybe Int) -- ^ the response if the property is an int, else Nothing
+getPropertyAsInt b o k = do
+  _v <- (getPropertyAsOpaque b) o k
+  maybe (pure Nothing) (\x -> (castToInt b) x) _v
+
+-- | Gets a JavaScript property as an string, returning @Nothing@ if the object being called is null or undefined.
+getPropertyAsString
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the object containing the property
+  -> String -- ^ the property name
+  -> IO (Maybe String) -- ^ the response
+getPropertyAsString b o k = do
+  _v <- (getPropertyAsOpaque b) o k
+  maybe (pure Nothing) (\x -> (castToString b) x) _v
+
+-- | Takes an element and clicks it. Useful for testing. See [HTMLElement.click](https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/click)
+htmlElemenetClick :: Browserful jsval -> jsval -> IO ()
+htmlElemenetClick b e = void $ (invokeOn0 b) e "click"
+
+-- | Logs a string. See [Console.log](https://developer.mozilla.org/en-US/docs/Web/API/Console/log)
+consoleLogS :: Browserful jsval -> String -> IO ()
+consoleLogS b s = do
+  _s <- (jsValFromString b) s
+  (consoleLog b) _s
+
+-- | Takes a node and appends a child. See [Node.appendChild](https://developer.mozilla.org/en-US/docs/Web/API/Node/appendChild)
+nodeAppendChild
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the node
+  -> jsval -- ^ the child to append
+  -> IO () -- ^ returns nothing
+nodeAppendChild b e v = void $ (invokeOn1 b) e "appendChild" v
+
+-- | Get the children of a node. See [Node.childNodes](https://developer.mozilla.org/en-US/docs/Web/API/Node/childNodes)
+nodeChildNodes
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the node
+  -> IO (Maybe [jsval])
+nodeChildNodes b v = do
+  _cn <- (getPropertyAsOpaque b) v "childNodes"
+  maybe (pure Nothing) (\x -> (castToArray b) x) _cn
+
+-- | Inserts a node into an element before another node.  See [Node.insertBefore](https://developer.mozilla.org/en-US/docs/Web/API/Node/insertBefore)
+nodeInsertBefore
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the parent element
+  -> jsval -- ^ the new node
+  -> jsval -- ^ the pre-existing node
+  -> IO () -- ^ returns nothing
+nodeInsertBefore b e k v = void $ (invokeOn2 b) e "insertBefore" k v
+
+-- | Removes a child from a parent node.  See [Node.removeChild](https://developer.mozilla.org/en-US/docs/Web/API/Node/removeChild)
+nodeRemoveChild
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the parent element
+  -> jsval -- ^ the child to remove
+  -> IO () -- ^ returns nothing
+nodeRemoveChild b e v = void $ (invokeOn1 b) e "removeChild" v
+
+-- | Gets the text content of a node. See [Node.textContent](https://developer.mozilla.org/en-US/docs/Web/API/Node/textContent)
+nodeTextContent
+  :: Browserful jsval -- ^ the browser
+  -> jsval -- ^ the node
+  -> IO (Maybe String) -- ^ the text content as a string
+nodeTextContent b e = do
+  _tc <- (getPropertyAsOpaque b) e "textContent"
+  maybe (pure Nothing) (\x -> (castToString b) x) _tc
+

@@ -1,97 +1,112 @@-import           Control.Monad-import           Control.Monad.Reader-import           Data.IORef-import           Prelude                 hiding ( div )-import           Test.Hspec-import           Web.Framework.Plzwrk-import           Web.Framework.Plzwrk.MockJSVal-import           Data.HashMap.Strict-import           Web.Framework.Plzwrk.Tag       ( p-                                                , br-                                                , txt-                                                , button-                                                , div'_-                                                )--data MyState = MyState-  { _name :: String-  , _ctr  :: Int-  }--main :: IO ()-main = hspec $ do-  describe "Element with basic state" $ do-    let domF =-          (\x y -> div'_-              [ p (wStyle "position" "absolute")-                  (take y $ repeat (txt (concat [x, show y])))-              , button-                (wId "incr" <.> wClasses ["a b ccc"] <.> wOnClick-                  (\_ s -> pure $ s { _ctr = y + 1 })-                )-                [txt "Increase counter"]-              , br-              ,button-                (   wId "decr"-                <.> wStyles [("position", "absolute"), ("margin", "10px")]-                <.> wOnClick (\_ s -> pure $ s { _ctr = y - 1 })-                )-                [txt "Decrease counter"]-              ]-            )-            <$> _name-            <*> _ctr-    let state = MyState "Mike" 1-    it "Creates the correct DOM from the state" $ do-      rf   <- defaultInternalBrowser-      mock <- makeMockBrowserWithContext rf-      plzwrk' domF state mock-      parentNode     <- documentBody mock-      childrenLevel0 <- (nodeChildNodes mock) parentNode-      length childrenLevel0 `shouldBe` 1-      divtag <- (elementTagName mock) (head childrenLevel0)-      divtag `shouldBe` "div"-      childrenLevel1 <- (nodeChildNodes mock) (head childrenLevel0)-      length childrenLevel1 `shouldBe` 4-      ptag <- (elementTagName mock) (head childrenLevel1)-      ptag `shouldBe` "p"-      childrenLevel2 <- (nodeChildNodes mock) (head childrenLevel1)-      length childrenLevel2 `shouldBe` 1--      -- increment 4 times--      (documentGetElementById mock) "incr"-        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)-      (documentGetElementById mock) "incr"-        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)-      (documentGetElementById mock) "incr"-        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)-      (documentGetElementById mock) "incr"-        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)-      parentNode'     <- documentBody mock-      childrenLevel0' <- (nodeChildNodes mock) parentNode'-      length childrenLevel0' `shouldBe` 1-      divtag' <- (elementTagName mock) (head childrenLevel0')-      divtag' `shouldBe` "div"-      childrenLevel1' <- (nodeChildNodes mock) (head childrenLevel0')-      length childrenLevel1' `shouldBe` 4-      childrenLevel2' <- (nodeChildNodes mock) (head childrenLevel1')-      length childrenLevel2' `shouldBe` 5-      content' <- mapM (nodeTextContent mock) childrenLevel2'-      content' `shouldBe` (take 5 $ repeat "Mike5")-      (documentGetElementById mock) "decr"-        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)-      (documentGetElementById mock) "decr"-        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)-      parentNode''     <- documentBody mock-      childrenLevel0'' <- (nodeChildNodes mock) parentNode''-      length childrenLevel0'' `shouldBe` 1-      divtag'' <- (elementTagName mock) (head childrenLevel0'')-      divtag'' `shouldBe` "div"-      childrenLevel1'' <- (nodeChildNodes mock) (head childrenLevel0'')-      length childrenLevel1'' `shouldBe` 4-      childrenLevel2'' <- (nodeChildNodes mock) (head childrenLevel1'')-      length childrenLevel2'' `shouldBe` 3-      content'' <- mapM (nodeTextContent mock) childrenLevel2''-      content'' `shouldBe` (take 3 $ repeat "Mike3")-      toHTML domF state `shouldBe` "<div><p style=\"position:absolute\">Mike1</p><button class=\"a b ccc\" id=\"incr\">Increase counter</button><br/><button style=\"margin:10px;position:absolute\" id=\"decr\">Decrease counter</button></div>"+import           Control.Monad
+import           Control.Monad.Reader
+import           Data.IORef
+import           Prelude                 hiding ( div )
+import           Test.Hspec
+import           Web.Framework.Plzwrk
+import           Web.Framework.Plzwrk.MockJSVal
+import           Data.HashMap.Strict
+import           Web.Framework.Plzwrk.Tag       ( p
+                                                , br
+                                                , txt
+                                                , button
+                                                , div'_
+                                                )
+
+nodeChildNodesOrThrow :: Browserful jsval -> jsval -> IO [jsval]
+nodeChildNodesOrThrow b v = do
+  _v <- (nodeChildNodes b v)
+  maybe (error "Could not find child nodes") pure _v
+
+nodeTextContentOrThrow :: Browserful jsval -> jsval -> IO String
+nodeTextContentOrThrow b v = do
+  _v <- (nodeTextContent b v)
+  maybe (error "Could not find text content") pure _v
+
+elementTagNameOrThrow :: Browserful jsval -> jsval -> IO String
+elementTagNameOrThrow b v = do
+  _v <- (elementTagName b v)
+  maybe (error "Could not find tag name") pure _v
+
+data MyState = MyState
+  { _name :: String
+  , _ctr  :: Int
+  }
+
+main :: IO ()
+main = hspec $ do
+  describe "Element with basic state" $ do
+    let domF =
+          (\x y -> div'_
+              [ p (wStyle "position" "absolute")
+                  (take y $ repeat (txt (concat [x, show y])))
+              , button
+                (wId "incr" <.> wClasses ["a b ccc"] <.> wOnClick
+                  (\_ s -> pure $ s { _ctr = y + 1 })
+                )
+                [txt "Increase counter"]
+              , br
+              ,button
+                (   wId "decr"
+                <.> wStyles [("position", "absolute"), ("margin", "10px")]
+                <.> wOnClick (\_ s -> pure $ s { _ctr = y - 1 })
+                )
+                [txt "Decrease counter"]
+              ]
+            )
+            <$> _name
+            <*> _ctr
+    let state = MyState "Mike" 1
+    it "Creates the correct DOM from the state" $ do
+      rf   <- defaultInternalBrowser
+      mock <- makeMockBrowserWithContext rf
+      plzwrk' domF state mock
+      parentNode     <- documentBody mock
+      childrenLevel0 <- (nodeChildNodesOrThrow mock) parentNode
+      length childrenLevel0 `shouldBe` 1
+      divtag <- (elementTagNameOrThrow mock) (head childrenLevel0)
+      divtag `shouldBe` "div"
+      childrenLevel1 <- (nodeChildNodesOrThrow mock) (head childrenLevel0)
+      length childrenLevel1 `shouldBe` 4
+      ptag <- (elementTagNameOrThrow mock) (head childrenLevel1)
+      ptag `shouldBe` "p"
+      childrenLevel2 <- (nodeChildNodesOrThrow mock) (head childrenLevel1)
+      length childrenLevel2 `shouldBe` 1
+
+      -- increment 4 times
+
+      (documentGetElementById mock) "incr"
+        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)
+      (documentGetElementById mock) "incr"
+        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)
+      (documentGetElementById mock) "incr"
+        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)
+      (documentGetElementById mock) "incr"
+        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)
+      parentNode'     <- documentBody mock
+      childrenLevel0' <- (nodeChildNodesOrThrow mock) parentNode'
+      length childrenLevel0' `shouldBe` 1
+      divtag' <- (elementTagNameOrThrow mock) (head childrenLevel0')
+      divtag' `shouldBe` "div"
+      childrenLevel1' <- (nodeChildNodesOrThrow mock) (head childrenLevel0')
+      length childrenLevel1' `shouldBe` 4
+      childrenLevel2' <- (nodeChildNodesOrThrow mock) (head childrenLevel1')
+      length childrenLevel2' `shouldBe` 5
+      content' <- mapM (nodeTextContentOrThrow mock) childrenLevel2'
+      content' `shouldBe` (take 5 $ repeat "Mike5")
+      (documentGetElementById mock) "decr"
+        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)
+      (documentGetElementById mock) "decr"
+        >>= maybe (error "Incr node does not exist") (htmlElemenetClick mock)
+      parentNode''     <- documentBody mock
+      childrenLevel0'' <- (nodeChildNodesOrThrow mock) parentNode''
+      length childrenLevel0'' `shouldBe` 1
+      divtag'' <- (elementTagNameOrThrow mock) (head childrenLevel0'')
+      divtag'' `shouldBe` "div"
+      childrenLevel1'' <- (nodeChildNodesOrThrow mock) (head childrenLevel0'')
+      length childrenLevel1'' `shouldBe` 4
+      childrenLevel2'' <- (nodeChildNodesOrThrow mock) (head childrenLevel1'')
+      length childrenLevel2'' `shouldBe` 3
+      content'' <- mapM (nodeTextContentOrThrow mock) childrenLevel2''
+      content'' `shouldBe` (take 3 $ repeat "Mike3")
+      toHTML domF state `shouldBe` "<div><p style=\"position:absolute\">Mike1</p><button class=\"a b ccc\" id=\"incr\">Increase counter</button><br/><button style=\"margin:10px;position:absolute\" id=\"decr\">Decrease counter</button></div>"