Add documentation to Widgets/Util module. Remove some unused definitions.

src/Monomer/Widgets/Util/Focus.hs

@@ -1,9 +1,18 @@
+{-|
+Module      : Monomer.Widgets.Util.Focus
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Helper functions for focus handling.
+-}
 module Monomer.Widgets.Util.Focus (
   isNodeFocused,
   isNodeParentOfFocused,
   parentPath,
   nextTargetStep,
-  nextTargetPath,
   isFocusCandidate,
   isTargetReached,
   isTargetValid,
@@ -27,32 +36,92 @@ import Monomer.Widgets.Util.Widget
 
 import qualified Monomer.Lens as L
 
+-- | Checks if the given node is focused
 isNodeFocused :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeFocused wenv node = wenv ^. L.focusedPath == node ^. L.info . L.path
 
+-- | Checks if the given node is a parent of the focused node
 isNodeParentOfFocused :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeParentOfFocused wenv node = seqStartsWith parentPath focusedPath where
   parentPath = node ^. L.info . L.path
   focusedPath = wenv ^. L.focusedPath
 
+-- | Returns the parent path of a node
 parentPath :: WidgetNode s e -> Path
 parentPath node = Seq.take (Seq.length path - 1) path where
   path = node ^. L.info . L.path
 
+-- | Returns the index of the child matching the next step implied by target.
 nextTargetStep :: Path -> WidgetNode s e -> Maybe PathStep
 nextTargetStep target node = nextStep where
   currentPath = node ^. L.info . L.path
   nextStep = Seq.lookup (Seq.length currentPath) target
 
-nextTargetPath :: Path -> WidgetNode s e -> Maybe Path
-nextTargetPath target node = nextPath where
-  nextStep = nextTargetStep target node
-  nextPath = (node ^. L.info . L.path |>) <$> nextStep
-
+{-|
+Checks if the node is a candidate for next focus in the given direction. The
+node must be focusable, enabled and visible, plus having the correct position
+considering the direction.
+-}
 isFocusCandidate :: FocusDirection -> Path -> WidgetNode s e -> Bool
 isFocusCandidate FocusFwd = isFocusFwdCandidate
 isFocusCandidate FocusBwd = isFocusBwdCandidate
 
+-- | Checks if the node's path matches the target.
+isTargetReached :: Path -> WidgetNode s e -> Bool
+isTargetReached target node = target == node ^. L.info . L.path
+
+-- | Checks if the node has a child matching the next target step.
+isTargetValid :: Path -> WidgetNode s e -> Bool
+isTargetValid target node = valid where
+  children = node ^. L.children
+  valid = case nextTargetStep target node of
+    Just step -> step < Seq.length children
+    Nothing -> False
+
+-- | Checks if the node is parent of the provided path.
+isNodeParentOfPath :: Path -> WidgetNode s e -> Bool
+isNodeParentOfPath path node = result where
+  widgetPath = node ^. L.info . L.path
+  lenWidgetPath = Seq.length widgetPath
+  pathPrefix = Seq.take lenWidgetPath path
+  result = widgetPath == pathPrefix
+
+-- | Checks if the node's path is after the target (deeper or to the right).
+isNodeAfterPath :: Path -> WidgetNode s e -> Bool
+isNodeAfterPath path node = result where
+  widgetPath = node ^. L.info . L.path
+  lenPath = Seq.length path
+  lenWidgetPath = Seq.length widgetPath
+  widgetPathPrefix = Seq.take lenPath widgetPath
+  result
+    | lenWidgetPath > lenPath = path <= widgetPathPrefix
+    | otherwise = path < widgetPath
+
+-- | Checks if the node's path is after the target (higher or to the left).
+isNodeBeforePath :: Path -> WidgetNode s e -> Bool
+isNodeBeforePath path node = result where
+  widgetPath = node ^. L.info . L.path
+  result
+    | path == emptyPath = True
+    | otherwise = path > widgetPath
+
+-- | Generates a result with events and requests associated to a focus change.
+handleFocusChange
+  :: Typeable e
+  => (c -> [Path -> e])          -- ^ Getter for event handler in a config type.
+  -> (c -> [WidgetRequest s e])  -- ^ Getter for reqs handler in a config type.
+  -> c                           -- ^ The node's config.
+  -> Path                        -- ^ The path of next/prev target, accordingly.
+  -> WidgetNode s e              -- ^ The node receiving the event.
+  -> Maybe (WidgetResult s e)    -- ^ The result.
+handleFocusChange evtFn reqFn config path node = result where
+  evts = ($ path) <$> evtFn config
+  reqs = reqFn config
+  result
+    | not (null evts && null reqs) = Just $ resultReqsEvts node reqs evts
+    | otherwise = Nothing
+
+-- Helpers
 isFocusFwdCandidate :: Path -> WidgetNode s e -> Bool
 isFocusFwdCandidate startFrom node = isValid where
   info = node ^. L.info
@@ -68,52 +137,3 @@ isFocusBwdCandidate startFrom node = isValid where
   isFocusable = info ^. L.focusable
   isEnabled = info ^. L.visible && info ^. L.enabled
   isValid = isBefore && isFocusable && isEnabled
-
-isTargetReached :: Path -> WidgetNode s e -> Bool
-isTargetReached target node = target == node ^. L.info . L.path
-
-isTargetValid :: Path -> WidgetNode s e -> Bool
-isTargetValid target node = valid where
-  children = node ^. L.children
-  valid = case nextTargetStep target node of
-    Just step -> step < Seq.length children
-    Nothing -> False
-
-isNodeParentOfPath :: Path -> WidgetNode s e -> Bool
-isNodeParentOfPath path node = result where
-  widgetPath = node ^. L.info . L.path
-  lenWidgetPath = Seq.length widgetPath
-  pathPrefix = Seq.take lenWidgetPath path
-  result = widgetPath == pathPrefix
-
-isNodeAfterPath :: Path -> WidgetNode s e -> Bool
-isNodeAfterPath path node = result where
-  widgetPath = node ^. L.info . L.path
-  lenPath = Seq.length path
-  lenWidgetPath = Seq.length widgetPath
-  widgetPathPrefix = Seq.take lenPath widgetPath
-  result
-    | lenWidgetPath > lenPath = path <= widgetPathPrefix
-    | otherwise = path < widgetPath
-
-isNodeBeforePath :: Path -> WidgetNode s e -> Bool
-isNodeBeforePath path node = result where
-  widgetPath = node ^. L.info . L.path
-  result
-    | path == emptyPath = True
-    | otherwise = path > widgetPath
-
-handleFocusChange
-  :: Typeable e
-  => (c -> [Path -> e])
-  -> (c -> [WidgetRequest s e])
-  -> c
-  -> Path
-  -> WidgetNode s e
-  -> Maybe (WidgetResult s e)
-handleFocusChange evtFn reqFn config path node = result where
-  evts = ($ path) <$> evtFn config
-  reqs = reqFn config
-  result
-    | not (null evts && null reqs) = Just $ resultReqsEvts node reqs evts
-    | otherwise = Nothing

src/Monomer/Widgets/Util/Hover.hs

@@ -1,3 +1,13 @@
+{-|
+Module      : Monomer.Widgets.Util.Hover
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Helper functions for hover related actions.
+-}
 module Monomer.Widgets.Util.Hover (
   isPointInNodeVp,
   isPointInNodeEllipse,
@@ -24,24 +34,34 @@ import Monomer.Graphics.Types
 
 import qualified Monomer.Lens as L
 
+-- | Checks if the given point is inside the node's viewport.
 isPointInNodeVp :: Point -> WidgetNode s e -> Bool
 isPointInNodeVp p node = pointInRect p (node ^. L.info . L.viewport)
 
+-- | Checks if the given point is inside the ellipse delimited by the viewport.
 isPointInNodeEllipse :: Point -> WidgetNode s e -> Bool
 isPointInNodeEllipse p node = pointInEllipse p (node ^. L.info . L.viewport)
 
+-- | Checks if the main button is pressed and pointer inside the vieport.
 isNodeActive :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeActive = isNodeActive_ False
 
+-- | Checks if the main button is pressed inside the vieport.
 isNodePressed :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodePressed = isNodePressed_ False
 
+-- | Checks if the node or any of its children is active.
 isNodeTreeActive :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeTreeActive = isNodeActive_ True
 
+-- | Checks if the node or any of its children is pressed.
 isNodeTreePressed :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeTreePressed = isNodePressed_ True
 
+{-|
+Checks if the node is active, optionally including children. An active node was
+clicked with the main button and has the pointer inside its viewport.
+-}
 isNodeActive_ :: Bool -> WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeActive_ includeChildren wenv node = validPos && pressed where
   viewport = node ^. L.info . L.viewport
@@ -49,6 +69,10 @@ isNodeActive_ includeChildren wenv node = validPos && pressed where
   validPos = pointInRect mousePos viewport
   pressed = isNodePressed_ includeChildren wenv node
 
+{-|
+Checks if the node is pressed, optionally including children. A pressed node was
+clicked with the main button.
+-}
 isNodePressed_ :: Bool -> WidgetEnv s e -> WidgetNode s e -> Bool
 isNodePressed_ includeChildren wenv node = result == Just True where
   path = node ^. L.info . L.path
@@ -57,12 +81,17 @@ isNodePressed_ includeChildren wenv node = result == Just True where
     | includeChildren = seqStartsWith path <$> pressed
     | otherwise = (path ==) <$> pressed
 
+{-|
+Checks if the node is being dragged. The node must have made a previous
+request to be in that state.
+-}
 isNodeDragged :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeDragged wenv node = mainPressed && draggedPath == Just nodePath where
   mainPressed = isJust (wenv ^. L.mainBtnPress)
   draggedPath = wenv ^? L.dragStatus . _Just . _1
   nodePath = node ^. L.info . L.path
 
+-- | Checks if node is hovered. Pointer must be in viewport and node top layer.
 isNodeHovered :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeHovered wenv node = validPos && validPress && topLevel where
   viewport = node ^. L.info . L.viewport
@@ -72,6 +101,7 @@ isNodeHovered wenv node = validPos && validPress && topLevel where
   validPress = isNothing pressed || isNodePressed wenv node
   topLevel = isNodeTopLevel wenv node
 
+-- | Checks if node is hovered, limited to an elliptical shape.
 isNodeHoveredEllipse_ :: Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeHoveredEllipse_ area wenv node = validPos && validPress && topLevel where
   mousePos = wenv ^. L.inputStatus . L.mousePos
@@ -80,6 +110,9 @@ isNodeHoveredEllipse_ area wenv node = validPos && validPress && topLevel where
   validPress = isNothing pressed || isNodePressed wenv node
   topLevel = isNodeTopLevel wenv node
 
+{-|
+Checks if a node is in a top layer. Being in zstack can cause this to be False.
+-}
 isNodeTopLevel :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeTopLevel wenv node = maybe inTopLayer isPrefix (wenv ^. L.overlayPath) where
   mousePos = wenv ^. L.inputStatus . L.mousePos
@@ -87,6 +120,7 @@ isNodeTopLevel wenv node = maybe inTopLayer isPrefix (wenv ^. L.overlayPath) whe
   path = node ^. L.info . L.path
   isPrefix parent = Seq.take (Seq.length parent) path == parent
 
+-- | Checks if the node is part of the active overlay, if any.
 isNodeInOverlay :: WidgetEnv s e -> WidgetNode s e -> Bool
 isNodeInOverlay wenv node = maybe False isPrefix (wenv ^. L.overlayPath) where
   path = node ^. L.info . L.path

src/Monomer/Widgets/Util/Lens.hs

@@ -1,3 +1,13 @@
+{-|
+Module      : Monomer.Widgets.Util.Lens
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Lenses for the Widget types.
+-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TemplateHaskell #-}

src/Monomer/Widgets/Util/Parser.hs

@@ -1,3 +1,13 @@
+{-|
+Module      : Monomer.Widgets.Util.Parser
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Very basic parsing helpers used by numeric input fields.
+-}
 module Monomer.Widgets.Util.Parser where
 
 import Control.Applicative ((<|>))
@@ -6,15 +16,17 @@ import Data.Text (Text)
 import qualified Data.Attoparsec.Text as A
 import qualified Data.Text as T
 
--- Parsing helpers
+-- | Combines a list of text parsers.
 join :: [A.Parser Text] -> A.Parser Text
 join [] = return T.empty
 join (x:xs) = (<>) <$> x <*> join xs
 
+-- | Combines a parser up to a maximum of repetitions.
 upto :: Int -> A.Parser Text -> A.Parser Text
 upto n p
   | n > 0 = (<>) <$> A.try p <*> upto (n-1) p <|> return T.empty
   | otherwise = return T.empty
 
+-- | Matches a single character.
 single :: Char -> A.Parser Text
 single c = T.singleton <$> A.char c

src/Monomer/Widgets/Util/Style.hs

@@ -1,3 +1,13 @@
+{-|
+Module      : Monomer.Widgets.Util.Style
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Helper functions for style related operations.
+-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -41,17 +51,19 @@ instance Default (ActiveStyleCfg s e) where
     _ascIsActive = isNodeActive
   }
 
+-- | Extracts/copies the field of a style into an empty style.
 collectStyleField
-  :: Lens' StyleState (Maybe t)
-  -> Style
-  -> Style
+  :: Lens' StyleState (Maybe t) -- ^ The field into the state.
+  -> Style                      -- ^ The source style.
+  -> Style                      -- ^ The new style.
 collectStyleField fieldS source = collectStyleField_ fieldS source def
 
+-- | Extracts/copies the field of a style into a provided style.
 collectStyleField_
-  :: Lens' StyleState (Maybe t)
-  -> Style
-  -> Style
-  -> Style
+  :: Lens' StyleState (Maybe t) -- ^ The field into the state.
+  -> Style                      -- ^ The source style.
+  -> Style                      -- ^ The target style.
+  -> Style                      -- ^ The updated style.
 collectStyleField_ fieldS source target = style where
   basic = Just $ target ^. L.basic . non def
     & fieldS .~ source ^? L.basic . _Just . fieldS . _Just
@@ -67,10 +79,16 @@ collectStyleField_ fieldS source target = style where
     & fieldS .~ source ^? L.disabled . _Just . fieldS . _Just
   style = Style basic hover focus focusHover active disabled
 
+-- | Returns the active style for the given node.
 activeStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
 activeStyle wenv node = activeStyle_ def wenv node
 
-activeStyle_ :: ActiveStyleCfg s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
+{-|
+Returns the active style for the given node, using the provided functions to
+determine hover, focus and active status.
+-}
+activeStyle_
+  :: ActiveStyleCfg s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
 activeStyle_ config wenv node = fromMaybe def styleState where
   Style{..} = node ^. L.info . L.style
   mousePos = wenv ^. L.inputStatus . L.mousePos
@@ -86,9 +104,14 @@ activeStyle_ config wenv node = fromMaybe def styleState where
     | isFocus = _styleFocus
     | otherwise = _styleBasic
 
+-- | Returns the correct focused style, depending if it's hovered or not.
 focusedStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
 focusedStyle wenv node = focusedStyle_ isNodeHovered wenv node
 
+{-|
+Returns the correct focused style, depending if it's hovered or not, using the
+provided function.
+-}
 focusedStyle_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
 focusedStyle_ isHoveredFn wenv node = fromMaybe def styleState where
   Style{..} = node ^. L.info . L.style
@@ -97,9 +120,11 @@ focusedStyle_ isHoveredFn wenv node = fromMaybe def styleState where
     | isHover = _styleFocusHover
     | otherwise = _styleFocus
 
+-- | Returns the active theme for the node.
 activeTheme :: WidgetEnv s e -> WidgetNode s e -> ThemeState
 activeTheme wenv node = activeTheme_ isNodeHovered wenv node
 
+-- | Returns the active theme for the node.
 activeTheme_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
 activeTheme_ isHoveredFn wenv node = themeState where
   theme = _weTheme wenv
@@ -116,6 +141,7 @@ activeTheme_ isHoveredFn wenv node = themeState where
     | isFocus = _themeFocus theme
     | otherwise = _themeBasic theme
 
+-- | Checks if hover or focus states changed between versions of the node.
 styleStateChanged :: WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
 styleStateChanged wenv node evt = hoverChanged || focusChanged where
   -- Hover
@@ -123,11 +149,15 @@ styleStateChanged wenv node evt = hoverChanged || focusChanged where
   -- Focus
   focusChanged = isOnFocus evt || isOnBlur evt
 
+{-|
+Initializes the node style states. Mainly, it uses basic as the base of all the
+other styles.
+-}
 initNodeStyle
-  :: GetBaseStyle s e
-  -> WidgetEnv s e
-  -> WidgetNode s e
-  -> WidgetNode s e
+  :: GetBaseStyle s e  -- ^ The function to get the base style.
+  -> WidgetEnv s e     -- ^ The widget environment.
+  -> WidgetNode s e    -- ^ The widget node.
+  -> WidgetNode s e    -- ^ The updated widget node.
 initNodeStyle getBaseStyle wenv node = newNode where
   nodeStyle = mergeBasicStyle $ node ^. L.info . L.style
   baseStyle = mergeBasicStyle $ fromMaybe def (getBaseStyle wenv node)
@@ -135,19 +165,25 @@ initNodeStyle getBaseStyle wenv node = newNode where
   newNode = node
     & L.info . L.style .~ (themeStyle <> baseStyle <> nodeStyle)
 
+{-|
+Checks for style changes between the old node and the provided result, in the
+context of an event. Generates requests for resize, render and cursor change as
+necessary.
+-}
 handleStyleChange
-  :: WidgetEnv s e
-  -> Path
-  -> StyleState
-  -> Bool
-  -> WidgetNode s e
-  -> SystemEvent
-  -> Maybe (WidgetResult s e)
-  -> Maybe (WidgetResult s e)
+  :: WidgetEnv s e             -- ^ The widget environment.
+  -> Path                      -- ^ The target of the event.
+  -> StyleState                -- ^ The active style.
+  -> Bool                      -- ^ Whether to check/update the cursor.
+  -> WidgetNode s e            -- ^ The old node.
+  -> SystemEvent               -- ^ The event.
+  -> Maybe (WidgetResult s e)  -- ^ The result containing the new node.
+  -> Maybe (WidgetResult s e)  -- ^ The updated result.
 handleStyleChange wenv target style doCursor node evt result = newResult where
   newResult = handleSizeChange wenv target evt node result
     & handleCursorChange wenv target evt style node
 
+-- Helpers
 handleSizeChange
   :: WidgetEnv s e
   -> Path

src/Monomer/Widgets/Util/Text.hs

@@ -1,3 +1,13 @@
+{-|
+Module      : Monomer.Widgets.Util.Text
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Helper functions to text related operations in widgets.
+-}
 {-# LANGUAGE BangPatterns #-}
 
 module Monomer.Widgets.Util.Text (
@@ -17,6 +27,7 @@ import Monomer.Graphics
 
 import Monomer.Lens as L
 
+-- | Returns the text metrics of the active style.
 getTextMetrics :: WidgetEnv s e -> StyleState -> TextMetrics
 getTextMetrics wenv style = textMetrics where
   renderer = _weRenderer wenv
@@ -24,32 +35,42 @@ getTextMetrics wenv style = textMetrics where
   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
   renderer = wenv ^. L.renderer
   size = calcTextSize_ renderer style SingleLine KeepSpaces Nothing Nothing text
 
+-- | Returns the size of the text using the active style.
 getTextSize_
-  :: WidgetEnv s e
-  -> StyleState
-  -> TextMode
-  -> TextTrim
-  -> Maybe Double
-  -> Maybe Int
-  -> Text
-  -> Size
+  :: WidgetEnv s e  -- ^ The widget environment.
+  -> StyleState     -- ^ The active style.
+  -> TextMode       -- ^ Whether to use single or multi line.
+  -> TextTrim       -- ^ Whether to trim spacers or keep them.
+  -> Maybe Double   -- ^ Maximum width (required for multi line).
+  -> Maybe Int      -- ^ Max lines.
+  -> Text           -- ^ Text to measure.
+  -> Size           -- ^ The calculated size.
 getTextSize_ wenv style mode trim mwidth mlines text = newSize where
   renderer = wenv ^. L.renderer
   newSize = calcTextSize_ renderer style mode trim mwidth mlines text
 
+-- | Returns the rectangle used by a single line of text.
 getTextRect
-  :: WidgetEnv s e -> StyleState -> Rect -> AlignTH -> AlignTV -> Text -> Rect
+  :: WidgetEnv s e  -- ^ The widget environment.
+  -> StyleState     -- ^ The active style.
+  -> Rect           -- ^ The bounding rect.
+  -> AlignTH        -- ^ The horizontal alignment.
+  -> AlignTV        -- ^ The vertical alignment.
+  -> Text           -- ^ The text to measure.
+  -> Rect           -- ^ The used rect. May be larger than the bounding rect.
 getTextRect wenv style !rect !alignH !alignV !text = textRect where
   renderer = _weRenderer wenv
   font = styleFont style
   fontSize = styleFontSize style
   !textRect = calcTextRect renderer rect font fontSize alignH alignV text
 
+-- | Returns the glyphs of a single line of text.
 getTextGlyphs :: WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
 getTextGlyphs wenv style !text = glyphs where
   font = styleFont style

src/Monomer/Widgets/Util/Theme.hs

@@ -1,3 +1,13 @@
+{-|
+Module      : Monomer.Widgets.Util.Theme
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Helper functions for loading theme values.
+-}
 {-# LANGUAGE RankNTypes #-}
 
 module Monomer.Widgets.Util.Theme where
@@ -10,43 +20,13 @@ import Monomer.Core
 
 import qualified Monomer.Lens as L
 
-themeEmptyOverlay :: WidgetEnv s e -> Style
-themeEmptyOverlay wenv = collectTheme wenv L.emptyOverlayStyle
-
-themeText :: WidgetEnv s e -> Style
-themeText wenv = collectThemeField wenv L.text L.textStyle
-
-themeBtn :: WidgetEnv s e -> Style
-themeBtn wenv = collectTheme wenv L.btnStyle
-
-themeBtnMain :: WidgetEnv s e -> Style
-themeBtnMain wenv = collectTheme wenv L.btnMainStyle
-
-themeDialogFrame :: WidgetEnv s e -> Style
-themeDialogFrame wenv = collectTheme wenv L.dialogFrameStyle
-
-themeDialogTitle :: WidgetEnv s e -> Style
-themeDialogTitle wenv = collectTheme wenv L.dialogTitleStyle
-
-themeDialogCloseIcon :: WidgetEnv s e -> Style
-themeDialogCloseIcon wenv = collectTheme wenv L.dialogCloseIconStyle
-
-themeDialogMsgBody :: WidgetEnv s e -> Style
-themeDialogMsgBody wenv = collectTheme wenv L.dialogMsgBodyStyle
-
-themeDialogButtons :: WidgetEnv s e -> Style
-themeDialogButtons wenv = collectTheme wenv L.dialogButtonsStyle
-
-collectThemeField
-  :: WidgetEnv s e -> Lens' StyleState (Maybe t) -> Lens' ThemeState t -> Style
-collectThemeField wenv fieldS fieldT = collectThemeField_ wenv fieldS fieldT def
-
+-- | Updates a the field of style with the field value from the active theme.
 collectThemeField_
-  :: WidgetEnv s e
-  -> Lens' StyleState (Maybe t)
-  -> Lens' ThemeState t
-  -> Style
-  -> Style
+  :: WidgetEnv s e               -- ^ The widget environment (to get the theme).
+  -> Lens' StyleState (Maybe t)  -- ^ The target field of the style.
+  -> Lens' ThemeState t          -- ^ The source field of the theme.
+  -> Style                       -- ^ The target style.
+  -> Style                       -- ^ The updated style.
 collectThemeField_ wenv fieldStyle fieldTheme target = style where
   basic = Just $ target ^. L.basic . non def
     & fieldStyle ?~ wenv ^. L.theme . L.basic . fieldTheme
@@ -62,7 +42,11 @@ collectThemeField_ wenv fieldStyle fieldTheme target = style where
     & fieldStyle ?~ wenv ^. L.theme . L.disabled . fieldTheme
   style = Style basic hover focus focusHover active disabled
 
-collectTheme :: WidgetEnv s e  -> Lens' ThemeState StyleState -> Style
+-- | Collects all the style states from a given field in the active theme.
+collectTheme
+  :: WidgetEnv s e               -- ^ The widget environment (to get the theme).
+  -> Lens' ThemeState StyleState -- ^ The field into the theme
+  -> Style                       -- ^ The collected style.
 collectTheme wenv fieldT = style where
   basic = Just $ wenv ^. L.theme . L.basic . fieldT
   hover = Just $ wenv ^. L.theme . L.hover . fieldT
@@ -72,7 +56,12 @@ collectTheme wenv fieldT = style where
   disabled = Just $ wenv ^. L.theme . L.disabled . fieldT
   style = Style basic hover focus focusHover active disabled
 
-collectUserTheme :: WidgetEnv s e  -> String -> Style
+-- | Collects all the style states from a given entry in the map of user styles
+-- | in the active theme.
+collectUserTheme
+  :: WidgetEnv s e  -- ^ The widget environment (to get the theme).
+  -> String         -- ^ The key into the user map.
+  -> Style          -- ^ The collected style.
 collectUserTheme wenv name = style where
   basic = wenv ^. L.theme . L.basic . L.userStyleMap . at name
   hover = wenv ^. L.theme . L.hover . L.userStyleMap . at name

src/Monomer/Widgets/Util/Widget.hs

@@ -1,3 +1,13 @@
+{-|
+Module      : Monomer.Widgets.Util.Widget
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Helper functions for widget lifecycle.
+-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -18,7 +28,6 @@ module Monomer.Widgets.Util.Widget (
   resultReqsEvts,
   makeState,
   useState,
-  matchFailedMsg,
   infoMatches,
   nodeMatches,
   handleWidgetIdChange,
@@ -47,6 +56,7 @@ import Monomer.Graphics.Types
 
 import qualified Monomer.Lens as L
 
+-- | Creates a basic widget node, with the given type, instance and no children.
 defaultWidgetNode :: WidgetType -> Widget s e -> WidgetNode s e
 defaultWidgetNode widgetType widget = WidgetNode {
   _wnWidget = widget,
@@ -54,6 +64,7 @@ defaultWidgetNode widgetType widget = WidgetNode {
   _wnChildren = Seq.empty
 }
 
+-- | Checks if the node is within the visible viewport, and itself visible.
 isWidgetVisible :: WidgetEnv s e -> WidgetNode s e -> Bool
 isWidgetVisible wenv node = isVisible && isOverlapped where
   info = node ^. L.info
@@ -61,31 +72,40 @@ isWidgetVisible wenv node = isVisible && isOverlapped where
   viewport = wenv ^. L.viewport
   isOverlapped = rectsOverlap viewport (info ^. L.viewport)
 
+-- | Checks if the visibility flags changed between the old and new node.
 nodeVisibleChanged :: WidgetNode s e -> WidgetNode s e -> Bool
 nodeVisibleChanged oldNode newNode = oldVisible /= newVisible where
   oldVisible = oldNode ^. L.info . L.visible
   newVisible = newNode ^. L.info . L.visible
 
+-- | Checks if the enabled flags changed between the old and new node.
 nodeEnabledChanged :: WidgetNode s e -> WidgetNode s e -> Bool
 nodeEnabledChanged oldNode newNode = oldEnabled /= newEnabled where
   oldEnabled = oldNode ^. L.info . L.enabled
   newEnabled = newNode ^. L.info . L.enabled
 
+-- | Checks if the enabled/visible flags changed between the old and new node.
 nodeFlagsChanged :: WidgetNode s e -> WidgetNode s e -> Bool
 nodeFlagsChanged oldNode newNode = visibleChanged || enabledChanged where
   visibleChanged = nodeVisibleChanged oldNode newNode
   enabledChanged = nodeEnabledChanged oldNode newNode
 
+-- | Checks if the visibility flags changed between the old and new children.
+-- | A change in count will result in a True result.
 childrenVisibleChanged :: WidgetNode s e -> WidgetNode s e -> Bool
 childrenVisibleChanged oldNode newNode = oldVisible /= newVisible where
   oldVisible = fmap (^. L.info . L.visible) (oldNode ^. L.children)
   newVisible = fmap (^. L.info . L.visible) (newNode ^. L.children)
 
+-- | Checks if the enabled flags changed between the old and new children.
+-- | A change in count will result in a True result.
 childrenEnabledChanged :: WidgetNode s e -> WidgetNode s e -> Bool
 childrenEnabledChanged oldNode newNode = oldVisible /= newVisible where
   oldVisible = fmap (^. L.info . L.enabled) (oldNode ^. L.children)
   newVisible = fmap (^. L.info . L.enabled) (newNode ^. L.children)
 
+-- | Checks if enabled/visible flags changed between the old and new children.
+-- | A change in count will result in a True result.
 childrenFlagsChanged :: WidgetNode s e -> WidgetNode s e -> Bool
 childrenFlagsChanged oldNode newNode = lenChanged || flagsChanged where
   oldChildren = oldNode ^. L.children
@@ -93,56 +113,81 @@ childrenFlagsChanged oldNode newNode = lenChanged || flagsChanged where
   flagsChanged = or (Seq.zipWith nodeFlagsChanged oldChildren newChildren)
   lenChanged = length oldChildren /= length newChildren
 
+-- | Returns the current value associated to the WidgetData.
 widgetDataGet :: s -> WidgetData s a -> a
 widgetDataGet _ (WidgetValue value) = value
 widgetDataGet model (WidgetLens lens) = model ^# lens
 
+{-|
+Generates a model update request with the provided value when the WidgetData is
+WidgetLens. For WidgetValue and onChange event should be used.
+-}
 widgetDataSet :: WidgetData s a -> a -> [WidgetRequest s e]
 widgetDataSet WidgetValue{} _ = []
 widgetDataSet (WidgetLens lens) value = [UpdateModel updateFn] where
   updateFn model = model & lens #~ value
 
+-- | Generates a WidgetResult with only the node field filled.
 resultNode :: WidgetNode s e -> WidgetResult s e
 resultNode node = WidgetResult node Seq.empty
 
+-- | Generates a WidgetResult with the node field and events filled.
 resultEvts :: Typeable e => WidgetNode s e -> [e] -> WidgetResult s e
 resultEvts node events = result where
   result = WidgetResult node (Seq.fromList $ RaiseEvent <$> events)
 
+-- | Generates a WidgetResult with the node field and reqs filled.
 resultReqs :: WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
 resultReqs node requests = result where
   result = WidgetResult node (Seq.fromList requests)
 
+{-|
+Generates a WidgetResult with the node, events and reqs fields filled. These
+related helpers exist because list has nicer literal syntax than Seq.
+
+The events are appended __after__ the requests. If a specific order of events
+and requests is needed, add the events to reqs using RaiseEvent.
+-}
 resultReqsEvts
-  :: Typeable e => WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
+  :: Typeable e
+  => WidgetNode s e       -- ^ The new version of the node.
+  -> [WidgetRequest s e]  -- ^ The widget requests.
+  -> [e]                  -- ^ The user events.
+  -> WidgetResult s e     -- ^ The result.
 resultReqsEvts node requests events = result where
   result = WidgetResult node (Seq.fromList requests <> evtSeq)
   evtSeq = Seq.fromList $ RaiseEvent <$> events
 
+{-|
+Wraps a value in WidgetState, ignoring wenv and node. Useful when creating
+Widget instances if the state is available beforehand.
+-}
 makeState
   :: WidgetModel i => i -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
 makeState state wenv node = Just (WidgetState state)
 
+-- | Casts the wrapped value in WidgetState to the expected type, if possible.
 useState :: WidgetModel i => Maybe WidgetState -> Maybe i
 useState Nothing = Nothing
 useState (Just (WidgetState state)) = cast state
 
-matchFailedMsg :: WidgetNodeInfo -> WidgetNodeInfo -> String
-matchFailedMsg oldInfo newInfo = message where
-  oldData = (oldInfo ^. L.widgetType, oldInfo ^. L.key)
-  newData = (newInfo ^. L.widgetType, newInfo ^. L.key)
-  message = "Nodes do not match: " ++ show oldData ++ " - " ++ show newData
-
+-- | Checks if the type and key of two WidgetNodeInfo match.
 infoMatches :: WidgetNodeInfo -> WidgetNodeInfo -> Bool
 infoMatches oldInfo newInfo = typeMatches && keyMatches where
   typeMatches = oldInfo ^. L.widgetType == newInfo ^. L.widgetType
   keyMatches = oldInfo ^. L.key == newInfo ^. L.key
 
+-- | Checks if the type and key of two WidgetNodes match.
 nodeMatches :: WidgetNode s e -> WidgetNode s e -> Bool
 nodeMatches oldNode newNode = infoMatches oldInfo newInfo where
   oldInfo = oldNode ^. L.info
   newInfo = newNode ^. L.info
 
+{-|
+Checks if the path the node in the provided result changed compared to the old
+node. In case it did, it appends a SetWidgetPath request to keep track of the
+new location.
+-}
 handleWidgetIdChange :: WidgetNode s e -> WidgetResult s e -> WidgetResult s e
 handleWidgetIdChange oldNode result = newResult where
   oldPath = oldNode ^. L.info . L.path
@@ -153,16 +198,20 @@ handleWidgetIdChange oldNode result = newResult where
         & L.requests %~ (SetWidgetPath widgetId newPath <|)
     | otherwise = result
 
+-- | Returns the WidgetId associated to the given path, if any.
 findWidgetIdFromPath :: WidgetEnv s e -> Path -> Maybe WidgetId
 findWidgetIdFromPath wenv path = mwni ^? _Just . L.widgetId where
   mwni = wenv ^. L.findByPath $ path
 
+-- | Sends a message to the given node with a delay of n ms.
 delayedMessage :: Typeable i => WidgetNode s e -> i -> Int -> WidgetRequest s e
 delayedMessage node msg delay = delayedMessage_ widgetId path msg delay where
   widgetId = node ^. L.info . L.widgetId
   path = node ^. L.info . L.path
 
-delayedMessage_ :: Typeable i => WidgetId -> Path -> i -> Int -> WidgetRequest s e
+-- | Sends a message to the given WidgetId with a delay of n ms.
+delayedMessage_
+  :: Typeable i => WidgetId -> Path -> i -> Int -> WidgetRequest s e
 delayedMessage_ widgetId path msg delay = RunTask widgetId path $ do
   threadDelay (delay * 1000)
   return msg