Standardize config options for label and button

app/Main.hs

@@ -145,7 +145,7 @@ buildUI model = trace "Creating UI" widgetTree where
       label (model ^. textField1) `style` [bgColor lightBlue, textLeft],
       textField textField1 `style` [bgColor lightBlue, textLeft],
       hgrid [
-        label_ "This is a really long label used to check what I did works fine" [textEllipsis] `style` [width 300],
+        label_ "This is a really long label used to check what I did works fine" [textMultiLine, textEllipsis] `style` [width 300],
         label "Jj label"
       ],
       hstack [
@@ -157,6 +157,6 @@ buildUI model = trace "Creating UI" widgetTree where
         image_ "https://picsum.photos/600/400" [fitFill, onLoadError ImageMsg]
       ],
       textDropdown_ textField1 items id [onChange DropdownVal, onChangeIdx DropdownIdx],
-      button "Click me" (PrintMessage "Button clicked")
+      button_ "Click\nme!" (PrintMessage "Button clicked") [textMultiLine]
     ] `key` "main vstack" `style` [borderT 20 red, borderL 10 blue, borderR 10 green, borderB 10 gray, iradius 50] --, padding 20
   items = fmap showt [1..100::Int]

src/Monomer/Core/Combinators.hs

@@ -49,10 +49,18 @@ class Decimals t where
 class MaxLength t where
   maxLength :: Int -> t
 
-class OnTextOverflow t where
+class TextMode_ t where
+  textSingleLine :: t
+  textMultiLine :: t
+
+class TextOverflow_ t where
   textEllipsis :: t
   textClip :: t
 
+class TextTrimSpaces t where
+  textTrimSpaces :: t
+  textKeepSpaces :: t
+
 class SelectOnBlur t where
   selectOnBlur :: Bool -> t
 

src/Monomer/Widgets/Button.hs

@@ -12,6 +12,7 @@ module Monomer.Widgets.Button (
 import Debug.Trace
 
 import Control.Applicative ((<|>))
+import Control.Lens ((^.))
 import Control.Monad (forM_)
 import Data.Default
 import Data.Maybe
@@ -30,6 +31,8 @@ data ButtonType
 data ButtonCfg s e = ButtonCfg {
   _btnButtonType :: Maybe ButtonType,
   _btnTextOverflow :: Maybe TextOverflow,
+  _btnTextMode :: Maybe TextMode,
+  _btnTrimSpaces :: Maybe Bool,
   _btnOnClick :: [e],
   _btnOnClickReq :: [WidgetRequest s]
 }
@@ -38,6 +41,8 @@ instance Default (ButtonCfg s e) where
   def = ButtonCfg {
     _btnButtonType = Nothing,
     _btnTextOverflow = Nothing,
+    _btnTextMode = Nothing,
+    _btnTrimSpaces = Nothing,
     _btnOnClick = [],
     _btnOnClickReq = []
   }
@@ -46,6 +51,8 @@ instance Semigroup (ButtonCfg s e) where
   (<>) t1 t2 = ButtonCfg {
     _btnButtonType = _btnButtonType t2 <|> _btnButtonType t1,
     _btnTextOverflow = _btnTextOverflow t2 <|> _btnTextOverflow t1,
+    _btnTextMode = _btnTextMode t2 <|> _btnTextMode t1,
+    _btnTrimSpaces = _btnTrimSpaces t2 <|> _btnTrimSpaces t1,
     _btnOnClick = _btnOnClick t1 <> _btnOnClick t2,
     _btnOnClickReq = _btnOnClickReq t1 <> _btnOnClickReq t2
   }
@@ -53,7 +60,7 @@ instance Semigroup (ButtonCfg s e) where
 instance Monoid (ButtonCfg s e) where
   mempty = def
 
-instance OnTextOverflow (ButtonCfg s e) where
+instance TextOverflow_ (ButtonCfg s e) where
   textEllipsis = def {
     _btnTextOverflow = Just Ellipsis
   }
@@ -61,6 +68,22 @@ instance OnTextOverflow (ButtonCfg s e) where
     _btnTextOverflow = Just ClipText
   }
 
+instance TextMode_ (ButtonCfg s e) where
+  textSingleLine = def {
+    _btnTextMode = Just SingleLine
+  }
+  textMultiLine = def {
+    _btnTextMode = Just MultiLine
+  }
+
+instance TextTrimSpaces (ButtonCfg s e) where
+  textTrimSpaces = def {
+    _btnTrimSpaces = Just True
+  }
+  textKeepSpaces = def {
+    _btnTrimSpaces = Just False
+  }
+
 instance OnClick (ButtonCfg s e) e where
   onClick handler = def {
     _btnOnClick = [handler]
@@ -109,6 +132,8 @@ makeButton config state = widget where
 
   buttonType = fromMaybe ButtonNormal (_btnButtonType config)
   overflow = fromMaybe Ellipsis (_btnTextOverflow config)
+  mode = fromMaybe SingleLine (_btnTextMode config)
+  trimSpaces = fromMaybe True (_btnTrimSpaces config)
   BtnState caption textLines = state
 
   getBaseStyle wenv inst = case buttonType of
@@ -126,14 +151,15 @@ makeButton config state = widget where
 
   getSizeReq wenv inst = sizeReq where
     style = activeStyle wenv inst
-    Size w h = getTextSize wenv style caption
+    targetW = fmap getMinSizeReq (style ^. L.sizeReqW)
+    Size w h = getTextSize_ wenv style mode trimSpaces targetW caption
     factor = 1
     sizeReq = (FlexSize w factor, FixedSize h)
 
   resize wenv viewport renderArea inst = newInst where
     style = activeStyle wenv inst
     rect = fromMaybe def (removeOuterBounds style renderArea)
-    newLines = fitTextToRect wenv style overflow SingleLine True rect caption
+    newLines = fitTextToRect wenv style overflow mode trimSpaces rect caption
     newWidget = makeButton config (BtnState caption newLines)
     newInst = inst {
       _wiWidget = newWidget

src/Monomer/Widgets/Label.hs

@@ -43,7 +43,7 @@ instance Semigroup LabelCfg where
 instance Monoid LabelCfg where
   mempty = def
 
-instance OnTextOverflow LabelCfg where
+instance TextOverflow_ LabelCfg where
   textEllipsis = def {
     _lscTextOverflow = Just Ellipsis
   }
@@ -51,6 +51,22 @@ instance OnTextOverflow LabelCfg where
     _lscTextOverflow = Just ClipText
   }
 
+instance TextMode_ LabelCfg where
+  textSingleLine = def {
+    _lscTextMode = Just SingleLine
+  }
+  textMultiLine = def {
+    _lscTextMode = Just MultiLine
+  }
+
+instance TextTrimSpaces LabelCfg where
+  textTrimSpaces = def {
+    _lscTrimSpaces = Just True
+  }
+  textKeepSpaces = def {
+    _lscTrimSpaces = Just False
+  }
+
 data LabelState = LabelState {
   _lstCaption :: Text,
   _lstTextLines :: Seq TextLine
@@ -77,7 +93,7 @@ makeLabel config state = widget where
   }
 
   overflow = fromMaybe Ellipsis (_lscTextOverflow config)
-  mode = fromMaybe MultiLine (_lscTextMode config)
+  mode = fromMaybe SingleLine (_lscTextMode config)
   trimSpaces = fromMaybe True (_lscTrimSpaces config)
   LabelState caption textLines = state