content: {-|
  Module      : Monomer.Widgets.Containers.Stack
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Container that stacks its children along a main axis.
  
  An hstack widget will assign horizontal space to its children according to their
  size requests. The inverse happens with vstack and vertical space, which assigns
  vertical space as requested and all the horizontal space available.
  
  For example, a label will get enough space to be displayed completely, and it
  will also get all the vertical space the hstack has. This means that if the
  hstack is the top level widget in the window, the label will also be as tall as
  the window.
  
  Both can be combined to create complex layouts. Considering the situation of a
  top-level hstack which created a large vertical label, we could wrap the hstack
  with a vstack to only use as much horizontal and vertical space as needed. Both
  stack widgets will request space from their parent, along their corresponding
  axis, based on the requests of their children.
  
  The layout algorithm considers the different type of size requirements and
  assigns space according to the logic defined in 'SizeReq'. If the requested
  fixed space is larger that the viewport of the stack, the content will overflow.
  
  @
  vstack_ [childSpacing] [
      label "Selected image",
      image "assets/large-image.jpg"
        \`styleBasic\` [maxHeight 400],
      button \"Complete\" CompleteAction
    ]
  @
  -}
  {-# LANGUAGE Strict #-}
  
  module Monomer.Widgets.Containers.Stack (
    -- * Configuration
    StackCfg,
    -- * Constructors
    hstack,
    hstack_,
    vstack,
    vstack_,
    -- * Helpers
    assignStackAreas
  ) where
  
  import Control.Applicative ((<|>))
  import Control.Lens ((&), (.~), (%~))
  import Data.Default
  import Data.List (foldl')
  import Data.Maybe
  import Data.Sequence (Seq(..), (|>))
  
  import qualified Data.Sequence as Seq
  
  import Monomer.Helper (applyFnList)
  import Monomer.Widgets.Container
  
  import qualified Monomer.Lens as L
  
  {-|
  Configuration options for stack:
  
  - 'childSpacing': spacing between the child widgets.
  - 'ignoreEmptyArea': when the widgets do not use all the available space,
    ignoring the unassigned space allows for mouse events to pass through. This is
    useful in zstack layers.
  - 'sizeReqUpdater': allows modifying the 'SizeReq' generated by the stack.
  -}
  data StackCfg = StackCfg {
    _stcChildSpacing :: Maybe Double,
    _stcIgnoreEmptyArea :: Maybe Bool,
    _stcSizeReqUpdater :: [SizeReqUpdater]
  }
  
  instance Default StackCfg where
    def = StackCfg {
      _stcChildSpacing = Nothing,
      _stcIgnoreEmptyArea = Nothing,
      _stcSizeReqUpdater = []
    }
  
  instance Semigroup StackCfg where
    (<>) s1 s2 = StackCfg {
      _stcChildSpacing = _stcChildSpacing s2 <|> _stcChildSpacing s1,
      _stcIgnoreEmptyArea = _stcIgnoreEmptyArea s2 <|> _stcIgnoreEmptyArea s1,
      _stcSizeReqUpdater = _stcSizeReqUpdater s1 <> _stcSizeReqUpdater s2
    }
  
  instance Monoid StackCfg where
    mempty = def
  
  instance CmbChildSpacing StackCfg where
    childSpacing_ spacing = def {
      _stcChildSpacing = Just spacing
    }
  
  instance CmbIgnoreEmptyArea StackCfg where
    ignoreEmptyArea_ ignore = def {
      _stcIgnoreEmptyArea = Just ignore
    }
  
  instance CmbSizeReqUpdater StackCfg where
    sizeReqUpdater updater = def {
      _stcSizeReqUpdater = [updater]
    }
  
  -- | Creates a horizontal stack.
  hstack
    :: (Traversable t)
    => t (WidgetNode s e)  -- ^ The list of items.
    -> WidgetNode s e      -- ^ The created stack.
  hstack children = hstack_ def children
  
  -- | Creates a horizontal stack. Accepts config.
  hstack_
    :: (Traversable t)
    => [StackCfg]          -- ^ The config options.
    -> t (WidgetNode s e)  -- ^ The list of items.
    -> WidgetNode s e      -- ^ The created stack.
  hstack_ configs children = newNode where
    config = mconcat configs
    newNode = defaultWidgetNode "hstack" (makeStack True config)
      & L.children .~ foldl' (|>) Empty children
  
  -- | Creates a vertical stack.
  vstack
    :: (Traversable t)
    => t (WidgetNode s e)  -- ^ The list of items.
    -> WidgetNode s e      -- ^ The created stack.
  vstack children = vstack_ def children
  
  -- | Creates a vertical stack. Accepts config.
  vstack_
    :: (Traversable t)
    => [StackCfg]          -- ^ The config options.
    -> t (WidgetNode s e)  -- ^ The list of items.
    -> WidgetNode s e      -- ^ The created stack.
  vstack_ configs children = newNode where
    config = mconcat configs
    newNode = defaultWidgetNode "vstack" (makeStack False config)
      & L.children .~ foldl' (|>) Empty children
  
  makeStack :: Bool -> StackCfg -> Widget s e
  makeStack isHorizontal config = widget where
    widget = createContainer () def {
      containerIgnoreEmptyArea = ignoreEmptyArea,
      containerLayoutDirection = getLayoutDirection isHorizontal,
      containerUseCustomSize = True,
      containerGetSizeReq = getSizeReq,
      containerResize = resize
    }
  
    isVertical = not isHorizontal
    ignoreEmptyArea = fromMaybe False (_stcIgnoreEmptyArea config)
    childSpacing = fromMaybe 0 (_stcChildSpacing config)
  
    getSizeReq wenv node children = newSizeReq where
      sizeReqFns = _stcSizeReqUpdater config
      vchildren = Seq.filter (_wniVisible . _wnInfo) children
      newSizeReqW = getDimSizeReq isHorizontal (_wniSizeReqW . _wnInfo) vchildren
      newSizeReqH = getDimSizeReq isVertical (_wniSizeReqH . _wnInfo) vchildren
      newSizeReq = applyFnList sizeReqFns (newSizeReqW, newSizeReqH)
  
    getDimSizeReq mainAxis accessor vchildren
      | Seq.null vreqs = fixedSize 0
      | mainAxis = foldl1 sizeReqMergeSum vreqs & L.fixed %~ (+ totalSpacing)
      | otherwise = foldl1 sizeReqMergeMax vreqs
      where
        vreqs = accessor <$> vchildren
        totalSpacing = fromIntegral (Seq.length vchildren - 1) * childSpacing
  
    resize wenv node viewport children = resized where
      style = currentStyle wenv node
      contentArea = fromMaybe def (removeOuterBounds style viewport)
      (newVps, newDim) = assignStackAreas isHorizontal contentArea childSpacing children
      newCa
        | isHorizontal = contentArea & L.w .~ newDim
        | otherwise = contentArea & L.h .~ newDim
      newNode = node
        & L.info . L.viewport .~ fromMaybe newCa (addOuterBounds style newCa)
      resized = (resultNode newNode, newVps)
  
  {-|
  Assigns space from rect to each of the provided widgets based on their size
  requirements.
  -}
  assignStackAreas
    :: Bool                 -- ^ True if horizontal, False for vertical.
    -> Rect                 -- ^ The available space to assign.
    -> Double               -- ^ The spacing between adjacent children.
    -> Seq (WidgetNode s e) -- ^ The widgets that will be assigned space.
    -> (Seq Rect, Double)   -- ^ The assigned areas and used space in main axis.
  assignStackAreas isHorizontal contentArea childSpacing children = result where
    Rect x y w h = contentArea
    mainSize = if isHorizontal then w else h
    mainStart = if isHorizontal then x else y
    rectSelector
      | isHorizontal = _rW
      | otherwise = _rH
    vchildren = Seq.filter (_wniVisible . _wnInfo) children
    reqs = fmap (mainReqSelector isHorizontal) vchildren
  
    sumSizes accum req = newStep where
      (cFixed, cFlex, cFlexFac, cExtraFac) = accum
      newFixed = cFixed + sizeReqFixed req
      newFlex = cFlex + sizeReqFlex req
      newFlexFac = cFlexFac + sizeReqFlex req * sizeReqFactor req
      newExtraFac = cExtraFac + sizeReqExtra req * sizeReqFactor req
      newStep = (newFixed, newFlex, newFlexFac, newExtraFac)
  
    visibleSpacings = max 0 (Seq.length vchildren - 1)
    totalSpacing = fromIntegral visibleSpacings * childSpacing
  
    (fixed, flex, flexFac, extraFac) = foldl' sumSizes def reqs
    flexAvail = min flex (mainSize - fixed - totalSpacing)
    extraAvail = max 0 (mainSize - fixed - totalSpacing - flexAvail)
  
    -- flexCoeff can only be negative
    flexCoeff
      | flexAvail < flex && flexFac > 0 = (flexAvail - flex) / flexFac
      | otherwise = 0
    extraCoeff
      | extraAvail > 0 && extraFac > 0 = extraAvail / extraFac
      | otherwise = 0
  
    foldHelper (accum, offset, vIndex) child = (newAccum, newOffset, newVIndex) where
      newRect = resizeChild isHorizontal contentArea flexCoeff extraCoeff offset child
      newAccum = accum |> newRect
      newOffset = offset + rectSelector newRect + spacing
      newVIndex = vIndex + if visible then 1 else 0
      spacing = if vIndex < Seq.length vchildren - 1 && visible then childSpacing else 0
      visible = _wniVisible (_wnInfo child)
  
    (areas, usedDim, _) = foldl' foldHelper (Seq.empty, mainStart, 0) children
    result = (areas, usedDim - mainStart)
  
  resizeChild :: Bool -> Rect -> Factor -> Factor -> Double -> WidgetNode s e -> Rect
  resizeChild horizontal contentArea flexCoeff extraCoeff offset child = result where
    Rect l t w h = contentArea
    emptyRect = Rect l t 0 0
    -- Either flex or extra is active (flex is negative or extra is >= 0)
    SizeReq fixed flex extra factor = mainReqSelector horizontal child
  
    tempMainSize = fixed
      + (1 + flexCoeff * factor) * flex
      + extraCoeff * factor * extra
    mainSize = max 0 tempMainSize
  
    hRect = Rect offset t mainSize h
    vRect = Rect l offset w mainSize
    result
      | not $ (_wniVisible . _wnInfo) child = emptyRect
      | horizontal = hRect
      | otherwise = vRect
  
  mainReqSelector :: Bool -> WidgetNode s e -> SizeReq
  mainReqSelector isHorizontal
    | isHorizontal = _wniSizeReqW . _wnInfo
    | otherwise = _wniSizeReqH . _wnInfo
  