Spacer.hs

{-|
Module      : Monomer.Widgets.Singles.Spacer
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Spacer is used for adding a fixed space between two widgets.

@
hstack [
  label \"Username\",
  spacer,
  label username
]
@

Filler is used for taking all the unused space between two widgets. Useful for
alignment purposes.

@
hstack [
  label "Section title",
  filler,
  button \"Close\" CloseSection
]
@

Both adapt to the active layout direction.
-}
{-# LANGUAGE FlexibleContexts #-}

module Monomer.Widgets.Singles.Spacer (
  --  * Configuration
  SpacerCfg,
  -- * Constructors
  spacer,
  spacer_,
  filler,
  filler_
) where

import Control.Applicative ((<|>))
import Control.Lens ((^.))
import Data.Default
import Data.Maybe
import Data.Tuple

import Monomer.Widgets.Single

import qualified Monomer.Core.Lens as L

{-|
Configuration options for spacer widget:

- 'width': the max width for spacer, the reference for filler.
- 'resizeFactor': flexibility to have more or less spaced assigned.
-}
data SpacerCfg = SpacerCfg {
  _spcWidth :: Maybe Double,
  _spcFactor :: Maybe Double
}

instance Default SpacerCfg where
  def = SpacerCfg {
    _spcWidth = Nothing,
    _spcFactor = Nothing
  }

instance Semigroup SpacerCfg where
  (<>) s1 s2 = SpacerCfg {
    _spcWidth = _spcWidth s2 <|> _spcWidth s1,
    _spcFactor = _spcFactor s2 <|> _spcFactor s1
  }

instance Monoid SpacerCfg where
  mempty = def

instance CmbWidth SpacerCfg where
  width w = def {
    _spcWidth = Just w
  }

instance CmbResizeFactor SpacerCfg where
  resizeFactor f = def {
    _spcFactor = Just f
  }

-- | Creates a spacer widget.
spacer :: WidgetNode s e
spacer = spacer_ def

-- | Creates a spacer widget. Accepts config.
spacer_ :: [SpacerCfg] -> WidgetNode s e
spacer_ configs = defaultWidgetNode "spacer" widget where
  config = mconcat (resizeFactor 0 : configs)
  widget = makeSpacer config

-- | Creates a filler widget.
filler :: WidgetNode s e
filler = filler_ def

-- | Creates a filler widget. Accepts config.
filler_ :: [SpacerCfg] -> WidgetNode s e
filler_ configs = defaultWidgetNode "filler" widget where
  config = mconcat configs
  widget = makeSpacer config

makeSpacer :: SpacerCfg -> Widget s e
makeSpacer config = widget where
  widget = createSingle () def {
    singleGetSizeReq = getSizeReq
  }

  getSizeReq wenv node = sizeReq where
    direction = wenv ^. L.layoutDirection
    factor = fromMaybe 0.5 (_spcFactor config)
    isFixed = factor < 0.01
    width
      | isFixed = fromMaybe 10 (_spcWidth config)
      | otherwise = fromMaybe 5 (_spcWidth config)

    flexSide = flexSize 5 0.5
    fixedW = fixedSize width
    flexW = flexSize width factor
    expandW = expandSize width factor

    sizeReq
      | isFixed && direction == LayoutNone = (fixedW, fixedW)
      | isFixed && direction == LayoutHorizontal = (fixedW, flexSide)
      | isFixed = (flexSide, fixedW)
      | direction == LayoutNone = (expandW, expandW)
      | direction == LayoutHorizontal = (expandW, flexW)
      | otherwise = (flexW, expandW)