content: {-|
  Module      : Monomer.Widgets.Containers.Base.LabeledItem
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Container for items with an associated clickable label. Mainly used with radio
  and checkbox.
  
  For usage examples, see:
  
  - "Monomer.Widgets.Singles.LabeledCheckbox"
  - "Monomer.Widgets.Singles.LabeledRadio"
  -}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE RankNTypes #-}
  
  module Monomer.Widgets.Containers.Base.LabeledItem (
    labeledItem
  ) where
  
  import Data.Default
  import Control.Lens ((&), (^.), (^?!), (.~), (<>~), ix)
  import Data.Sequence ((|>))
  import Data.Text (Text)
  
  import qualified Data.Sequence as Seq
  
  import Monomer.Core
  import Monomer.Core.Combinators as Cmb
  
  import Monomer.Widgets.Container
  import Monomer.Widgets.Containers.Stack
  import Monomer.Widgets.Singles.Label
  
  import qualified Monomer.Lens as L
  
  {-|
  Creates a stack with a label and the provided widget, passing to this widget all
  the click events received. Positioning is configurable.
  -}
  labeledItem
    :: WidgetEvent e
    => WidgetType      -- ^ The 'WidgetType' of the provided widget.
    -> RectSide        -- ^ The side of the label.
    -> Maybe Double    -- ^ The child spacing.
    -> Text            -- ^ The caption.
    -> LabelCfg s e    -- ^ The config options.
    -> WidgetNode s e  -- ^ The child node.
    -> WidgetNode s e  -- ^ The created stack.
  labeledItem wtype textSide childSpacing caption labelCfg itemNode = labeledNode where
    widget = makeLabeledItem textSide childSpacing caption labelCfg itemNode
    labeledNode = defaultWidgetNode wtype widget
  
  makeLabeledItem
    :: WidgetEvent e
    => RectSide
    -> Maybe Double
    -> Text
    -> LabelCfg s e
    -> WidgetNode s e
    -> Widget s e
  makeLabeledItem textSide childSpacing caption labelCfg itemNode = widget where
    widget = createContainer () def {
      containerInit = init,
      containerMerge = merge,
      containerFilterEvent = filterEvent
    }
  
    createChildNode wenv node = newNode where
      nodeStyle = node ^. L.info . L.style
      labelStyle = def
        & collectStyleField_ L.text nodeStyle
        & collectStyleField_ L.cursorIcon nodeStyle
      itemStyle = def
        & collectStyleField_ L.fgColor nodeStyle
        & collectStyleField_ L.hlColor nodeStyle
        & collectStyleField_ L.sndColor nodeStyle
        & collectStyleField_ L.cursorIcon nodeStyle
  
      baseLabel = label_ caption [labelCfg] `styleBasic` [cursorHand]
      labelNode = baseLabel
        & L.info . L.style <>~ labelStyle
      styledNode = itemNode
        & L.info . L.style <>~ itemStyle
  
      childNode
        | textSide == SideLeft = hstack_ stackCfg [ labelNode, styledNode ]
        | textSide == SideRight = hstack_ stackCfg [ styledNode, labelNode ]
        | textSide == SideTop = vstack_ stackCfg [ labelNode, styledNode ]
        | otherwise = vstack_ stackCfg [ styledNode, labelNode ]
      stackCfg =
        [maybe Cmb.childSpacing Cmb.childSpacing_ childSpacing]
      newNode = node
        & L.children .~ Seq.singleton childNode
  
    init wenv node = result where
      result = resultNode (createChildNode wenv node)
  
    merge wenv node oldNode oldState = result where
      result = resultNode (createChildNode wenv node)
  
    filterEvent :: ContainerFilterHandler s e
    filterEvent wenv node target evt = case evt of
      Click p btn clicks
        | isPointInNodeVp labelNode p -> Just (newPath, newEvt) where
          newEvt = Click targetCenter btn clicks
  
      ButtonAction p btn BtnPressed clicks
        | isPointInNodeVp labelNode p -> Just (newPath, newEvt) where
          newEvt = ButtonAction targetCenter btn BtnPressed clicks
  
      _ -> Just (target, evt)
      where
        labelIdx
          | textSide `elem` [SideLeft, SideTop] = 0
          | otherwise = 1
        targetIdx = 1 - labelIdx
        newPath = Seq.take (length target - 1) target |> targetIdx
        labelNode = node ^. L.children . ix 0 . L.children ^?! ix labelIdx
        targetNode = node ^. L.children . ix 0 . L.children ^?! ix targetIdx
        targetCenter = rectCenter (targetNode ^. L.info . L.viewport)
  