plzwrk 0.0.0.1 → 0.0.0.2

raw patch · 13 files changed

+1604/−1233 lines, 13 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 +24/−11
• kitchen-sink/Main.hs +80/−78
• plzwrk.cabal +2/−2
• src/Web/Framework/Plzwrk.hs +8/−11
• src/Web/Framework/Plzwrk/Asterius.hs +126/−100
• src/Web/Framework/Plzwrk/Base.hs +127/−68
• src/Web/Framework/Plzwrk/Browserful.hs +89/−26
• src/Web/Framework/Plzwrk/Domify.hs +481/−346
• src/Web/Framework/Plzwrk/MockJSVal.hs +519/−483
• src/Web/Framework/Plzwrk/Tag.hs +1/−1
• src/Web/Framework/Plzwrk/Util.hs +45/−5
• test/Spec.hs +97/−102

@@ -1,5 +1,10 @@ # Changelog for plzwrk +## 0.0.0.2++- Adds server side rendering via `toHTML` and `plzwrkSSR`.+- Adds more documentation.+ ## 0.0.0.1  - Adds util functions for attribute creation like `wClass`, `wId` etc.

@@ -31,13 +31,14 @@ 
 ## Making a webpage
 
-`plzwrk` uses [Asterius](https://github.com/tweag/asterius) as its backend for web development. Compiling an application using `plzwrk` is no different than compiling an application using `ahc-cabal` and `ahc-dist` as described in the [Asterius documentation](https://asterius.netlify.app) with **one caveat**. You **must** use `-f plzwrk-enable-asterius` when running `ahc-cabal`.
+`plzwrk` uses [Asterius](https://github.com/tweag/asterius) as its backend for web development. Compiling an application using `plzwrk` is no different than compiling an application using `ahc-cabal` and `ahc-dist` as described in the [Asterius documentation](https://asterius.netlify.app) with **one caveat**. You **must** use `--constraint "plzwrk +plzwrk-enable-asterius"` when running `ahc-cabal`.
 
-A minimal flow is shown below, mostly copied from the asterius documentation. It assumes that you have a cabal-buildable project in the root directory. Note the use of the `-f plzwrk-enable-asterius` flag in the `ahc-cabal` step.
+A minimal flow is shown below, mostly copied from the asterius documentation. It assumes that you have a cabal-buildable project in the root directory. Note the use of the `--constraint "plzwrk +plzwrk-enable-asterius"` flag in the `ahc-cabal` step.
 
 ```bash
 username@hostname:~/my-dir$ docker run --rm -it -v $(pwd):/project -w /project terrorjack/asterius
-asterius@hostname:/project$ ahc-cabal new-install -f plzwrk-enable-asterius --installdir <inst-dir> <exec-name>
+asterius@hostname:/project$ ahc-cabal update
+asterius@hostname:/project$ ahc-cabal new-install --constraint "plzwrk +plzwrk-enable-asterius" --installdir <inst-dir> <exec-name>
 asterius@hostname:/project$ cd <inst-dir> && ahc-dist --input-exe <exec-name> --browser --bundle
 ```
 
@@ -84,6 +85,16 @@ 
 > 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
+
+Plzwrk supports static site 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.
+
+When compiling using `ahc-cabal`, make sure to use the `plzwrkSSR` family of functions. These functions will look for pre-existing elements in the DOM and attach event listeners to them instead of creating elements from scratch. Additionally, if the static website needs to be initialized with data (ie using the result of an HTTP response made on the server), you'll need to pass these values dynamically to the function that calls `plzwrkSSR`. You can do this using the `foreign export` syntax as described in the [Asterius documentation](https://asterius.netlify.app/jsffi.html#jsffi-static-exports).
+
+When compiling with `cabal`, you'll likely be using it to output an HTML document or build a server that serves your website as `text/html`. Regardless of the approach, you should use `toHTML` to create the part of the initial DOM controlled by plzwrk.  Also, in your HTML, make sure to include a link to the script(s) produced by `ahc-dist` and, if needed, make sure to call your exported functions.
+
 ## Testing your code
 
 Plzwrk comes with a mock browser that can act as a drop-in replacement for your browser. Use this in your tests.
@@ -96,15 +107,17 @@     print "Now I'm using the mock browser."
 ```
 
-## Using
+## When to use
 
-Plzwrk should be considered experimental. It is unfit for production and the syntax will change frequently, often in non-backward-compatible ways. There is a [changelog](ChangeLog.md).
+Plzwrk may be a good fit if you enjoy the benefits of programming in Haskell and would like to create a web app.
 
-## Contributing
+Plzwrk is experimental. It is unfit for production and the syntax will change frequently, often in non-backward-compatible ways. We will try to document all of these changes in the [changelog](ChangeLog.md).
 
-Thanks for your interest in contributing! Here is a small list  of things I'd really appreciate help with:
+Some alternatives to `plzwrk`:
 
-- Static site rendering
-- Automatic code splitting
-- Hot reloading
-- Documentation+- [Elm](https://elm-lang.org/), a delightful language for reliable web apps.
+- [Purescript react basic](https://github.com/lumihq/purescript-react-basic), an opinionated set of bindings to the React library, optimizing for the most basic use cases.
+
+## Contributing
+
+Thanks for your interest in contributing! If you have a bug or feature request, please file an [issue](https://github.com/meeshkan/plzwrk/issues), or if you'd like to hack at the code base, please propose a [pull request](https://github.com/meeshkan/plzwrk/issues).

@@ -34,87 +34,89 @@   }
   deriving Show
 
+-- here is where we'll show our "surprise" aphorism
+surprise =
+  (\noun -> if (length noun == 0)
+      then div'_ []
+      else p'__ $ concat ["Life is like", indefiniteArticle noun, noun]
+    )
+    <$> _myNoun
+
+-- here is where we will input a noun for our "surprise" aphorosim
+writeSomethingConcrete browser = input
+  (wAttr "type" "text" <.> wStyle "box-sizing" "content-box" <.> wOnInput
+    (\e s -> do
+      v <- (eventTargetValue browser) e
+      return $ maybe s (\q -> s { _myNoun = q }) v
+    )
+  )
+  []
+
+aphorismList =
+  (\a2c -> ul'
+      (wClass "res")
+      (fmap (\(a, c) -> (li__ (concat [a, " is like", indefiniteArticle c, c])))
+            a2c
+      )
+    )
+    <$> _abstractToConcrete
+
+addAphorismButton browser =
+  (\a2c -> button'
+      (wId "incr" <.> wClass "dim" <.> wOnClick
+        (\e s -> do
+          (eventTargetBlur browser) e
+          (consoleLog 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
+          return $ newS
+        )
+      )
+      [txt "More aphorisms"]
+    )
+    <$> _abstractToConcrete
+
+removeAphorismButton browser =
+  (\a2c -> button'
+      (wId "decr" <.> wClass "dim" <.> wOnClick
+        (\e s -> do
+          (eventTargetBlur browser) e
+          pure $ s { _abstractToConcrete = if null a2c then [] else tail a2c }
+        )
+      )
+      [txt "Less aphorisms"]
+    )
+    <$> _abstractToConcrete
+
+loginText =
+  (\name -> p'_ [txt "Logged in as: ", span (wClass "username") [txt name]])
+    <$> _name
+
 main :: IO ()
 main = do
   browser <- asteriusBrowser
   -- add some css!
-  _head   <- (getHead browser)
-  _style  <- (createElement browser) "style"
-  _css    <- (createTextNode browser) (DT.unpack myCss)
-  (appendChild browser) _style _css
-  (appendChild browser) _head _style
-  -- here is our "surprise" aphorism
-  let surpriseF =
-        (\noun -> if (length noun == 0)
-            then div'_ []
-            else p'__ $ concat ["Life is like", a_n noun, noun]
-          )
-          <$> _myNoun
-  -- here is our input
-  let inputF = input
-        (wAttr "type" "text" <.> wStyle "box-sizing" "content-box" <.> wOnInput
-          (\e s -> do
-            opq <- (getOpaque browser) e "target"
-            v <- maybe (pure Nothing) (\y -> (getString browser) y "value") opq
-            return $ maybe s (\q -> s { _myNoun = q }) v
-          )
-        )
-        []
+  _head   <- (documentHead browser)
+  _style  <- (documentCreateElement browser) "style"
+  _css    <- (documentCreateTextNode browser) (DT.unpack myCss)
+  (nodeAppendChild browser) _style _css
+  (nodeAppendChild browser) _head _style
   -- and here is our main div
-  let
-    mainDivF =
-      (\abstractToConcrete name -> T.main'_
-          [ section
-              (wClass "content")
-              [ h1__ "Aphorism Machine"
-              , ul
-                (wClass "res")
-                (fmap
-                  (\(abs, conc) ->
-                    (li__ (concat [abs, " is like", a_n conc, conc]))
-                  )
-                  abstractToConcrete
-                )
-              , br
-              , surpriseF
-              , div
-                (wStyles [("width", "100%"), ("display", "inline-block")])
-                [ button
-                  (wId "incr" <.> wClass "dim" <.> wOnClick
-                    (\_ s -> do
-                      (consoleLog browser)
-                        $  "Here is the current state "
-                        <> show s
-                      concept    <- randAbstract (random01 browser)
-                      comparedTo <- randConcrete (random01 browser)
-                      let
-                        newS = s
-                          { _abstractToConcrete = (concept, comparedTo)
-                                                    : abstractToConcrete
-                          }
-                      (consoleLog browser) $ "Here is the new state " <> show newS
-                      return $ newS
-                    )
-                  )
-                  [txt "More aphorisms"]
-                , button
-                  (wId "decr" <.> wClass "dim" <.> wOnClick
-                    (\_ s -> pure $ s
-                      { _abstractToConcrete = if (null abstractToConcrete)
-                                                then []
-                                                else tail abstractToConcrete
-                      }
-                    )
-                  )
-                  [txt "Less aphorisms"]
-                ]
-              , inputF
-              , p_ [txt "Logged in as: ", span (wClass "username") [txt name]]
-              ]
-          ]
-        )
-        <$> _abstractToConcrete
-        <*> _name
+  let mainDivF = T.main_
+        [ section
+            (wClass "content")
+            [ h1__ "Aphorism Machine"
+            , aphorismList
+            , br
+            , surprise
+            , div (wStyles [("width", "100%"), ("display", "inline-block")])
+                  [addAphorismButton browser, removeAphorismButton browser]
+            , writeSomethingConcrete browser
+            , loginText
+            ]
+        ]
   let state = MyState "Bob" [] ""
   plzwrk' mainDivF state browser
 
@@ -126,8 +128,8 @@   return $ l !! i
 
 
-a_n :: String -> String
-a_n x =
+indefiniteArticle :: String -> String
+indefiniteArticle x =
   let hd = take 1 x
   in  if (hd == "a" || hd == "e" || hd == "i" || hd == "o" || hd == "u")
         then " an "

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

@@ -14,21 +14,15 @@ -}
 
 module Web.Framework.Plzwrk
-  ( hydrate
-  , dats
-  , dats'
+  ( plzwrk
+  , plzwrk'
+  , plzwrk'_
+  , plzwrkSSR
+  , toHTML
   , Node(..)
-  , HydratedNode(..)
   , Attributes(..)
-  , cssToStyle
   , Browserful(..)
-  , reconcile
-  , plzwrk
-  , plzwrk'
-  , plzwrk'_
-  , OldStuff(..)
   -- util
-  , (@=)
   , (<.>)
   , wStyle
   , wStyle'
@@ -48,6 +42,9 @@   , wAttr'
   , wAttrs
   , wAttrs'
+  , eventPreventDefault
+  , eventTargetBlur
+  , eventTargetValue
   )
 where
 

@@ -1,12 +1,29 @@+{-|
+Module      : Web.Framework.Plzwrk.Asterius
+Description : Asterius bindings for plzwrk
+Copyright   : (c) Mike Solomon 2020
+License     : GPL-3
+Maintainer  : mike@meeshkan.com
+Stability   : experimental
+Portability : POSIX, Windows
+
+This module exports a single function called @asteriusBrowser@
+that you can use to build your DOM with asterius (see the
+examples in the README.md). Unfortunately, due to the way
+cabal compiles this documentation, it does not appear on
+this page. Instead, a dummy function called @ignoreMe@ appears.
+This is because @asteriusBrowser@ can only be created by using
+`ahc-cabal`, and haddock uses `cabal` as a default.
+-}
 {-# LANGUAGE CPP #-}
 #if defined(PLZWRK_ENABLE_ASTERIUS)
 {-# LANGUAGE InterruptibleFFI  #-}
 module Web.Framework.Plzwrk.Asterius (asteriusBrowser) where
 
-import Asterius.Aeson
+import           Asterius.Aeson
 import           Asterius.ByteString
 import           Asterius.Types
-import qualified Data.ByteString        as BS
+import qualified Data.ByteString               as BS
 import           Data.ByteString.Unsafe
 import           Data.Coerce
 import           Foreign.Ptr
@@ -14,80 +31,91 @@ 
 asteriusBrowser :: IO (Browserful JSVal)
 asteriusBrowser = return Browserful
-  { addEventListener    = _addEventListener
-  , appendChild         = _appendChild
-  , click               = _click
-  , consoleLog          = _consoleLog
-  , consoleLog'         = _consoleLog'
-  , createElement       = _createElement
-  , createTextNode      = _createTextNode
-  , freeCallback        = _freeCallback
-  , getBody             = _getBody
-  , getBool             = _getBool
-  , getDouble           = _getDouble
-  , getChildren         = _getChildren
-  , getElementById      = _getElementById
-  , getHead             = _getHead
-  , getInt              = _getInt
-  , getOpaque           = _getOpaque
-  , getString           = _getString
-  , getTag              = _getTag
-  , insertBefore        = _insertBefore
-  , invokeOn            = _invokeOn
-  , makeHaskellCallback = _makeHaskellCallback
-  , random01            = _random01
-  , removeChild         = _removeChild
-  , removeEventListener = _removeEventListener
-  , setAttribute        = _setAttribute
-  , textContent         = _textContent
+  { eventTargetAddEventListener    = _eventTargetAddEventListener
+  , nodeAppendChild                = _nodeAppendChild
+  , htmlElemenetClick              = _htmlElemenetClick
+  , consoleLog                     = _consoleLog
+  , consoleLog'                    = _consoleLog'
+  , documentCreateElement          = _documentCreateElement
+  , documentCreateTextNode         = _documentCreateTextNode
+  , documentBody                   = _documentBody
+  , documentGetElementById         = _documentGetElementById
+  , documentHead                   = _documentHead
+  , _freeCallback                  = __freeCallback
+  , getPropertyAsBool              = _getPropertyAsBool
+  , getPropertyAsDouble            = _getPropertyAsDouble
+  , getPropertyAsInt               = _getPropertyAsInt
+  , getPropertyAsOpaque            = _getPropertyAsOpaque
+  , getPropertyAsString            = _getString
+  , elementTagName                 = _elementTagName
+  , nodeInsertBefore               = _nodeInsertBefore
+  , invokeOn0                      = _invokeOn0
+  , _makeHaskellCallback           = __makeHaskellCallback
+  , nodeChildNodes                 = _nodeChildNodes
+  , mathRandom                     = _mathRandom
+  , nodeRemoveChild                = _nodeRemoveChild
+  , eventTargetRemoveEventListener = _eventTargetRemoveEventListener
+  , elementSetAttribute            = _elementSetAttribute
+  , nodeTextContent                = _nodeTextContent
   }
 
-_createElement :: String -> IO JSVal
-_createElement = js_createElement . toJSString
+_documentCreateElement :: String -> IO JSVal
+_documentCreateElement = js_documentCreateElement . toJSString
 
-_getTag :: JSVal -> IO String
-_getTag x =  do
-  v <- js_getTag x
+_elementTagName :: JSVal -> IO String
+_elementTagName x = do
+  v <- js_elementTagName x
   return $ fromJSString v
 
-_textContent :: JSVal -> IO String
-_textContent x =  do
-  v <- js_textContent x
+_nodeTextContent :: JSVal -> IO String
+_nodeTextContent x = do
+  v <- js_nodeTextContent x
   return $ fromJSString v
 
-_setAttribute :: JSVal -> String -> String -> IO ()
-_setAttribute e k v = js_setAttribute e (toJSString k) (toJSString v)
+_elementSetAttribute :: JSVal -> String -> String -> IO ()
+_elementSetAttribute e k v =
+  js_elementSetAttribute e (toJSString k) (toJSString v)
 
-_getOpaque :: JSVal -> String -> IO (Maybe JSVal)
-_getOpaque n k = do
+_getPropertyAsOpaque :: JSVal -> String -> IO (Maybe JSVal)
+_getPropertyAsOpaque n k = do
   isUndef <- js_null_or_undef n
-  if isUndef then pure Nothing else (do
-      v <- _js_getOpaque n (toJSString k)
-      isUndef' <- js_null_or_undef v
-      if isUndef' then pure Nothing else pure (Just 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 pure (Just v)
+      )
 
 _getString :: JSVal -> String -> IO (Maybe String)
-_getString n k = _getGeneric (\v -> (jsonFromJSVal v) :: Either String String) n k
+_getString n k =
+  _getGeneric (\v -> (jsonFromJSVal v) :: Either String String) n k
 
-_getBool :: JSVal -> String -> IO (Maybe Bool)
-_getBool n k = _getGeneric (\v -> (jsonFromJSVal v) :: Either String Bool) n k
+_getPropertyAsBool :: JSVal -> String -> IO (Maybe Bool)
+_getPropertyAsBool n k =
+  _getGeneric (\v -> (jsonFromJSVal v) :: Either String Bool) n k
 
-_getInt :: JSVal -> String -> IO (Maybe Int)
-_getInt n k = _getGeneric (\v -> (jsonFromJSVal v) :: Either String Int) n k
+_getPropertyAsInt :: JSVal -> String -> IO (Maybe Int)
+_getPropertyAsInt n k =
+  _getGeneric (\v -> (jsonFromJSVal v) :: Either String Int) n k
 
-_getDouble :: JSVal -> String -> IO (Maybe Double)
-_getDouble n k = _getGeneric (\v -> (jsonFromJSVal v) :: Either String Double) n k
+_getPropertyAsDouble :: JSVal -> String -> IO (Maybe Double)
+_getPropertyAsDouble n k =
+  _getGeneric (\v -> (jsonFromJSVal v) :: Either String Double) n k
 
 _getGeneric :: (JSVal -> Either String a) -> JSVal -> String -> IO (Maybe a)
 _getGeneric f n k = do
   isUndef <- js_null_or_undef n
-  if isUndef then pure Nothing else (do
-    v <- _js_getOpaque 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)
+  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)
       )
 
 _consoleLog :: String -> IO ()
@@ -97,106 +125,104 @@ _consoleLog' v = _js_consoleLog' v
 
 
-_addEventListener :: JSVal -> String -> JSVal -> IO ()
-_addEventListener target event callback =
-  js_addEventListener target (toJSString event) callback
-
-_removeEventListener :: JSVal -> String -> JSVal -> IO ()
-_removeEventListener target event callback =
-  js_removeEventListener target (toJSString event) callback
+_eventTargetAddEventListener :: JSVal -> String -> JSVal -> IO ()
+_eventTargetAddEventListener target event callback =
+  js_eventTargetAddEventListener target (toJSString event) callback
 
-_createTextNode :: String -> IO JSVal
-_createTextNode = js_createTextNode . toJSString
+_eventTargetRemoveEventListener :: JSVal -> String -> JSVal -> IO ()
+_eventTargetRemoveEventListener target event callback =
+  js_eventTargetRemoveEventListener target (toJSString event) callback
 
-_invokeOn :: JSVal -> String -> IO ()
-_invokeOn e s = _js_invokeOn e (toJSString s)
+_documentCreateTextNode :: String -> IO JSVal
+_documentCreateTextNode = js_documentCreateTextNode . toJSString
 
+_invokeOn0 :: JSVal -> String -> IO JSVal
+_invokeOn0 e s = _js_invokeOn0 e (toJSString s)
 
-_getElementById :: String -> IO (Maybe JSVal)
-_getElementById k = do
-  v <- js_getElementById (toJSString k)
+_documentGetElementById :: String -> IO (Maybe JSVal)
+_documentGetElementById k = do
+  v <- js_documentGetElementById (toJSString k)
   u <- js_null_or_undef v
   return $ if u then Nothing else Just v
 
 getJSVal :: JSFunction -> JSVal
 getJSVal (JSFunction x) = x
 
-_makeHaskellCallback :: (JSVal -> IO ()) -> IO JSVal
-_makeHaskellCallback a = do
+__makeHaskellCallback :: (JSVal -> IO ()) -> IO JSVal
+__makeHaskellCallback a = do
   x <- makeHaskellCallback1 a
   return $ getJSVal x
 
-_freeCallback :: JSVal -> IO ()
-_freeCallback v = freeHaskellCallback (JSFunction v)
+__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 "console.log($1)"
   _js_consoleLog :: JSString -> IO ()
 
 foreign import javascript "console.log($1)"
   _js_consoleLog' :: JSVal -> IO ()
 
-
 foreign import javascript "$1[$2]()"
-  _js_invokeOn :: JSVal -> JSString -> IO ()
+  _js_invokeOn0 :: JSVal -> JSString -> IO JSVal
 
 foreign import javascript "$1[$2]"
-  _js_getOpaque :: JSVal -> JSString -> IO JSVal
+  _js_getPropertyAsOpaque :: JSVal -> JSString -> IO JSVal
 
 foreign import javascript "document.createElement($1)"
-  js_createElement :: JSString -> IO JSVal
+  js_documentCreateElement :: JSString -> IO JSVal
 
 foreign import javascript "Math.random()"
-  _random01 :: IO Double
+  _mathRandom :: IO Double
 
 foreign import javascript "document.body"
-  _getBody :: IO JSVal
+  _documentBody :: IO JSVal
 
 foreign import javascript "document.head"
-  _getHead :: IO JSVal
+  _documentHead :: IO JSVal
 
 foreign import javascript "$1.tagName"
-  js_getTag :: JSVal -> IO JSString
+  js_elementTagName :: JSVal -> IO JSString
 
 foreign import javascript "$1.textContent"
-  js_textContent :: JSVal -> IO JSString
+  js_nodeTextContent :: JSVal -> IO JSString
 
 foreign import javascript "$1.setAttribute($2,$3)"
-  js_setAttribute :: JSVal -> JSString -> JSString -> IO ()
+  js_elementSetAttribute :: JSVal -> JSString -> JSString -> IO ()
 
 foreign import javascript "$1.appendChild($2)"
-  _appendChild :: JSVal -> JSVal -> IO ()
+  _nodeAppendChild :: JSVal -> JSVal -> IO ()
 
 foreign import javascript "($1 == null) || ($1 == undefined)"
   js_null_or_undef :: JSVal -> IO Bool
 
 foreign import javascript "$1.childNodes"
-  _js_getChildren :: JSVal -> IO JSArray
-
-_getChildren :: JSVal -> IO [JSVal]
-_getChildren x = do
-  v <- _js_getChildren x
-  return $ fromJSArray v
+  _js_nodeChildNodes :: JSVal -> IO JSArray
 
 foreign import javascript "$1.click()"
-  _click :: JSVal -> IO ()
+  _htmlElemenetClick :: JSVal -> IO ()
 
 foreign import javascript "$1.insertBefore($2,$3)"
-  _insertBefore :: JSVal -> JSVal -> JSVal -> IO ()
+  _nodeInsertBefore :: JSVal -> JSVal -> JSVal -> IO ()
 
 foreign import javascript "$1.removeChild($2)"
-  _removeChild :: JSVal -> JSVal -> IO ()
+  _nodeRemoveChild :: JSVal -> JSVal -> IO ()
 
 foreign import javascript "$1.addEventListener($2,$3)"
-  js_addEventListener :: JSVal -> JSString -> JSVal -> IO ()
+  js_eventTargetAddEventListener :: JSVal -> JSString -> JSVal -> IO ()
 
 foreign import javascript "$1.removeEventListener($2,$3)"
-  js_removeEventListener :: JSVal -> JSString -> JSVal -> IO ()
+  js_eventTargetRemoveEventListener :: JSVal -> JSString -> JSVal -> IO ()
 
 foreign import javascript "document.createTextNode($1)"
-  js_createTextNode :: JSString -> IO JSVal
+  js_documentCreateTextNode :: JSString -> IO JSVal
 
 foreign import javascript "document.getElementById($1)"
-  js_getElementById :: JSString -> IO JSVal
+  js_documentGetElementById :: JSString -> IO JSVal
 
 foreign import javascript "wrapper oneshot"
   makeHaskellCallback1 :: (JSVal -> IO ()) -> IO JSFunction

@@ -1,68 +1,127 @@-module Web.Framework.Plzwrk.Base
-  ( hydrate
-  , dats
-  , dats'
-  , Node(..)
-  , HydratedNode(..)
-  , Attributes(..)
-  , cssToStyle
-  )
-where
-
-import           Data.List
-
-import           Data.HashMap.Strict
-import           Data.Set                hiding ( empty
-                                                , toList
-                                                )
-import qualified Data.Set                      as S
-
-cssToStyle :: (HashMap String String) -> String
-cssToStyle css =
-  (intercalate ";" $ fmap (\(x, y) -> x <> ":" <> y) (toList css))
-
--- data classes
-
-data Attributes s opq = MkAttributes
-  { _style    :: HashMap String String
-  , _class    :: Set String
-  , _simple   :: HashMap String String
-  , _handlers :: HashMap String (opq -> s -> IO s)
-  }
-
-dats = (\_ -> MkAttributes empty S.empty empty empty)
-dats' = MkAttributes empty S.empty empty empty
-
-
-instance Show (Attributes s opq) where
-  show (MkAttributes __style __class __simple _) =
-    "Attributes ("
-      <> show __style
-      <> ", "
-      <> show __class
-      <> ", "
-      <> show __simple
-      <> ")"
-
-data Node s opq = Element String (s -> Attributes s opq) [s -> Node s opq]
-    | TextNode String
-
-instance Show (Node s opq) where
-  show (Element t _ _) = show t
-  show (TextNode t   ) = show t
-
-data HydratedNode s opq = HydratedElement
-    { _hy_tag  :: String
-    , _hy_attr :: (Attributes s opq)
-    , _hy_kids :: [HydratedNode s opq]
-    }
-    | HydratedTextNode String
-    deriving (Show)
-
-_hydrate :: s -> Node s opq -> HydratedNode s opq
-_hydrate s (Element a b c) =
-  HydratedElement a (b s) (fmap (\x -> hydrate s x) c)
-_hydrate s (TextNode t) = HydratedTextNode t
-
-hydrate :: s -> (s -> Node s opq) -> HydratedNode s opq
-hydrate s f = _hydrate s (f s)
+module Web.Framework.Plzwrk.Base+  ( hydrate+  , dats+  , dats'+  , Node(..)+  , HydratedNode(..)+  , Attributes(..)+  , cssToStyle+  , toHTML+  )+where++import           Data.List++import qualified Data.HashMap.Strict           as HM+import qualified Data.Set                      as S++cssToStyle :: (HM.HashMap String String) -> String+cssToStyle css =+  (intercalate ";" $ fmap (\(x, y) -> x <> ":" <> y) (HM.toList css))+++-- |Attributes for a DOM Node.+-- Attributes are parameterized by two types+-- * @s@ - the type of the state+-- * @opq@ - the type of an opaque object in JavaScript+--+-- You will rarely need to instantiate @Attributes@ yourself,+-- as it is easier to work with utility functions like 'wId',+-- 'wStyle' etc that produce Applicative Functors with signature+-- @(s -> Attributes s opq)@. These AFs are used in the 'Node' data.+data Attributes s opq = MkAttributes+  { _style    :: HM.HashMap String String+  , _class    :: S.Set String+  , _simple   :: HM.HashMap String String+  , _handlers :: HM.HashMap String (opq -> s -> IO s)+  }++dats = (\_ -> MkAttributes HM.empty S.empty HM.empty HM.empty)+dats' = MkAttributes HM.empty S.empty HM.empty HM.empty+++instance Show (Attributes s opq) where+  show (MkAttributes __style __class __simple _) =+    "Attributes ("+      <> show __style+      <> ", "+      <> show __class+      <> ", "+      <> show __simple+      <> ")"++-- |A DOM node.+-- The easiest way to create nodes is using tags such as+-- 'Web.Framework.Plzwrk.Util.span' or 'Web.Framework.Plzwrk.br'.+-- Nodes can be created for arbitrary tags using the 'Element'+-- constructor.+--+-- Node is parameterized by two types+-- * @s@ - the type of the state+-- * @opq@ - the type of an opaque object in JavaScript+--+-- Note that nodes, when passed as an arguemnt to 'plzwrk', need+-- to be Applicative Functors in the form @(s -> Node s opq)@.+data Node s opq = Element+    { _elt_tag :: String+    , _elt_attrs :: (s -> Attributes s opq)+    , _elt_children :: [s -> Node s opq]+    } | TextNode { _tn_text :: String }++instance Show (Node s opq) where+  show (Element t _ _) = show t+  show (TextNode t   ) = show t++data HydratedNode s opq = HydratedElement+    { _hy_tag  :: String+    , _hy_attr :: (Attributes s opq)+    , _hy_kids :: [HydratedNode s opq]+    }+    | HydratedTextNode String+    deriving (Show)++_hydrate :: s -> Node s opq -> HydratedNode s opq+_hydrate s (Element a b c) =+  HydratedElement a (b s) (fmap (\x -> hydrate s x) c)+_hydrate s (TextNode t) = HydratedTextNode t++hydrate :: s -> (s -> Node s opq) -> HydratedNode s opq+hydrate s f = _hydrate s (f s)++stringifyAttributes :: Attributes state jsval -> String+stringifyAttributes (MkAttributes __style __class __simple _) =+  intercalate " " $ filter+    (not . null)+    [ (if (HM.null __style)+        then ""+        else "style=\"" ++ cssToStyle __style ++ "\""+      )+    , (if (S.null __class)+        then ""+        else "class=\"" ++ unwords (S.toList __class) ++ "\""+      )+    , (if (HM.null __simple)+        then ""+        else intercalate " "+          $ fmap (\(x, y) -> x ++ "=\"" ++ y ++ "\"") (HM.toList __simple)+      )+    ]++_toHTML :: HydratedNode state jsval -> String+_toHTML (HydratedElement tag attrs ch) =+  "<"+    ++ tag+    ++ (if (null atts) then "" else " " ++ atts)+    ++ (if (null ch)+         then "/>"+         else ">" ++ (concat $ fmap _toHTML ch) ++ "</" ++ tag ++ ">"+       )+  where atts = stringifyAttributes attrs+_toHTML (HydratedTextNode txt) = txt++-- |Converts a Node to HTML.+toHTML+  :: (state -> Node state jsval) -- ^ A function that takes a state and produces a DOM+  -> state -- ^ An initial state+  -> String -- ^ The resulting HTML+toHTML domF state = _toHTML (hydrate state domF)

@@ -3,31 +3,94 @@   )
 where
 
+-- | A data class holding functions that operate on opaque
+-- JavaScript types, parameterized by @jsval@. When possible,
+-- the real names of browser functions like 'addEventListener'
+-- and 'appendChild' are used.
+--
+-- Browserful is currently implemented as data instead of as
+-- a typeclass because it is unclear what type of additional
+-- monadic transformer around IO would be most appropriate to
+-- retain the state of @jsval@ objects, whereas when part of
+-- a dataclass, the state retention is abstracted away.
+
 data Browserful jsval = Browserful
-  { addEventListener    :: jsval -> String -> jsval -> IO ()
-  , appendChild         :: jsval -> jsval -> IO ()
-  , consoleLog          :: String -> IO ()
-  , consoleLog'         :: jsval -> IO ()
-  , click               :: jsval -> IO ()
-  , createElement       :: String -> IO jsval
-  , createTextNode      :: String -> IO jsval
-  , freeCallback        :: jsval -> IO ()
-  , getBody             :: IO jsval
-  , getBool             :: jsval -> String -> IO (Maybe Bool)
-  , getChildren         :: jsval -> IO [jsval]
-  , getDouble           :: jsval -> String -> IO (Maybe Double)
-  , getHead             :: IO jsval
-  , getElementById      :: String -> IO (Maybe jsval)
-  , getInt              :: jsval -> String -> IO (Maybe Int)
-  , getOpaque           :: jsval -> String -> IO (Maybe jsval)
-  , getString           :: jsval -> String -> IO (Maybe String)
-  , getTag              :: jsval -> IO String
-  , insertBefore        :: jsval -> jsval -> jsval -> IO ()
-  , invokeOn            :: jsval -> String -> IO ()
-  , makeHaskellCallback :: (jsval -> IO ()) -> IO jsval
-  , random01            :: IO Double
-  , removeChild         :: jsval -> jsval -> IO ()
-  , removeEventListener :: jsval -> String -> jsval -> IO ()
-  , setAttribute        :: jsval -> String -> String -> IO ()
-  , textContent         :: jsval -> IO String
+  {
+    -- | Logs a string. See [Console.log](https://developer.mozilla.org/en-US/docs/Web/API/Console/log)
+    consoleLog                     :: String -> IO ()
+
+    -- | Logs an opaque JavaScript value. See [Console.log](https://developer.mozilla.org/en-US/docs/Web/API/Console/log)
+  , consoleLog'                    :: jsval -> IO ()
+
+    -- | The body of the document. See [Document.body](https://developer.mozilla.org/en-US/docs/Web/API/Document/body)
+  , documentBody                   :: IO jsval
+
+    -- | Creates an element with a given tag. See [Document.createElement](https://developer.mozilla.org/en-US/docs/Web/API/Document/createElement)
+  , documentCreateElement          :: String -> IO jsval
+
+    -- | Creates a text node with the given text. See [Document.createTextNode](https://developer.mozilla.org/en-US/docs/Web/API/Document/createTextNode)
+  , documentCreateTextNode         :: String -> IO jsval
+
+    -- | Gets an element by id from a document. See [Document.getElementById](https://developer.mozilla.org/en-US/docs/Web/API/Document/getElementById)
+  , documentGetElementById         :: String -> IO (Maybe jsval)
+
+    -- | 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 ()
+
+    -- | 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
+
+    -- | 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 ()
+
+    -- | 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 ()
+
+    -- | 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)
+
+    -- | 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)
+
+    -- | 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)
+
+    -- | Gets a JavaScript property, returning @Nothing@ if the object being called is null or undefined.
+  , getPropertyAsOpaque            :: jsval -> String -> IO (Maybe 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)
+
+    -- | 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 ()
+
+    -- | Invokes on target a function with 0 arguments.
+  , invokeOn0                      :: jsval -> String -> 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
+
+    -- | Frees a callback. Should only be called in advanced cases. In most usage, callbacks are freed automatically by plzwrk.
+  , _freeCallback                  :: jsval -> IO ()
+
+    -- | 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
   }

@@ -1,346 +1,481 @@-module Web.Framework.Plzwrk.Domify
-  ( reconcile
-  , plzwrk
-  , plzwrk'
-  , plzwrk'_
-  , OldStuff(..)
-  )
-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
-  :: 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 refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedElement currentTag currentAttributes currentChildren currentNode)) (Just maybeNewNode@(HydratedElement maybeNewTag maybeNewAttributes maybeNewChildren))
-  = if (nodesEq currentTag maybeNewTag currentAttributes maybeNewAttributes)
-    then
-      (do
--- the tags and attributes are equal
-
-
-        let maxlen = max (length maybeNewChildren) (length currentChildren)
-        newChildren <- sequence $ getZipList
-          (   (reconcile refToOldStuff domCreationF currentNode topLevelNode)
-          <$> (ZipList (padr maxlen Nothing (fmap Just currentChildren)))
-          <*> (ZipList (padr maxlen Nothing (fmap Just maybeNewChildren)))
-          )
-        -- make new attributes to set event handlers
-
-
-        currentAttributes <- hydratedAttrsToDomifiedAttrs refToOldStuff
-                                                          domCreationF
-                                                          parentNode
-                                                          maybeNewAttributes
-        removeEventHandlers currentNode currentAttributes
-        setEventHandlers currentNode currentAttributes
-        return $ Just
-          (DomifiedElement currentTag
-                           currentAttributes
-                           (catMaybes newChildren)
-                           currentNode
-          )
-      )
-    else
-      (do
-        res <- domify refToOldStuff
-                      domCreationF
-                      parentNode
-                      topLevelNode
-                      (Just currentNode)
-                      maybeNewNode
-        return $ Just res
-      )
-reconcile refToOldStuff domCreationF parentNode topLevelNode (Just currentDomifiedString@(DomifiedTextNode currentString currentNode)) (Just maybeNewNode@(HydratedTextNode maybeNewString))
-  = if (currentString == maybeNewString)
-    then pure (Just currentDomifiedString)
-    else
-      (do
-        res <- domify refToOldStuff
-                      domCreationF
-                      parentNode
-                      topLevelNode
-                      (Just currentNode)
-                      maybeNewNode
-        return $ Just res
-      )
-reconcile refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedElement _ _ _ currentNode)) (Just maybeNewNode@(HydratedTextNode _))
-  = do
-    res <- domify refToOldStuff
-                  domCreationF
-                  parentNode
-                  topLevelNode
-                  (Just currentNode)
-                  maybeNewNode
-    return $ Just res
-reconcile refToOldStuff domCreationF parentNode topLevelNode (Just (DomifiedTextNode _ currentNode)) (Just maybeNewNode@(HydratedElement _ _ _))
-  = do
-    res <- domify refToOldStuff
-                  domCreationF
-                  parentNode
-                  topLevelNode
-                  (Just currentNode)
-                  maybeNewNode
-    return $ Just res
-reconcile refToOldStuff domCreationF parentNode topLevelNode Nothing (Just maybeNewNode)
-  = do
-    res <- domify refToOldStuff
-                  domCreationF
-                  parentNode
-                  topLevelNode
-                  Nothing
-                  maybeNewNode
-    return $ Just res
-reconcile refToOldStuff domCreationF parentNode _ (Just (DomifiedElement _ _ _ currentNode)) Nothing
-  = do
-    _removeChild <- asks removeChild
-    liftIO $ _removeChild parentNode currentNode
-    return Nothing
-reconcile refToOldStuff domCreationF parentNode _ (Just (DomifiedTextNode _ currentNode)) Nothing
-  = do
-    _removeChild <- asks removeChild
-    liftIO $ _removeChild parentNode currentNode
-    return Nothing
-reconcile _ _ _ _ _ _ = error "Inconsistent state"
-
-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
-    (reconcile 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
-    _setAttribute <- asks setAttribute
-    liftIO $ if (HM.null __style)
-      then (pure ())
-      else (_setAttribute currentNode "style") . cssToStyle $ __style
-    liftIO $ if (S.null __class)
-      then (pure ())
-      else ((_setAttribute currentNode "class") . unwords . S.toList) $ __class
-    liftIO $ mapM_ (\x -> _setAttribute 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
-  _addEventListener <- asks addEventListener
-  liftIO $ handleOnlyEventListeners _addEventListener
-                                    currentNode
-                                    domifiedAttributes
-
-removeEventHandlers
-  :: jsval -> DomifiedAttributes jsval -> ReaderT (Browserful jsval) IO ()
-removeEventHandlers currentNode domifiedAttributes = do
-  _removeEventListener <- asks removeEventListener
-  liftIO $ handleOnlyEventListeners _removeEventListener
-                                    currentNode
-                                    domifiedAttributes
-
-domify
-  :: IORef (OldStuff state jsval)
-  -> (state -> Node state jsval)
-  -> jsval
-  -> jsval
-  -> Maybe jsval
-  -> HydratedNode state jsval
-  -> ReaderT (Browserful jsval) IO (DomifiedNode jsval)
-domify refToOldStuff domCreationF parentNode topLevelNode replacing (HydratedElement tag attrs children)
-  = do
-    _createElement <- asks createElement
-    _appendChild   <- asks appendChild
-    _insertBefore  <- asks insertBefore
-    _removeChild   <- asks removeChild
-    newNode        <- liftIO $ _createElement tag
-    newAttributes  <- hydratedAttrsToDomifiedAttrs refToOldStuff
-                                                   domCreationF
-                                                   topLevelNode
-                                                   attrs
-    setAtts newNode newAttributes
-    newChildren <- mapM
-      (domify refToOldStuff domCreationF newNode topLevelNode Nothing)
-      children
-    maybe
-      (liftIO $ _appendChild parentNode newNode)
-      (\x -> do
-        liftIO $ _insertBefore parentNode newNode x
-        liftIO $ _removeChild parentNode x
-      )
-      replacing
-    liftIO $ return (DomifiedElement tag newAttributes newChildren newNode)
-domify _ _ parentNode topLevelNode replacing (HydratedTextNode text) = do
-  _createElement  <- asks createElement
-  _appendChild    <- asks appendChild
-  _insertBefore   <- asks insertBefore
-  _removeChild    <- asks removeChild
-  _createTextNode <- asks createTextNode
-  newTextNode     <- liftIO $ _createTextNode text
-  maybe
-    (liftIO $ _appendChild parentNode newTextNode)
-    (\x -> do
-      liftIO $ _insertBefore parentNode newTextNode x
-      liftIO $ _removeChild parentNode x
-    )
-    replacing
-  liftIO $ return (DomifiedTextNode text newTextNode)
-
-plzwrk
-  :: (state -> Node state jsval) -> state -> Browserful jsval -> String -> IO ()
-plzwrk domF state env nodeId = do
-  refToOldStuff <- newIORef (OldStuff state Nothing)
-  parentNode    <- (getElementById env) nodeId
-  newDom        <- maybe
-    (error $ ("Cannot find node with id " <> nodeId))
-    (\x -> runReaderT
-      (reconcile refToOldStuff domF x x Nothing (Just $ hydrate state domF))
-      env
-    )
-    parentNode
-  writeIORef refToOldStuff (OldStuff state newDom)
-
-plzwrk' :: (state -> Node state jsval) -> state -> Browserful jsval -> IO ()
-plzwrk' domF state env = do
-  refToOldStuff <- newIORef (OldStuff state Nothing)
-  parentNode    <- (getBody env)
-  newDom        <- runReaderT
-    (reconcile refToOldStuff
-               domF
-               parentNode
-               parentNode
-               Nothing
-               (Just $ hydrate state domF)
-    )
-    env
-  writeIORef refToOldStuff (OldStuff state newDom)
-
-plzwrk'_ :: (Int -> Node Int jsval) -> Browserful jsval -> IO ()
-plzwrk'_ domF env = plzwrk' domF 0 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++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

@@ -1,483 +1,519 @@-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
-
-_addEventListener
-  :: MockJSVal
-  -> String
-  -> MockJSVal
-  -> IO (MockAttributes, [LogEvent], [LogEvent])
-_addEventListener (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]
-      )
-_addEventListener _ _ _ = error "Can only add event listener to element"
-
-_setAttribute :: MockJSVal -> String -> String -> IO (MockAttributes, [LogEvent])
-_setAttribute (MockJSElement n _ (MockAttributes atts lstns) _ logn) nm attr =
-  pure
-    $ ( MockAttributes (insert nm attr atts) lstns
-      , logn <> [AttributeReceived nm attr]
-      )
-_setAttribute _ _ _ = error "Can only add event listener to element"
-
-_appendChild
-  :: MockJSVal -> MockJSVal -> IO ([MockJSVal], [LogEvent], [LogEvent])
-_appendChild (MockJSElement n _ _ kids logn) kid@(MockJSElement m _ _ _ logm) =
-  pure $ (kids <> [kid], logn <> [ChildReceived m], logm <> [AddedAsChildTo n])
-_appendChild (MockJSElement n _ _ kids logn) kid@(MockJSTextNode m _ logm) =
-  pure $ (kids <> [kid], logn <> [ChildReceived m], logm <> [AddedAsChildTo n])
-_appendChild _ _ = error "Can only append element to element"
-
-__removeChild
-  :: Int
-  -> [MockJSVal]
-  -> [LogEvent]
-  -> MockJSVal
-  -> Int
-  -> [LogEvent]
-  -> IO ([MockJSVal], [LogEvent], [LogEvent])
-__removeChild 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))
-
-_removeChild
-  :: MockJSVal -> MockJSVal -> IO ([MockJSVal], [LogEvent], [LogEvent])
-_removeChild (MockJSElement n _ _ kids logn) kid@(MockJSElement m _ _ _ logm) =
-  __removeChild n kids logn kid m logm
-_removeChild (MockJSElement n _ _ kids logn) kid@(MockJSTextNode m _ logm) =
-  __removeChild n kids logn kid m logm
-_removeChild _ _ = error "Can only remove element from element"
-
-_removeEventListener
-  :: MockJSVal
-  -> String
-  -> MockJSVal
-  -> IO (MockAttributes, [LogEvent], [LogEvent])
-_removeEventListener (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)
-_removeEventListener _ _ _ = error "Can only add event listener to element"
-
-_insertBeforeInternal
-  :: Int
-  -> [MockJSVal]
-  -> [LogEvent]
-  -> MockJSVal
-  -> Int
-  -> [LogEvent]
-  -> MockJSVal
-  -> Int
-  -> [LogEvent]
-  -> IO
-       ( [MockJSVal]
-       , [LogEvent]
-       , [LogEvent]
-       , [LogEvent]
-       )
-_insertBeforeInternal 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))
-
-
-_insertBefore
-  :: MockJSVal
-  -> MockJSVal
-  -> MockJSVal
-  -> IO ([MockJSVal], [LogEvent], [LogEvent], [LogEvent])
-_insertBefore (MockJSElement n _ _ kids logn) newI@(MockJSElement m _ _ _ logm) existingI@(MockJSElement l _ _ _ logl)
-  = _insertBeforeInternal n kids logn newI m logm existingI l logl
-_insertBefore (MockJSElement n _ _ kids logn) newI@(MockJSTextNode m _ logm) existingI@(MockJSElement l _ _ _ logl)
-  = _insertBeforeInternal n kids logn newI m logm existingI l logl
-_insertBefore (MockJSElement n _ _ kids logn) newI@(MockJSElement m _ _ _ logm) existingI@(MockJSTextNode l _ logl)
-  = _insertBeforeInternal n kids logn newI m logm existingI l logl
-_insertBefore (MockJSElement n _ _ kids logn) newI@(MockJSTextNode m _ logm) existingI@(MockJSTextNode l _ logl)
-  = _insertBeforeInternal n kids logn newI m logm existingI l logl
-_insertBefore _ _ _ = error "Can only append element to element"
-
-_getTag :: MockJSVal -> IO String
-_getTag (MockJSElement _ tag _ _ _) = return tag
-_getTag _                           = error "Can only get tag of element"
-
-_textContent :: MockJSVal -> IO String
-_textContent (MockJSTextNode _ txt _) = return txt
-_textContent _ = error "Can only get text content of text node"
-
-
-_getChildren :: MockJSVal -> IO [Int]
-_getChildren (MockJSElement _ _ _ kids _) = return $ fmap _ptr kids
-_getChildren _ = 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)
-
-
-_click :: MockJSVal -> IO ()
-_click (MockJSElement _ _ (MockAttributes _ evts) _ _) = do
-  let oc = lookup "click" evts
-  maybe (pure ()) (\x -> dummyClick x) oc
-
-_click _ = 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 }
-
-_'addEventListener :: IORef MockBrowserInternal -> Int -> String -> Int -> IO ()
-_'addEventListener env elt evt fn = do
-  _elt                            <- look env elt
-  _fn                             <- look env fn
-  (newAttrs, newLogElt, newLogFn) <- _addEventListener _elt evt _fn
-  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLogElt
-  wrt env fn $ _withNewLog _fn newLogFn
-
-_'appendChild :: IORef MockBrowserInternal -> Int -> Int -> IO ()
-_'appendChild env parent kid = do
-  _parent                            <- look env parent
-  _kid                               <- look env kid
-  (newKids, newLogParent, newLogKid) <- _appendChild _parent _kid
-  wrt env parent $ _withNewLog (_withNewKids _parent newKids) newLogParent
-  wrt env kid $ _withNewLog _kid newLogKid
-
-_'createElement :: IORef MockBrowserInternal -> String -> IO Int
-_'createElement env tg = do
-  i <- incr env
-  let elt =
-        MockJSElement i tg (MockAttributes empty empty) [] [CreatedElement i]
-  wrt env i elt
-  return i
-
-_'random01 :: IORef MockBrowserInternal -> IO Double
-_'random01 _ = pure 0.5
-
-_'consoleLog :: IORef MockBrowserInternal -> String -> IO ()
-_'consoleLog _ txt = print txt
-
-_'consoleLog' :: IORef MockBrowserInternal -> Int -> IO ()
-_'consoleLog' _ v = print (show v)
-
-
-_'createTextNode :: IORef MockBrowserInternal -> String -> IO Int
-_'createTextNode env txt = do
-  i <- incr env
-  let elt = MockJSTextNode i txt [CreatedTextNode i]
-  wrt env i elt
-  return i
-
-_'getString :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe String)
-_'getString env _ _ = pure Nothing -- not implemented yet
-
-_'getBool :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Bool)
-_'getBool env _ _ = pure Nothing -- not implemented yet
-
-_'getInt :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Int)
-_'getInt env _ _ = pure Nothing -- not implemented yet
-
-_'getDouble :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Double)
-_'getDouble env _ _ = pure Nothing -- not implemented yet
-
-_'getOpaque :: IORef MockBrowserInternal -> Int -> String -> IO (Maybe Int)
-_'getOpaque env _ _ = pure Nothing -- not implemented yet
-
-
-_'invokeOn :: IORef MockBrowserInternal -> Int -> String -> IO ()
-_'invokeOn env _ _ = pure () -- not implemented yet
-
-
-_'getTag :: IORef MockBrowserInternal -> Int -> IO String
-_'getTag env elt = do
-  _elt <- look env elt
-  _getTag _elt
-
-_'getChildren :: IORef MockBrowserInternal -> Int -> IO [Int]
-_'getChildren env elt = do
-  _elt <- look env elt
-  _getChildren _elt
-
-_'textContent :: IORef MockBrowserInternal -> Int -> IO String
-_'textContent env elt = do
-  _elt <- look env elt
-  _textContent _elt
-
-_'freeCallback :: IORef MockBrowserInternal -> Int -> IO ()
-_'freeCallback env fn = do
-  _fn    <- look env fn
-  newLog <- _freeCallback _fn
-  wrt env fn $ _withNewLog _fn newLog
-
-_'click :: IORef MockBrowserInternal -> Int -> IO ()
-_'click env elt = do
-  _elt <- look env elt
-  _click _elt
-
-idEq :: String -> MockJSVal -> Bool
-idEq txt (MockJSElement _ _ (MockAttributes atts _) _ _) =
-  Just txt == (lookup "id" atts)
-idEq _ _ = False
-
-_'getBody :: IORef MockBrowserInternal -> IO Int
-_'getBody ref = do
-  mb <- readIORef ref
-  let browser = unBrowser mb
-  pt <- maybe (error "No body.") (\x -> pure $ _ptr x) $ lookup 0 browser
-  return pt
-
-_'getHead :: IORef MockBrowserInternal -> IO Int
-_'getHead ref = pure (-1) -- need to implement in mock?
-
-_getElementByIdInternal :: MockJSVal -> String -> [Int]
-_getElementByIdInternal jsv@(MockJSElement _ _ _ ch _) txt = if (idEq txt jsv)
-  then [_ptr jsv]
-  else (foldr (++) [] $ fmap (\x -> _getElementByIdInternal x txt) ch)
-_getElementByIdInternal _ _ = []
-
-_'getElementById :: IORef MockBrowserInternal -> String -> IO (Maybe Int)
-_'getElementById env txt = do
-  body  <- _'getBody env
-  _body <- look env body
-  let elts = _getElementByIdInternal _body txt
-  return $ if (null elts) then (Nothing) else (Just $ head elts)
-
-_'insertBefore :: IORef MockBrowserInternal -> Int -> Int -> Int -> IO ()
-_'insertBefore env parent newItem existingItem = do
-  _parent       <- look env parent
-  _newItem      <- look env newItem
-  _existingItem <- look env existingItem
-  (newKids, newLogParent, newLogNewItem, newLogExistingItem) <- _insertBefore
-    _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
-
-_'removeChild :: IORef MockBrowserInternal -> Int -> Int -> IO ()
-_'removeChild env parent kid = do
-  _parent                            <- look env parent
-  _kid                               <- look env kid
-  (newKids, newLogParent, newLogKid) <- _removeChild _parent _kid
-  wrt env parent $ _withNewLog (_withNewKids _parent newKids) newLogParent
-  wrt env kid $ _withNewLog _kid newLogKid
-
-_'removeEventListener
-  :: IORef MockBrowserInternal -> Int -> String -> Int -> IO ()
-_'removeEventListener env elt evt fn = do
-  _elt                            <- look env elt
-  _fn                             <- look env fn
-  (newAttrs, newLogElt, newLogFn) <- _removeEventListener _elt evt _fn
-  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLogElt
-  wrt env fn $ _withNewLog _fn newLogFn
-
-_'setAttribute :: IORef MockBrowserInternal -> Int -> String -> String -> IO ()
-_'setAttribute env elt nm attr = do
-  _elt               <- look env elt
-  (newAttrs, newLog) <- _setAttribute _elt nm attr
-  wrt env elt $ _withNewLog (_withNewAttrs _elt newAttrs) newLog
-
-makeMockBrowserWithContext :: IORef MockBrowserInternal -> IO (Browserful Int)
-makeMockBrowserWithContext r = return Browserful
-  { addEventListener    = _'addEventListener r
-  , appendChild         = _'appendChild r
-  , consoleLog          = _'consoleLog r
-  , consoleLog'         = _'consoleLog' r
-  , click               = _'click r
-  , createElement       = _'createElement r
-  , createTextNode      = _'createTextNode r
-  , freeCallback        = _'freeCallback r
-  , getBody             = _'getBody r
-  , getBool             = _'getBool r
-  , getChildren         = _'getChildren r
-  , getDouble           = _'getDouble r
-  , getElementById      = _'getElementById r
-  , getHead             = _'getHead r
-  , getInt              = _'getInt r
-  , getOpaque           = _'getOpaque r
-  , getString           = _'getString r
-  , getTag              = _'getTag r
-  , insertBefore        = _'insertBefore r
-  , invokeOn            = _'invokeOn r
-  , makeHaskellCallback = _'makeHaskellCallback r
-  , random01            = _'random01 r
-  , removeChild         = _'removeChild r
-  , removeEventListener = _'removeEventListener r
-  , setAttribute        = _'setAttribute r
-  , textContent         = _'textContent 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.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

@@ -3,7 +3,7 @@ 
 {-|
 Module      : Web.Framework.Plzwrk.Tag
-Description : Base functions for plzwrk
+Description : Useful tags like div and img
 Copyright   : (c) Mike Solomon 2020
 License     : GPL-3
 Maintainer  : mike@meeshkan.com

@@ -1,6 +1,5 @@ module Web.Framework.Plzwrk.Util-  ( (@=)-  , (<.>)+  ( (<.>)   , wStyle   , wStyle'   , wStyles@@ -19,18 +18,20 @@   , 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(..)                                                 )--(@=) :: k -> v -> (k, v)-k @= v = (k, v)+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)@@ -39,62 +40,101 @@                          , _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"

@@ -1,102 +1,97 @@-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_, 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_ (take y $ repeat (txt (concat [x, show y])))
-              , button
-                (pure dats'
-                  { _simple   = singleton "id" "incr"
-                  , _handlers = singleton "click"
-                                          (\_ s -> pure $ s { _ctr = y + 1 })
-                  }
-                )
-                [txt "Increase counter"]
-              , button
-                (pure dats'
-                  { _simple   = singleton "id" "decr"
-                  , _handlers = singleton "click"
-                                          (\_ s -> pure $ s { _ctr = y - 1 })
-                  }
-                )
-                [txt "Decrease counter"]
-              ]
-            )
-            <$> _name
-            <*> _ctr
-    let state = MyState "Mike" 0
-    it "Creates the correct DOM from the state" $ do
-      rf          <- defaultInternalBrowser
-      mock        <- makeMockBrowserWithContext rf
-      refToOldDom <- newIORef (OldStuff state Nothing)
-      parentNode  <- getBody mock
-      newDom      <- runReaderT
-        (reconcile refToOldDom
-                   domF
-                   parentNode
-                   parentNode
-                   Nothing
-                   (Just $ hydrate state domF)
-        )
-        mock
-      writeIORef refToOldDom (OldStuff state newDom)
-      childrenLevel0 <- (getChildren mock) parentNode
-      length childrenLevel0 `shouldBe` 1
-      divtag <- (getTag mock) (head childrenLevel0)
-      divtag `shouldBe` "div"
-      childrenLevel1 <- (getChildren mock) (head childrenLevel0)
-      length childrenLevel1 `shouldBe` 3
-      ptag <- (getTag mock) (head childrenLevel1)
-      ptag `shouldBe` "p"
-      childrenLevel2 <- (getChildren mock) (head childrenLevel1)
-      length childrenLevel2 `shouldBe` 0
-      -- increment 4 times
-      (getElementById mock) "incr"
-        >>= maybe (error "Incr node does not exist") (click mock)
-      (getElementById mock) "incr"
-        >>= maybe (error "Incr node does not exist") (click mock)
-      (getElementById mock) "incr"
-        >>= maybe (error "Incr node does not exist") (click mock)
-      (getElementById mock) "incr"
-        >>= maybe (error "Incr node does not exist") (click mock)
-      parentNode'     <- getBody mock
-      childrenLevel0' <- (getChildren mock) parentNode'
-      length childrenLevel0' `shouldBe` 1
-      divtag' <- (getTag mock) (head childrenLevel0')
-      divtag' `shouldBe` "div"
-      childrenLevel1' <- (getChildren mock) (head childrenLevel0')
-      length childrenLevel1' `shouldBe` 3
-      childrenLevel2' <- (getChildren mock) (head childrenLevel1')
-      length childrenLevel2' `shouldBe` 4
-      content' <- mapM (textContent mock) childrenLevel2'
-      content' `shouldBe` (take 4 $ repeat "Mike4")
-      (getElementById mock) "decr"
-        >>= maybe (error "Incr node does not exist") (click mock)
-      (getElementById mock) "decr"
-        >>= maybe (error "Incr node does not exist") (click mock)
-      parentNode''     <- getBody mock
-      childrenLevel0'' <- (getChildren mock) parentNode''
-      length childrenLevel0'' `shouldBe` 1
-      divtag'' <- (getTag mock) (head childrenLevel0'')
-      divtag'' `shouldBe` "div"
-      childrenLevel1'' <- (getChildren mock) (head childrenLevel0'')
-      length childrenLevel1'' `shouldBe` 3
-      childrenLevel2'' <- (getChildren mock) (head childrenLevel1'')
-      length childrenLevel2'' `shouldBe` 2
-      content'' <- mapM (textContent mock) childrenLevel2''
-      content'' `shouldBe` (take 2 $ repeat "Mike2")
+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>"