Improve textArea and scroll test cases

tasks.md

@@ -656,12 +656,13 @@
     - Fix nested wheel event.
       - I accidentally removed IgnoreParentEvents logic.
     - Drag select in text area should make cursor visible.
-
-Next
   - Complete test cases
     - Multiline text editing
     - IgnoreParentEvents.
     - Improve scroll test cases
+
+Next
+  - Rename LeftBtn -> BtnLeft
   - Create user documentation
     - Overview of the library
     - Tutorials

test/unit/Monomer/Widgets/Containers/ScrollSpec.hs

@@ -26,6 +26,7 @@ import Monomer.Widgets.Containers.Scroll
 import Monomer.Widgets.Containers.Stack
 import Monomer.Widgets.Singles.Button
 import Monomer.Widgets.Singles.Label
+import Monomer.Widgets.Singles.Spacer
 
 import qualified Monomer.Lens as L
 
@@ -44,6 +45,7 @@ spec = describe "Scroll" $ do
 handleEvent :: Spec
 handleEvent = describe "handleEvent" $ do
   handleChildrenFocus
+  handleNestedWheel
   handleMessageReset
 
 handleChildrenFocus :: Spec
@@ -53,13 +55,8 @@ handleChildrenFocus = describe "handleChildrenFocus" $ do
     evtsIgnore evts2 `shouldBe` Seq.fromList [Button1]
     evtsIgnore evts3 `shouldBe` Seq.fromList [Button1]
 
-  it "should follow focus events" $
+  it "should follow focus events" $ do
     evtsFollow evts1 `shouldBe` Seq.fromList [Button2]
-
-  xit "should follow focus events on overlay" $
-    evtsFollow evts2 `shouldBe` Seq.fromList [Button2]
-
-  it "should follow focus events on non overlay" $
     evtsFollow evts3 `shouldBe` Seq.fromList [Button4]
 
   where
@@ -80,6 +77,38 @@ handleChildrenFocus = describe "handleChildrenFocus" $ do
     evtsIgnore es = nodeHandleEventEvts wenv es ignoreNode
     evtsFollow es = nodeHandleEventEvts wenv es followNode
 
+handleNestedWheel :: Spec
+handleNestedWheel = describe "handleNestedWheel" $ do
+  it "should scroll main widget" $ do
+    events evts1 `shouldBe` Seq.fromList [Button4]
+
+  it "should scroll child widget" $ do
+    events evts2 `shouldBe` Seq.fromList [Button3]
+
+  where
+    wenv = mockWenv () & L.windowSize .~ Size 640 480
+    pointClick = Point 160 240
+    pointWheel1 = Point 480 240
+    pointWheel2 = Point 160 240
+    evtWheel p = WheelScroll p (Point 0 (-2000)) WheelNormal
+    evts1 = [evtWheel pointWheel1, evtClick pointClick]
+    evts2 = [evtWheel pointWheel2, evtClick pointClick]
+    st = [width 320, height 480]
+    childNode = vscroll (vstack [
+        button "Button 1" Button1 `style` st,
+        button "Button 2" Button2 `style` st,
+        button "Button 3" Button3 `style` st
+      ]) `style` [height 480]
+    mainNode = vstack [
+        childNode,
+        button "Button 4" Button4 `style` st
+      ] `style` [width 320]
+    scrollNode = vscroll $ hstack [
+        mainNode,
+        filler
+      ]
+    events es = nodeHandleEventEvts wenv es scrollNode
+
 handleMessageReset :: Spec
 handleMessageReset = describe "handleMessageReset" $ do
   it "should not generate an event if scroll does not show Button1" $

test/unit/Monomer/Widgets/Singles/TextAreaSpec.hs

@@ -231,6 +231,39 @@ handleEventMouseSelect = describe "handleEventMouseSelect" $ do
     let steps = [evtT str, evtPress selStart, evtMove selEnd, evtRelease selEnd, evtT "New"]
     model steps ^. textValue `shouldBe` "New"
 
+  it "should input 'This is long\nline', click twice, input 'a'" $ do
+    let str = "This is long\nline"
+    let point = Point 80 10
+    let steps = [evtT str, ButtonAction point LeftBtn BtnReleased 2, evtT "a"]
+    model steps ^. textValue `shouldBe` "This is a\nline"
+
+  it "should input 'This is long\nline', click three times, input 'New'" $ do
+    let str = "This is long line\nline"
+    let point = Point 80 10
+    let steps = [evtT str, ButtonAction point LeftBtn BtnReleased 3, evtT "New"]
+    model steps ^. textValue `shouldBe` "New\nline"
+
+  it "should input 'This is long\nline', click four times, input 'Clear'" $ do
+    let str = "This is long line\nline"
+    let point = Point 80 10
+    let steps = [evtT str, ButtonAction point LeftBtn BtnReleased 4, evtT "Clear"]
+    model steps ^. textValue `shouldBe` "Clear"
+
+  it "should input multiline text, move to start, select the first line and clear it" $ do
+    let str = "a\nb\nc\nd\ne\nf\n"
+    let selStart = Point 20 10
+    let steps = [evtT str, evtKG keyUp, ButtonAction selStart LeftBtn BtnReleased 3, evtT ""]
+    model steps ^. textValue `shouldBe` "\nb\nc\nd\ne\nf\n"
+
+  it "should input multiline text, move to start, select drag four lines, unselect, select active line and clear it (tests auto scroll)" $ do
+    let str = "a\nb\nc\nd\ne\nf\n"
+    let selStart = Point 0 10
+    let selEnd = Point 0 100
+    let selSteps = [evtPress selStart, evtMove selEnd, evtRelease selEnd]
+    let lineSteps = [ButtonAction selStart LeftBtn BtnReleased 3, evtT ""]
+    let steps = [evtT str, evtKG keyUp] ++ selSteps ++ lineSteps
+    model steps ^. textValue `shouldBe` "a\nb\nc\nd\n\nf\n"
+
   where
     wenv = mockWenvEvtUnit (TestModel "")
     txtNode = vstack [