monomer 1.0.0.2 → 1.0.0.3

raw patch · 71 files changed

+413/−278 lines, 71 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−1
• README.md +3/−3
• examples/ticker/Main.hs +32/−6
• examples/ticker/TickerTypes.hs +1/−1
• monomer.cabal +1/−1
• src/Monomer/Core/SizeReq.hs +2/−0
• src/Monomer/Core/Style.hs +2/−0
• src/Monomer/Core/StyleTypes.hs +1/−0
• src/Monomer/Core/StyleUtil.hs +1/−0
• src/Monomer/Core/ThemeTypes.hs +1/−0
• src/Monomer/Core/WidgetTypes.hs +10/−9
• src/Monomer/Graphics/FontManager.hs +1/−0
• src/Monomer/Graphics/NanoVGRenderer.hs +1/−0
• src/Monomer/Graphics/Text.hs +2/−1
• src/Monomer/Graphics/Types.hs +1/−0
• src/Monomer/Graphics/Util.hs +12/−7
• src/Monomer/Helper.hs +13/−2
• src/Monomer/Main/Core.hs +16/−16
• src/Monomer/Main/Handlers.hs +1/−0
• src/Monomer/Main/Platform.hs +8/−6
• src/Monomer/Main/Types.hs +2/−1
• src/Monomer/Main/UserUtil.hs +2/−0
• src/Monomer/Main/Util.hs +2/−1
• src/Monomer/Main/WidgetTask.hs +8/−4
• src/Monomer/Widgets/Animation/Fade.hs +1/−0
• src/Monomer/Widgets/Animation/Slide.hs +1/−0
• src/Monomer/Widgets/Composite.hs +40/−39
• src/Monomer/Widgets/Container.hs +93/−88
• src/Monomer/Widgets/Containers/Alert.hs +2/−0
• src/Monomer/Widgets/Containers/Box.hs +1/−0
• src/Monomer/Widgets/Containers/Confirm.hs +1/−0
• src/Monomer/Widgets/Containers/Draggable.hs +1/−0
• src/Monomer/Widgets/Containers/DropTarget.hs +1/−0
• src/Monomer/Widgets/Containers/Dropdown.hs +1/−0
• src/Monomer/Widgets/Containers/Grid.hs +2/−1
• src/Monomer/Widgets/Containers/Keystroke.hs +1/−0
• src/Monomer/Widgets/Containers/Scroll.hs +4/−1
• src/Monomer/Widgets/Containers/SelectList.hs +1/−0
• src/Monomer/Widgets/Containers/Split.hs +1/−0
• src/Monomer/Widgets/Containers/Stack.hs +2/−0
• src/Monomer/Widgets/Containers/ThemeSwitch.hs +1/−0
• src/Monomer/Widgets/Containers/Tooltip.hs +1/−0
• src/Monomer/Widgets/Containers/ZStack.hs +1/−1
• src/Monomer/Widgets/Single.hs +1/−0
• src/Monomer/Widgets/Singles/Base/InputField.hs +35/−33
• src/Monomer/Widgets/Singles/Button.hs +7/−5
• src/Monomer/Widgets/Singles/Checkbox.hs +3/−1
• src/Monomer/Widgets/Singles/ColorPicker.hs +1/−0
• src/Monomer/Widgets/Singles/Dial.hs +10/−8
• src/Monomer/Widgets/Singles/ExternalLink.hs +6/−5
• src/Monomer/Widgets/Singles/Image.hs +5/−3
• src/Monomer/Widgets/Singles/Label.hs +1/−0
• src/Monomer/Widgets/Singles/LabeledCheckbox.hs +1/−0
• src/Monomer/Widgets/Singles/LabeledRadio.hs +1/−0
• src/Monomer/Widgets/Singles/Radio.hs +3/−1
• src/Monomer/Widgets/Singles/SeparatorLine.hs +4/−3
• src/Monomer/Widgets/Singles/Slider.hs +13/−11
• src/Monomer/Widgets/Singles/TextArea.hs +14/−12
• src/Monomer/Widgets/Singles/TextDropdown.hs +1/−0
• src/Monomer/Widgets/Singles/TextField.hs +1/−0
• src/Monomer/Widgets/Util/Drawing.hs +1/−0
• src/Monomer/Widgets/Util/Focus.hs +2/−0
• src/Monomer/Widgets/Util/Hover.hs +2/−0
• src/Monomer/Widgets/Util/Keyboard.hs +2/−0
• src/Monomer/Widgets/Util/Parser.hs +2/−0
• src/Monomer/Widgets/Util/Style.hs +1/−0
• src/Monomer/Widgets/Util/Text.hs +6/−6
• src/Monomer/Widgets/Util/Theme.hs +1/−0
• src/Monomer/Widgets/Util/Types.hs +2/−0
• src/Monomer/Widgets/Util/Widget.hs +1/−0
• test/unit/Monomer/TestUtil.hs +0/−1

@@ -1,7 +1,13 @@+### 1.0.0.3++- Consume and forward all available messages from Producers on each cycle.+- Add Nix and GitHub Actions support (thanks @smunix!).+- Fix space leak when rebuilding the UI or handling events.+ ### 1.0.0.2  - Use the recently published nanovg-0.8.0.0 from Hackage, instead of the version from the PR's commit.-- Added `appRenderOnMainThread` option.+- Add `appRenderOnMainThread` option.  ### 1.0.0.1 

@@ -80,10 +80,10 @@  This library is licensed under the [BSD-3 license](LICENSE). -Fonts used in examples:+Fonts used in the examples: -- [Roboto](https://fonts.google.com/specimen/Roboto), licensed under the [Apache license](http://www.apache.org/licenses/LICENSE-2.0)-- [Remix Icon](https://remixicon.com), licensed under the [Apache license](http://www.apache.org/licenses/LICENSE-2.0)+- [Roboto](https://fonts.google.com/specimen/Roboto), licensed under the [Apache license](http://www.apache.org/licenses/LICENSE-2.0).+- [Remix Icon](https://remixicon.com), licensed under the [Apache license](http://www.apache.org/licenses/LICENSE-2.0).  ## Acknowledgments 

@@ -13,6 +13,7 @@ import Control.Monad.STM import Data.Aeson import Data.Default+import Data.Foldable (foldl') import Data.Maybe import Data.Scientific import Data.Text (Text)@@ -139,8 +140,8 @@       Model $ model & symbolPairs .~ moveBefore (model^.symbolPairs) target pair     ] -  TickerUpdate ticker -> [-    Model $ model & tickers . at (ticker ^. symbolPair) ?~ ticker+  TickerUpdate updates -> [+    Model (processTickerUpdates model updates)     ]    TickerError err -> [Task $ print ("Error", err) >> return TickerIgnore]@@ -149,6 +150,11 @@    TickerIgnore -> [] +processTickerUpdates :: TickerModel -> [Ticker] -> TickerModel+processTickerUpdates model updates = foldl' stepTicker model updates where+  stepTicker model ticker = model+    & tickers . at (ticker ^. symbolPair) ?~ ticker+ handleSubscription :: AppEnv -> [Text] -> Text -> IO TickerEvt handleSubscription env pairs action = do   liftIO . atomically $ writeTChan (env^.channel) req@@ -176,8 +182,11 @@  startProducer :: AppEnv -> (TickerEvt -> IO ()) -> IO () startProducer env sendMsg = do+  groupChannel <- newTChanIO+   Wuss.runSecureClient url port path $ \connection -> do-    receiveWs connection sendMsg+    groupTickers groupChannel sendMsg+    receiveWs connection groupChannel sendMsg     sendWs (env ^. channel) connection   where     url = "stream.binance.com"@@ -189,15 +198,23 @@   threadDelay 500000   subscribe env initialList -receiveWs :: WS.Connection -> (TickerEvt -> IO ()) -> IO ()-receiveWs conn sendMsg = void . forkIO . forever $ do+groupTickers :: TChan Ticker -> (TickerEvt -> IO a) -> IO ()+groupTickers channel sendMsg = void . forkIO . forever $ do+  ticker <- liftIO . atomically $ readTChan channel+  tickers <- collectJustM . liftIO . atomically $ tryReadTChan channel+  sendMsg $ TickerUpdate (ticker : tickers)++  threadDelay $ 500 * 1000++receiveWs :: WS.Connection -> TChan Ticker -> (TickerEvt -> IO ()) -> IO ()+receiveWs conn groupChannel sendMsg = void . forkIO . forever $ do   msg <- WS.receiveData conn   let serverMsg = decode msg    forM_ serverMsg $ \case     MsgResponse resp -> sendMsg $ TickerResponse resp     MsgError err -> sendMsg $ TickerError err-    MsgTicker ticker -> sendMsg $ TickerUpdate ticker+    MsgTicker ticker -> liftIO . atomically $ writeTChan groupChannel ticker  sendWs :: (Show a, ToJSON a) => TChan a -> WS.Connection -> IO () sendWs channel connection = forever $ do@@ -231,6 +248,15 @@   & L.userColorMap . at "rowBg" ?~ rgbHex "#656565"   & L.userColorMap . at "trashBg" ?~ rgbHex "#555555"   & L.userColorMap . at "trashFg" ?~ rgbHex "#909090"++collectJustM :: MonadIO m => m (Maybe a) -> m [a]+collectJustM action = do+  x <- action+  case x of+    Nothing -> return []+    Just x -> do+      xs <- collectJustM action+      return (x : xs)  formatTickerValue :: Scientific -> Text formatTickerValue = T.pack . formatScientific Fixed (Just 8)

@@ -41,7 +41,7 @@   | TickerRemovePairBegin Text   | TickerRemovePair Text   | TickerMovePair Text Text-  | TickerUpdate Ticker+  | TickerUpdate [Ticker]   | TickerError ServerError   | TickerResponse ServerResponse   deriving (Eq, Show)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           monomer-version:        1.0.0.2+version:        1.0.0.3 synopsis:       A GUI library for writing native Haskell applications. description:    Monomer is an easy to use, cross platform, GUI library for writing native                 Haskell applications.

@@ -8,6 +8,8 @@  Helper functions creating, validating and merging size requirements. -}+{-# LANGUAGE Strict #-}+ module Monomer.Core.SizeReq (   SizeReqUpdater(..),   clearExtra,

@@ -8,6 +8,8 @@  Helper functions for creating style configurations, and corresponding instances. -}+{-# LANGUAGE Strict #-}+ module Monomer.Core.Style (   module Monomer.Core.StyleTypes,   module Monomer.Core.ThemeTypes,

@@ -9,6 +9,7 @@ Basic types for styling widgets. -} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StrictData #-}  module Monomer.Core.StyleTypes where 

@@ -10,6 +10,7 @@ -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Strict #-}  module Monomer.Core.StyleUtil (   getContentArea,

@@ -9,6 +9,7 @@ Theme configuration types. -} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Strict #-}  module Monomer.Core.ThemeTypes where 

