Fix unit tests. Remove hedgehog-classes dependency and related utilit…

…ies module

package.yaml

@@ -90,7 +90,6 @@ tests:
     - call-stack
     - monomer
     - hedgehog
-    - hedgehog-classes
     - hspec
     - HUnit
     - silently

stack.yaml

@@ -42,7 +42,6 @@ packages:
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (e.g., acme-missiles-0.3)
 extra-deps:
-- hedgehog-classes-0.2.5
 - nanovg-0.6.0.0
 
 # Override default flag values for local packages and extra-deps

stack.yaml.lock

@@ -4,13 +4,6 @@
 #   https://docs.haskellstack.org/en/stable/lock_files
 
 packages:
-- completed:
-    hackage: hedgehog-classes-0.2.5@sha256:a37e4af8b8ddb3e92120d0a5ddd892f669fe75fc13dcfd9723850574530d1f2b,5723
-    pantry-tree:
-      size: 5192
-      sha256: 965b5001ec24cddf85cf72f15ab99d335d0b19c0c8515f8b09fdc8b8d68c89b4
-  original:
-    hackage: hedgehog-classes-0.2.5
 - completed:
     hackage: nanovg-0.6.0.0@sha256:326e73fe2c4ec56656fa42894c53a8e26b3e60449c69578f5f6da50c0ad60ed2,4146
     pantry-tree:

tasks.md

@@ -337,6 +337,7 @@
   - Image
     - Does adding function to return imgData from Renderer make sense? Replace imageExists?
     - Remove delay logic when adding an image
+  - Check why after click focus is not immediately shown in listView items
 
 - Pending
   - Add testing
@@ -354,7 +355,6 @@
   - Add user documentation
 
 Maybe postponed after release?
-  - Check why after click focus is not immediately shown in listView items
   - Make sure WidgetTask/Node association is preserved if node location in tree changes
   - Further textField improvements
     - Handle undo history

test/unit/Monomer/TestUtil.hs

@@ -8,6 +8,7 @@ import Data.Text (Text)
 import Data.Sequence (Seq)
 import System.IO.Unsafe
 
+import qualified Data.ByteString as BS
 import qualified Data.Map.Strict as M
 import qualified Data.Text as T
 import qualified Data.Sequence as Seq
