replica (empty) → 0.1.0.0

raw patch · 9 files changed

+652/−0 lines, 9 filesdep +Diffdep +QuickCheckdep +aesonsetup-changed

Dependencies added: Diff, QuickCheck, aeson, base, bytestring, containers, file-embed, http-types, quickcheck-instances, replica, template-haskell, text, wai, wai-websockets, websockets

Files

ChangeLog.md +3/−0
LICENSE +30/−0
README.md +80/−0
Setup.hs +2/−0
replica.cabal +77/−0
src/Network/Wai/Handler/Replica.hs +103/−0
src/Replica/Internal.hs +18/−0
src/Replica/VDOM.hs +272/−0
test/Spec.hs +67/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for replica++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,80 @@+# Replica++[![CircleCI](https://circleci.com/gh/pkamenarsky/replica.svg?style=svg)](https://circleci.com/gh/pkamenarsky/replica)++![Remote logo](./docs/replica-logo.svg)++**Replica** is a *remote virtual DOM* library for Haskell. In contrast to traditional virtual DOM implementations, a remote virtual DOM runs *on the server* and is replicated to the client, which just acts as a dumb terminal.++![Remote DOM](./docs/replica-dom.svg)++See [list of **Replica** frameworks](#list-of-replica-frameworks).++## Motivation++SPAs written in frameworks such as [React](https://reactjs.org) or [Vue](https://vuejs.org) oftentimes require setting up projects in different languages with their respective build tooling, thinking about protocols between server and client, designing data types for communication (whether explicitly or implicitly) and coming up with a way to keeping everything in sync reliably. More often than not this results in copious amounts of boilerplate and support code completely unrelated to the task at hand.++A change on the backend has to be propagated through the server code and protocol or API long before the affected UI components can be adjusted. Conversely, a specification or requirements change in the UI depend upon long-winded thought experiments in data flow before the required modifications on the backend can be pinned down. Prototyping speed grinds to a halt and maintenance costs skyrocket.++There is also the additional burden of thinking about security – a simple `select * from users` would also send the (hopefully) hashed user passwords back to the client, even though they are not displayed anywhere in the UI. Thinking hard about scrubbing sensitive data before throwing something over the wire is laborious and error prone and humans make mistakes.++And so, one often finds oneself longing for the Olden Days of server side HTML rendering, where all the data was readily available at one's fingertips without protocols or different ecosystems to be taken care of. However, one then looses out on designing UIs declaratively in the spirit of [Elm](https://elm-lang.org) or [React](https://reactjs.org) and of course on the interactivity offered by code running directly on the client side.++**Replica** seeks the middle ground - it runs a virtual DOM *remotely on the server* while pushing only minimal diffs to the client, which in turn sends events triggered by the user back to the backend. This offers all of the advantages of generating a complete UI on the server, while still providing the interactivity of more traditional SPAs running entirely on the client.++A word about data volume - currently, the data format is not optimised for size at all; that said, it should be comparable to a finely hand-tuned protocol, since only the most minimal changeset is sent over the wire (save for a small-ish volume constant because of the ceremony caused by the recursive tree nature of the data). In contrast, many APIs are constructed to send the whole requested dataset on every change, so **Replica**'s diffs might fare favourably here. Furthermore, designing a protocol with minimal data volumes in mind would probably also increase the volume of the aforementioned incidental boilerplate and support code.++## Client side prediction++**Replica** runs over a WebSocket connection. A virtual DOM wired up with events which might lead to change needs to react to every such event - be it a mouse click or a key stroke. Normally, even on an average connection, some lag between a click on a button and showing the updated UI is fine; not so when it comes to typing. Even a lag of ~50ms starts to be noticeable, since the DOM is a complete and accurate representation of the UI displayed to the user and the values of text input elements need to be replicated as well.++Game developers have had to deal with the problem of client side prediction at least since the days of Quake and so the solution space is well understood. **Replica**, for the time being, offers a simple implementaion - every event -> DOM patch roundtrip increases a frame number on the server and every such patch is tagged with said frame number. Additionally, every input element wired with an event listener keeps its value in a capped queue in the browser DOM for a given number of frames (currently 20). Finally, when the DOM is patched, the input value is not touched iff the server value matches any of the previous frame values stored on the client.++Even with a simple scheme like this the user experience is indistinguishable from code running directly on the client, for the majority of cases, for even higher lag values of ~100ms - 200ms. *Rare* edge cases show, but those can be mitigated in the future by employing more sophisticated client side prediction algorithms.++## Caveats++Since DOM diffing runs on the server, **Replica** is relatively more resource intensive than a comparable backend implementation which just servers data without diffing. It's not recommended to use it for high-traffic user facing applications. However, it might be the perfect fit for internal tooling where in many cases prototyping and maintenance costs trump hardware prices by a long margin.++Additionally, events such as `onMouseMove` are discouraged, although they are supported in principle. This is because there might be better ways to provide high interactivity in the future (for example, by implemeting a custom, highly optimised `onMouseDrag` event) than bombarding the server with a torrent of movement events.++There's no support for animations and lifecycle events yet, however the implementation would be relatively straightforward.++## Building++Install [TypeScript](https://www.typescriptlang.org) and [Stack](https://docs.haskellstack.org/en/stable/README). Then:++```+cd js && tsc --project tsconfig.json && cd ..+stack build --test+```++The TypeScript step must be executed whenever `js/client.ts` changes.++## Integration with UI frameworks++**Replica** aims to be framework agnostic. It offers a simple API and hooking into it should be as uncomplicated as possible. That said, feedback is very much welcome.++The easiest way to run **Replica** is to call `Network.Wai.Handler.Replica.app`. This takes care of distributing a complete `index.html` together with the Javascript driver to the client. Everything should work out of the box.++For finer grained integration, there's `Network.Wai.Handler.Replica.websocketApp`, which just handles the WebSocket part of the connection; the root `index.html` and `js/dist/client.js` must be distributed separately.++`Replica.VDOM.diff` and `Replica.VDOM.fireEvent` allow for complete control over the remote virtual DOM.++## List of **Replica** frameworks++* [`concur-replica`](https://github.com/pkamenarsky/concur-replica)++## Roadmap++* Hackage documentation+* Initial server-side rendering+* SVG support+* Better diffing algorithm+* Lifecycle events and animation hooks+* `onMouseDrag` event+* Nix derivation++## Bugs and features++Comments, bug reports and feature PRs very much welcome.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ replica.cabal view