@@ -12,6 +12,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Strict #-}  module Monomer.Core.WidgetTypes where @@ -342,29 +343,29 @@ data WidgetNodeInfo =   WidgetNodeInfo {     -- | Type of the widget.-    _wniWidgetType :: !WidgetType,+    _wniWidgetType :: WidgetType,     -- | The identifier at creation time of the widget (runtime generated).-    _wniWidgetId :: !WidgetId,+    _wniWidgetId :: WidgetId,     -- | Key/Identifier of the widget (user provided). Used for merging.     _wniKey :: Maybe WidgetKey,     -- | The path of the instance in the widget tree, as a set of indexes.-    _wniPath :: !Path,+    _wniPath :: Path,     -- | The requested width for the widget. The one in style takes precedence.-    _wniSizeReqW :: !SizeReq,+    _wniSizeReqW :: SizeReq,     -- | The requested height for the widget. The one in style takes precedence.-    _wniSizeReqH :: !SizeReq,+    _wniSizeReqH :: SizeReq,     -- | Indicates if the widget is enabled for user interaction.-    _wniEnabled :: !Bool,+    _wniEnabled :: Bool,     -- | Indicates if the widget is visible.-    _wniVisible :: !Bool,+    _wniVisible :: Bool,     -- | Indicates whether the widget can receive focus.-    _wniFocusable :: !Bool,+    _wniFocusable :: Bool,     {-|     The area of the window where the widget can draw. Could be out of bounds or     partially invisible if inside a scroll. The viewport on 'WidgetEnv' defines     what is currently visible.     -}-    _wniViewport :: !Rect,+    _wniViewport :: Rect,     -- | Style attributes of the widget instance.     _wniStyle :: Style   } deriving (Eq, Show, Generic)

@@ -9,6 +9,7 @@ Provides functions for getting text dimensions and metrics. -} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}  module Monomer.Graphics.FontManager (   makeFontManager

@@ -11,6 +11,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-} {-# LANGUAGE TupleSections #-}  module Monomer.Graphics.NanoVGRenderer (makeRenderer) where

@@ -11,6 +11,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}  module Monomer.Graphics.Text (   calcTextSize,@@ -193,7 +194,7 @@   spaceV = unFontSpace $ maybe def _tlFontSpaceV (textLines ^? ix 0)   lineW line = line ^. L.size . L.w   lineH line = line ^. L.size . L.h + unFontSpace (_tlFontSpaceV line)-  width = maximum (fmap lineW textLines)+  ~width = maximum (fmap lineW textLines)   height = sum (fmap lineH textLines) - spaceV   size     | Seq.null textLines = def

@@ -11,6 +11,7 @@ Angles are always expressed in degrees, not radians. -} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Strict #-}  module Monomer.Graphics.Types where 

@@ -8,6 +8,8 @@  Helper functions for graphics related operations. -}+{-# LANGUAGE Strict #-}+ module Monomer.Graphics.Util (   clampChannel,   clampAlpha,@@ -59,14 +61,17 @@ -- | Creates a Color from a hex string. It may include a # prefix or not. rgbHex :: String -> Color rgbHex hex-  | length hex == 7 = rgbHex (tail hex)-  | length hex == 6 = rgb r g b+  | length hex == 7 = rgbHexSix (tail hex)+  | length hex == 6 = rgbHexSix hex   | otherwise = rgb 0 0 0-  where-    [r1, r2, g1, g2, b1, b2] = hex-    r = digitToInt r1 * 16 + digitToInt r2-    g = digitToInt g1 * 16 + digitToInt g2-    b = digitToInt b1 * 16 + digitToInt b2++-- | Creates a color from a six characters hex string. Fails if len is invalid.+rgbHexSix :: [Char] -> Color+rgbHexSix hex = rgb r g b where+  [r1, r2, g1, g2, b1, b2] = hex+  r = digitToInt r1 * 16 + digitToInt r2+  g = digitToInt g1 * 16 + digitToInt g2+  b = digitToInt b1 * 16 + digitToInt b2  {-| Creates a Color from a hex string plus an alpha component. It may include a #

@@ -6,11 +6,12 @@ Stability   : experimental Portability : non-portable -Helper functions used across the library. Do not belong to any specifig module-and are not directly exported.+Helper functions used across the library. They do not belong to any specific+module and are not directly exported. -} module Monomer.Helper where +import Control.Monad.IO.Class (MonadIO) import Data.Sequence (Seq(..))  import qualified Data.Sequence as Seq@@ -19,6 +20,16 @@ maybeConcat :: Monoid a => [a] -> Maybe a maybeConcat [] = Nothing maybeConcat lst = Just (mconcat lst)++-- | Runs an action until Nothing is returned, collecting the results in a list.+collectJustM :: MonadIO m => m (Maybe a) -> m [a]+collectJustM action = do+  x <- action+  case x of+    Nothing -> return []+    Just x -> do+      xs <- collectJustM action+      return (x : xs)  -- | Returns the last item in a sequence. Unsafe, fails if sequence is empty. seqLast :: Seq a -> a

