Add V versions of widgets

app/Main.hs

@@ -127,9 +127,10 @@ handleAppEvent model evt = case evt of
   CheckboxSt st -> Task $ do
     putStrLn $ "Checkbox is: " ++ show st
     return Nothing
-  RadioSt st -> Task $ do
-    putStrLn $ "Radio is: " ++ show st
-    return Nothing
+--  RadioSt st -> Task $ do
+--    putStrLn $ "Radio is: " ++ show st
+--    return Nothing
+  RadioSt st -> Model (model & fruit .~ st)
   _ -> Model model
 
 buildUI model = trace "Creating UI" widgetTree where
@@ -160,9 +161,9 @@ buildUI model = trace "Creating UI" widgetTree where
 --    ] `key` "Main"
   widgetTree = vstack [
       hstack [
-        radio_ fruit Apple (onChange RadioSt),
-        radio_ fruit Orange (onChange RadioSt),
-        radio_ fruit Pear (onChange RadioSt)
+        radioV (model ^. fruit) RadioSt Apple,
+        radioV (model ^. fruit) RadioSt Orange,
+        radioV (model ^. fruit) RadioSt Pear
       ],
       hstack [
         checkbox condition1,
@@ -184,12 +185,6 @@ buildUI model = trace "Creating UI" widgetTree where
       integralField_ integer1 (validInput validInteger1 <> minValue 10 <> maxValue 100)
         `style` if model ^. validInteger1 then def else border 1 red,
       listView textField1 items label
---      hstack [
---        label "This is a long label",
---        label "Another long label",
---        label "Yet another long label"
---      ],
---      image "assets/images/pecans.jpg" `style` marginT 10
     ] `style` borderT 20 red <> borderL 10 blue <> borderR 10 green <> borderB 10 gray <> iradius 50 -- <> padding 20
   newLabel i = label ("New: " <> showt i) `style` altColor i
   altColor i = bgColor (if even i then gray else darkGray)

docs/design-decisions.md

@@ -6,3 +6,4 @@ Why Lens and not MicroLens?
 Why does Widget have a reference to children widget, considering the Widget may not have any?
 Why records of functions instead of typeclasses?
 Why functional dependencies instead of type families for widget combinators?
+Why do you use Lens style record field names for internal config types?

src/Monomer/Widget/Widgets/Checkbox.hs

@@ -69,11 +69,12 @@ checkbox field = checkbox_ field def
 checkbox_ :: ALens' s Bool -> CheckboxCfg s e -> WidgetInstance s e
 checkbox_ field config = checkboxD_ (WidgetLens field) def
 
-checkboxV :: Bool -> WidgetInstance s e
-checkboxV value = checkboxV_ value def
+checkboxV :: Bool -> (Bool -> e) -> WidgetInstance s e
+checkboxV value handler = checkboxV_ value handler def
 
-checkboxV_ :: Bool -> CheckboxCfg s e -> WidgetInstance s e
-checkboxV_ value config = checkboxD_ (WidgetValue value) def
+checkboxV_ :: Bool -> (Bool -> e) -> CheckboxCfg s e -> WidgetInstance s e
+checkboxV_ value handler config = checkboxD_ (WidgetValue value) newConfig where
+  newConfig = config <> onChange handler
 
 checkboxD_ :: WidgetData s Bool -> CheckboxCfg s e -> WidgetInstance s e
 checkboxD_ widgetData config = checkboxInstance where

src/Monomer/Widget/Widgets/Dropdown.hs

@@ -127,23 +127,26 @@ dropdown_ field items makeMain makeRow config = newInst where
 dropdownV
   :: (Traversable t, Eq a)
   => a
+  -> (a -> e)
   -> t a
   -> (a -> Text)
   -> (a -> WidgetInstance s e)
   -> WidgetInstance s e
-dropdownV value items makeMain makeRow = newInst where
-  newInst = dropdownV_ value items makeMain makeRow def
+dropdownV value handler items makeMain makeRow = newInst where
+  newInst = dropdownV_ value handler items makeMain makeRow def
 
 dropdownV_
   :: (Traversable t, Eq a)
   => a
+  -> (a -> e)
   -> t a
   -> (a -> Text)
   -> (a -> WidgetInstance s e)
   -> DropdownCfg s e a
   -> WidgetInstance s e
-dropdownV_ value items makeMain makeRow config = newInst where
-  newInst = dropdownD_ (WidgetValue value) items makeMain makeRow config
+dropdownV_ value handler items makeMain makeRow config = newInst where
+  newConfig = config <> onChange handler
+  newInst = dropdownD_ (WidgetValue value) items makeMain makeRow newConfig
 
 dropdownD_
   :: (Traversable t, Eq a)

src/Monomer/Widget/Widgets/FloatingField.hs

@@ -118,15 +118,19 @@ floatingField_ field config = floatingFieldD_ (WidgetLens field) config
 
 floatingFieldV
   :: FormattableFloat a
-  => a -> WidgetInstance s e
-floatingFieldV field = floatingFieldV_ field def
+  => a -> (a -> e) -> WidgetInstance s e
+floatingFieldV value handler = floatingFieldV_ value handler def
 
 floatingFieldV_
   :: FormattableFloat a
   => a
+  -> (a -> e)
   -> FloatingFieldCfg s e a
   -> WidgetInstance s e
-floatingFieldV_ field config = floatingFieldD_ (WidgetValue field) config
+floatingFieldV_ value handler config = newInst where
+  widgetData = WidgetValue value
+  newConfig = config <> onChange handler
+  newInst = floatingFieldD_ widgetData newConfig
 
 floatingFieldD_
   :: FormattableFloat a

src/Monomer/Widget/Widgets/IntegralField.hs

@@ -105,15 +105,19 @@ integralField_
   -> WidgetInstance s e
 integralField_ field config = integralFieldD_ (WidgetLens field) config
 
-integralFieldV :: FormattableInt a => a -> WidgetInstance s e
-integralFieldV field = integralFieldV_ field def
+integralFieldV :: FormattableInt a => a -> (a -> e) -> WidgetInstance s e
+integralFieldV value handler = integralFieldV_ value handler def
 
 integralFieldV_
   :: FormattableInt a
   => a
+  -> (a -> e)
   -> IntegralFieldCfg s e a
   -> WidgetInstance s e
-integralFieldV_ field config = integralFieldD_ (WidgetValue field) config
+integralFieldV_ value handler config = newInst where
+  widgetData = WidgetValue value
+  newConfig = config <> onChange handler
+  newInst = integralFieldD_ widgetData newConfig
 
 integralFieldD_
   :: FormattableInt a

src/Monomer/Widget/Widgets/ListView.hs

@@ -125,20 +125,25 @@ listView_ field items makeRow config = newInst where
 listViewV
   :: (Traversable t, Eq a)
   => a
+  -> (Int -> a -> e)
   -> t a
   -> (a -> WidgetInstance s e)
   -> WidgetInstance s e
-listViewV value items makeRow = listViewV_ value items makeRow def
+listViewV value handler items makeRow = newInst where
+  newInst = listViewV_ value handler items makeRow def
 
 listViewV_
   :: (Traversable t, Eq a)
   => a
+  -> (Int -> a -> e)
   -> t a
   -> (a -> WidgetInstance s e)
   -> ListViewCfg s e a
   -> WidgetInstance s e
-listViewV_ value items makeRow config = newInst where
-  newInst = listViewD_ (WidgetValue value) items makeRow config
+listViewV_ value handler items makeRow config = newInst where
+  widgetData = WidgetValue value
+  newConfig = config <> onChangeIdx handler
+  newInst = listViewD_ widgetData items makeRow newConfig
 
 listViewD_
   :: (Traversable t, Eq a)
@@ -147,10 +152,10 @@ listViewD_
   -> (a -> WidgetInstance s e)
   -> ListViewCfg s e a
   -> WidgetInstance s e
-listViewD_ value items makeRow config = makeInstance widget where
+listViewD_ widgetData items makeRow config = makeInstance widget where
   newItems = foldl' (|>) Empty items
   newState = ListViewState 0
-  widget = makeListView value newItems makeRow config newState
+  widget = makeListView widgetData newItems makeRow config newState
 
 makeInstance :: Widget s e -> WidgetInstance s e
 makeInstance widget = (defaultWidgetInstance "listView" widget) {

src/Monomer/Widget/Widgets/Radio.hs

@@ -69,14 +69,20 @@ radio field option = radio_ field option def
 radio_ :: (Eq a) => ALens' s a -> a -> RadioCfg s e a -> WidgetInstance s e
 radio_ field option config = radioD_ (WidgetLens field) option config
 
-radioV :: (Eq a) => a -> a -> WidgetInstance s e
-radioV value option = radioV_ value option def
+radioV :: (Eq a) => a -> (a -> e) -> a -> WidgetInstance s e
+radioV value handler option = radioV_ value handler option def
 
-radioV_ :: (Eq a) => a -> a -> RadioCfg s e a -> WidgetInstance s e
-radioV_ value option config = radioD_ (WidgetValue value) option config
+radioV_ :: (Eq a) => a -> (a -> e) -> a -> RadioCfg s e a -> WidgetInstance s e
+radioV_ value handler option config = radioD_ widgetData option newConfig where
+  widgetData = WidgetValue value
+  newConfig = config <> onChange handler
 
 radioD_
-  :: (Eq a) => WidgetData s a -> a -> RadioCfg s e a -> WidgetInstance s e
+  :: (Eq a)
+  => WidgetData s a
+  -> a
+  -> RadioCfg s e a
+  -> WidgetInstance s e
 radioD_ widgetData option config = radioInstance where
   widget = makeRadio widgetData option config
   radioInstance = (defaultWidgetInstance "radio" widget) {

src/Monomer/Widget/Widgets/TextDropdown.hs

@@ -13,6 +13,7 @@ import Data.Text (Text)
 import Monomer.Widget.Types
 import Monomer.Widget.Widgets.Label
 import Monomer.Widget.Widgets.Dropdown
+import Monomer.Widget.Widgets.WidgetCombinators
 
 textDropdown
   :: (Traversable t, Eq a)
@@ -36,21 +37,25 @@ textDropdown_ field items toText config = newInst where
 textDropdownV
   :: (Traversable t, Eq a)
   => a
+  -> (a -> e)
   -> t a
   -> (a -> Text)
   -> WidgetInstance s e
-textDropdownV value items toText = newInst where
-  newInst = textDropdownV_ value items toText def
+textDropdownV value handler items toText = newInst where
+  newInst = textDropdownV_ value handler items toText def
 
 textDropdownV_
   :: (Traversable t, Eq a)
   => a
+  -> (a -> e)
   -> t a
   -> (a -> Text)
   -> DropdownCfg s e a
   -> WidgetInstance s e
-textDropdownV_ value items toText config = newInst where
-  newInst = textDropdownD_ (WidgetValue value) items toText config
+textDropdownV_ value handler items toText config = newInst where
+  widgetData = WidgetValue value
+  newConfig = config <> onChange handler
+  newInst = textDropdownD_ widgetData items toText newConfig
 
 textDropdownD_
   :: (Traversable t, Eq a)

src/Monomer/Widget/Widgets/TextField.hs

@@ -88,11 +88,13 @@ textField field = textField_ field def
 textField_ :: ALens' s Text -> TextFieldCfg s e -> WidgetInstance s e
 textField_ field config = textFieldD_ (WidgetLens field) config
 
-textFieldV :: Text -> WidgetInstance s e
-textFieldV value = textFieldV_ value def
+textFieldV :: Text -> (Text -> e) -> WidgetInstance s e
+textFieldV value handler = textFieldV_ value handler def
 
-textFieldV_ :: Text -> TextFieldCfg s e -> WidgetInstance s e
-textFieldV_ value config = textFieldD_ (WidgetValue value) config
+textFieldV_ :: Text -> (Text -> e) -> TextFieldCfg s e -> WidgetInstance s e
+textFieldV_ value handler config = textFieldD_ widgetData newConfig where
+  widgetData = WidgetValue value
+  newConfig = config <> onChange handler
 
 textFieldD_ :: WidgetData s Text -> TextFieldCfg s e -> WidgetInstance s e
 textFieldD_ widgetData config = inputField where

tasks.md

@@ -178,9 +178,9 @@
 
 - Pending
   - textField should support textFieldV and validInputV
-  - Add mandatory event parameter for V constructors
+    - Add mandatory event parameter for V constructors
   - Why does the model update when trying to input a char in FloatingInput?
-  - Focus event not received when click and gaining focus
+  - Focus event not received after clicking and gaining focus
   - Rethink focus handling. Maybe return list of all focusable elements? Currently shift-tab is not possible
     - http://hackage.haskell.org/package/data-clist-0.1.2.3
   - Compare Cairo/Skia interfaces to make Renderer able to handle future implementations