Show and Eq instances for Html (#16)

* Show and Eq instances for Html

* suggested changes

Author: timdeputter

src/Flame/Types.purs

@@ -3,6 +3,8 @@ module Flame.Types where
 
 import Prelude
 
+import Data.Array as DA
+import Data.Foldable as DF
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Foreign.Object (Object)
@@ -59,6 +61,24 @@ data Html message =
 
 derive instance elementFunctor :: Functor Html
 
+
+instance showHtml :: Show (Html message) where
+        show (Node tag nodeData children) = "(Node " <> tag <> " " <> show (isNonEventData nodeData) <> " " <> show children <> ")"
+        show (Text t) = "(Text " <> t <> ")"
+
+instance eqHtml :: Eq (Html message) where
+        eq (Node tag nodeData children) (Node tag2 nodeData2 children2) = tag == tag2 && eqArrayNodeData nodeData nodeData2 && children == children2
+                where eqArrayNodeData arr1 arr2 = DF.all (flip DF.elem (isNonEventData arr2)) (isNonEventData arr1)
+        eq (Text t) (Text t2) = t == t2
+        eq _ _ = false
+
+
+isNonEventData :: forall t. Array (NodeData t) -> Array (NodeData t)
+isNonEventData = DA.filter case _ of
+                        Attribute _ _ -> true
+                        Property _ _ -> true
+                        _ -> false
+
 -- | Convenience wrapper around `VNodeData`
 --snabbom has support for style and class node data but I dont think it is worth it
 data NodeData message =
@@ -69,5 +89,16 @@ data NodeData message =
 
 derive instance nodeDataFunctor :: Functor NodeData
 
+instance showNodeData :: Show (NodeData message) where
+        show (Attribute name val) = "(Attribute " <> name <> " " <> val <> ")"
+        show (Property name val) = "(Property " <> name <> " " <> val <> ")"
+        show _ = ""
+
+instance eqNodeData :: Eq (NodeData message) where
+        eq (Attribute name val) (Attribute name2 val2) = name == name2 && val == val2
+        eq (Property name val) (Property name2 val2) = name == name2 && val == val2
+        eq _ _ = false
+
+
 -- | Infix tuple constructor
 infixr 6 Tuple as :>

test/Main.purs

@@ -15,12 +15,12 @@ import Effect.Class (liftEffect)
 import Flame.Application.DOM as FAD
 import Flame.Application.Effectful as FAE
 import Flame.HTML.Attribute as HA
-import Test.Basic.ContentEditable as TBC
 import Flame.HTML.Element as HE
 import Flame.Renderer.String as FRS
 import Partial.Unsafe (unsafePartial)
 import Partial.Unsafe as PU
 import Signal.Channel as SC
+import Test.Basic.ContentEditable as TBC
 import Test.Basic.EffectList as TBEL
 import Test.Basic.Effectful as TBE
 import Test.Basic.NoEffects as TBN
@@ -57,6 +57,8 @@ foreign import keydownEvent :: Effect Event
 foreign import errorEvent :: Effect Event
 foreign import offlineEvent :: Effect Event
 
+
+
 main :: Effect Unit
 main =
         runTest do
@@ -194,6 +196,29 @@ main =
                                 html' <- liftEffect $ FRS.render html
                                 --events are part of virtual dom data and do not show up on the rendered markup
                                 TUA.equal """<a>TEST</a>""" html'
+                suite "show" do
+                        test "simple element" do
+                                let html = HE.div [HA.id "1"] [HE.text "T"]
+                                TUA.equal """(Node div [(Property id 1)] [(Text T)])""" $ show $ html
+                        test "events do not matter" do
+                                let html = HE.div [HA.id "1", HA.onClick "Test"] [HE.text "T"]
+                                TUA.equal """(Node div [(Property id 1)] [(Text T)])""" $ show $ html
+                        test "element with childs" do
+                                let html = HE.div_ [HE.div_ [HE.br]]
+                                TUA.equal """(Node div [] [(Node div [] [(Node br [] [])])])""" $ show $ html 
+                suite "eq" do
+                        test "simple element" do
+                                TUA.equal' "equal html" (HE.div [HA.id "1"] [HE.text "T"]) (HE.div [HA.id "1"] [HE.text "T"])
+                                TUA.assert "diffent property" $ (HE.div [HA.id "1"] [HE.text "T"]) /= (HE.div [HA.id "2"] [HE.text "T"])
+                        test "events do not matter" do
+                                TUA.equal' "equal html" (HE.div [HA.id "1", HA.onClick unit] [HE.text "T"]) (HE.div [HA.id "1"] [HE.text "T"])
+                        test "property order does not matter" do
+                                TUA.assert "should equal" $
+                                        (HE.div [HA.class' "test", HA.id "1"] [HE.text "T"]) == (HE.div [HA.id "1", HA.class' "test"] [HE.text "T"]) 
+                        test "child order does matter" do
+                                TUA.assert "should not equal" $
+                                        (HE.div_ [HE.text "T", HE.br]) /= (HE.div_ [HE.br, HE.text "T"])
+
                 suite "diff" do
                         test "updates record fields" do
                                 TUA.equal { a: 23, b: "hello", c: true } $ FAE.diff' {c: true} { a : 23, b: "hello", c: false }