@@ -0,0 +1,77 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 9160ee1ac83c3f9ccf4b993f35dca621a8d07555c2af141f61853d1ba4ad7819++name:           replica+version:        0.1.0.0+description:    Please see the README on GitHub at <https://github.com/githubuser/replica#readme>+homepage:       https://github.com/https://github.com/pkamenarsky/replica#readme+bug-reports:    https://github.com/https://github.com/pkamenarsky/replica/issues+author:         Philip Kamenarsky+maintainer:     p.kamenarsky@gmail.com+copyright:      2019 (c) Philip Kamenarsky+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/https://github.com/pkamenarsky/replica++library+  exposed-modules:+      Replica.VDOM+      Network.Wai.Handler.Replica+  other-modules:+      Replica.Internal+      Paths_replica+  hs-source-dirs:+      src+  ghc-options: -Wall -ferror-spans -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-import-lists+  build-depends:+      Diff+    , aeson+    , base >=4.7 && <5+    , bytestring+    , containers+    , file-embed+    , http-types+    , template-haskell+    , text+    , wai+    , wai-websockets+    , websockets+  default-language: Haskell2010++test-suite replica-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_replica+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      Diff+    , QuickCheck+    , aeson+    , base >=4.7 && <5+    , bytestring+    , containers+    , file-embed+    , http-types+    , quickcheck-instances+    , replica+    , template-haskell+    , text+    , wai+    , wai-websockets+    , websockets+  default-language: Haskell2010