@@ -100,17 +101,18 @@ mockRenderer = Renderer {
   renderText = mockRenderText,
 
   -- Image
-  addImage = \name action size imgData -> return (),
-  updateImage = \name imgData -> return (),
+  getImage = const . Just $ ImageDef "test" def BS.empty,
+  addImage = \name size imgData -> return (),
+  updateImage = \name size imgData -> return (),
   deleteImage = \name -> return (),
-  existsImage = const True,
   renderImage = \name rect alpha -> return ()
 }
 
 mockWenv :: s -> WidgetEnv s e
 mockWenv model = WidgetEnv {
   _weOS = "Mac OS X",
   _weRenderer = mockRenderer,
+  _weMainButton = LeftBtn,
   _weTheme = def,
   _weWindowSize = testWindowSize,
   _weGlobalKeys = M.empty,
@@ -138,8 +140,8 @@ nodeUpdateSizeReq :: WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
 nodeUpdateSizeReq wenv node = (sizeReqW,  sizeReqH) where
   WidgetResult node2 _ _ = widgetInit (node ^. L.widget) wenv node
   reqNode = widgetUpdateSizeReq (node2 ^. L.widget) wenv node2
-  sizeReqW = reqNode ^. L.sizeReqW
-  sizeReqH = reqNode ^. L.sizeReqH
+  sizeReqW = reqNode ^. L.info ^. L.sizeReqW
+  sizeReqH = reqNode ^. L.info ^. L.sizeReqH
 
 nodeResize :: WidgetEnv s e -> Rect -> WidgetNode s e -> WidgetNode s e
 nodeResize wenv viewport node = newNode where

test/unit/Monomer/Widgets/CompositeSpec.hs

@@ -91,8 +91,8 @@ handleEventBasic = describe "handleEventBasic" $ do
     wenv = mockWenv def
     handleEvent :: MainModel -> MainEvt -> [EventResponse MainModel MainEvt ()]
     handleEvent model evt = [Model (model & clicks %~ (+1))]
-    buildUI model = button "Click" MainBtnClicked
-    cmpNode = composite "main" id Nothing handleEvent buildUI
+    buildUI wenv model = button "Click" MainBtnClicked
+    cmpNode = composite "main" id Nothing buildUI handleEvent
     model es = nodeHandleEventCtxModel wenv es cmpNode
 
 handleEventChild :: Spec
@@ -113,14 +113,14 @@ handleEventChild = describe "handleEventChild" $ do
     wenv = mockWenv def
     handleChild :: ChildModel -> ChildEvt -> [EventResponse ChildModel ChildEvt MainEvt]
     handleChild model evt = [Model (model & clicks %~ (+1))]
-    buildChild model = button "Click" ChildBtnClicked
+    buildChild wenv model = button "Click" ChildBtnClicked
     handleEvent :: MainModel -> MainEvt -> [EventResponse MainModel MainEvt ()]
     handleEvent model evt = [Model (model & clicks %~ (+1))]
-    buildUI model = vstack [
+    buildUI wenv model = vstack [
         button "Click" MainBtnClicked,
-        composite "child" child Nothing handleChild buildChild
+        composite "child" child Nothing buildChild handleChild
       ]
-    cmpNode = composite "main" id Nothing handleEvent buildUI
+    cmpNode = composite "main" id Nothing buildUI handleEvent
     model es = nodeHandleEventCtxModel wenv es cmpNode
 
 handleEventLocalKey :: Spec
@@ -135,30 +135,30 @@ handleEventLocalKey = describe "handleEventLocalKey" $
     wenv = mockWenv (TestModel "" "")
     handleEvent :: TestModel -> () -> [EventResponse TestModel () ()]
     handleEvent model evt = []
-    buildUI1 model = hstack [
+    buildUI1 wenv model = hstack [
         vstack [
           textField text1 `key` "localTxt1"
         ],
         vstack [
           textField text1 `key` "localTxt2"
         ]
       ]
-    buildUI2 model = hstack [
+    buildUI2 wenv model = hstack [
         vstack [
           textField text1 `key` "localTxt2"
         ],
         vstack [
           textField text1 `key` "localTxt1"
         ]
       ]
-    cmpNode1 = composite "main" id Nothing handleEvent buildUI1
-    cmpNode2 = composite_ "main" id Nothing handleEvent buildUI2 [mergeRequired (\_ _ -> True)]
+    cmpNode1 = composite "main" id Nothing buildUI1 handleEvent
+    cmpNode2 = composite_ "main" id Nothing buildUI2 handleEvent [mergeRequired (\_ _ -> True)]
     evts1 = [evtK keyTab, evtT "aacc", moveCharL, moveCharL]
     model1 = nodeHandleEventModel wenv evts1 cmpNode1
     (wenv1, _, oldRoot1) = fst $ nodeHandleEvents wenv evts1 cmpNode1
     cntResM = widgetMerge (cmpNode2 ^. L.widget) wenv1 oldRoot1 cmpNode2
     evts2 = [evtK keyTab, evtK keyTab, evtT "bb"]
-    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.widget)
+    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.node)
 
 handleEventGlobalKey :: Spec
 handleEventGlobalKey = describe "handleEventGlobalKey" $
@@ -172,30 +172,30 @@ handleEventGlobalKey = describe "handleEventGlobalKey" $
     wenv = mockWenv (TestModel "" "")
     handleEvent :: TestModel -> () -> [EventResponse TestModel () ()]
     handleEvent model evt = []
-    buildUI1 model = hstack [
+    buildUI1 wenv model = hstack [
         vstack [
           textField text1 `globalKey` "globalTxt1"
         ],
         vstack [
           textField text1 `globalKey` "globalTxt2"
         ]
       ]
-    buildUI2 model = hstack [
+    buildUI2 wenv model = hstack [
         vstack [
           textField text1 `globalKey` "globalTxt2"
         ],
         vstack [
           textField text1 `globalKey` "globalTxt1"
         ]
       ]
-    cmpNode1 = composite "main" id Nothing handleEvent buildUI1
-    cmpNode2 = composite_ "main" id Nothing handleEvent buildUI2 [mergeRequired (\_ _ -> True)]
+    cmpNode1 = composite "main" id Nothing buildUI1 handleEvent
+    cmpNode2 = composite_ "main" id Nothing buildUI2 handleEvent [mergeRequired (\_ _ -> True)]
     evts1 = [evtK keyTab, evtT "aacc", moveCharL, moveCharL]
     model1 = nodeHandleEventModel wenv evts1 cmpNode1
     (wenv1, _, oldRoot1) = fst $ nodeHandleEvents wenv evts1 cmpNode1
     cntResM = widgetMerge (cmpNode2 ^. L.widget) wenv1 oldRoot1 cmpNode2
     evts2 = [evtK keyTab, evtK keyTab, evtT "bb"]
-    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.widget)
+    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.node)
 
 updateSizeReq :: Spec
 updateSizeReq = describe "updateSizeReq" $ do
@@ -208,12 +208,12 @@ updateSizeReq = describe "updateSizeReq" $ do
   where
     wenv = mockWenv ()
     handleEvent model evt = []
-    buildUI :: () -> WidgetNode () ()
-    buildUI model = vstack [
+    buildUI :: WidgetEnv () () -> () -> WidgetNode () ()
+    buildUI wenv model = vstack [
         label "label 1",
         label "label 2"
       ]
-    cmpNode = composite "main" id Nothing handleEvent buildUI
+    cmpNode = composite "main" id Nothing buildUI handleEvent
     (sizeReqW, sizeReqH) = nodeUpdateSizeReq wenv cmpNode
 
 resize :: Spec
@@ -231,13 +231,13 @@ resize = describe "resize" $ do
     pendingWith "Instance tree data not yet implemented"
 
   where
-    wenv = mockWenv () & L.appWindowSize .~ Size 640 480
+    wenv = mockWenv () & L.windowSize .~ Size 640 480
     vp   = Rect 0 0 640 480
     cvp1 = Rect 0 0 640 480
     handleEvent model evt = []
-    buildUI :: () -> WidgetNode () ()
-    buildUI model = hstack []
-    cmpNode = composite "main" id Nothing handleEvent buildUI
+    buildUI :: WidgetEnv () () -> () -> WidgetNode () ()
+    buildUI wenv model = hstack []
+    cmpNode = composite "main" id Nothing buildUI handleEvent
     newNode = nodeInit wenv cmpNode
     viewport = newNode ^. L.info . L.viewport
     childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children

test/unit/Monomer/Widgets/ContainerSpec.hs

@@ -66,7 +66,7 @@ handleEventNormal = describe "handleEventNormal" $
     (wenv1, _, oldRoot1) = fst $ nodeHandleEvents wenv evts1 cntNode1
     cntResM = widgetMerge (cntNode2 ^. L.widget) wenv1 oldRoot1 cntNode2
     evts2 = [evtK keyTab, evtT "bb"]
-    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.widget)
+    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.node)
 
 handleEventNoKey :: Spec
 handleEventNoKey = describe "handleEventNoKey" $
@@ -91,7 +91,7 @@ handleEventNoKey = describe "handleEventNoKey" $
     (wenv1, _, oldRoot1) = fst $ nodeHandleEvents wenv evts1 cntNode1
     cntResM = widgetMerge (cntNode2 ^. L.widget) wenv1 oldRoot1 cntNode2
     evts2 = [evtK keyTab, evtK keyTab, evtT "bb"]
-    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.widget)
+    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.node)
 
 handleEventLocalKey :: Spec
 handleEventLocalKey = describe "handleEventLocalKey" $