@@ -8,9 +8,9 @@  Core glue for running an application. -}-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}  module Monomer.Main.Core (   AppEventResponse(..),@@ -143,7 +143,7 @@    startTs <- fmap fromIntegral SDL.ticks   model <- use L.mainModel-  os <- getPlatform+  os <- liftIO getPlatform   widgetSharedMVar <- liftIO $ newMVar Map.empty   renderer <- if useRenderThread     then return Nothing@@ -231,8 +231,8 @@   dragged <- getDraggedMsgInfo   mainPress <- use L.mainBtnPress   inputStatus <- use L.inputStatus-  mousePos <- getCurrentMousePos epr-  currWinSize <- getViewportSize window dpr+  mousePos <- liftIO $ getCurrentMousePos epr+  currWinSize <- liftIO $ getViewportSize window dpr    let Size rw rh = windowSize   let ts = startTicks - _mlFrameStartTs@@ -419,29 +419,29 @@   -> WidgetEnv s e   -> WidgetNode s e   -> IO ()-renderWidgets !window dpr renderer clearColor wenv widgetRoot = do+renderWidgets window dpr renderer clearColor wenv widgetRoot = do   Size dwW dwH <- getDrawableSize window   Size vpW vpH <- getViewportSize window dpr    let position = GL.Position 0 0   let size = GL.Size (round dwW) (round dwH) -  liftIO $ GL.viewport GL.$= (position, size)+  GL.viewport GL.$= (position, size) -  liftIO $ GL.clearColor GL.$= clearColor4-  liftIO $ GL.clear [GL.ColorBuffer]+  GL.clearColor GL.$= clearColor4+  GL.clear [GL.ColorBuffer] -  liftIO $ beginFrame renderer vpW vpH-  liftIO $ widgetRender (widgetRoot ^. L.widget) wenv widgetRoot renderer-  liftIO $ endFrame renderer+  beginFrame renderer vpW vpH+  widgetRender (widgetRoot ^. L.widget) wenv widgetRoot renderer+  endFrame renderer -  liftIO $ renderRawTasks renderer+  renderRawTasks renderer -  liftIO $ beginFrame renderer vpW vpH-  liftIO $ renderOverlays renderer-  liftIO $ endFrame renderer+  beginFrame renderer vpW vpH+  renderOverlays renderer+  endFrame renderer -  liftIO $ renderRawOverlays renderer+  renderRawOverlays renderer    SDL.glSwapWindow window   where

@@ -12,6 +12,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE Strict #-}  module Monomer.Main.Handlers (   HandlerStep,

@@ -8,6 +8,8 @@  Helper functions for SDL platform related operations. -}+{-# LANGUAGE Strict #-}+ module Monomer.Main.Platform (   defaultWindowSize,   initSDLWindow,@@ -138,20 +140,20 @@   SDL.quit  -- | Returns the current mouse position.-getCurrentMousePos :: (MonadIO m) => Double -> m Point+getCurrentMousePos :: Double -> IO Point getCurrentMousePos epr = do   SDL.P (SDL.V2 x y) <- Mouse.getAbsoluteMouseLocation   return $ Point (epr * fromIntegral x) (epr * fromIntegral y)  -- | Returns the drawable size of the provided window. May differ from window --   size if HDPI is enabled.-getDrawableSize :: (MonadIO m) => SDL.Window -> m Size+getDrawableSize :: SDL.Window -> IO Size getDrawableSize window = do   SDL.V2 fbWidth fbHeight <- SDL.glGetDrawableSize window   return $ Size (fromIntegral fbWidth) (fromIntegral fbHeight)  -- | Returns the size of the provided window.-getWindowSize :: (MonadIO m) => SDL.Window -> m Size+getWindowSize :: SDL.Window -> IO Size getWindowSize window = do   SDL.V2 rw rh <- SDL.get (SDL.windowSize window) @@ -163,16 +165,16 @@ example, on Windows and Linux Wayland this size may be smaller than the window size because of dpr scaling. -}-getViewportSize :: (MonadIO m) => SDL.Window -> Double -> m Size+getViewportSize :: SDL.Window -> Double -> IO Size getViewportSize window dpr = do   SDL.V2 fw fh <- SDL.glGetDrawableSize window    return $ Size (fromIntegral fw / dpr) (fromIntegral fh / dpr)  -- | Returns the name of the host OS.-getPlatform :: (MonadIO m) => m Text+getPlatform :: IO Text getPlatform = do-  platform <- liftIO . peekCString =<< Raw.getPlatform+  platform <- peekCString =<< Raw.getPlatform    return $ T.pack platform 

@@ -14,6 +14,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Strict #-}  module Monomer.Main.Types where @@ -85,7 +86,7 @@   -- | Main application model.   _mcMainModel :: s,   -- | Active window.-  _mcWindow :: SDL.Window,+  _mcWindow :: ~SDL.Window,   -- | Main window size.   _mcWindowSize :: Size,   -- | Device pixel rate.

@@ -9,6 +9,8 @@ Helper functions for Monomer users, to simplify common operations such as focus change and clipboard requests. -}+{-# LANGUAGE Strict #-}+ module Monomer.Main.UserUtil where  import Control.Applicative ((<|>))

@@ -10,6 +10,7 @@ -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE Strict #-}  module Monomer.Main.Util where @@ -45,7 +46,7 @@   -> Double   -> s   -> MonomerCtx s e-initMonomerCtx win channel winSize dpr epr model = MonomerCtx {+initMonomerCtx ~win channel winSize dpr epr model = MonomerCtx {   _mcMainModel = model,   _mcWindow = win,   _mcWindowSize = winSize,

@@ -10,6 +10,7 @@ message) and Producers (multiple messages). -} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Strict #-}  module Monomer.Main.WidgetTask (handleWidgetTasks) where @@ -27,6 +28,7 @@ import qualified Data.Sequence as Seq  import Monomer.Core+import Monomer.Helper (collectJustM) import Monomer.Main.Handlers import Monomer.Main.Lens import Monomer.Main.Util@@ -72,11 +74,13 @@     Just taskRes -> processTaskResult wenv widgetRoot widgetId taskRes     Nothing -> return (wenv, widgetRoot, Seq.empty) processTask wenv widgetRoot (WidgetProducer widgetId channel task) = do-  channelStatus <- liftIO . atomically $ tryReadTChan channel+  channelStatus <- collectJustM . liftIO . atomically $ tryReadTChan channel -  case channelStatus of-    Just taskMsg -> processTaskEvent wenv widgetRoot widgetId taskMsg-    Nothing -> return (wenv, widgetRoot, Seq.empty)+  foldM processMsg (wenv, widgetRoot, Seq.empty) channelStatus+  where+    processMsg (wenv1, root1, reqs1) taskMsg = do+      (wenv2, root2, reqs2) <- processTaskEvent wenv1 root1 widgetId taskMsg+      return (wenv2, root2, reqs1 <> reqs2)  processTaskResult   :: (MonomerM s e m, Typeable i)