+ src/Network/Wai/Handler/Replica.hs view

@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Network.Wai.Handler.Replica where++import           Control.Concurrent             (Chan, forkIO, newChan, readChan, writeChan)+import           Control.Monad                  (forever, void)++import           Data.Aeson                     ((.:), (.=))+import qualified Data.Aeson                     as A++import qualified Data.ByteString                as B+import qualified Data.ByteString.Lazy           as BL+import qualified Data.Text                      as T+import           Network.HTTP.Types             (status200)++import           Network.WebSockets             (ServerApp)+import           Network.WebSockets.Connection  (ConnectionOptions, Connection, acceptRequest, forkPingThread, receiveData, sendTextData)+import           Network.Wai                    (Application, responseLBS)+import           Network.Wai.Handler.WebSockets (websocketsOr)++import qualified Replica.VDOM                   as V++import           Debug.Trace                    (traceIO)++data Event = Event+  { evtType        :: T.Text+  , evtEvent       :: A.Value+  , evtPath        :: [Int]+  , evtClientFrame :: Int+  } deriving Show++instance A.FromJSON Event where+  parseJSON (A.Object o) = Event+    <$> o .: "eventType"+    <*> o .: "event"+    <*> o .: "path"+    <*> o .: "clientFrame"+  parseJSON _ = fail "Expected object"++data Update+  = ReplaceDOM V.HTML+  | UpdateDOM Int Int [V.Diff]++instance A.ToJSON Update where+  toJSON (ReplaceDOM dom) = A.object+    [ "type" .= V.t "replace"+    , "dom"  .= dom+    ]+  toJSON (UpdateDOM serverFrame clientFrame ddiff) = A.object+    [ "type" .= V.t "update"+    , "serverFrame" .= serverFrame+    , "clientFrame" .= clientFrame+    , "diff" .= ddiff+    ]++app :: forall st.+     B.ByteString+  -> ConnectionOptions+  -> st+  -> (st -> IO (Maybe (V.HTML, Event -> IO st)))+  -> Application+app title options initial step+  = websocketsOr options (websocketApp initial step) backupApp+  where+    indexBS = BL.fromStrict $ V.index title++    backupApp :: Application+    backupApp _ respond = respond $ responseLBS status200 [] indexBS++websocketApp :: forall st.+     st+  -> (st -> IO (Maybe (V.HTML, Event -> IO st)))+  -> ServerApp+websocketApp initial step pendingConn = do+  conn <- acceptRequest pendingConn+  chan <- newChan++  forkPingThread conn 30+    +  _ <- forkIO $ forever $ do+    msg <- receiveData conn+    case A.decode msg of+      Just e  -> writeChan chan e+      Nothing -> traceIO $ "Couldn't decode event: " <> show msg++  void $ go conn chan Nothing initial 0 0++  where+    go :: Connection -> Chan Event -> Maybe V.HTML -> st -> Int -> Int -> IO ()+    go conn chan oldDom st serverFrame clientFrame = do+      r <- step st+      case r of+        Nothing -> pure ()+        Just (newDom, await) -> do+          case oldDom of+            Nothing -> sendTextData conn $ A.encode $ ReplaceDOM newDom+            Just oldDom' -> sendTextData conn $ A.encode $ UpdateDOM serverFrame clientFrame (V.diff oldDom' newDom)+          +          event <- readChan chan+          newSt <- await event+    +          go conn chan (Just newDom) newSt (serverFrame + 1) (evtClientFrame event)

+ src/Replica/Internal.hs view

@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Replica.Internal where++import qualified Data.ByteString            as B+import qualified Data.FileEmbed             as FE++import           Language.Haskell.TH.Syntax (Lift, lift)++instance Lift B.ByteString where+  lift = FE.bsToExp++replace :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString+replace needle with str+  | Just suffix <- B.stripPrefix needle suffix' = prefix <> with <> suffix+  | otherwise = error "Can't find substring"+  where+    (prefix, suffix') = B.breakSubstring needle str