@@ -116,4 +116,4 @@ handleEventLocalKey = describe "handleEventLocalKey" $
     (wenv1, _, oldRoot1) = fst $ nodeHandleEvents wenv evts1 cntNode1
     cntResM = widgetMerge (cntNode2 ^. L.widget) wenv1 oldRoot1 cntNode2
     evts2 = [evtK keyTab, evtK keyTab, evtT "bb"]
-    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.widget)
+    modelM = nodeHandleEventModelNoInit wenv1 evts2 (cntResM ^. L.node)

test/unit/Monomer/Widgets/GridSpec.hs

@@ -144,7 +144,7 @@ resizeItemsH = describe "several items, horizontal" $ do
     childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
 
   where
-    wenv = mockWenv () & L.appWindowSize .~ Size 480 640
+    wenv = mockWenv () & L.windowSize .~ Size 480 640
     vp   = Rect   0 0 480 640
     cvp1 = Rect   0 0 160 640
     cvp2 = Rect 160 0 160 640

test/unit/Monomer/Widgets/StackSpec.hs

@@ -99,7 +99,7 @@ resizeFlexibleH = describe "flexible items, horizontal" $ do
     childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
 
   where
-    wenv = mockWenv () & L.appWindowSize .~ Size 480 640
+    wenv = mockWenv () & L.windowSize .~ Size 480 640
     vp   = Rect   0 0 480 640
     cvp1 = Rect   0 0 112 640
     cvp2 = Rect 112 0 256 640