@@ -17,6 +17,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Animation.Fade (   -- * Configuration

@@ -16,6 +16,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Animation.Slide (   -- * Configuration

@@ -19,6 +19,7 @@ - Event Handler: processes user defined events which are raised by the widgets created when building the UI. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-}@@ -266,9 +267,9 @@ }  data Composite s e sp ep = Composite {-  _cmpWidgetData :: WidgetData sp s,-  _cmpEventHandler :: EventHandler s e sp ep,-  _cmpUiBuilder :: UIBuilder s e,+  _cmpWidgetData :: !(WidgetData sp s),+  _cmpEventHandler :: !(EventHandler s e sp ep),+  _cmpUiBuilder :: !(UIBuilder s e),   _cmpMergeRequired :: MergeRequired s,   _cmpMergeReqs :: [MergeReqsHandler s e],   _cmpOnInit :: [e],@@ -280,8 +281,8 @@ }  data CompositeState s e = CompositeState {-  _cpsModel :: Maybe s,-  _cpsRoot :: WidgetNode s e,+  _cpsModel :: !(Maybe s),+  _cpsRoot :: !(WidgetNode s e),   _cpsWidgetKeyMap :: WidgetKeyMap s e } @@ -366,7 +367,7 @@ compositeD_ wType wData uiBuilder evtHandler configs = newNode where   config = mconcat configs   mergeReq = fromMaybe (/=) (_cmcMergeRequired config)-  widgetRoot = spacer+  !widgetRoot = spacer   composite = Composite {     _cmpWidgetData = wData,     _cmpEventHandler = evtHandler,@@ -382,14 +383,14 @@   }   state = CompositeState Nothing widgetRoot M.empty   widget = createComposite composite state-  newNode = defaultWidgetNode wType widget+  !newNode = defaultWidgetNode wType widget  createComposite   :: (CompositeModel s, CompositeEvent e, CompositeEvent ep, CompParentModel sp)   => Composite s e sp ep   -> CompositeState s e   -> Widget sp ep-createComposite comp state = widget where+createComposite !comp !state = widget where   widget = Widget {     widgetInit = compositeInit comp state,     widgetMerge = compositeMerge comp state,@@ -416,15 +417,15 @@   -> WidgetResult sp ep compositeInit comp state wenv widgetComp = newResult where   CompositeState{..} = state-  model = getModel comp wenv-  cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model+  !model = getModel comp wenv+  !cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model   -- Creates UI using provided function-  builtRoot = _cmpUiBuilder comp cwenv model-  tempRoot = cascadeCtx wenv widgetComp builtRoot+  !builtRoot = _cmpUiBuilder comp cwenv model+  !tempRoot = cascadeCtx wenv widgetComp builtRoot    WidgetResult root reqs = widgetInit (tempRoot ^. L.widget) cwenv tempRoot   newEvts = RaiseEvent <$> Seq.fromList (_cmpOnInit comp)-  newState = state {+  !newState = state {     _cpsModel = Just model,     _cpsRoot = root,     _cpsWidgetKeyMap = collectWidgetKeys M.empty root@@ -433,7 +434,7 @@   getBaseStyle wenv node = Nothing   styledComp = initNodeStyle getBaseStyle wenv widgetComp   tempResult = WidgetResult root (reqs <> newEvts)-  newResult = toParentResult comp newState wenv styledComp tempResult+  !newResult = toParentResult comp newState wenv styledComp tempResult  -- | Merge compositeMerge@@ -467,11 +468,11 @@     | otherwise = True   initRequired = not (nodeMatches tempRoot oldRoot) -  WidgetResult newRoot tmpReqs+  WidgetResult !newRoot !tmpReqs     | initRequired = widgetInit tempWidget cwenv tempRoot     | mergeRequired = widgetMerge tempWidget cwenv tempRoot oldRoot     | otherwise = resultNode oldRoot-  newState = validState {+  !newState = validState {     _cpsModel = Just model,     _cpsRoot = newRoot,     _cpsWidgetKeyMap = collectWidgetKeys M.empty newRoot@@ -492,7 +493,7 @@    tmpResult = WidgetResult newRoot (tmpReqs <> extraReqs <> evts)   reducedResult = toParentResult comp newState wenv styledComp tmpResult-  newResult = handleWidgetIdChange oldComp reducedResult+  !newResult = handleWidgetIdChange oldComp reducedResult  -- | Dispose compositeDispose@@ -605,18 +606,18 @@ compositeHandleEvent comp state wenv widgetComp target evt = result where   CompositeState{..} = state   widget = _cpsRoot ^. L.widget-  model = getModel comp wenv-  cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model+  !model = getModel comp wenv+  !cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model   rootEnabled = _cpsRoot ^. L.info . L.enabled   compVisible = widgetComp ^. L.info . L.visible   compEnabled = widgetComp ^. L.info . L.enabled    processEvent = toParentResult comp state wenv widgetComp-  evtResult+  !evtResult     | not (compVisible && compEnabled) = Nothing     | rootEnabled = widgetHandleEvent widget cwenv _cpsRoot target evt     | otherwise = Nothing-  result = fmap processEvent evtResult+  !result = fmap processEvent evtResult  -- | Message handling compositeHandleMessage@@ -628,7 +629,7 @@   -> Path   -> i   -> Maybe (WidgetResult sp ep)-compositeHandleMessage comp state@CompositeState{..} wenv widgetComp target arg+compositeHandleMessage comp state@CompositeState{..} !wenv !widgetComp !target arg   | isTargetReached widgetComp target = case cast arg of       Just evt -> Just $ handleMsgEvent comp state wenv widgetComp evt       Nothing -> case cast arg of@@ -637,8 +638,8 @@   | otherwise = fmap processEvent result where       processEvent = toParentResult comp state wenv widgetComp       cmpWidget = _cpsRoot ^. L.widget-      model = getModel comp wenv-      cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model+      !model = getModel comp wenv+      !cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model       result = widgetHandleMessage cmpWidget cwenv _cpsRoot target arg  -- Preferred size@@ -717,9 +718,9 @@ compositeRender comp state wenv widgetComp renderer = action where   CompositeState{..} = state   widget = _cpsRoot ^. L.widget-  model = getModel comp wenv-  cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model-  action = widgetRender widget cwenv _cpsRoot renderer+  !model = getModel comp wenv+  !cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model+  !action = widgetRender widget cwenv _cpsRoot renderer  handleMsgEvent   :: (CompositeModel s, CompositeEvent e, CompositeEvent ep, CompParentModel sp)@@ -735,10 +736,10 @@     | isJust _cpsModel = fromJust _cpsModel     | otherwise = getModel comp wenv   evtHandler = _cmpEventHandler comp-  cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model-  response = evtHandler cwenv _cpsRoot model event-  newReqs = evtResponseToRequest widgetComp _cpsWidgetKeyMap <$> response-  newResult = WidgetResult widgetComp (Seq.fromList (catMaybes newReqs))+  !cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model+  !response = evtHandler cwenv _cpsRoot model event+  !newReqs = evtResponseToRequest widgetComp _cpsWidgetKeyMap <$> response+  !newResult = WidgetResult widgetComp (Seq.fromList (catMaybes newReqs))  handleMsgUpdate   :: (CompositeModel s, CompositeEvent e, CompositeEvent ep, CompParentModel sp)@@ -753,8 +754,8 @@   model     | isJust _cpsModel = fromJust _cpsModel     | otherwise = getModel comp wenv-  newModel = fnUpdate model-  result+  !newModel = fnUpdate model+  !result     | model == newModel = resultNode widgetComp     | otherwise = mergeChild comp state wenv newModel _cpsRoot widgetComp @@ -766,7 +767,7 @@   -> WidgetNode sp ep   -> WidgetResult s e   -> WidgetResult sp ep-toParentResult comp state wenv widgetComp result = newResult where+toParentResult comp state !wenv !widgetComp !result = newResult where   WidgetResult newRoot reqs = result   widgetId = widgetComp ^. L.info . L.widgetId   newState = state {@@ -776,7 +777,7 @@     & L.widget .~ createComposite comp newState   newNode = updateSizeReq comp newState wenv newComp   newReqs = seqCatMaybes (toParentReq widgetId <$> reqs)-  newResult = WidgetResult newNode newReqs+  !newResult = WidgetResult newNode newReqs  evtResponseToRequest   :: (CompositeModel s, CompositeEvent e, CompositeEvent ep, CompParentModel sp)@@ -814,15 +815,15 @@       & L.info . L.widgetId .~ _cpsRoot ^. L.info . L.widgetId   builtWidget = builtRoot ^. L.widget   mergedResult = widgetMerge builtWidget cwenv builtRoot widgetRoot-  mergedState = state {+  !mergedState = state {     _cpsModel = Just newModel,     _cpsRoot = mergedResult ^. L.node,     _cpsWidgetKeyMap = collectWidgetKeys M.empty (mergedResult ^. L.node)   }-  result = toParentResult comp mergedState wenv widgetComp mergedResult-  newReqs = widgetDataSet (_cmpWidgetData comp) newModel+  !result = toParentResult comp mergedState wenv widgetComp mergedResult+  !newReqs = widgetDataSet (_cmpWidgetData comp) newModel     ++ fmap ($ newModel) (_cmpOnChangeReq comp)-  newResult = result+  !newResult = result     & L.requests <>~ Seq.fromList newReqs  getModel

@@ -8,6 +8,7 @@  Helper for creating widgets with children elements. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}@@ -433,7 +434,7 @@   => a   -> Container s e a   -> Widget s e-createContainer state container = Widget {+createContainer !state !container = Widget {   widgetInit = initWrapper container,   widgetMerge = mergeWrapper container,   widgetDispose = disposeWrapper container,@@ -466,16 +467,16 @@   -> WidgetNode s e   -> Int   -> WidgetEnv s e-getUpdateCWenv container wenv node cnode cidx = newWenv where+getUpdateCWenv container !wenv !node !cnode !cidx = newWenv where   cOffset = containerChildrenOffset container   updateCWenv = containerUpdateCWenv container   layoutDirection = containerLayoutDirection container-  offsetWenv wenv+  offsetWenv !wenv     | isJust cOffset = updateWenvOffset container wenv node     | otherwise = wenv-  directionWenv = wenv+  !directionWenv = wenv     & L.layoutDirection .~ layoutDirection-  newWenv = updateCWenv (offsetWenv directionWenv) node cnode cidx+  !newWenv = updateCWenv (offsetWenv directionWenv) node cnode cidx  {-| Helper function that updates widget environment based on current container@@ -621,7 +622,7 @@   -> WidgetNode s e   -> WidgetResult s e   -> WidgetResult s e-mergeChildren updateCWenv wenv newNode oldNode result = newResult where+mergeChildren updateCWenv !wenv !newNode !oldNode !result = newResult where   WidgetResult uNode uReqs = result   oldChildren = oldNode ^. L.children   oldIts = Seq.mapWithIndex (,) oldChildren@@ -639,7 +640,7 @@   removedReqs = foldMap _wrRequests removedResults   mergedNode = uNode & L.children .~ mergedChildren   newReqs = uReqs <> mergedReqs <> removedReqs-  newResult = WidgetResult mergedNode newReqs+  !newResult = WidgetResult mergedNode newReqs  mergeChildSeq   :: (Int -> WidgetNode s e -> WidgetEnv s e)@@ -651,25 +652,26 @@   -> Seq (Int, WidgetNode s e)   -> (Seq (WidgetResult s e), Seq (WidgetResult s e)) mergeChildSeq updateCWenv wenv oldKeys newKeys newNode oldIts Empty = res where-  dispose (idx, child) = case flip M.member newKeys <$> child^. L.info. L.key of+  isMember = flip M.member newKeys+  dispose (!idx, !child) = case isMember <$> child ^. L.info . L.key of     Just True -> WidgetResult child Empty     _ -> widgetDispose (child ^. L.widget) wenv child-  removed = fmap dispose oldIts-  res = (Empty, removed)+  !removed = fmap dispose oldIts+  !res = (Empty, removed) mergeChildSeq updateCWenv wenv oldKeys newKeys newNode Empty newIts = res where-  init (idx, child) = widgetInit (child ^. L.widget) wenv child-  merged = fmap init newIts-  res = (merged, Empty)+  init (idx, !child) = widgetInit (child ^. L.widget) wenv child+  !merged = fmap init newIts+  !res = (merged, Empty) mergeChildSeq updateCWenv wenv oldKeys newKeys newNode oldIts newIts = res where-  (_, oldChild) :<| oldChildren = oldIts-  (newIdx, newChild) :<| newChildren = newIts-  newWidget = newChild ^. L.widget-  newWidgetId = newChild ^. L.info . L.widgetId-  newChildKey = newChild ^. L.info . L.key-  cwenv = updateCWenv newIdx newChild+  (_, !oldChild) :<| oldChildren = oldIts+  (!newIdx, !newChild) :<| newChildren = newIts+  !newWidget = newChild ^. L.widget+  !newWidgetId = newChild ^. L.info . L.widgetId+  !newChildKey = newChild ^. L.info . L.key+  !cwenv = updateCWenv newIdx newChild    oldKeyMatch = newChildKey >>= \key -> M.lookup key oldKeys-  oldMatch = fromJust oldKeyMatch+  oldMatch = fromMaybe newNode oldKeyMatch   isMergeKey = isJust oldKeyMatch && nodeMatches newChild oldMatch    mergedOld = widgetMerge newWidget cwenv newChild oldChild@@ -677,15 +679,15 @@   initNew = widgetInit newWidget cwenv newChild     & L.requests %~ (|> ResizeWidgets newWidgetId) -  (child, oldRest)+  (!child, !oldRest)     | nodeMatches newChild oldChild = (mergedOld, oldChildren)     | isMergeKey = (mergedKey, oldIts)     | otherwise = (initNew, oldIts) -  (cmerged, cremoved)+  (!cmerged, !cremoved)     = mergeChildSeq updateCWenv wenv oldKeys newKeys newNode oldRest newChildren-  merged = child <| cmerged-  res = (merged, cremoved)+  !merged = child <| cmerged+  !res = (merged, cremoved)  mergeChildrenCheckVisible   :: WidgetNode s e@@ -695,7 +697,7 @@   newNode = result ^. L.node   widgetId = newNode ^. L.info . L.widgetId   resizeRequired = childrenVisibleChanged oldNode newNode-  newResult+  !newResult     | resizeRequired = result & L.requests %~ (|> ResizeWidgets widgetId)     | otherwise = result @@ -733,15 +735,15 @@   widgetId = node ^. L.info . L.widgetId   children = tempNode ^. L.children -  dispose idx child = widgetDispose (child ^. L.widget) cwenv child where+  dispose !idx !child = widgetDispose (child ^. L.widget) cwenv child where     cwenv = updateCWenv wenv node child idx   results = Seq.mapWithIndex dispose children   newReqs = foldMap _wrRequests results |> ResetWidgetPath widgetId-  result = WidgetResult node (reqs <> newReqs)+  !result = WidgetResult node (reqs <> newReqs)  -- | Find next focusable item defaultFindNextFocus :: ContainerFindNextFocusHandler s e-defaultFindNextFocus wenv node direction start = vchildren where+defaultFindNextFocus !wenv !node !direction !start = vchildren where   vchildren = Seq.filter (^. L.info . L.visible) (node ^. L.children)  findNextFocusWrapper@@ -751,13 +753,13 @@   -> FocusDirection   -> Path   -> Maybe WidgetNodeInfo-findNextFocusWrapper container wenv node dir start = nextFocus where+findNextFocusWrapper container !wenv !node !dir !start = nextFocus where   handler = containerFindNextFocus container   handlerResult = handler wenv node dir start   children     | dir == FocusBwd = Seq.reverse handlerResult     | otherwise = handlerResult-  nextFocus+  !nextFocus     | isFocusCandidate node start dir = Just (node ^. L.info)     | otherwise = findFocusCandidate container wenv dir start node children @@ -770,12 +772,12 @@   -> Seq (WidgetNode s e)   -> Maybe WidgetNodeInfo findFocusCandidate _ _ _ _ _ Empty = Nothing-findFocusCandidate container wenv dir start node (ch :<| chs) = result where+findFocusCandidate container !wenv !dir !start !node (ch :<| chs) = result where   updateCWenv = getUpdateCWenv container-  path = node ^. L.info . L.path-  idx = fromMaybe 0 (Seq.lookup (length path - 1) path)-  cwenv = updateCWenv wenv node ch idx-  isWidgetAfterStart+  !path = node ^. L.info . L.path+  !idx = fromMaybe 0 (Seq.lookup (length path - 1) path)+  !cwenv = updateCWenv wenv node ch idx+  !isWidgetAfterStart     | dir == FocusBwd = isNodeBeforePath ch start     | otherwise = isNodeParentOfPath ch start || isNodeAfterPath ch start @@ -786,7 +788,7 @@  -- | Find instance matching point defaultFindByPoint :: ContainerFindByPointHandler s e-defaultFindByPoint wenv node start point = result where+defaultFindByPoint !wenv !node !start !point = result where   children = node ^. L.children   pointInWidget wi = wi ^. L.visible && pointInRect point (wi ^. L.viewport)   result = Seq.findIndexL (pointInWidget . _wnInfo) children@@ -798,7 +800,7 @@   -> Path   -> Point   -> Maybe WidgetNodeInfo-findByPointWrapper container wenv node start point = result where+findByPointWrapper !container !wenv !node !start !point = result where   offset = fromMaybe def (containerChildrenOffset container)   updateCWenv = getUpdateCWenv container   ignoreEmpty = containerIgnoreEmptyArea container@@ -832,7 +834,7 @@   -> WidgetNode s e   -> Path   -> Seq WidgetNodeInfo-containerFindBranchByPath wenv node path+containerFindBranchByPath !wenv !node !path   | info ^. L.path == path = Seq.singleton info   | isJust nextChild = info <| nextInst (fromJust nextChild)   | otherwise = Seq.empty@@ -858,55 +860,57 @@   -> Path   -> SystemEvent   -> Maybe (WidgetResult s e)-handleEventWrapper container wenv node baseTarget baseEvt+handleEventWrapper container !wenv !node !baseTarget !baseEvt   | not (node ^. L.info . L.visible) || isNothing filteredEvt = Nothing   | targetReached || not targetValid = pResultStyled-  | otherwise = cResultStyled+  | otherwise = nextTargetStep pNode target >>= cResultStyled   where     -- Having targetValid = False means the next path step is not in     -- _wiChildren, but may still be valid in the receiving widget     -- For example, Composite has its own tree of child widgets with (possibly)     -- different types for Model and Events, and is candidate for the next step-    offset = fromMaybe def (containerChildrenOffset container)-    style = containerGetCurrentStyle container wenv node-    doCursor = not (containerUseCustomCursor container)+    !offset = fromMaybe def (containerChildrenOffset container)+    !style = containerGetCurrentStyle container wenv node+    !doCursor = not (containerUseCustomCursor container)     updateCWenv = getUpdateCWenv container     filterHandler = containerFilterEvent container     eventHandler = containerHandleEvent container -    targetReached = isTargetReached node target-    targetValid = isTargetValid node target-    filteredEvt = filterHandler wenv node baseTarget baseEvt-    (target, evt) = fromMaybe (baseTarget, baseEvt) filteredEvt+    !targetReached = isTargetReached node target+    !targetValid = isTargetValid node target+    !filteredEvt = filterHandler wenv node baseTarget baseEvt+    (!target, !evt) = fromMaybe (baseTarget, baseEvt) filteredEvt     -- Event targeted at parent-    pResult = eventHandler wenv node target evt+    !pResult = eventHandler wenv node target evt     pResultStyled = handleStyleChange wenv target style doCursor node evt       $ handleSizeReqChange container wenv node (Just evt) pResult-    -- Event targeted at children     pNode = maybe node (^. L.node) pResult-    cwenv = updateCWenv wenv pNode child childIdx-    childIdx = fromJust $ nextTargetStep pNode target-    children = pNode ^. L.children-    child = Seq.index children childIdx-    childWidget = child ^. L.widget-    cevt = translateEvent (negPoint offset) evt -    childrenIgnored = isJust pResult && ignoreChildren (fromJust pResult)-    parentIgnored = isJust cResult && ignoreParent (fromJust cResult)+    -- Event targeted at children+    cResultStyled childIdx = result where+      --childIdx = fromJust $ nextTargetStep pNode target+      children = pNode ^. L.children+      child = Seq.index children childIdx+      childWidget = child ^. L.widget+      cevt = translateEvent (negPoint offset) evt+      cwenv = updateCWenv wenv pNode child childIdx -    cResult-      | childrenIgnored || not (child ^. L.info . L.enabled) = Nothing-      | otherwise = widgetHandleEvent childWidget cwenv child target cevt-    cResultMerged-      | parentIgnored = mergeParentChildEvts node Nothing cResult childIdx-      | otherwise = mergeParentChildEvts pNode pResult cResult childIdx+      childrenIgnored = isJust pResult && ignoreChildren (fromJust pResult)+      parentIgnored = isJust cResult && ignoreParent (fromJust cResult) -    cpNode-      | parentIgnored = node-      | otherwise = pNode-    cResultStyled = handleStyleChange cwenv target style doCursor cpNode cevt-      $ handleSizeReqChange container cwenv cpNode (Just cevt) cResultMerged+      cResult+        | childrenIgnored || not (child ^. L.info . L.enabled) = Nothing+        | otherwise = widgetHandleEvent childWidget cwenv child target cevt+      cResultMerged+        | parentIgnored = mergeParentChildEvts node Nothing cResult childIdx+        | otherwise = mergeParentChildEvts pNode pResult cResult childIdx +      cpNode+        | parentIgnored = node+        | otherwise = pNode+      !result = handleStyleChange cwenv target style doCursor cpNode cevt+        $ handleSizeReqChange container cwenv cpNode (Just cevt) cResultMerged+ mergeParentChildEvts   :: WidgetNode s e   -> Maybe (WidgetResult s e)@@ -943,7 +947,7 @@   -> Path   -> i   -> Maybe (WidgetResult s e)-handleMessageWrapper container wenv node target arg+handleMessageWrapper container !wenv !node !target arg   | not targetReached && not targetValid = Nothing   | otherwise = handleSizeReqChange container wenv node Nothing result   where@@ -952,19 +956,20 @@      targetReached = isTargetReached node target     targetValid = isTargetValid node target-    childIdx = fromJust $ nextTargetStep node target-    children = node ^. L.children-    child = Seq.index children childIdx-    cwenv = updateCWenv wenv node child childIdx -    message = widgetHandleMessage (child ^. L.widget) cwenv child target arg-    messageResult = updateChild <$> message-    updateChild cr = cr {-      _wrNode = replaceChild node (_wrNode cr) childIdx-    }+    messageResult childIdx = updateChild <$> message where+      children = node ^. L.children+      child = Seq.index children childIdx+      cwenv = updateCWenv wenv node child childIdx++      message = widgetHandleMessage (child ^. L.widget) cwenv child target arg+      updateChild !cr = cr {+        _wrNode = replaceChild node (_wrNode cr) childIdx+      }+     result       | targetReached = handler wenv node target arg-      | otherwise = messageResult+      | otherwise = nextTargetStep node target >>= messageResult  -- | Preferred size defaultGetSizeReq :: ContainerGetSizeReqHandler s e@@ -1049,12 +1054,12 @@   children = node ^. L.children    (tempRes, assigned) = handler wenv node viewport children-  resize idx (child, vp) = newChildRes where-    cwenv = updateCWenv wenv node child idx+  resize idx (!child, !vp) = newChildRes where+    !cwenv = updateCWenv wenv node child idx     tempChildRes = widgetResize (child ^. L.widget) cwenv child vp resizeReq     cvp = tempChildRes ^. L.node . L.info . L.viewport     icvp = fromMaybe vp (intersectRects vp cvp)-    newChildRes = tempChildRes+    !newChildRes = tempChildRes       & L.node . L.info . L.viewport .~ (if useChildSize then icvp else vp)    newChildrenRes = Seq.mapWithIndex resize (Seq.zip children assigned)@@ -1082,7 +1087,7 @@   -> WidgetNode s e   -> Renderer   -> IO ()-renderWrapper container wenv node renderer =+renderWrapper container wenv !node !renderer =   drawInScissor renderer useScissor viewport $     drawStyledAction renderer viewport style $ \_ -> do       renderBefore wenv node renderer@@ -1115,7 +1120,7 @@     useChildrenScissor = isJust childrenScissor     childrenScissorRect = fromMaybe def childrenScissor     pairs = Seq.mapWithIndex (,) children-    cwenv child idx = updateCWenv wenv node child idx+    cwenv !child !idx = updateCWenv wenv node child idx  -- | Event Handling Helpers ignoreChildren :: WidgetResult s e -> Bool@@ -1128,19 +1133,19 @@  replaceChild   :: WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e-replaceChild parent child idx = parent & L.children .~ newChildren where+replaceChild !parent !child !idx = parent & L.children .~ newChildren where   newChildren = Seq.update idx child (parent ^. L.children)  cascadeCtx   :: WidgetEnv s e -> WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e-cascadeCtx wenv parent child idx = newChild where+cascadeCtx !wenv !parent !child !idx = newChild where   pInfo = parent ^. L.info   cInfo = child ^. L.info   parentPath = pInfo ^. L.path   parentVisible = pInfo ^. L.visible   parentEnabled = pInfo ^. L.enabled-  newPath = parentPath |> idx-  newChild = child+  !newPath = parentPath |> idx+  !newChild = child     & L.info . L.widgetId .~ WidgetId (wenv ^. L.timestamp) newPath     & L.info . L.path .~ newPath     & L.info . L.visible .~ (cInfo ^. L.visible && parentVisible)

@@ -9,6 +9,8 @@ Simple alert dialog, displaying a close button and optional title. Usually embedded in a zstack component and displayed/hidden depending on context. -}+{-# LANGUAGE Strict #-}+ module Monomer.Widgets.Containers.Alert (   -- * Configuration   AlertCfg,

@@ -24,6 +24,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Containers.Box (   -- * Configuration

@@ -12,6 +12,7 @@ -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Containers.Confirm (   -- * Configuration

@@ -13,6 +13,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Containers.Draggable (   -- * Configuration

@@ -16,6 +16,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Containers.DropTarget (   -- * Configuration

@@ -18,6 +18,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Containers.Dropdown (   -- * Configuration

@@ -11,6 +11,7 @@ The reverse happens for vgrid. -} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Containers.Grid (   -- * Configuration@@ -108,7 +109,7 @@     where       vreqs = accesor <$> vchildren       nreqs = Seq.length vreqs-      maxSize = foldl1 sizeReqMergeMax vreqs+      ~maxSize = foldl1 sizeReqMergeMax vreqs    resize wenv node viewport children = resized where     style = currentStyle wenv node

@@ -32,6 +32,7 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Containers.Keystroke (   -- * Configuration

@@ -23,6 +23,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Containers.Scroll (   -- * Configuration@@ -375,7 +376,9 @@   checkFwdStyle wenv node = newNode where     fwdStyle = _scScrollFwdStyle config     style = node ^. L.info . L.style-    (parentStyle, childStyle) = fromJust fwdStyle wenv style+    (parentStyle, childStyle)+      | isJust fwdStyle = fromJust fwdStyle wenv style+      | otherwise = def     newNode       | isJust fwdStyle = node         & L.info . L.style .~ parentStyle

@@ -14,6 +14,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Containers.SelectList (   -- * Configuration

@@ -14,6 +14,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Containers.Split (   -- * Configuration

@@ -11,6 +11,8 @@ the logic defined in 'SizeReq'. If the requested fixed space is larger that the viewport of the stack, the content will overflow. -}+{-# LANGUAGE Strict #-}+ module Monomer.Widgets.Containers.Stack (   -- * Configuration   StackCfg,

@@ -13,6 +13,7 @@ themeSwitch widget in a "Monomer.Widgets.Containers.Box". -} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Containers.ThemeSwitch (   -- * Configuration

@@ -16,6 +16,7 @@ -} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Containers.Tooltip (   -- * Configuration

@@ -15,9 +15,9 @@ The container will request the largest combination of horizontal and vertical size requested by its child nodes. -}-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Containers.ZStack (   -- * Configuration

@@ -10,6 +10,7 @@ -} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Single (   -- * Re-exported modules

@@ -18,6 +18,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.Base.InputField (   -- * Configuration@@ -226,7 +227,7 @@   => InputFieldCfg s e a   -> InputFieldState a   -> Widget s e-makeInputField config state = widget where+makeInputField !config !state = widget where   widget = createSingle state def {     singleFocusOnBtnPressed = False,     singleUseCustomCursor = True,@@ -242,25 +243,25 @@   }    -- Simpler access to state members-  currPlaceholder = _ifsPlaceholder state-  currVal = _ifsCurrValue state-  currText = _ifsCurrText state-  currGlyphs = _ifsGlyphs state-  currPos = _ifsCursorPos state-  currSel = _ifsSelStart state-  currOffset = _ifsOffset state-  currHistory = _ifsHistory state-  currHistIdx = _ifsHistIdx state+  !currPlaceholder = _ifsPlaceholder state+  !currVal = _ifsCurrValue state+  !currText = _ifsCurrText state+  !currGlyphs = _ifsGlyphs state+  !currPos = _ifsCursorPos state+  !currSel = _ifsSelStart state+  !currOffset = _ifsOffset state+  !currHistory = _ifsHistory state+  !currHistIdx = _ifsHistIdx state   -- Text/value conversion functions-  caretW = fromMaybe defCaretW (_ifcCaretWidth config)-  caretMs = fromMaybe defCaretMs (_ifcCaretMs config)-  fromText = _ifcFromText config-  toText = _ifcToText config-  getModelValue wenv = widgetDataGet (_weModel wenv) (_ifcValue config)+  !caretW = fromMaybe defCaretW (_ifcCaretWidth config)+  !caretMs = fromMaybe defCaretMs (_ifcCaretMs config)+  !fromText = _ifcFromText config+  !toText = _ifcToText config+  getModelValue !wenv = widgetDataGet (_weModel wenv) (_ifcValue config)   -- Mouse select handling options-  wheelHandler = _ifcWheelHandler config-  dragHandler = _ifcDragHandler config-  dragCursor = _ifcDragCursor config+  !wheelHandler = _ifcWheelHandler config+  !dragHandler = _ifcDragHandler config+  !dragCursor = _ifcDragCursor config    getBaseStyle wenv node = _ifcStyle config >>= handler where     handler lstyle = Just $ collectTheme wenv (cloneLens lstyle)@@ -504,8 +505,8 @@       | isKeyboardUndo wenv evt -> moveHistory wenv node state config (-1)       | isKeyboardRedo wenv evt -> moveHistory wenv node state config 1       | otherwise -> fmap handleKeyRes keyRes <|> cursorRes where-          keyRes = handleKeyPress wenv mod code-          handleKeyRes (newText, newPos, newSel) = result where+          !keyRes = handleKeyPress wenv mod code+          handleKeyRes (!newText, !newPos, !newSel) = result where             result = genInputResult wenv node False newText newPos newSel []           cursorReq = changeCursorReq validCursor           cursorRes@@ -613,8 +614,8 @@     newOffset = _ifsOffset tempState     history = _ifsHistory tempState     histIdx = _ifsHistIdx tempState-    newStep = HistoryStep stVal newText newPos newSel newOffset-    newState+    !newStep = HistoryStep stVal newText newPos newSel newOffset+    !newState       | currText == newText = tempState       | length history == histIdx = tempState {           _ifsHistory = history |> newStep,@@ -624,10 +625,10 @@           _ifsHistory = Seq.take (histIdx - 1) history |> newStep,           _ifsHistIdx = histIdx         }-    newNode = node+    !newNode = node       & L.widget .~ makeInputField config newState     (reqs, events) = genReqsEvents node config state newText newReqs-    result+    !result       | acceptInput || not textAdd = resultReqsEvts newNode reqs events       | otherwise = resultReqsEvts node reqs events @@ -769,7 +770,7 @@   -> Text   -> [WidgetRequest s e]   -> ([WidgetRequest s e], [e])-genReqsEvents node config state newText newReqs = result where+genReqsEvents node config !state !newText !newReqs = result where   widgetId = node ^. L.info . L.widgetId   resizeOnChange = _ifcResizeOnChange config   fromText = _ifcFromText config@@ -782,7 +783,7 @@   stateVal = fromMaybe currVal newVal   txtChanged = newText /= currText   valChanged = stateVal /= currVal-  evtValid+  !evtValid     | txtChanged = fmap ($ isValid) (_ifcValidV config)     | otherwise = []   reqValid = setModelValid config isValid@@ -795,8 +796,8 @@   reqOnChange     | accepted && valChanged = fmap ($ stateVal) (_ifcOnChangeReq config)     | otherwise = []-  reqs = newReqs ++ reqUpdateModel ++ reqValid ++ reqResize ++ reqOnChange-  result = (reqs, evtValid)+  !reqs = newReqs ++ reqUpdateModel ++ reqValid ++ reqResize ++ reqOnChange+  !result = (reqs, evtValid)  moveHistory   :: (InputFieldValue a, WidgetEvent e)@@ -824,7 +825,8 @@     newState = tempState {       _ifsHistIdx = clamp 0 lenHistory reqHistIdx     }-    newNode = node & L.widget .~ makeInputField config newState+    !newNode = node+      & L.widget .~ makeInputField config newState  newStateFromHistory   :: WidgetEnv s e@@ -835,7 +837,7 @@   -> InputFieldState a newStateFromHistory wenv node oldState config inputHist = newState where   HistoryStep hValue hText hPos hSel hOffset = inputHist-  tempState = oldState { _ifsOffset = hOffset }+  !tempState = oldState { _ifsOffset = hOffset }   newState = newTextState wenv node oldState config hValue hText hPos hSel  newTextState@@ -888,8 +890,8 @@     | Just cursor == sel = Nothing     | isJust sel && (justSel < 0 || justSel > T.length text) = Nothing     | otherwise = sel-  tmpState = updatePlaceholder wenv node oldState config-  newState = tmpState {+  !tmpState = updatePlaceholder wenv node oldState config+  !newState = tmpState {     _ifsCurrValue = value,     _ifsCurrText = text,     _ifsCursorPos = cursor,@@ -906,7 +908,7 @@   -> InputFieldState a   -> InputFieldCfg s e a   -> InputFieldState a-updatePlaceholder wenv node state config = newState where+updatePlaceholder wenv node !state !config = newState where   fontMgr = wenv ^. L.fontManager   style = currentStyle wenv node   Rect cx cy cw ch = getContentArea node style

@@ -9,9 +9,11 @@ Button widget, with support for multiline text. At the most basic level, a button consists of a caption and an event to raise when clicked. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.Button (   -- * Configuration@@ -181,11 +183,11 @@ button_ caption handler configs = buttonNode where   config = onClick handler <> mconcat configs   widget = makeButton caption config-  buttonNode = defaultWidgetNode "button" widget+  !buttonNode = defaultWidgetNode "button" widget     & L.info . L.focusable .~ True  makeButton :: WidgetEvent e => Text -> ButtonCfg s e -> Widget s e-makeButton caption config = widget where+makeButton !caption !config = widget where   widget = createContainer () def {     containerAddStyleReq = False,     containerUseScissor = True,@@ -198,7 +200,7 @@     containerResize = resize   } -  buttonType = fromMaybe ButtonNormal (_btnButtonType config)+  !buttonType = fromMaybe ButtonNormal (_btnButtonType config)    getBaseStyle wenv node     | ignoreTheme = Nothing@@ -220,9 +222,9 @@     nodeStyle = node ^. L.info . L.style     labelCfg = _btnLabelCfg config     labelCurrStyle = labelCurrentStyle childOfFocusedStyle-    labelNode = label_ caption [ignoreTheme, labelCfg, labelCurrStyle]+    !labelNode = label_ caption [ignoreTheme, labelCfg, labelCurrStyle]       & L.info . L.style .~ nodeStyle-    newNode = node+    !newNode = node       & L.children .~ Seq.singleton labelNode    init wenv node = result where

@@ -11,8 +11,10 @@ hstack). Alternatively, "Monomer.Widgets.Singles.LabeledCheckbox" provides this functionality out of the box. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.Checkbox (   -- * Configuration@@ -169,7 +171,7 @@  makeCheckbox   :: WidgetEvent e => WidgetData s Bool -> CheckboxCfg s e -> Widget s e-makeCheckbox widgetData config = widget where+makeCheckbox !widgetData !config = widget where   widget = createSingle () def {     singleGetBaseStyle = getBaseStyle,     singleHandleEvent = handleEvent,

@@ -11,6 +11,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE Strict #-} {-# LANGUAGE TemplateHaskell #-}  module Monomer.Widgets.Singles.ColorPicker (

@@ -11,12 +11,14 @@  Similar in objective to "Monomer.Widgets.Singles.Slider", but uses less space. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.Dial (   -- * Configuration@@ -222,7 +224,7 @@   -> DialCfg s e a   -> DialState   -> Widget s e-makeDial field minVal maxVal config state = widget where+makeDial !field !minVal !maxVal !config !state = widget where   widget = createSingle state def {     singleFocusOnBtnPressed = False,     singleGetBaseStyle = getBaseStyle,@@ -285,12 +287,12 @@         fastSpeed = max 1 $ round (fromIntegral maxPos / 100)         warpSpeed = max 1 $ round (fromIntegral maxPos / 10)         vPos pos = clamp 0 maxPos pos-        newResult newPos = addReqsEvts (resultNode newNode) newVal where+        newResult !newPos = addReqsEvts (resultNode newNode) newVal where           newVal = valueFromPos minVal dragRate newPos-          newState = state { _dlsPos = newPos }-          newNode = node+          !newState = state { _dlsPos = newPos }+          !newNode = node             & L.widget .~ makeDial field minVal maxVal config newState-        handleNewPos newPos+        handleNewPos !newPos           | vPos newPos /= pos = Just $ newResult (vPos newPos)           | otherwise = Nothing @@ -383,7 +385,7 @@   newVal = valueFromPos minVal dragRate newPos  valueFromPos :: DialValue a => a -> Rational -> Integer -> a-valueFromPos minVal dragRate newPos = newVal where+valueFromPos !minVal !dragRate !newPos = newVal where   newVal = minVal + fromFractional (dragRate * fromIntegral newPos)  getDialInfo :: WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)@@ -395,8 +397,8 @@   dialW = fromMaybe (theme ^. L.dialWidth) (_dlcWidth config)   dialL = _rX carea + (_rW carea - dialW) / 2   dialT = _rY carea + (_rH carea - dialW) / 2-  dialCenter = Point (dialL + dialW / 2) (dialT + dialW / 2)-  dialArea = Rect dialL dialT dialW dialW+  !dialCenter = Point (dialL + dialW / 2) (dialT + dialW / 2)+  !dialArea = Rect dialL dialT dialW dialW  currentStyleConfig :: Rect -> CurrentStyleCfg s e currentStyleConfig dialArea = def

@@ -9,9 +9,11 @@ Provides a clickable link that opens in the system's browser. It uses OS services to open the URI, which means not only URLs can be opened. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.ExternalLink (   -- * Configuration@@ -145,7 +147,7 @@  makeExternalLink   :: WidgetEvent e => Text -> Text -> ExternalLinkCfg s e -> Widget s e-makeExternalLink caption url config = widget where+makeExternalLink !caption !url !config = widget where   widget = createContainer () def {     containerAddStyleReq = False,     containerUseScissor = True,@@ -164,11 +166,10 @@     nodeStyle = node ^. L.info . L.style     labelCfg = _elcLabelCfg config     labelCurrStyle = labelCurrentStyle childOfFocusedStyle-    labelNode = label_ caption [ignoreTheme, labelCfg, labelCurrStyle]+    !labelNode = label_ caption [ignoreTheme, labelCfg, labelCurrStyle]       & L.info . L.style .~ nodeStyle-    childNode = labelNode-    newNode = node-      & L.children .~ Seq.singleton childNode+    !newNode = node+      & L.children .~ Seq.singleton labelNode    init wenv node = result where     result = resultNode (createChildNode wenv node)

@@ -15,10 +15,12 @@ - If you choose 'fitNone', adding 'imageRepeatX' and 'imageRepeatY' won't have   any kind of effect. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.Image (   -- * Configuration@@ -277,7 +279,7 @@  makeImage   :: WidgetEvent e => ImageSource -> ImageCfg e -> ImageState -> Widget s e-makeImage imgSource config state = widget where+makeImage !imgSource !config !state = widget where   widget = createSingle state def {     singleUseScissor = True,     singleInit = init,@@ -288,11 +290,11 @@     singleRender = render   } -  isImageMem = case imgSource of+  !isImageMem = case imgSource of     ImageMem{} -> True     _ -> False -  imgName source = case source of+  imgName !source = case source of     ImageMem path -> path     ImagePath path -> path 

@@ -9,6 +9,7 @@ Label widget, with support for multiline text. -} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Singles.Label (   -- * Configuration

@@ -11,6 +11,7 @@ -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Singles.LabeledCheckbox (   -- * Configuration

@@ -12,6 +12,7 @@ -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Singles.LabeledRadio (   -- * Configuration

@@ -12,8 +12,10 @@ Alternatively, 'Monomer.Widgets.Singles.LabeledRadio' provides this functionality out of the box. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.Radio (   -- * Configuration@@ -154,7 +156,7 @@     & L.info . L.focusable .~ True  makeRadio :: (Eq a, WidgetEvent e) => WidgetData s a -> a -> RadioCfg s e a -> Widget s e-makeRadio field option config = widget where+makeRadio !field !option !config = widget where   widget = createSingle () def {     singleGetBaseStyle = getBaseStyle,     singleGetCurrentStyle = getCurrentStyle,

@@ -14,7 +14,9 @@ direction, and takes all the available space in the other direction. In case of wanting a shorter line, padding should be used. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.SeparatorLine (   -- * Configuration@@ -81,15 +83,13 @@   widget = makeSeparatorLine config  makeSeparatorLine :: SeparatorLineCfg -> Widget s e-makeSeparatorLine config = widget where+makeSeparatorLine !config = widget where   widget = createSingle () def {     singleGetBaseStyle = getBaseStyle,     singleGetSizeReq = getSizeReq,     singleRender = render   } -  factor = fromMaybe 0 (_slcFactor config)-   getBaseStyle wenv node = Just style where     style = collectTheme wenv L.separatorLineStyle @@ -97,6 +97,7 @@     theme = currentTheme wenv node     direction = wenv ^. L.layoutDirection     width = fromMaybe (theme ^. L.separatorLineWidth) (_slcWidth config)+    factor = fromMaybe 0 (_slcFactor config)      isFixed = factor < 0.01     flexSide = flexSize 10 0.5

@@ -12,12 +12,14 @@ Similar in objective to 'Monomer.Widgets.Singles.Dial', but more convenient in some layouts. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.Slider (   -- * Configuration@@ -317,7 +319,7 @@   -> SliderCfg s e a   -> SliderState   -> Widget s e-makeSlider isHz field minVal maxVal config state = widget where+makeSlider !isHz !field !minVal !maxVal !config !state = widget where   widget = createSingle state def {     singleFocusOnBtnPressed = False,     singleGetBaseStyle = getBaseStyle,@@ -373,7 +375,7 @@         fastSpeed = max 1 $ round (fromIntegral maxPos / 100)         warpSpeed = max 1 $ round (fromIntegral maxPos / 10) -        handleNewPos newPos+        handleNewPos !newPos           | validPos /= pos = resultFromPos validPos []           | otherwise = Nothing           where@@ -403,22 +405,22 @@       shiftPressed = wenv ^. L.inputStatus . L.keyMod . L.leftShift       SliderState maxPos pos = state -      resultFromPoint point reqs = resultFromPos newPos reqs where-        newPos = posFromMouse isHz vp point+      resultFromPoint !point !reqs = resultFromPos newPos reqs where+        !newPos = posFromMouse isHz vp point -      resultFromPos newPos extraReqs = Just newResult where-        newState = state {+      resultFromPos !newPos !extraReqs = Just newResult where+        !newState = state {           _slsPos = newPos         }-        newNode = node+        !newNode = node           & L.widget .~ makeSlider isHz field minVal maxVal config newState-        result = resultReqs newNode [RenderOnce]-        newVal = valueFromPos newPos+        !result = resultReqs newNode [RenderOnce]+        !newVal = valueFromPos newPos -        reqs = widgetDataSet field newVal+        !reqs = widgetDataSet field newVal           ++ fmap ($ newVal) (_slcOnChangeReq config)           ++ extraReqs-        newResult+        !newResult           | pos /= newPos = result               & L.requests <>~ Seq.fromList reqs           | otherwise = result

@@ -8,11 +8,13 @@  Input field for multiline 'Text'. -}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}  module Monomer.Widgets.Singles.TextArea (   -- * Configuration@@ -239,7 +241,7 @@   -> TextAreaCfg s e   -> TextAreaState   -> Widget s e-makeTextArea wdata config state = widget where+makeTextArea !wdata !config !state = widget where   widget = createSingle state def {     singleInit = init,     singleMerge = merge,@@ -249,25 +251,25 @@     singleRender = render   } -  caretMs = fromMaybe defCaretMs (_tacCaretMs config)-  maxLength = _tacMaxLength config-  maxLines = _tacMaxLines config-  getModelValue wenv = widgetDataGet (_weModel wenv) wdata+  !caretMs = fromMaybe defCaretMs (_tacCaretMs config)+  !maxLength = _tacMaxLength config+  !maxLines = _tacMaxLines config+  getModelValue !wenv = widgetDataGet (_weModel wenv) wdata   -- State-  currText = _tasText state-  textLines = _tasTextLines state+  !currText = _tasText state+  !textLines = _tasTextLines state   -- Helpers-  validText state = validLen && validLines where+  validText !state = validLen && validLines where     text = _tasText state     lines = _tasTextLines state     validLen = T.length text <= fromMaybe maxBound maxLength     validLines = length lines <= fromMaybe maxBound maxLines-  line idx+  line !idx     | idx >= 0 && idx < length textLines = Seq.index textLines idx ^. L.text     | otherwise = ""-  lineLen = T.length . line-  totalLines = length textLines-  lastPos = (lineLen (totalLines - 1), totalLines)+  !lineLen = T.length . line+  !totalLines = length textLines+  !lastPos = (lineLen (totalLines - 1), totalLines)    init wenv node = resultNode newNode where     text = getModelValue wenv

@@ -11,6 +11,7 @@ is needed, 'Monomer.Widgets.Containers.Dropdown' can be used. -} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Singles.TextDropdown (   -- * Configuratiom

@@ -12,6 +12,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Singles.TextField (   -- * Configuration

@@ -10,6 +10,7 @@ "Monomer.Graphics.Types.Renderer". -} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Util.Drawing (   drawInScissor,

@@ -8,6 +8,8 @@  Helper functions for focus handling. -}+{-# LANGUAGE Strict #-}+ module Monomer.Widgets.Util.Focus (   isNodeFocused,   isNodeInfoFocused,

@@ -8,6 +8,8 @@  Helper functions for hover related actions. -}+{-# LANGUAGE Strict #-}+ module Monomer.Widgets.Util.Hover (   isPointInNodeVp,   isPointInNodeEllipse,

@@ -8,6 +8,8 @@  Utility functions for widget keyboard handling. -}+{-# LANGUAGE Strict #-}+ module Monomer.Widgets.Util.Keyboard (   isShortCutControl,   isKeyboardCopy,

@@ -8,6 +8,8 @@  Very basic parsing helpers used by numeric input fields. -}+{-# LANGUAGE Strict #-}+ module Monomer.Widgets.Util.Parser where  import Control.Applicative ((<|>))

@@ -10,6 +10,7 @@ -} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Util.Style (   collectStyleField,

@@ -8,7 +8,7 @@  Helper functions to text related operations in widgets. -}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Util.Text (   getTextMetrics,@@ -32,13 +32,13 @@ getTextMetrics :: WidgetEnv s e -> StyleState -> TextMetrics getTextMetrics wenv style = textMetrics where   fontMgr = wenv ^. L.fontManager-  !textMetrics = computeTextMetrics fontMgr font fontSize+  textMetrics = computeTextMetrics fontMgr font fontSize   font = styleFont style   fontSize = styleFontSize style  -- | Returns the size of the text using the active style and default options. getTextSize :: WidgetEnv s e -> StyleState -> Text -> Size-getTextSize wenv style !text = size where+getTextSize wenv style text = size where   fontMgr = wenv ^. L.fontManager   size = calcTextSize_ fontMgr style SingleLine KeepSpaces Nothing Nothing text @@ -65,7 +65,7 @@   -> AlignTV        -- ^ The vertical alignment.   -> Text           -- ^ The text to measure.   -> Rect           -- ^ The used rect. May be larger than the bounding rect.-getSingleTextLineRect wenv style !rect !alignH !alignV !text = textRect where+getSingleTextLineRect wenv style rect alignH alignV text = textRect where   fontMgr = wenv ^. L.fontManager   font = styleFont style   fSize = styleFontSize style@@ -93,9 +93,9 @@  -- | Returns the glyphs of a single line of text. getTextGlyphs :: WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos-getTextGlyphs wenv style !text = glyphs where+getTextGlyphs wenv style text = glyphs where   fontMgr = wenv ^. L.fontManager   font = styleFont style   fSize = styleFontSize style   fSpcH = styleFontSpaceH style-  !glyphs = computeGlyphsPos fontMgr font fSize fSpcH text+  glyphs = computeGlyphsPos fontMgr font fSize fSpcH text

@@ -9,6 +9,7 @@ Helper functions for loading theme values. -} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Util.Theme where 

@@ -8,6 +8,8 @@  Common types for widget related functions. -}+{-# LANGUAGE Strict #-}+ module Monomer.Widgets.Util.Types (   IsHovered,   IsFocused,

@@ -10,6 +10,7 @@ -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Strict #-}  module Monomer.Widgets.Util.Widget (   defaultWidgetNode,

@@ -33,7 +33,6 @@ import Monomer.Main.Handlers import Monomer.Main.Types import Monomer.Main.Util-import Monomer.Widgets.Util.Widget  import qualified Monomer.Lens as L