+ src/Replica/VDOM.hs view

@@ -0,0 +1,272 @@+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}++module Replica.VDOM where++import           Data.Aeson                 ((.=))+import qualified Data.Aeson                 as A+import qualified Data.ByteString            as B+import qualified Data.FileEmbed             as FE+import           Data.Monoid                ((<>))+import qualified Data.Text                  as T++import qualified Data.Map                   as M++import qualified Data.Algorithm.Diff        as D++import           Language.Haskell.TH.Syntax (lift)+import           Replica.Internal           (replace)++t :: T.Text -> T.Text+t = id++type HTML = [VDOM]++data Attr+  = AText  !T.Text+  | ABool  !Bool+  | AEvent !(DOMEvent -> IO ())+  | AMap   !Attrs++instance A.ToJSON Attr where+  toJSON (AText v) = A.String v+  toJSON (ABool v)  = A.Bool v+  toJSON (AEvent _) = A.Null+  toJSON (AMap v)   = A.toJSON $ fmap A.toJSON v++type Attrs = M.Map T.Text Attr++data AttrDiff+  = DeleteKey !T.Text+  | InsertKey !T.Text !Attr+  | DiffKey   !T.Text ![KeyDiff]++instance A.ToJSON AttrDiff where+  toJSON (DeleteKey k) = A.object+    [ "type" .= t "delete"+    , "key" .= k+    ]+  toJSON (InsertKey k v) = A.object+    [ "type" .= t "insert"+    , "key" .= k+    , "value" .= v+    ]+  toJSON (DiffKey k ds) = A.object+    [ "type" .= t "diff"+    , "key" .= k+    , "diff" .= ds+    ]++data KeyDiff+  = Replace !Attr+  | DiffMap ![AttrDiff]++instance A.ToJSON KeyDiff where+  toJSON (Replace v) = A.object+    [ "type" .= t "replace"+    , "value" .= v+    ]+  toJSON (DiffMap ds) = A.object+    [ "type" .= t "diff"+    , "diff" .= ds+    ]++diffAttrs :: Attrs -> Attrs -> [AttrDiff]+diffAttrs a b+  =  fmap DeleteKey (M.keys deleted)+  <> fmap (uncurry InsertKey) (M.assocs inserted)+  <> concatMap diffKey (M.assocs same)+  where+    deleted  = a `M.difference` b+    inserted = b `M.difference` a+    same     = M.intersectionWith (,) a b++    diffKey :: (T.Text, (Attr, Attr)) -> [AttrDiff]+    diffKey (k, (m, n))+      | null ds   = []+      | otherwise = [DiffKey k ds]+      where+        ds = diffVValue m n++    diffVValue :: Attr -> Attr -> [KeyDiff]+    diffVValue (AText m) vn@(AText n)+      | m == n = []+      | otherwise = [Replace vn]+    diffVValue (ABool m) vn@(ABool n)+      | m == n = []+      | otherwise = [Replace vn]+    diffVValue (AEvent _) (AEvent _) = []+    diffVValue (AMap m) (AMap n)+      | null das  = []+      | otherwise = [DiffMap $ diffAttrs m n]+      where+        das = diffAttrs m n+    diffVValue _ n                   = [Replace n]++patchAttrs :: [AttrDiff] -> Attrs -> Attrs+patchAttrs [] a                 = a+patchAttrs (DeleteKey k:ds) a   = patchAttrs ds $ M.delete k a+patchAttrs (InsertKey k v:ds) a = patchAttrs ds $ M.insert k v a+patchAttrs (DiffKey k vds:ds) a = patchAttrs ds $ M.adjust (patchVValue vds) k a+  where+    patchVValue [] v                      = v+    patchVValue (Replace m:vs) _          = patchVValue vs m+    patchVValue (DiffMap ads:vs) (AMap m) = patchVValue vs $ AMap (patchAttrs ads m)+    patchVValue (DiffMap _:_) _           = error "Can't patch map non-maps"++data VDOM+  = VNode !T.Text !Attrs ![VDOM]+  | VLeaf !T.Text !Attrs+  | VText !T.Text++instance A.ToJSON VDOM where+  toJSON (VText text) = A.object+    [ "type" .= t "text"+    , "text" .= text+    ]+  toJSON (VLeaf element attrs) = A.object+    [ "type"    .= t "leaf"+    , "element" .= element+    , "attrs"   .= attrs+    ]+  toJSON (VNode element attrs children) = A.object+    [ "type"     .= t "node"+    , "element"  .= element+    , "attrs"    .= attrs+    , "children" .= children+    ]++data Diff+  = Delete !Int+  | Insert !Int !VDOM+  | Diff !Int ![AttrDiff] ![Diff]+  | ReplaceText !Int !T.Text++instance A.ToJSON Diff where+  toJSON (Delete i) = A.object+    [ "type"  .= t "delete"+    , "index" .= i+    ]+  toJSON (Insert i v) = A.object+    [ "type"  .= t "insert"+    , "dom"   .= v+    , "index" .= i+    ]+  toJSON (Diff i ads ds) = A.object+    [ "type"  .= t "diff"+    , "diff"  .= ds+    , "adiff" .= ads+    , "index" .= i+    ]+  toJSON (ReplaceText i text) = A.object+    [ "type"  .= t "replace_text"+    , "index" .= i+    , "text"  .= text+    ]++diff :: HTML -> HTML -> [Diff]+diff a b = concatMap (uncurry toDiff) (zip vdiffs is)+  where+    go i (D.First _:ds) = i:go i ds+    go i (_:ds) = i:go (i + 1) ds+    go _ [] = []++    vdiffs = D.getDiffBy eqNode a b+    is     = go 0 vdiffs+    +    toDiff :: D.Diff VDOM -> Int -> [Diff]+    toDiff (D.First _) i  = [Delete i]+    toDiff (D.Second v) i = [Insert i v]+    toDiff (D.Both (VNode _ ca c) (VNode _ da d)) i    +      | null das && null ds = []+      | otherwise           = [Diff i (diffAttrs ca da) (diff c d)]+      where+        das = diffAttrs ca da+        ds  = diff c d+    toDiff (D.Both (VLeaf _ ca) (VLeaf _ da)) i+      | null das  = []+      | otherwise = [Diff i (diffAttrs ca da) []]+      where+        das = diffAttrs ca da+    toDiff (D.Both (VText m) (VText n)) i+      | m == n    = []+      | otherwise = [ReplaceText i n]+    toDiff _ _ = []++    key attrs = M.lookup "key" attrs++    eqType (Just (AText m)) (Just (AText n))+      | m == n    = True+      | otherwise = False+    eqType Nothing Nothing = True+    eqType _ _ = False++    eqNode (VNode n na _) (VNode m ma _)+      | Just (AText k1) <- key na+      , Just (AText k2) <- key ma = k1 == k2+      | otherwise = n == m && M.lookup "type" na `eqType` M.lookup "type" ma+    eqNode (VLeaf n na) (VLeaf m ma)+      | Just (AText k1) <- key na+      , Just (AText k2) <- key ma = k1 == k2+      | otherwise = n == m && M.lookup "type" na `eqType` M.lookup "type" ma+    eqNode (VText _) (VText _) = True+    eqNode _ _ = False++patch :: [Diff] -> HTML -> HTML+patch [] a                  = a+patch (Delete i:rds) a      = patch rds $ take i a <> drop (i + 1) a+patch (Insert i v:rds) a    = patch rds $ take i a <> [v] <> drop i a+patch (Diff i ads ds:rds) a = patch rds $ take i a <> [v] <> drop (i + 1) a+  where+    v = case a !! i of+      VNode e as cs -> VNode e (patchAttrs ads as) (patch ds cs)+      VLeaf e as    -> VLeaf e (patchAttrs ads as)+      VText _       -> error "Can't node patch text"+patch (ReplaceText i n:rds) a = patch rds $ take i a <> [v] <> drop (i + 1) a+  where+    v = case a !! i of+      VText _ -> VText n+      _       -> error "Can't text patch node"++newtype DOMEvent = DOMEvent { getDOMEvent :: A.Value }++type Path = [Int]++fireWithAttrs :: Attrs -> T.Text -> DOMEvent -> IO ()+fireWithAttrs attrs evtName evtValue = case M.lookup evtName attrs of+  Just (AEvent attrEvent) -> attrEvent evtValue+  _ -> pure ()++fireEvent :: HTML -> Path -> T.Text -> DOMEvent -> IO ()+fireEvent _ []      = \_ _ -> pure ()+fireEvent ds (x:xs) = if x < length ds+  then fireEventOnNode (ds !! x) xs+  else \_ _ -> pure ()+  where+    fireEventOnNode (VNode _ attrs _) []        = fireWithAttrs attrs+    fireEventOnNode (VLeaf _ attrs) []          = fireWithAttrs attrs+    fireEventOnNode (VNode _ _ children) (p:ps) = if p < length children+      then fireEventOnNode (children !! p) ps+      else \_ _ -> pure ()+    fireEventOnNode _ _                         = \_ _ -> pure ()++clientDriver :: B.ByteString+clientDriver = $(FE.embedFile "js/dist/client.js")++stagedIndex :: B.ByteString+stagedIndex = $(lift+    $ replace "<script src=\"dist/client.js\"></script>"+        ("<script language=\"javascript\">\n"+        <> $(FE.embedFile "js/dist/client.js")+        <> "</script>"+        )+    $(FE.embedFile "js/index.html")+  )++index :: B.ByteString -> B.ByteString+index title = replace "$TITLE" title $ stagedIndex

