{-|
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.
-}
{-# 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 {
  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)