content: {-|
  Module      : Monomer.Widgets.Containers.Grid
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Layout container which distributes space evenly along the main axis. For the
  secondary axis children will receive as much space as available for the grid
  widget itself.
  
  In the same way as with hstack and vstack, 'hgrid' and 'vgrid' can be combined
  to create more complex layouts.
  
  The hgrid widget requests maxWidth * elements as its width, and the max height
  as its height. The inverse happens for vgrid.
  
  @
  hgrid [
      label "Third 1",
      label "Third 2",
      label "Third 3"
    ]
  @
  -}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE Strict #-}
  
  module Monomer.Widgets.Containers.Grid (
    -- * Configuration
    GridCfg,
    -- * Constructors
    hgrid,
    hgrid_,
    vgrid,
    vgrid_
  ) 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 grid:
  
  - 'childSpacing': spacing between the child widgets.
  - 'sizeReqUpdater': allows modifying the 'SizeReq' generated by the grid.
  -}
  data GridCfg = GridCfg {
    _grcChildSpacing :: Maybe Double,
    _grcSizeReqUpdater :: [SizeReqUpdater]
  }
  
  instance Default GridCfg where
    def = GridCfg {
      _grcChildSpacing = Nothing,
      _grcSizeReqUpdater = []
    }
  
  instance Semigroup GridCfg where
    (<>) s1 s2 = GridCfg {
      _grcChildSpacing = _grcChildSpacing s2 <|> _grcChildSpacing s1,
      _grcSizeReqUpdater = _grcSizeReqUpdater s1 <> _grcSizeReqUpdater s2
    }
  
  instance Monoid GridCfg where
    mempty = def
  
  instance CmbChildSpacing GridCfg where
    childSpacing_ spacing = def {
      _grcChildSpacing = Just spacing
    }
  
  instance CmbSizeReqUpdater GridCfg where
    sizeReqUpdater updater = def {
      _grcSizeReqUpdater = [updater]
    }
  
  -- | Creates a grid of items with the same width.
  hgrid
    :: Traversable t
    => t (WidgetNode s e)  -- ^ The list of items.
    -> WidgetNode s e      -- ^ The created grid.
  hgrid children = hgrid_ def children
  
  -- | Creates a grid of items with the same width. Accepts config.
  hgrid_
    :: Traversable t
    => [GridCfg]           -- ^ The config options.
    -> t (WidgetNode s e)  -- ^ The list of items.
    -> WidgetNode s e      -- ^ The created grid.
  hgrid_ configs children = newNode where
    config = mconcat configs
    newNode = defaultWidgetNode "hgrid" (makeFixedGrid True config)
      & L.children .~ foldl' (|>) Empty children
  
  -- | Creates a grid of items with the same height.
  vgrid
    :: Traversable t
    => t (WidgetNode s e)  -- ^ The list of items.
    -> WidgetNode s e      -- ^ The created grid.
  vgrid children = vgrid_ def children
  
  -- | Creates a grid of items with the same height. Accepts config.
  vgrid_
    :: Traversable t
    => [GridCfg]           -- ^ The config options.
    -> t (WidgetNode s e)  -- ^ The list of items.
    -> WidgetNode s e      -- ^ The created grid.
  vgrid_ configs children = newNode where
    config = mconcat configs
    newNode = defaultWidgetNode "vgrid" (makeFixedGrid False config)
      & L.children .~ foldl' (|>) Empty children
  
  makeFixedGrid :: Bool -> GridCfg -> Widget s e
  makeFixedGrid isHorizontal config = widget where
    widget = createContainer () def {
      containerLayoutDirection = getLayoutDirection isHorizontal,
      containerGetSizeReq = getSizeReq,
      containerResize = resize
    }
  
    isVertical = not isHorizontal
    childSpacing = fromMaybe 0 (_grcChildSpacing config)
  
    getSizeReq wenv node children = newSizeReq where
      sizeReqFns = _grcSizeReqUpdater 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 (Seq.replicate nreqs maxSize) & L.fixed %~ (+ totalSpacing)
      | otherwise = maxSize
      where
        vreqs = accessor <$> vchildren
        nreqs = Seq.length vreqs
        ~maxSize = foldl1 sizeReqMergeMax vreqs
        totalSpacing = fromIntegral (nreqs - 1) * childSpacing
  
    resize wenv node viewport children = resized where
      style = currentStyle wenv node
      contentArea = fromMaybe def (removeOuterBounds style viewport)
      Rect l t w h = contentArea
      vchildren = Seq.filter (_wniVisible . _wnInfo) children
  
      totalSpacingW = fromIntegral (max 0 (cols - 1)) * childSpacing
      totalSpacingH = fromIntegral (max 0 (rows - 1)) * childSpacing
  
      cols = if isHorizontal then length vchildren else 1
      rows = if isHorizontal then 1 else length vchildren
  
      cw = if cols > 0 then (w - totalSpacingW) / fromIntegral cols else 0
      ch = if rows > 0 then (h - totalSpacingH) / fromIntegral rows else 0
  
      cx i
        | rows == 0 = 0
        | isHorizontal = l + fromIntegral i * cw + spacingOffset i
        | otherwise = l
      cy i
        | cols == 0 = 0
        | isVertical = t + fromIntegral i * ch + spacingOffset i
        | otherwise = t
      spacingOffset i =
        fromIntegral i * childSpacing
  
      foldHelper (currAreas, index) child = (newAreas, newIndex) where
        (newIndex, newViewport)
          | child ^. L.info . L.visible = (index + 1, calcViewport index)
          | otherwise = (index, def)
        newArea = newViewport
        newAreas = currAreas |> newArea
      calcViewport i = Rect (cx i) (cy i) cw ch
  
      assignedAreas = fst $ foldl' foldHelper (Seq.empty, 0) children
      resized = (resultNode node, assignedAreas)
  