+ test/Spec.hs view

@@ -0,0 +1,67 @@+{-# LANGUAGE StandaloneDeriving #-}++module Main where++import           Data.Monoid+import qualified Data.Text as T++import           Test.QuickCheck+import           Test.QuickCheck.Instances++import           Replica.VDOM++instance Arbitrary Attr where+  arbitrary = do+    t <- choose (0, 3) :: Gen Int+    case t of+      0 -> AText <$> arbitrary+      1 -> ABool <$> arbitrary+      2 -> pure $ AEvent (\_ -> pure ())+      3 -> AMap <$> arbitrary++instance Eq Attr where+  AText m == AText n = m == n+  ABool m == ABool n = m == n+  AEvent _ == AEvent _ = True+  AMap m   == AMap n = m == n++instance Show Attr where+  show (AText t)  = "AText " <> T.unpack t+  show (ABool t)  = "ABool " <> show t+  show (AEvent _) = "AEvent"+  show (AMap m)   = "AMap " <> show m+ +propAttrsDiff :: Attrs -> Attrs -> Bool +propAttrsDiff a b = patchAttrs (diffAttrs a b) a == b++quickCheckAttrsDiff = quickCheckWith args propAttrsDiff+  where+    args = stdArgs { maxSize = 7, maxSuccess = 1000 }++--------------------------------------------------------------------------------++deriving instance Eq VDOM+deriving instance Show VDOM++instance Arbitrary VDOM where+  arbitrary = do+    t <- choose (0, 1) :: Gen Int+    case t of+      0 -> VNode <$> arbitrary <*> arbitrary <*> arbitrary+      -- 1 -> VLeaf <$> arbitrary <*> arbitrary+      1 -> VText <$> arbitrary++propDiff :: HTML -> HTML -> Bool +propDiff a b = patch (diff a b) a == b++quickCheckDiff a b = quickCheckWith args propDiff+  where+    args = stdArgs { maxSize = a, maxSuccess = b }++--------------------------------------------------------------------------------++main :: IO ()+main = do+  quickCheckAttrsDiff+  quickCheckDiff 4 1000+  quickCheckDiff 5 200