{-|
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.
Filler is used for taking all the unused space between two widgets. Useful for
alignment purposes.

Both adapt to the current layout direction, if any.

Configs:

- width: the max width for spacer, the reference for filler.
- resizeFactor: flexibility to have more or less spaced assigned.
-}
{-# LANGUAGE FlexibleContexts #-}

module Monomer.Widgets.Singles.Spacer (
  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.
data SpacerCfg = SpacerCfg {
  SpacerCfg -> Maybe Double
_spcWidth :: Maybe Double,
  SpacerCfg -> Maybe Double
_spcFactor :: Maybe Double
}

instance Default SpacerCfg where
  def :: SpacerCfg
def = SpacerCfg :: Maybe Double -> Maybe Double -> SpacerCfg
SpacerCfg {
    _spcWidth :: Maybe Double
_spcWidth = Maybe Double
forall a. Maybe a
Nothing,
    _spcFactor :: Maybe Double
_spcFactor = Maybe Double
forall a. Maybe a
Nothing
  }

instance Semigroup SpacerCfg where
  <> :: SpacerCfg -> SpacerCfg -> SpacerCfg
(<>) SpacerCfg
s1 SpacerCfg
s2 = SpacerCfg :: Maybe Double -> Maybe Double -> SpacerCfg
SpacerCfg {
    _spcWidth :: Maybe Double
_spcWidth = SpacerCfg -> Maybe Double
_spcWidth SpacerCfg
s2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SpacerCfg -> Maybe Double
_spcWidth SpacerCfg
s1,
    _spcFactor :: Maybe Double
_spcFactor = SpacerCfg -> Maybe Double
_spcFactor SpacerCfg
s2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SpacerCfg -> Maybe Double
_spcFactor SpacerCfg
s1
  }

instance Monoid SpacerCfg where
  mempty :: SpacerCfg
mempty = SpacerCfg
forall a. Default a => a
def

instance CmbWidth SpacerCfg where
  width :: Double -> SpacerCfg
width Double
w = SpacerCfg
forall a. Default a => a
def {
    _spcWidth :: Maybe Double
_spcWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
  }

instance CmbResizeFactor SpacerCfg where
  resizeFactor :: Double -> SpacerCfg
resizeFactor Double
f = SpacerCfg
forall a. Default a => a
def {
    _spcFactor :: Maybe Double
_spcFactor = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
f
  }

-- | Creates a spacer widget.
spacer :: WidgetNode s e
spacer :: WidgetNode s e
spacer = [SpacerCfg] -> WidgetNode s e
forall s e. [SpacerCfg] -> WidgetNode s e
spacer_ [SpacerCfg]
forall a. Default a => a
def

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

-- | Creates a filler widget.
filler :: WidgetNode s e
filler :: WidgetNode s e
filler = [SpacerCfg] -> WidgetNode s e
forall s e. [SpacerCfg] -> WidgetNode s e
filler_ [SpacerCfg]
forall a. Default a => a
def

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

makeSpacer :: SpacerCfg -> Widget s e
makeSpacer :: SpacerCfg -> Widget s e
makeSpacer SpacerCfg
config = Widget s e
forall s e. Widget s e
widget where
  widget :: Widget s e
widget = () -> Single s e () -> Widget s e
forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle () Single s e ()
forall a. Default a => a
def {
    singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = SingleGetSizeReqHandler s e
forall s p.
HasLayoutDirection s LayoutDirection =>
s -> p -> (SizeReq, SizeReq)
getSizeReq
  }

  getSizeReq :: s -> p -> (SizeReq, SizeReq)
getSizeReq s
wenv p
node = (SizeReq, SizeReq)
sizeReq where
    direction :: LayoutDirection
direction = s
wenv s -> Getting LayoutDirection s LayoutDirection -> LayoutDirection
forall s a. s -> Getting a s a -> a
^. Getting LayoutDirection s LayoutDirection
forall s a. HasLayoutDirection s a => Lens' s a
L.layoutDirection
    factor :: Double
factor = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.5 (SpacerCfg -> Maybe Double
_spcFactor SpacerCfg
config)
    isFixed :: Bool
isFixed = Double
factor Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.01
    width :: Double
width
      | Bool
isFixed = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
10 (SpacerCfg -> Maybe Double
_spcWidth SpacerCfg
config)
      | Bool
otherwise = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
5 (SpacerCfg -> Maybe Double
_spcWidth SpacerCfg
config)

    flexSide :: SizeReq
flexSide = Double -> Double -> SizeReq
flexSize Double
5 Double
0.5
    fixedW :: SizeReq
fixedW = Double -> SizeReq
fixedSize Double
width
    flexW :: SizeReq
flexW = Double -> Double -> SizeReq
flexSize Double
width Double
factor
    expandW :: SizeReq
expandW = Double -> Double -> SizeReq
expandSize Double
width Double
factor

    sizeReq :: (SizeReq, SizeReq)
sizeReq
      | Bool
isFixed Bool -> Bool -> Bool
&& LayoutDirection
direction LayoutDirection -> LayoutDirection -> Bool
forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutNone = (SizeReq
fixedW, SizeReq
fixedW)
      | Bool
isFixed Bool -> Bool -> Bool
&& LayoutDirection
direction LayoutDirection -> LayoutDirection -> Bool
forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutHorizontal = (SizeReq
fixedW, SizeReq
flexSide)
      | Bool
isFixed = (SizeReq
flexSide, SizeReq
fixedW)
      | LayoutDirection
direction LayoutDirection -> LayoutDirection -> Bool
forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutNone = (SizeReq
expandW, SizeReq
expandW)
      | LayoutDirection
direction LayoutDirection -> LayoutDirection -> Bool
forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutHorizontal = (SizeReq
expandW, SizeReq
flexW)
      | Bool
otherwise = (SizeReq
flexW, SizeReq
expandW)