test/unit/Monomer/Widgets/Util/StyleSpec.hs

@@ -59,9 +59,9 @@ testHandleSizeChange :: Spec
 testHandleSizeChange = describe "handleSizeChange" $ do
   it "should request Resize widgets if sizeReq changed" $ do
     resHover ^? _Just . L.requests `shouldSatisfy` (==3) . maybeLength
-    resHover ^? _Just . L.requests . ix 0 `shouldSatisfy` isResizeWidgets
-    resHover ^? _Just . L.requests . ix 1 `shouldSatisfy` isRenderOnce
-    resHover ^? _Just . L.requests . ix 2 `shouldSatisfy` isSetCursorIcon
+    resHover ^? _Just . L.requests . ix 0 `shouldSatisfy` isMResizeWidgets
+    resHover ^? _Just . L.requests . ix 1 `shouldSatisfy` isMRenderOnce
+    resHover ^? _Just . L.requests . ix 2 `shouldSatisfy` isMSetCursorIcon
 
   it "should not request Resize widgets if sizeReq has not changed" $
     resFocus ^? _Just . L.requests `shouldSatisfy` (==0) . maybeLength
@@ -84,17 +84,17 @@ testHandleSizeChange = describe "handleSizeChange" $ do
     resHover = handleStyleChange wenvHover path evtEnter hoverStyle Nothing node
     resFocus = handleStyleChange wenvFocus path Focus focusStyle Nothing node
 
-isResizeWidgets :: Maybe (WidgetRequest s) -> Bool
-isResizeWidgets (Just ResizeWidgets) = True
-isResizeWidgets _ = False
+isMResizeWidgets :: Maybe (WidgetRequest s) -> Bool
+isMResizeWidgets (Just ResizeWidgets) = True
+isMResizeWidgets _ = False
 
-isRenderOnce :: Maybe (WidgetRequest s) -> Bool
-isRenderOnce (Just RenderOnce{}) = True
-isRenderOnce _ = False
+isMRenderOnce :: Maybe (WidgetRequest s) -> Bool
+isMRenderOnce (Just RenderOnce{}) = True
+isMRenderOnce _ = False
 
-isSetCursorIcon :: Maybe (WidgetRequest s) -> Bool
-isSetCursorIcon (Just SetCursorIcon{}) = True
-isSetCursorIcon _ = False
+isMSetCursorIcon :: Maybe (WidgetRequest s) -> Bool
+isMSetCursorIcon (Just SetCursorIcon{}) = True
+isMSetCursorIcon _ = False
 
 maybeLength :: Maybe (Seq a) -> Int
 maybeLength Nothing = 0